TITLE

AUTHOR
Version 
CREATEDATE

Table of Contents

Table of contents

Database Class Index
Database Class List
Here are the classes, structs, unions and interfaces with brief descriptions:
_dirdesc  	pagenum
_REPARSE_DATA_BUFFER  	pagenum
_TABLE  	pagenum
_TimeLocale  	pagenum
AcceptCallback  	pagenum
AccessProc  	pagenum
ActiveCommandTrace  	pagenum
ActiveInterpTrace  	pagenum
ActiveVarTrace  	pagenum
AfterAssocData  	pagenum
AfterInfo  	pagenum
arc  	pagenum
arcbatch  	pagenum
arcp  	pagenum
ArraySearch  	pagenum
AssocData  	pagenum
AsyncHandler  	pagenum
AuxData  	pagenum
AuxDataType  	pagenum
BgError  	pagenum
BuiltinFunc  	pagenum
ByteArray  	pagenum
ByteCode  	pagenum
CallFrame  	pagenum
carc  	pagenum
Cdtor  	pagenum
CfrgHeader  	pagenum
CfrgItem  	pagenum
Channel  	pagenum
ChannelBuffer  	pagenum
ChannelHandler  	pagenum
ChannelHandlerEvent  	pagenum
ChannelState  	pagenum
CharSet  	pagenum
CharSet::Range  	pagenum
CloseCallback  	pagenum
CmdInfo  	pagenum
CmdLocation  	pagenum
CmdTable  	pagenum
cname  	pagenum
cnfa  	pagenum
colordesc  	pagenum
colormap  	pagenum
colors  	pagenum
Command  	pagenum
CommandTrace  	pagenum
CompiledLocal  	pagenum
CompileEnv  	pagenum
CompoundVarTrace  	pagenum
ConsoleEvent  	pagenum
Conversation  	pagenum
CopyState  	pagenum
crange  	pagenum
cvec  	pagenum
ddeEnumServices  	pagenum
DelCmd  	pagenum
Detached  	pagenum
dfa  	pagenum
dirent  	pagenum
dl_info  	pagenum
DNRState  	pagenum
DUMMY_REPARSE_BUFFER  	pagenum
ErrAssocData  	pagenum
EscapeEncodingData  	pagenum
EscapeSubTable  	pagenum
EventScriptRecord  	pagenum
EventSource  	pagenum
ExceptionRange  	pagenum
ExecEnv  	pagenum
ExitHandler  	pagenum
ExitToShellDataStruct  	pagenum
ExitToShellUPPList  	pagenum
Export  	pagenum
ExprInfo  	pagenum
FileEvent  	pagenum
FileHandler  	pagenum
FileHandlerEvent  	pagenum
FileInfo  	pagenum
FileState  	pagenum
FilesystemRecord  	pagenum
fns  	pagenum
ForeachInfo  	pagenum
ForeachVarList  	pagenum
FsDivertLoad  	pagenum
FsPath  	pagenum
GetsState  	pagenum
guts  	pagenum
IdleHandler  	pagenum
ImportedCmdData  	pagenum
ImportRef  	pagenum
IndexRep  	pagenum
InstructionDesc  	pagenum
InteractiveState  	pagenum
Interp  	pagenum
InterpInfo  	pagenum
JumpFixup  	pagenum
JumpFixupArray  	pagenum
Link  	pagenum
List  	pagenum
listEl  	pagenum
LiteralEntry  	pagenum
LiteralTable  	pagenum
LoadedPackage  	pagenum
LocaleTable  	pagenum
Map  	pagenum
Master  	pagenum
MathFunc  	pagenum
Module  	pagenum
MountPointMap  	pagenum
Namespace  	pagenum
NextChannelHandler  	pagenum
nfa  	pagenum
NotifierState  	pagenum
OemId  	pagenum
olddirect  	pagenum
OpenFileChannelProc  	pagenum
OpenResourceFork  	pagenum
Package  	pagenum
ParseInfo  	pagenum
Pipe  	pagenum
PipeEvent  	pagenum
pipeinfo  	pagenum
PipeInfo  	pagenum
PipeState  	pagenum
PkgAvail  	pagenum
PortInfo  	pagenum
Proc  	pagenum
ProcInfo  	pagenum
ptrs  	pagenum
Reference  	pagenum
regex_t  	pagenum
RegisteredInterp  	pagenum
regmatch_t  	pagenum
RegWinProcs  	pagenum
rerr  	pagenum
ResolvedCmdName  	pagenum
ResolverScheme  	pagenum
ResultBuffer  	pagenum
rm_detail_t  	pagenum
SelectMasks  	pagenum
SerialEvent  	pagenum
Slave  	pagenum
smalldfa  	pagenum
SocketEvent  	pagenum
SocketInfo  	pagenum
SortElement  	pagenum
SortInfo  	pagenum
sset  	pagenum
state  	pagenum
StatProc  	pagenum
String  	pagenum
StringTraceData  	pagenum
subre  	pagenum
SyncObjRecord  	pagenum
TableEncodingData  	pagenum
Target  	pagenum
Tcl_CallFrame  	pagenum
Tcl_ChannelType  	pagenum
Tcl_CmdInfo  	pagenum
Tcl_DString  	pagenum
Tcl_DyldLoadHandle  	pagenum
Tcl_DyldModuleHandle  	pagenum
Tcl_EncodingType  	pagenum
Tcl_Event  	pagenum
Tcl_Filesystem  	pagenum
Tcl_GlobTypeData  	pagenum
Tcl_HashEntry  	pagenum
Tcl_HashKeyType  	pagenum
Tcl_HashSearch  	pagenum
Tcl_HashTable  	pagenum
Tcl_Interp  	pagenum
Tcl_Namespace  	pagenum
Tcl_NotifierProcs  	pagenum
Tcl_Obj  	pagenum
Tcl_ObjType  	pagenum
Tcl_Parse  	pagenum
Tcl_RegExpIndices  	pagenum
Tcl_RegExpInfo  	pagenum
Tcl_ResolvedVarInfo  	pagenum
Tcl_ResolverInfo  	pagenum
Tcl_SavedResult  	pagenum
Tcl_Time  	pagenum
Tcl_Token  	pagenum
Tcl_Value  	pagenum
TclDatetoktype  	pagenum
TclEncoding  	pagenum
TclFileAttrProcs  	pagenum
TclIntPlatStubs  	pagenum
TclIntStubs  	pagenum
TclMacLoadInfo  	pagenum
TclMacThrdData  	pagenum
tclOSAComponent  	pagenum
tclOSAContext  	pagenum
tclOSAScript  	pagenum
TclPlatStubs  	pagenum
TclRegexp  	pagenum
TclStubHooks  	pagenum
TclStubs  	pagenum
TclWinProcs  	pagenum
TcpState  	pagenum
TestAsyncHandler  	pagenum
TestEvent  	pagenum
TestString  	pagenum
ThreadSpecificData  	pagenum
TimeInfo  	pagenum
TimerHandler  	pagenum
TMInfo  	pagenum
Trace  	pagenum
TraceCommandInfo  	pagenum
TraceVarInfo  	pagenum
TransformChannelData  	pagenum
tree  	pagenum
Var  	pagenum
vars  	pagenum
VarTrace  	pagenum
WaitInfo  	pagenum
WIN32_FIND_DATAT  	pagenum
WinCondition  	pagenum
YYSTYPE  	pagenum

Database File Index
Database File List
Here is a list of all files with brief descriptions:compat/dirent.h  	pagenum
compat/dirent2.h  	pagenum
compat/dlfcn.h  	pagenum
compat/fixstrtod.c  	pagenum
compat/float.h  	pagenum
compat/gettod.c  	pagenum
compat/limits.h  	pagenum
compat/memcmp.c  	pagenum
compat/opendir.c  	pagenum
compat/stdlib.h  	pagenum
compat/strftime.c  	pagenum
compat/string.h  	pagenum
compat/strncasecmp.c  	pagenum
compat/strstr.c  	pagenum
compat/strtod.c  	pagenum
compat/strtol.c  	pagenum
compat/strtoll.c  	pagenum
compat/strtoul.c  	pagenum
compat/strtoull.c  	pagenum
compat/tclErrno.h  	pagenum
compat/tmpnam.c  	pagenum
compat/unistd.h  	pagenum
compat/waitpid.c  	pagenum
generic/regc_color.c  	pagenum
generic/regc_cvec.c  	pagenum
generic/regc_lex.c  	pagenum
generic/regc_locale.c  	pagenum
generic/regc_nfa.c  	pagenum
generic/regcomp.c  	pagenum
generic/regcustom.h  	pagenum
generic/rege_dfa.c  	pagenum
generic/regerror.c  	pagenum
generic/regerrs.h  	pagenum
generic/regex.h  	pagenum
generic/regexec.c  	pagenum
generic/regfree.c  	pagenum
generic/regfronts.c  	pagenum
generic/regguts.h  	pagenum
generic/tcl.h  	pagenum
generic/tclAlloc.c  	pagenum
generic/tclAsync.c  	pagenum
generic/tclBasic.c  	pagenum
generic/tclBinary.c  	pagenum
generic/tclCkalloc.c  	pagenum
generic/tclClock.c  	pagenum
generic/tclCmdAH.c  	pagenum
generic/tclCmdIL.c  	pagenum
generic/tclCmdMZ.c  	pagenum
generic/tclCompCmds.c  	pagenum
generic/tclCompExpr.c  	pagenum
generic/tclCompile.c  	pagenum
generic/tclCompile.h  	pagenum
generic/tclDate.c  	pagenum
generic/tclDecls.h  	pagenum
generic/tclEncoding.c  	pagenum
generic/tclEnv.c  	pagenum
generic/tclEvent.c  	pagenum
generic/tclExecute.c  	pagenum
generic/tclFCmd.c  	pagenum
generic/tclFileName.c  	pagenum
generic/tclGet.c  	pagenum
generic/tclHash.c  	pagenum
generic/tclHistory.c  	pagenum
generic/tclIndexObj.c  	pagenum
generic/tclInitScript.h  	pagenum
generic/tclInt.h  	pagenum
generic/tclIntDecls.h  	pagenum
generic/tclInterp.c  	pagenum
generic/tclIntPlatDecls.h  	pagenum
generic/tclIO.c  	pagenum
generic/tclIO.h  	pagenum
generic/tclIOCmd.c  	pagenum
generic/tclIOGT.c  	pagenum
generic/tclIOSock.c  	pagenum
generic/tclIOUtil.c  	pagenum
generic/tclLink.c  	pagenum
generic/tclListObj.c  	pagenum
generic/tclLiteral.c  	pagenum
generic/tclLoad.c  	pagenum
generic/tclLoadNone.c  	pagenum
generic/tclMain.c  	pagenum
generic/tclMath.h  	pagenum
generic/tclNamesp.c  	pagenum
generic/tclNotify.c  	pagenum
generic/tclObj.c  	pagenum
generic/tclPanic.c  	pagenum
generic/tclParse.c  	pagenum
generic/tclParseExpr.c  	pagenum
generic/tclPipe.c  	pagenum
generic/tclPkg.c  	pagenum
generic/tclPlatDecls.h  	pagenum
generic/tclPort.h  	pagenum
generic/tclPosixStr.c  	pagenum
generic/tclPreserve.c  	pagenum
generic/tclProc.c  	pagenum
generic/tclRegexp.c  	pagenum
generic/tclRegexp.h  	pagenum
generic/tclResolve.c  	pagenum
generic/tclResult.c  	pagenum
generic/tclScan.c  	pagenum
generic/tclStringObj.c  	pagenum
generic/tclStubInit.c  	pagenum
generic/tclStubLib.c  	pagenum
generic/tclTest.c  	pagenum
generic/tclTestObj.c  	pagenum
generic/tclTestProcBodyObj.c  	pagenum
generic/tclThread.c  	pagenum
generic/tclThreadAlloc.c  	pagenum
generic/tclThreadJoin.c  	pagenum
generic/tclThreadTest.c  	pagenum
generic/tclTimer.c  	pagenum
generic/tclUniData.c  	pagenum
generic/tclUtf.c  	pagenum
generic/tclUtil.c  	pagenum
generic/tclVar.c  	pagenum
mac/MW_TclAppleScriptHeader.h  	pagenum
mac/MW_TclBuildLibHeader.h  	pagenum
mac/MW_TclHeader.h  	pagenum
mac/MW_TclHeaderCommon.h  	pagenum
mac/MW_TclStaticHeader.h  	pagenum
mac/MW_TclTestHeader.h  	pagenum
mac/tclMac.h  	pagenum
mac/tclMacAlloc.c  	pagenum
mac/tclMacAppInit.c  	pagenum
mac/tclMacBOAAppInit.c  	pagenum
mac/tclMacBOAMain.c  	pagenum
mac/tclMacChan.c  	pagenum
mac/tclMacCommonPch.h  	pagenum
mac/tclMacDNR.c  	pagenum
mac/tclMacEnv.c  	pagenum
mac/tclMacExit.c  	pagenum
mac/tclMacFCmd.c  	pagenum
mac/tclMacFile.c  	pagenum
mac/tclMacInit.c  	pagenum
mac/tclMacInt.h  	pagenum
mac/tclMacInterupt.c  	pagenum
mac/tclMacLibrary.c  	pagenum
mac/tclMacLoad.c  	pagenum
mac/tclMacMath.h  	pagenum
mac/tclMacNotify.c  	pagenum
mac/tclMacOSA.c  	pagenum
mac/tclMacPanic.c  	pagenum
mac/tclMacPort.h  	pagenum
mac/tclMacResource.c  	pagenum
mac/tclMacSock.c  	pagenum
mac/tclMacTest.c  	pagenum
mac/tclMacThrd.c  	pagenum
mac/tclMacThrd.h  	pagenum
mac/tclMacTime.c  	pagenum
mac/tclMacUnix.c  	pagenum
mac/tclMacUtil.c  	pagenum
macosx/tclMacOSXBundle.c  	pagenum
macosx/tclMacOSXNotify.c  	pagenum
tools/man2tcl.c  	pagenum
unix/tclAppInit.c  	pagenum
unix/tclLoadAix.c  	pagenum
unix/tclLoadAout.c  	pagenum
unix/tclLoadDl.c  	pagenum
unix/tclLoadDld.c  	pagenum
unix/tclLoadDyld.c  	pagenum
unix/tclLoadNext.c  	pagenum
unix/tclLoadOSF.c  	pagenum
unix/tclLoadShl.c  	pagenum
unix/tclUnixChan.c  	pagenum
unix/tclUnixCompat.c  	pagenum
unix/tclUnixEvent.c  	pagenum
unix/tclUnixFCmd.c  	pagenum
unix/tclUnixFile.c  	pagenum
unix/tclUnixInit.c  	pagenum
unix/tclUnixNotfy.c  	pagenum
unix/tclUnixPipe.c  	pagenum
unix/tclUnixPort.h  	pagenum
unix/tclUnixSock.c  	pagenum
unix/tclUnixTest.c  	pagenum
unix/tclUnixThrd.c  	pagenum
unix/tclUnixThrd.h  	pagenum
unix/tclUnixTime.c  	pagenum
unix/tclXtNotify.c  	pagenum
unix/tclXtTest.c  	pagenum
unix/dltest/pkga.c  	pagenum
unix/dltest/pkgb.c  	pagenum
unix/dltest/pkgc.c  	pagenum
unix/dltest/pkgd.c  	pagenum
unix/dltest/pkge.c  	pagenum
unix/dltest/pkgf.c  	pagenum
win/cat.c  	pagenum
win/nmakehlp.c  	pagenum
win/stub16.c  	pagenum
win/tclAppInit.c  	pagenum
win/tclWin32Dll.c  	pagenum
win/tclWinChan.c  	pagenum
win/tclWinConsole.c  	pagenum
win/tclWinDde.c  	pagenum
win/tclWinError.c  	pagenum
win/tclWinFCmd.c  	pagenum
win/tclWinFile.c  	pagenum
win/tclWinInit.c  	pagenum
win/tclWinInt.h  	pagenum
win/tclWinLoad.c  	pagenum
win/tclWinMtherr.c  	pagenum
win/tclWinNotify.c  	pagenum
win/tclWinPipe.c  	pagenum
win/tclWinPort.h  	pagenum
win/tclWinReg.c  	pagenum
win/tclWinSerial.c  	pagenum
win/tclWinSock.c  	pagenum
win/tclWinTest.c  	pagenum
win/tclWinThrd.c  	pagenum
win/tclWinThrd.h  	pagenum
win/tclWinTime.c  	pagenum

Database Class Documentation
_dirdesc Struct Reference
#include <dirent2.h>

Detailed Description

Definition at line 44 of file dirent2.h.Public Attributes
int dd_fd
long dd_loc
long dd_size
char dd_buf [DIRBLKSIZ]

Member Data Documentation
char _dirdesc::dd_buf[DIRBLKSIZ]

Definition at line 48 of file dirent2.h.int _dirdesc::dd_fd

Definition at line 45 of file dirent2.h.
Referenced by opendir().long _dirdesc::dd_loc

Definition at line 46 of file dirent2.h.
Referenced by opendir().long _dirdesc::dd_size

Definition at line 47 of file dirent2.h.
The documentation for this struct was generated from the following file:
compat/dirent2.h

_REPARSE_DATA_BUFFER Struct Reference

Detailed Description

Definition at line 110 of file tclWinFile.c.Public Attributes
DWORD ReparseTag
WORD ReparseDataLength
WORD Reserved
union {
  struct {
    WORD SubstituteNameOffset
    WORD SubstituteNameLength
    WORD PrintNameOffset
    WORD PrintNameLength
    WCHAR PathBuffer [1]
  } SymbolicLinkReparseBuffer
  struct {
    WORD SubstituteNameOffset
    WORD SubstituteNameLength
    WORD PrintNameOffset
    WORD PrintNameLength
    WCHAR PathBuffer [1]
  } MountPointReparseBuffer
  struct {
    BYTE DataBuffer [1]
  } GenericReparseBuffer
}; 

Member Data Documentation
union { ... } 
BYTE _REPARSE_DATA_BUFFER::DataBuffer[1]

Definition at line 130 of file tclWinFile.c.struct { ... }   _REPARSE_DATA_BUFFER::GenericReparseBuffer
struct { ... }   _REPARSE_DATA_BUFFER::MountPointReparseBuffer
WCHAR _REPARSE_DATA_BUFFER::PathBuffer[1]

Definition at line 120 of file tclWinFile.c.
Referenced by WinReadLinkDirectory().WORD _REPARSE_DATA_BUFFER::PrintNameLength

Definition at line 119 of file tclWinFile.c.WORD _REPARSE_DATA_BUFFER::PrintNameOffset

Definition at line 118 of file tclWinFile.c.WORD _REPARSE_DATA_BUFFER::ReparseDataLength

Definition at line 112 of file tclWinFile.c.
Referenced by NativeWriteReparse(), and WinSymLinkDirectory().DWORD _REPARSE_DATA_BUFFER::ReparseTag

Definition at line 111 of file tclWinFile.c.
Referenced by NativeReadReparse(), TclWinSymLinkDelete(), WinReadLinkDirectory(), and WinSymLinkDirectory().WORD _REPARSE_DATA_BUFFER::Reserved

Definition at line 113 of file tclWinFile.c.
Referenced by WinSymLinkDirectory().WORD _REPARSE_DATA_BUFFER::SubstituteNameLength

Definition at line 117 of file tclWinFile.c.WORD _REPARSE_DATA_BUFFER::SubstituteNameOffset

Definition at line 116 of file tclWinFile.c.struct { ... }   _REPARSE_DATA_BUFFER::SymbolicLinkReparseBuffer

Referenced by WinReadLinkDirectory(), and WinSymLinkDirectory().
The documentation for this struct was generated from the following file:
win/tclWinFile.c

_TABLE Struct Reference

Detailed Description

Definition at line 45 of file tclDate.c.Public Attributes
char * name
int type
time_t value

Member Data Documentation
char* _TABLE::name

Definition at line 46 of file tclDate.c.
Referenced by LookupWord(), and TclpGetTZName().int _TABLE::type

Definition at line 47 of file tclDate.c.
Referenced by LookupWord(), and TclpGetTZName().time_t _TABLE::value

Definition at line 48 of file tclDate.c.
Referenced by LookupWord(), and TclpGetTZName().
The documentation for this struct was generated from the following file:
generic/tclDate.c

_TimeLocale Struct Reference

Detailed Description

Definition at line 62 of file strftime.c.Public Attributes
const char * abday [7]
const char * day [7]
const char * abmon [12]
const char * mon [12]
const char * am_pm [2]
const char * d_t_fmt
const char * d_fmt
const char * t_fmt
const char * t_fmt_ampm

Member Data Documentation
const char* _TimeLocale::abday[7]

Definition at line 63 of file strftime.c.
Referenced by _fmt().const char* _TimeLocale::abmon[12]

Definition at line 65 of file strftime.c.
Referenced by _fmt().const char* _TimeLocale::am_pm[2]

Definition at line 67 of file strftime.c.
Referenced by _fmt().const char* _TimeLocale::d_fmt

Definition at line 69 of file strftime.c.
Referenced by _fmt().const char* _TimeLocale::d_t_fmt

Definition at line 68 of file strftime.c.
Referenced by _fmt().const char* _TimeLocale::day[7]

Definition at line 64 of file strftime.c.
Referenced by _fmt().const char* _TimeLocale::mon[12]

Definition at line 66 of file strftime.c.
Referenced by _fmt().const char* _TimeLocale::t_fmt

Definition at line 70 of file strftime.c.
Referenced by _fmt().const char* _TimeLocale::t_fmt_ampm

Definition at line 71 of file strftime.c.
Referenced by _fmt().
The documentation for this struct was generated from the following file:
compat/strftime.c

AcceptCallback Struct Reference

Detailed Description

Definition at line 21 of file tclIOCmd.c.Public Attributes
char * script
Tcl_Interp * interp

Member Data Documentation
Tcl_Interp* AcceptCallback::interp

Definition at line 23 of file tclIOCmd.c.
Referenced by AcceptCallbackProc(), Tcl_SocketObjCmd(), TcpAcceptCallbacksDeleteProc(), and TcpServerCloseProc().char* AcceptCallback::script

Definition at line 22 of file tclIOCmd.c.
Referenced by AcceptCallbackProc(), Tcl_SocketObjCmd(), and TcpServerCloseProc().
The documentation for this struct was generated from the following file:
generic/tclIOCmd.c

AccessProc Struct Reference

Detailed Description

Definition at line 325 of file tclIOUtil.c.Public Attributes
TclAccessProc_ * proc
AccessProc * nextPtr

Member Data Documentation
struct AccessProc* AccessProc::nextPtr

Definition at line 327 of file tclIOUtil.c.
Referenced by Tcl_FSAccess(), TclAccessDeleteProc(), and TclAccessInsertProc().TclAccessProc_* AccessProc::proc

Definition at line 326 of file tclIOUtil.c.
Referenced by Tcl_FSAccess(), TclAccessDeleteProc(), and TclAccessInsertProc().
The documentation for this struct was generated from the following file:
generic/tclIOUtil.c

ActiveCommandTrace Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 346 of file tclInt.h.Public Attributes
Command * cmdPtr
ActiveCommandTrace * nextPtr
CommandTrace * nextTracePtr
int reverseScan

Member Data Documentation
struct Command* ActiveCommandTrace::cmdPtr

Definition at line 347 of file tclInt.h.
Referenced by CallCommandTraces(), and TclCheckExecutionTraces().struct ActiveCommandTrace* ActiveCommandTrace::nextPtr

Definition at line 348 of file tclInt.h.
Referenced by CallCommandTraces(), Tcl_UntraceCommand(), and TclCheckExecutionTraces().CommandTrace* ActiveCommandTrace::nextTracePtr

Definition at line 352 of file tclInt.h.
Referenced by CallCommandTraces(), Tcl_UntraceCommand(), and TclCheckExecutionTraces().int ActiveCommandTrace::reverseScan

Definition at line 356 of file tclInt.h.
Referenced by CallCommandTraces(), Tcl_UntraceCommand(), and TclCheckExecutionTraces().
The documentation for this struct was generated from the following file:
generic/tclInt.h

ActiveInterpTrace Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 722 of file tclInt.h.Public Attributes
ActiveInterpTrace * nextPtr
Trace * nextTracePtr
int reverseScan

Member Data Documentation
struct ActiveInterpTrace* ActiveInterpTrace::nextPtr

Definition at line 723 of file tclInt.h.
Referenced by Tcl_DeleteTrace(), and TclCheckInterpTraces().Trace* ActiveInterpTrace::nextTracePtr

Definition at line 727 of file tclInt.h.
Referenced by Tcl_DeleteTrace(), and TclCheckInterpTraces().int ActiveInterpTrace::reverseScan

Definition at line 731 of file tclInt.h.
Referenced by Tcl_DeleteTrace(), and TclCheckInterpTraces().
The documentation for this struct was generated from the following file:
generic/tclInt.h

ActiveVarTrace Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 368 of file tclInt.h.Public Attributes
Var * varPtr
ActiveVarTrace * nextPtr
VarTrace * nextTracePtr

Member Data Documentation
struct ActiveVarTrace* ActiveVarTrace::nextPtr

Definition at line 370 of file tclInt.h.
Referenced by CallVarTraces(), DeleteArray(), Tcl_UntraceVar2(), TclDeleteVars(), and UnsetVarStruct().VarTrace* ActiveVarTrace::nextTracePtr

Definition at line 374 of file tclInt.h.
Referenced by CallVarTraces(), DeleteArray(), Tcl_UntraceVar2(), TclDeleteVars(), and UnsetVarStruct().struct Var* ActiveVarTrace::varPtr

Definition at line 369 of file tclInt.h.
Referenced by CallVarTraces(), DeleteArray(), TclDeleteVars(), and UnsetVarStruct().
The documentation for this struct was generated from the following file:
generic/tclInt.h

AfterAssocData Struct Reference

Detailed Description

Definition at line 64 of file tclTimer.c.Public Attributes
Tcl_Interp * interp
AfterInfo * firstAfterPtr

Member Data Documentation
AfterInfo* AfterAssocData::firstAfterPtr

Definition at line 67 of file tclTimer.c.
Referenced by AfterCleanupProc(), AfterProc(), FreeAfterPtr(), and Tcl_AfterObjCmd().Tcl_Interp* AfterAssocData::interp

Definition at line 65 of file tclTimer.c.
Referenced by AfterProc(), and Tcl_AfterObjCmd().
The documentation for this struct was generated from the following file:
generic/tclTimer.c

AfterInfo Struct Reference

Detailed Description

Definition at line 40 of file tclTimer.c.Public Attributes
AfterAssocData * assocPtr
Tcl_Obj * commandPtr
int id
Tcl_TimerToken token
AfterInfo * nextPtr

Member Data Documentation
struct AfterAssocData* AfterInfo::assocPtr

Definition at line 41 of file tclTimer.c.
Referenced by AfterProc(), and Tcl_AfterObjCmd().Tcl_Obj* AfterInfo::commandPtr

Definition at line 45 of file tclTimer.c.
Referenced by AfterCleanupProc(), AfterProc(), and Tcl_AfterObjCmd().int AfterInfo::id

Definition at line 46 of file tclTimer.c.
Referenced by GetAfterEvent(), and Tcl_AfterObjCmd().struct AfterInfo* AfterInfo::nextPtr

Definition at line 54 of file tclTimer.c.
Referenced by AfterCleanupProc(), AfterProc(), FreeAfterPtr(), GetAfterEvent(), and Tcl_AfterObjCmd().Tcl_TimerToken AfterInfo::token

Definition at line 48 of file tclTimer.c.
Referenced by AfterCleanupProc(), and Tcl_AfterObjCmd().
The documentation for this struct was generated from the following file:
generic/tclTimer.c

arc Struct Reference
#include <regguts.h>

Detailed Description

Definition at line 283 of file regguts.h.Public Attributes
int type
color co
state * from
state * to
arc * outchain
arc * inchain
arc * colorchain

Member Data Documentation
color arc::co

Definition at line 286 of file regguts.h.
Referenced by cbracket(), cloneouts(), colorchain(), combine(), compact(), cparc(), dovec(), findarc(), makesearch(), newarc(), okcolors(), pullback(), pushfwd(), singleton(), and uncolorchain().struct arc* arc::colorchain

Definition at line 292 of file regguts.h.
Referenced by colorchain(), okcolors(), and uncolorchain().struct state* arc::from

Definition at line 287 of file regguts.h.
Referenced by cloneouts(), copyins(), cparc(), dovec(), freearc(), makesearch(), markcanreach(), moveins(), newarc(), okcolors(), pull(), pullback(), push(), pushfwd(), and unempty().struct arc* arc::inchain

Definition at line 291 of file regguts.h.
Referenced by copyins(), freearc(), makesearch(), markcanreach(), newarc(), pull(), and pushfwd().struct arc* arc::outchain

Definition at line 289 of file regguts.h.
Referenced by analyze(), cbracket(), cleartraverse(), cloneouts(), compact(), copyouts(), duptraverse(), findarc(), fixempties(), freearc(), makesearch(), markreachable(), newarc(), pullback(), and push().struct state* arc::to

Definition at line 288 of file regguts.h.
Referenced by analyze(), cbracket(), cleartraverse(), cloneouts(), compact(), copyouts(), cparc(), deltraverse(), dovec(), duptraverse(), freearc(), leaders(), makesearch(), markreachable(), moveouts(), newarc(), okcolors(), pull(), pullback(), push(), pushfwd(), and unempty().int arc::type

Definition at line 284 of file regguts.h.
Referenced by allocarc(), combine(), compact(), cparc(), findarc(), fixempties(), freearc(), makesearch(), newarc(), okcolors(), pullback(), pushfwd(), and unempty().
The documentation for this struct was generated from the following file:
generic/regguts.h

arcbatch Struct Reference
#include <regguts.h>

Detailed Description

Definition at line 295 of file regguts.h.Public Attributes
arcbatch * next
arc a [ABSIZE]

Member Data Documentation
struct arc arcbatch::a[ABSIZE]

Definition at line 298 of file regguts.h.
Referenced by allocarc().struct arcbatch* arcbatch::next

Definition at line 296 of file regguts.h.
Referenced by allocarc(), destroystate(), and newstate().
The documentation for this struct was generated from the following file:
generic/regguts.h

arcp Struct Reference

Detailed Description

Definition at line 37 of file regexec.c.Public Attributes
sset * ss
color co

Member Data Documentation
color arcp::co

Definition at line 39 of file regexec.c.
Referenced by getvacant(), and pickss().struct sset* arcp::ss

Definition at line 38 of file regexec.c.
Referenced by getvacant(), and pickss().
The documentation for this struct was generated from the following file:
generic/regexec.c

ArraySearch Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 386 of file tclInt.h.Public Attributes
int id
Var * varPtr
Tcl_HashSearch search
Tcl_HashEntry * nextEntry
ArraySearch * nextPtr

Member Data Documentation
int ArraySearch::id

Definition at line 387 of file tclInt.h.
Referenced by ParseSearchId(), and Tcl_ArrayObjCmd().Tcl_HashEntry* ArraySearch::nextEntry

Definition at line 394 of file tclInt.h.
Referenced by Tcl_ArrayObjCmd().struct ArraySearch* ArraySearch::nextPtr

Definition at line 400 of file tclInt.h.
Referenced by DeleteSearches(), ParseSearchId(), and Tcl_ArrayObjCmd().Tcl_HashSearch ArraySearch::search

Definition at line 392 of file tclInt.h.
Referenced by Tcl_ArrayObjCmd().struct Var* ArraySearch::varPtr

Definition at line 390 of file tclInt.h.
Referenced by Tcl_ArrayObjCmd().
The documentation for this struct was generated from the following file:
generic/tclInt.h

AssocData Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 742 of file tclInt.h.Public Attributes
Tcl_InterpDeleteProc * proc
ClientData clientData

Member Data Documentation
ClientData AssocData::clientData

Definition at line 744 of file tclInt.h.
Referenced by DeleteInterpProc(), Tcl_CallWhenDeleted(), Tcl_DeleteAssocData(), Tcl_DontCallWhenDeleted(), Tcl_GetAssocData(), and Tcl_SetAssocData().Tcl_InterpDeleteProc* AssocData::proc

Definition at line 743 of file tclInt.h.
Referenced by DeleteInterpProc(), Tcl_CallWhenDeleted(), Tcl_DeleteAssocData(), Tcl_DontCallWhenDeleted(), Tcl_GetAssocData(), and Tcl_SetAssocData().
The documentation for this struct was generated from the following file:
generic/tclInt.h

AsyncHandler Struct Reference

Detailed Description

Definition at line 29 of file tclAsync.c.Public Attributes
int ready
AsyncHandler * nextPtr
Tcl_AsyncProc * proc
ClientData clientData
ThreadSpecificData * originTsd
Tcl_ThreadId originThrdId

Member Data Documentation
ClientData AsyncHandler::clientData

Definition at line 37 of file tclAsync.c.
Referenced by Tcl_AsyncCreate(), and Tcl_AsyncInvoke().struct AsyncHandler* AsyncHandler::nextPtr

Definition at line 33 of file tclAsync.c.
Referenced by Tcl_AsyncCreate(), Tcl_AsyncDelete(), and Tcl_AsyncInvoke().Tcl_ThreadId AsyncHandler::originThrdId

Definition at line 43 of file tclAsync.c.
Referenced by Tcl_AsyncCreate(), and Tcl_AsyncMark().struct ThreadSpecificData* AsyncHandler::originTsd

Definition at line 39 of file tclAsync.c.
Referenced by Tcl_AsyncCreate(), and Tcl_AsyncMark().Tcl_AsyncProc* AsyncHandler::proc

Definition at line 35 of file tclAsync.c.
Referenced by Tcl_AsyncCreate(), and Tcl_AsyncInvoke().int AsyncHandler::ready

Definition at line 30 of file tclAsync.c.
Referenced by Tcl_AsyncCreate(), Tcl_AsyncInvoke(), and Tcl_AsyncMark().
The documentation for this struct was generated from the following file:
generic/tclAsync.c

AuxData Struct Reference
#include <tclCompile.h>

Detailed Description

Definition at line 170 of file tclCompile.h.Public Attributes
AuxDataType * type
ClientData clientData

Member Data Documentation
ClientData AuxData::clientData

Definition at line 173 of file tclCompile.h.
Referenced by Tcl_ExprObj(), TclCreateAuxData(), TclExecuteByteCode(), and TclSetByteCodeFromAny().AuxDataType* AuxData::type

Definition at line 171 of file tclCompile.h.
Referenced by Tcl_ExprObj(), TclCreateAuxData(), and TclSetByteCodeFromAny().
The documentation for this struct was generated from the following file:
generic/tclCompile.h

AuxDataType Struct Reference
#include <tclCompile.h>

Detailed Description

Definition at line 150 of file tclCompile.h.Public Attributes
char * name
AuxDataDupProc * dupProc
AuxDataFreeProc * freeProc

Member Data Documentation
AuxDataDupProc* AuxDataType::dupProc

Definition at line 153 of file tclCompile.h.AuxDataFreeProc* AuxDataType::freeProc

Definition at line 159 of file tclCompile.h.
Referenced by Tcl_ExprObj(), and TclSetByteCodeFromAny().char* AuxDataType::name

Definition at line 151 of file tclCompile.h.
The documentation for this struct was generated from the following file:
generic/tclCompile.h

BgError Struct Reference

Detailed Description

Definition at line 27 of file tclEvent.c.Public Attributes
Tcl_Interp * interp
char * errorMsg
char * errorInfo
char * errorCode
BgError * nextPtr

Member Data Documentation
char* BgError::errorCode

Definition at line 36 of file tclEvent.c.
Referenced by BgErrorDeleteProc(), and Tcl_BackgroundError().char* BgError::errorInfo

Definition at line 34 of file tclEvent.c.
Referenced by BgErrorDeleteProc(), and Tcl_BackgroundError().char* BgError::errorMsg

Definition at line 31 of file tclEvent.c.
Referenced by BgErrorDeleteProc(), and Tcl_BackgroundError().Tcl_Interp* BgError::interp

Definition at line 28 of file tclEvent.c.
Referenced by HandleBgErrors(), and Tcl_BackgroundError().struct BgError* BgError::nextPtr

Definition at line 38 of file tclEvent.c.
Referenced by BgErrorDeleteProc(), HandleBgErrors(), and Tcl_BackgroundError().
The documentation for this struct was generated from the following file:
generic/tclEvent.c

BuiltinFunc Struct Reference
#include <tclCompile.h>

Detailed Description

Definition at line 609 of file tclCompile.h.Public Attributes
char * name
int numArgs
Tcl_ValueType argTypes [MAX_MATH_ARGS]
CallBuiltinFuncProc * proc
ClientData clientData

Member Data Documentation
Tcl_ValueType BuiltinFunc::argTypes[MAX_MATH_ARGS]

Definition at line 612 of file tclCompile.h.ClientData BuiltinFunc::clientData

Definition at line 615 of file tclCompile.h.
Referenced by TclExecuteByteCode().char* BuiltinFunc::name

Definition at line 610 of file tclCompile.h.int BuiltinFunc::numArgs

Definition at line 611 of file tclCompile.h.CallBuiltinFuncProc* BuiltinFunc::proc

Definition at line 614 of file tclCompile.h.
Referenced by TclExecuteByteCode().
The documentation for this struct was generated from the following file:
generic/tclCompile.h

ByteArray Struct Reference

Detailed Description

Definition at line 109 of file tclBinary.c.Public Attributes
int used
int allocated
unsigned char bytes [4]

Member Data Documentation
int ByteArray::allocated

Definition at line 112 of file tclBinary.c.
Referenced by DupByteArrayInternalRep(), SetByteArrayFromAny(), Tcl_SetByteArrayLength(), and Tcl_SetByteArrayObj().unsigned char ByteArray::bytes[4]

Definition at line 114 of file tclBinary.c.
Referenced by DupByteArrayInternalRep(), SetByteArrayFromAny(), Tcl_GetByteArrayFromObj(), Tcl_SetByteArrayLength(), Tcl_SetByteArrayObj(), and UpdateStringOfByteArray().int ByteArray::used

Definition at line 110 of file tclBinary.c.
Referenced by DupByteArrayInternalRep(), SetByteArrayFromAny(), Tcl_GetByteArrayFromObj(), Tcl_SetByteArrayLength(), Tcl_SetByteArrayObj(), and UpdateStringOfByteArray().
The documentation for this struct was generated from the following file:
generic/tclBinary.c

ByteCode Struct Reference
#include <tclCompile.h>

Detailed Description

Definition at line 283 of file tclCompile.h.Public Attributes
TclHandle interpHandle
int compileEpoch
Namespace * nsPtr
int nsEpoch
int refCount
unsigned int flags
char * source
Proc * procPtr
size_t structureSize
int numCommands
int numSrcBytes
int numCodeBytes
int numLitObjects
int numExceptRanges
int numAuxDataItems
int numCmdLocBytes
int maxExceptDepth
int maxStackDepth
unsigned char * codeStart
Tcl_Obj ** objArrayPtr
ExceptionRange * exceptArrayPtr
AuxData * auxDataArrayPtr
unsigned char * codeDeltaStart
unsigned char * codeLengthStart
unsigned char * srcDeltaStart
unsigned char * srcLengthStart

Member Data Documentation
AuxData* ByteCode::auxDataArrayPtr

Definition at line 343 of file tclCompile.h.
Referenced by TclExecuteByteCode(), and TclInitByteCodeObj().unsigned char* ByteCode::codeDeltaStart

Definition at line 346 of file tclCompile.h.
Referenced by EncodeCmdLocMap(), and GetSrcInfoForPc().unsigned char* ByteCode::codeLengthStart

Definition at line 356 of file tclCompile.h.
Referenced by EncodeCmdLocMap(), and GetSrcInfoForPc().unsigned char* ByteCode::codeStart

Definition at line 333 of file tclCompile.h.
Referenced by GetExceptRangeForPc(), GetSrcInfoForPc(), TclExecuteByteCode(), and TclInitByteCodeObj().int ByteCode::compileEpoch

Definition at line 289 of file tclCompile.h.
Referenced by ProcCompileProc(), Tcl_ExprObj(), TclCompEvalObj(), and TclInitByteCodeObj().ExceptionRange* ByteCode::exceptArrayPtr

Definition at line 339 of file tclCompile.h.
Referenced by GetExceptRangeForPc(), and TclInitByteCodeObj().unsigned int ByteCode::flags

Definition at line 305 of file tclCompile.h.
Referenced by ProcCompileProc(), Tcl_ExprObj(), TclCompEvalObj(), and TclInitByteCodeObj().TclHandle ByteCode::interpHandle

Definition at line 284 of file tclCompile.h.
Referenced by ProcCompileProc(), Tcl_ExprObj(), TclCompEvalObj(), and TclInitByteCodeObj().int ByteCode::maxExceptDepth

Definition at line 329 of file tclCompile.h.
Referenced by TclExecuteByteCode(), and TclInitByteCodeObj().int ByteCode::maxStackDepth

Definition at line 331 of file tclCompile.h.
Referenced by TclExecuteByteCode(), and TclInitByteCodeObj().int ByteCode::nsEpoch

Definition at line 297 of file tclCompile.h.
Referenced by TclCompEvalObj(), and TclInitByteCodeObj().Namespace* ByteCode::nsPtr

Definition at line 293 of file tclCompile.h.
Referenced by ProcCompileProc(), TclCompEvalObj(), and TclInitByteCodeObj().int ByteCode::numAuxDataItems

Definition at line 326 of file tclCompile.h.
Referenced by TclInitByteCodeObj().int ByteCode::numCmdLocBytes

Definition at line 327 of file tclCompile.h.
Referenced by TclInitByteCodeObj().int ByteCode::numCodeBytes

Definition at line 323 of file tclCompile.h.
Referenced by GetSrcInfoForPc(), and TclInitByteCodeObj().int ByteCode::numCommands

Definition at line 321 of file tclCompile.h.
Referenced by GetSrcInfoForPc(), and TclInitByteCodeObj().int ByteCode::numExceptRanges

Definition at line 325 of file tclCompile.h.
Referenced by GetExceptRangeForPc(), and TclInitByteCodeObj().int ByteCode::numLitObjects

Definition at line 324 of file tclCompile.h.
Referenced by TclInitByteCodeObj(), and TclReleaseLiteral().int ByteCode::numSrcBytes

Definition at line 322 of file tclCompile.h.
Referenced by TclCompEvalObj(), and TclInitByteCodeObj().Tcl_Obj** ByteCode::objArrayPtr

Definition at line 336 of file tclCompile.h.
Referenced by TclExecuteByteCode(), TclInitByteCodeObj(), and TclReleaseLiteral().Proc* ByteCode::procPtr

Definition at line 312 of file tclCompile.h.
Referenced by TclCompEvalObj(), and TclInitByteCodeObj().int ByteCode::refCount

Definition at line 301 of file tclCompile.h.
Referenced by FreeByteCodeInternalRep(), TclCompEvalObj(), and TclInitByteCodeObj().char* ByteCode::source

Definition at line 308 of file tclCompile.h.
Referenced by GetSrcInfoForPc(), TclExecuteByteCode(), and TclInitByteCodeObj().unsigned char* ByteCode::srcDeltaStart

Definition at line 364 of file tclCompile.h.
Referenced by EncodeCmdLocMap(), and GetSrcInfoForPc().unsigned char* ByteCode::srcLengthStart

Definition at line 372 of file tclCompile.h.
Referenced by EncodeCmdLocMap(), and GetSrcInfoForPc().size_t ByteCode::structureSize

Definition at line 317 of file tclCompile.h.
Referenced by TclInitByteCodeObj().
The documentation for this struct was generated from the following file:
generic/tclCompile.h

CallFrame Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 761 of file tclInt.h.Public Attributes
Namespace * nsPtr
int isProcCallFrame
int objc
Tcl_Obj *CONST * objv
CallFrame * callerPtr
CallFrame * callerVarPtr
int level
Proc * procPtr
Tcl_HashTable * varTablePtr
int numCompiledLocals
Var * compiledLocals

Member Data Documentation
struct CallFrame* CallFrame::callerPtr

Definition at line 774 of file tclInt.h.
Referenced by Tcl_PopCallFrame(), and Tcl_PushCallFrame().struct CallFrame* CallFrame::callerVarPtr

Definition at line 778 of file tclInt.h.
Referenced by InfoLevelCmd(), Tcl_PopCallFrame(), Tcl_PushCallFrame(), and TclGetFrame().Var* CallFrame::compiledLocals

Definition at line 801 of file tclInt.h.
Referenced by AppendLocals(), ObjMakeUpvar(), Tcl_PushCallFrame(), TclDeleteCompiledLocalVars(), TclExecuteByteCode(), TclInitCompiledLocals(), TclLookupSimpleVar(), and TclObjLookupVar().int CallFrame::isProcCallFrame

Definition at line 764 of file tclInt.h.
Referenced by InfoLocalsCmd(), InfoVarsCmd(), ObjMakeUpvar(), Tcl_GlobalObjCmd(), Tcl_PushCallFrame(), Tcl_VariableObjCmd(), TclLookupSimpleVar(), and TclObjLookupVar().int CallFrame::level

Definition at line 785 of file tclInt.h.
Referenced by InfoLevelCmd(), Tcl_PushCallFrame(), TclCheckExecutionTraces(), and TclGetFrame().Namespace* CallFrame::nsPtr

Definition at line 762 of file tclInt.h.
Referenced by SetCmdNameFromAny(), Tcl_GetCommandFromObj(), Tcl_GetCurrentNamespace(), Tcl_PopCallFrame(), Tcl_PushCallFrame(), TclCompEvalObj(), TclEvalObjvInternal(), TclGetNamespaceForQualName(), TclLookupSimpleVar(), TclObjLookupVar(), and TclSetCmdNameObj().int CallFrame::numCompiledLocals

Definition at line 799 of file tclInt.h.
Referenced by AppendLocals(), Tcl_PopCallFrame(), Tcl_PushCallFrame(), and TclDeleteCompiledLocalVars().int CallFrame::objc

Definition at line 771 of file tclInt.h.
Referenced by InfoLevelCmd(), and Tcl_PushCallFrame().Tcl_Obj* CONST* CallFrame::objv

Definition at line 773 of file tclInt.h.
Referenced by InfoLevelCmd(), and Tcl_PushCallFrame().Proc* CallFrame::procPtr

Definition at line 789 of file tclInt.h.
Referenced by AppendLocals(), Tcl_PushCallFrame(), TclCompEvalObj(), TclInitCompiledLocals(), TclLookupSimpleVar(), and TclObjLookupVar().Tcl_HashTable* CallFrame::varTablePtr

Definition at line 795 of file tclInt.h.
Referenced by AppendLocals(), Tcl_PopCallFrame(), Tcl_PushCallFrame(), and TclLookupSimpleVar().
The documentation for this struct was generated from the following file:
generic/tclInt.h

carc Struct Reference
#include <regguts.h>

Detailed Description

Definition at line 338 of file regguts.h.Public Attributes
color co
int to

Member Data Documentation
color carc::co

Definition at line 339 of file regguts.h.
Referenced by carcsort(), compact(), and miss().int carc::to

Definition at line 340 of file regguts.h.
Referenced by carcsort(), compact(), and miss().
The documentation for this struct was generated from the following file:
generic/regguts.h

Cdtor Struct Reference

Detailed Description

Definition at line 58 of file tclLoadAix.c.Public Attributes
void(* init )(void)
void(* term )(void)

Member Data Documentation
void(* Cdtor::init)(void)
void(* Cdtor::term)(void)

Referenced by dlclose().
The documentation for this struct was generated from the following file:
unix/tclLoadAix.c

CfrgHeader Struct Reference

Detailed Description

Definition at line 46 of file tclMacLoad.c.Public Attributes
long res1
long res2
long version
long res3
long res4
long filler1
long filler2
long itemCount
char arrayStart

Member Data Documentation
char CfrgHeader::arrayStart

Definition at line 55 of file tclMacLoad.c.long CfrgHeader::filler1

Definition at line 52 of file tclMacLoad.c.long CfrgHeader::filler2

Definition at line 53 of file tclMacLoad.c.long CfrgHeader::itemCount

Definition at line 54 of file tclMacLoad.c.long CfrgHeader::res1

Definition at line 47 of file tclMacLoad.c.long CfrgHeader::res2

Definition at line 48 of file tclMacLoad.c.long CfrgHeader::res3

Definition at line 50 of file tclMacLoad.c.long CfrgHeader::res4

Definition at line 51 of file tclMacLoad.c.long CfrgHeader::version

Definition at line 49 of file tclMacLoad.c.
The documentation for this struct was generated from the following file:
mac/tclMacLoad.c

CfrgItem Struct Reference

Detailed Description

Definition at line 62 of file tclMacLoad.c.Public Attributes
OSType archType
long updateLevel
long currVersion
long oldDefVersion
long appStackSize
short appSubFolder
char usage
char location
long codeOffset
long codeLength
long res1
long res2
short itemSize
Str255 name

Member Data Documentation
long CfrgItem::appStackSize

Definition at line 67 of file tclMacLoad.c.short CfrgItem::appSubFolder

Definition at line 68 of file tclMacLoad.c.OSType CfrgItem::archType

Definition at line 63 of file tclMacLoad.c.
Referenced by TryToLoad().long CfrgItem::codeLength

Definition at line 72 of file tclMacLoad.c.
Referenced by TryToLoad().long CfrgItem::codeOffset

Definition at line 71 of file tclMacLoad.c.
Referenced by TryToLoad().long CfrgItem::currVersion

Definition at line 65 of file tclMacLoad.c.short CfrgItem::itemSize

Definition at line 75 of file tclMacLoad.c.
Referenced by TryToLoad().char CfrgItem::location

Definition at line 70 of file tclMacLoad.c.Str255 CfrgItem::name

Definition at line 76 of file tclMacLoad.c.
Referenced by TryToLoad().long CfrgItem::oldDefVersion

Definition at line 66 of file tclMacLoad.c.long CfrgItem::res1

Definition at line 73 of file tclMacLoad.c.long CfrgItem::res2

Definition at line 74 of file tclMacLoad.c.long CfrgItem::updateLevel

Definition at line 64 of file tclMacLoad.c.char CfrgItem::usage

Definition at line 69 of file tclMacLoad.c.
The documentation for this struct was generated from the following file:
mac/tclMacLoad.c

Channel Struct Reference
#include <tclIO.h>

Detailed Description

Definition at line 130 of file tclIO.h.Public Attributes
ChannelState * state
ClientData instanceData
Tcl_ChannelType * typePtr
Channel * downChanPtr
Channel * upChanPtr
ChannelBuffer * inQueueHead
ChannelBuffer * inQueueTail

Member Data Documentation
struct Channel* Channel::downChanPtr

Definition at line 137 of file tclIO.h.
Referenced by Tcl_CreateChannel(), Tcl_GetStackedChannel(), Tcl_StackChannel(), and Tcl_UnstackChannel().ChannelBuffer* Channel::inQueueHead

Definition at line 147 of file tclIO.h.
Referenced by Tcl_ChannelBuffered(), Tcl_CreateChannel(), Tcl_StackChannel(), and Tcl_UnstackChannel().ChannelBuffer* Channel::inQueueTail

Definition at line 148 of file tclIO.h.
Referenced by Tcl_CreateChannel(), Tcl_StackChannel(), and Tcl_UnstackChannel().ClientData Channel::instanceData

Definition at line 133 of file tclIO.h.
Referenced by CloseChannel(), FlushChannel(), Tcl_Close(), Tcl_CreateChannel(), Tcl_GetChannelHandle(), Tcl_GetChannelInstanceData(), Tcl_GetChannelOption(), Tcl_NotifyChannel(), Tcl_Seek(), Tcl_SetChannelOption(), Tcl_StackChannel(), Tcl_Tell(), Tcl_UnstackChannel(), and Tcl_WriteRaw().struct ChannelState* Channel::state

Definition at line 131 of file tclIO.h.
Referenced by ChannelTimerProc(), CleanupChannelHandlers(), CloseChannel(), CreateScriptRecord(), DeleteChannelTable(), DeleteScriptRecord(), DetachChannel(), FlushChannel(), SetBlockMode(), Tcl_ClearChannelHandlers(), Tcl_Close(), Tcl_CreateChannel(), Tcl_CreateChannelHandler(), Tcl_DeleteChannelHandler(), Tcl_FileEventObjCmd(), Tcl_Flush(), Tcl_GetChannel(), Tcl_GetChannelHandle(), Tcl_GetChannelOption(), Tcl_GetChannelThread(), Tcl_GetsObj(), Tcl_GetTopChannel(), Tcl_IsChannelRegistered(), Tcl_NotifyChannel(), Tcl_Read(), Tcl_ReadChars(), Tcl_ReadRaw(), Tcl_RegisterChannel(), Tcl_Seek(), Tcl_SetChannelOption(), Tcl_StackChannel(), Tcl_Tell(), Tcl_Ungets(), Tcl_UnstackChannel(), Tcl_WriteRaw(), TclChannelTransform(), TclCopyChannel(), TestChannelCmd(), and TestChannelEventCmd().Tcl_ChannelType* Channel::typePtr

Definition at line 135 of file tclIO.h.
Referenced by CloseChannel(), FlushChannel(), Tcl_Close(), Tcl_CreateChannel(), Tcl_GetChannelHandle(), Tcl_GetChannelOption(), Tcl_GetChannelType(), Tcl_NotifyChannel(), Tcl_Seek(), Tcl_SetChannelOption(), Tcl_StackChannel(), Tcl_Tell(), Tcl_UnstackChannel(), Tcl_WriteRaw(), TclChannelEventScriptInvoker(), and TestChannelCmd().struct Channel* Channel::upChanPtr

Definition at line 140 of file tclIO.h.
Referenced by CloseChannel(), Tcl_CreateChannel(), Tcl_NotifyChannel(), Tcl_StackChannel(), and Tcl_UnstackChannel().
The documentation for this struct was generated from the following file:
generic/tclIO.h

ChannelBuffer Struct Reference
#include <tclIO.h>

Detailed Description

Definition at line 60 of file tclIO.h.Public Attributes
int nextAdded
int nextRemoved
int bufLength
ChannelBuffer * nextPtr
char buf [4]

Member Data Documentation
char ChannelBuffer::buf[4]

Definition at line 68 of file tclIO.h.
Referenced by CopyAndTranslateBuffer(), CopyBuffer(), DoWrite(), FilterInputBytes(), FlushChannel(), GetInput(), ReadBytes(), ReadChars(), Tcl_GetsObj(), Tcl_Ungets(), WriteBytes(), and WriteChars().int ChannelBuffer::bufLength

Definition at line 65 of file tclIO.h.
Referenced by AllocChannelBuffer(), CheckFlush(), DoWrite(), FilterInputBytes(), GetInput(), PeekAhead(), RecycleBuffer(), WriteBytes(), and WriteChars().int ChannelBuffer::nextAdded

Definition at line 61 of file tclIO.h.
Referenced by AllocChannelBuffer(), CheckFlush(), CommonGetsCleanup(), CopyAndTranslateBuffer(), CopyBuffer(), DoReadChars(), DoWrite(), FilterInputBytes(), FlushChannel(), GetInput(), PeekAhead(), ReadBytes(), ReadChars(), Tcl_ChannelBuffered(), Tcl_InputBuffered(), Tcl_OutputBuffered(), Tcl_Ungets(), TestChannelCmd(), WriteBytes(), and WriteChars().struct ChannelBuffer* ChannelBuffer::nextPtr

Definition at line 66 of file tclIO.h.
Referenced by AllocChannelBuffer(), CommonGetsCleanup(), CopyBuffer(), DiscardInputQueued(), DiscardOutputQueued(), DoReadChars(), FilterInputBytes(), FlushChannel(), GetInput(), PeekAhead(), ReadChars(), Tcl_ChannelBuffered(), Tcl_InputBuffered(), Tcl_OutputBuffered(), Tcl_Ungets(), and TestChannelCmd().int ChannelBuffer::nextRemoved

Definition at line 63 of file tclIO.h.
Referenced by AllocChannelBuffer(), CommonGetsCleanup(), CopyAndTranslateBuffer(), CopyBuffer(), DoReadChars(), FilterInputBytes(), FlushChannel(), PeekAhead(), ReadBytes(), ReadChars(), Tcl_ChannelBuffered(), Tcl_GetsObj(), Tcl_InputBuffered(), Tcl_OutputBuffered(), and TestChannelCmd().
The documentation for this struct was generated from the following file:
generic/tclIO.h

ChannelHandler Struct Reference
#include <tclIO.h>

Detailed Description

Definition at line 343 of file tclIO.h.Public Attributes
Channel * chanPtr
int mask
Tcl_ChannelProc * proc
ClientData clientData
ChannelHandler * nextPtr

Member Data Documentation
Channel* ChannelHandler::chanPtr

Definition at line 344 of file tclIO.h.
Referenced by Tcl_ClearChannelHandlers(), Tcl_CreateChannelHandler(), and Tcl_DeleteChannelHandler().ClientData ChannelHandler::clientData

Definition at line 348 of file tclIO.h.
Referenced by Tcl_CreateChannelHandler(), Tcl_DeleteChannelHandler(), and Tcl_NotifyChannel().int ChannelHandler::mask

Definition at line 345 of file tclIO.h.
Referenced by Tcl_CreateChannelHandler(), and Tcl_NotifyChannel().struct ChannelHandler* ChannelHandler::nextPtr

Definition at line 349 of file tclIO.h.
Referenced by Tcl_ClearChannelHandlers(), Tcl_CreateChannelHandler(), Tcl_DeleteChannelHandler(), and Tcl_NotifyChannel().Tcl_ChannelProc* ChannelHandler::proc

Definition at line 346 of file tclIO.h.
Referenced by Tcl_CreateChannelHandler(), Tcl_DeleteChannelHandler(), and Tcl_NotifyChannel().
The documentation for this struct was generated from the following file:
generic/tclIO.h

ChannelHandlerEvent Struct Reference
#include <tclIO.h>

Detailed Description

Definition at line 383 of file tclIO.h.Public Attributes
Tcl_Event header
Channel * chanPtr
int readyMask

Member Data Documentation
Channel* ChannelHandlerEvent::chanPtr

Definition at line 385 of file tclIO.h.Tcl_Event ChannelHandlerEvent::header

Definition at line 384 of file tclIO.h.int ChannelHandlerEvent::readyMask

Definition at line 386 of file tclIO.h.
The documentation for this struct was generated from the following file:
generic/tclIO.h

ChannelState Struct Reference
#include <tclIO.h>

Detailed Description

Definition at line 160 of file tclIO.h.Public Attributes
CONST char * channelName
int flags
Tcl_Encoding encoding
Tcl_EncodingState inputEncodingState
int inputEncodingFlags
Tcl_EncodingState outputEncodingState
int outputEncodingFlags
TclEolTranslation inputTranslation
TclEolTranslation outputTranslation
int inEofChar
int outEofChar
int unreportedError
int refCount
CloseCallback * closeCbPtr
char * outputStage
ChannelBuffer * curOutPtr
ChannelBuffer * outQueueHead
ChannelBuffer * outQueueTail
ChannelBuffer * saveInBufPtr
ChannelBuffer * inQueueHead
ChannelBuffer * inQueueTail
ChannelHandler * chPtr
int interestMask
EventScriptRecord * scriptRecordPtr
int bufSize
Tcl_TimerToken timer
CopyState * csPtr
Channel * topChanPtr
Channel * bottomChanPtr
ChannelState * nextCSPtr
Tcl_ThreadId managingThread

Member Data Documentation
Channel* ChannelState::bottomChanPtr

Definition at line 231 of file tclIO.h.
Referenced by DetachChannel(), Tcl_GetChannel(), Tcl_GetChannelHandle(), Tcl_IsChannelRegistered(), and Tcl_RegisterChannel().int ChannelState::bufSize

Definition at line 226 of file tclIO.h.
Referenced by TclCopyChannel().CONST char* ChannelState::channelName

Definition at line 161 of file tclIO.h.
Referenced by Tcl_GetChannel().struct ChannelHandler* ChannelState::chPtr

Definition at line 217 of file tclIO.h.CloseCallback* ChannelState::closeCbPtr

Definition at line 202 of file tclIO.h.CopyState* ChannelState::csPtr

Definition at line 228 of file tclIO.h.
Referenced by StopCopy(), and TclCopyChannel().ChannelBuffer* ChannelState::curOutPtr

Definition at line 207 of file tclIO.h.Tcl_Encoding ChannelState::encoding

Definition at line 166 of file tclIO.h.
Referenced by CopyData().int ChannelState::flags

Definition at line 164 of file tclIO.h.
Referenced by CopyData(), StopCopy(), Tcl_GetChannel(), and TclCopyChannel().int ChannelState::inEofChar

Definition at line 191 of file tclIO.h.int ChannelState::inputEncodingFlags

Definition at line 172 of file tclIO.h.Tcl_EncodingState ChannelState::inputEncodingState

Definition at line 169 of file tclIO.h.TclEolTranslation ChannelState::inputTranslation

Definition at line 185 of file tclIO.h.ChannelBuffer* ChannelState::inQueueHead

Definition at line 214 of file tclIO.h.ChannelBuffer* ChannelState::inQueueTail

Definition at line 215 of file tclIO.h.int ChannelState::interestMask

Definition at line 219 of file tclIO.h.Tcl_ThreadId ChannelState::managingThread

Definition at line 236 of file tclIO.h.
Referenced by Tcl_GetChannelThread().struct ChannelState* ChannelState::nextCSPtr

Definition at line 234 of file tclIO.h.
Referenced by Tcl_CutChannel().int ChannelState::outEofChar

Definition at line 193 of file tclIO.h.int ChannelState::outputEncodingFlags

Definition at line 180 of file tclIO.h.Tcl_EncodingState ChannelState::outputEncodingState

Definition at line 177 of file tclIO.h.char* ChannelState::outputStage

Definition at line 204 of file tclIO.h.TclEolTranslation ChannelState::outputTranslation

Definition at line 188 of file tclIO.h.ChannelBuffer* ChannelState::outQueueHead

Definition at line 208 of file tclIO.h.ChannelBuffer* ChannelState::outQueueTail

Definition at line 209 of file tclIO.h.int ChannelState::refCount

Definition at line 199 of file tclIO.h.ChannelBuffer* ChannelState::saveInBufPtr

Definition at line 211 of file tclIO.h.EventScriptRecord* ChannelState::scriptRecordPtr

Definition at line 221 of file tclIO.h.Tcl_TimerToken ChannelState::timer

Definition at line 227 of file tclIO.h.Channel* ChannelState::topChanPtr

Definition at line 229 of file tclIO.h.
Referenced by CopyData(), Tcl_GetTopChannel(), and Tcl_StackChannel().int ChannelState::unreportedError

Definition at line 196 of file tclIO.h.
Referenced by CopyData().
The documentation for this struct was generated from the following file:
generic/tclIO.h

CharSet Struct Reference

Detailed Description

Definition at line 43 of file tclScan.c.Public Attributes
int exclude
int nchars
Tcl_UniChar * chars
int nranges
CharSet::Range * ranges
Classes
struct Range

Member Data Documentation
Tcl_UniChar* CharSet::chars

Definition at line 46 of file tclScan.c.int CharSet::exclude

Definition at line 44 of file tclScan.c.int CharSet::nchars

Definition at line 45 of file tclScan.c.int CharSet::nranges

Definition at line 47 of file tclScan.c.struct CharSet::Range * CharSet::ranges

The documentation for this struct was generated from the following file:
generic/tclScan.c

CharSet::Range Struct Reference

Detailed Description

Definition at line 48 of file tclScan.c.Public Attributes
Tcl_UniChar start
Tcl_UniChar end

Member Data Documentation
Tcl_UniChar CharSet::Range::end

Definition at line 50 of file tclScan.c.Tcl_UniChar CharSet::Range::start

Definition at line 49 of file tclScan.c.
The documentation for this struct was generated from the following file:
generic/tclScan.c

CloseCallback Struct Reference
#include <tclIO.h>

Detailed Description

Definition at line 95 of file tclIO.h.Public Attributes
Tcl_CloseProc * proc
ClientData clientData
CloseCallback * nextPtr

Member Data Documentation
ClientData CloseCallback::clientData

Definition at line 97 of file tclIO.h.
Referenced by Tcl_Close(), Tcl_CreateCloseHandler(), and Tcl_DeleteCloseHandler().struct CloseCallback* CloseCallback::nextPtr

Definition at line 99 of file tclIO.h.
Referenced by Tcl_Close(), Tcl_CreateCloseHandler(), and Tcl_DeleteCloseHandler().Tcl_CloseProc* CloseCallback::proc

Definition at line 96 of file tclIO.h.
Referenced by Tcl_Close(), Tcl_CreateCloseHandler(), and Tcl_DeleteCloseHandler().
The documentation for this struct was generated from the following file:
generic/tclIO.h

CmdInfo Struct Reference

Detailed Description

Definition at line 50 of file tclBasic.c.Public Attributes
char * name
Tcl_CmdProc * proc
Tcl_ObjCmdProc * objProc
CompileProc * compileProc
int isSafe

Member Data Documentation
CompileProc* CmdInfo::compileProc

Definition at line 54 of file tclBasic.c.
Referenced by Tcl_CreateInterp().int CmdInfo::isSafe

Definition at line 55 of file tclBasic.c.
Referenced by TclHideUnsafeCommands().char* CmdInfo::name

Definition at line 51 of file tclBasic.c.
Referenced by Tcl_CreateInterp(), and TclHideUnsafeCommands().Tcl_ObjCmdProc* CmdInfo::objProc

Definition at line 53 of file tclBasic.c.
Referenced by Tcl_CreateInterp().Tcl_CmdProc* CmdInfo::proc

Definition at line 52 of file tclBasic.c.
Referenced by Tcl_CreateInterp().
The documentation for this struct was generated from the following file:
generic/tclBasic.c

CmdLocation Struct Reference
#include <tclCompile.h>

Detailed Description

Definition at line 117 of file tclCompile.h.Public Attributes
int codeOffset
int numCodeBytes
int srcOffset
int numSrcBytes

Member Data Documentation
int CmdLocation::codeOffset

Definition at line 118 of file tclCompile.h.
Referenced by EncodeCmdLocMap(), EnterCmdStartData(), and GetCmdLocEncodingSize().int CmdLocation::numCodeBytes

Definition at line 119 of file tclCompile.h.
Referenced by EnterCmdExtentData(), EnterCmdStartData(), GetCmdLocEncodingSize(), and TclCompileScript().int CmdLocation::numSrcBytes

Definition at line 121 of file tclCompile.h.
Referenced by EnterCmdExtentData(), EnterCmdStartData(), and GetCmdLocEncodingSize().int CmdLocation::srcOffset

Definition at line 120 of file tclCompile.h.
Referenced by EncodeCmdLocMap(), EnterCmdStartData(), and GetCmdLocEncodingSize().
The documentation for this struct was generated from the following file:
generic/tclCompile.h

CmdTable Struct Reference

Detailed Description

Definition at line 36 of file tclTestProcBodyObj.c.Public Attributes
char * cmdName
Tcl_ObjCmdProc * proc
int exportIt

Member Data Documentation
char* CmdTable::cmdName

Definition at line 38 of file tclTestProcBodyObj.c.int CmdTable::exportIt

Definition at line 40 of file tclTestProcBodyObj.c.Tcl_ObjCmdProc* CmdTable::proc

Definition at line 39 of file tclTestProcBodyObj.c.
The documentation for this struct was generated from the following file:
generic/tclTestProcBodyObj.c

cname Struct Reference

Detailed Description

Definition at line 17 of file regc_locale.c.Public Attributes
char * name
char code

Member Data Documentation
char cname::code

Definition at line 19 of file regc_locale.c.char* cname::name

Definition at line 18 of file regc_locale.c.
Referenced by element().
The documentation for this struct was generated from the following file:
generic/regc_locale.c

cnfa Struct Reference
#include <regguts.h>

Detailed Description

Definition at line 343 of file regguts.h.Public Attributes
int nstates
int ncolors
int flags
int pre
int post
color bos [2]
color eos [2]
carc ** states
carc * arcs

Member Data Documentation
struct carc* cnfa::arcs

Definition at line 353 of file regguts.h.
Referenced by compact().color cnfa::bos[2]

Definition at line 350 of file regguts.h.
Referenced by compact(), longest(), and shortest().color cnfa::eos[2]

Definition at line 351 of file regguts.h.
Referenced by compact(), longest(), and shortest().int cnfa::flags

Definition at line 346 of file regguts.h.
Referenced by compact().int cnfa::ncolors

Definition at line 345 of file regguts.h.
Referenced by compact(), lacon(), and newdfa().int cnfa::nstates

Definition at line 344 of file regguts.h.
Referenced by altdissect(), ccondissect(), compact(), condissect(), crevdissect(), and newdfa().int cnfa::post

Definition at line 349 of file regguts.h.
Referenced by compact(), initialize(), and miss().int cnfa::pre

Definition at line 348 of file regguts.h.
Referenced by compact(), and initialize().struct carc** cnfa::states

Definition at line 352 of file regguts.h.
Referenced by compact(), and miss().
The documentation for this struct was generated from the following file:
generic/regguts.h

colordesc Struct Reference
#include <regguts.h>

Detailed Description

Definition at line 207 of file regguts.h.Public Attributes
uchr nchrs
color sub
arc * arcs
int flags
tree * block

Member Data Documentation
struct arc* colordesc::arcs

Definition at line 211 of file regguts.h.
Referenced by colorchain(), freecolor(), initcm(), newcolor(), okcolors(), and uncolorchain().union tree* colordesc::block

Definition at line 216 of file regguts.h.
Referenced by freecolor(), initcm(), newcolor(), and subblock().int colordesc::flags

Definition at line 212 of file regguts.h.
Referenced by colorcomplement(), freecolor(), initcm(), newcolor(), and rainbow().uchr colordesc::nchrs

Definition at line 208 of file regguts.h.
Referenced by freecolor(), initcm(), newcolor(), okcolors(), and subblock().color colordesc::sub

Definition at line 209 of file regguts.h.
Referenced by freecolor(), initcm(), newcolor(), okcolors(), and rainbow().
The documentation for this struct was generated from the following file:
generic/regguts.h

colormap Struct Reference
#include <regguts.h>

Detailed Description

Definition at line 220 of file regguts.h.Public Attributes
int magic
vars * v
size_t ncds
size_t max
color free
colordesc * cd
colordesc cdspace [NINLINECDS]
tree tree [NBYTS]

Member Data Documentation
struct colordesc* colormap::cd

Definition at line 227 of file regguts.h.
Referenced by colorcomplement(), initcm(), okcolors(), rainbow(), and subblock().struct colordesc colormap::cdspace[NINLINECDS]

Definition at line 230 of file regguts.h.
Referenced by initcm().color colormap::free

Definition at line 226 of file regguts.h.
Referenced by initcm().int colormap::magic

Definition at line 221 of file regguts.h.
Referenced by initcm().size_t colormap::max

Definition at line 225 of file regguts.h.
Referenced by initcm().size_t colormap::ncds

Definition at line 224 of file regguts.h.
Referenced by initcm().union tree colormap::tree[NBYTS]

Definition at line 231 of file regguts.h.
Referenced by initcm(), and subblock().struct vars* colormap::v

Definition at line 223 of file regguts.h.
Referenced by initcm(), and newnfa().
The documentation for this struct was generated from the following file:
generic/regguts.h

colors Struct Reference
#include <regguts.h>

Detailed Description

Definition at line 193 of file regguts.h.Public Attributes
color ccolor [BYTTAB]

Member Data Documentation
color colors::ccolor[BYTTAB]

Definition at line 194 of file regguts.h.
The documentation for this struct was generated from the following file:
generic/regguts.h

Command Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 1063 of file tclInt.h.Public Attributes
Tcl_HashEntry * hPtr
Namespace * nsPtr
int refCount
int cmdEpoch
CompileProc * compileProc
Tcl_ObjCmdProc * objProc
ClientData objClientData
Tcl_CmdProc * proc
ClientData clientData
Tcl_CmdDeleteProc * deleteProc
ClientData deleteData
int flags
ImportRef * importRefPtr
CommandTrace * tracePtr

Member Data Documentation
ClientData Command::clientData

Definition at line 1090 of file tclInt.h.
Referenced by AliasCreate(), ProcBodyTestProcObjCmd(), StringTraceProc(), Tcl_CreateCommand(), Tcl_CreateInterp(), Tcl_CreateObjCommand(), Tcl_GetCommandInfoFromToken(), Tcl_SetCommandInfoFromToken(), TclFindProc(), and TclInvokeStringCommand().int Command::cmdEpoch

Definition at line 1082 of file tclInt.h.
Referenced by SetCmdNameFromAny(), Tcl_CreateCommand(), Tcl_CreateInterp(), Tcl_CreateObjCommand(), Tcl_DeleteCommandFromToken(), Tcl_GetCommandFromObj(), Tcl_HideCommand(), TclEvalObjvInternal(), and TclSetCmdNameObj().CompileProc* Command::compileProc

Definition at line 1085 of file tclInt.h.
Referenced by Tcl_CreateCommand(), Tcl_CreateInterp(), Tcl_CreateObjCommand(), Tcl_DeleteCommandFromToken(), Tcl_Import(), and TclCompileScript().ClientData Command::deleteData

Definition at line 1094 of file tclInt.h.
Referenced by AliasCreate(), Tcl_CreateCommand(), Tcl_CreateInterp(), Tcl_CreateObjCommand(), Tcl_DeleteCommandFromToken(), Tcl_GetCommandInfoFromToken(), and Tcl_SetCommandInfoFromToken().Tcl_CmdDeleteProc* Command::deleteProc

Definition at line 1091 of file tclInt.h.
Referenced by AliasCreate(), Tcl_CreateCommand(), Tcl_CreateInterp(), Tcl_CreateObjCommand(), Tcl_DeleteCommandFromToken(), Tcl_ForgetImport(), Tcl_GetCommandInfoFromToken(), Tcl_Import(), Tcl_SetCommandInfoFromToken(), and TclGetOriginalCommand().int Command::flags

Definition at line 1095 of file tclInt.h.
Referenced by CallCommandTraces(), Tcl_CreateCommand(), Tcl_CreateInterp(), Tcl_CreateObjCommand(), Tcl_DeleteCommandFromToken(), Tcl_TraceCommand(), Tcl_UntraceCommand(), TclCompileScript(), TclEvalObjvInternal(), and TclExecuteByteCode().Tcl_HashEntry* Command::hPtr

Definition at line 1064 of file tclInt.h.
Referenced by Tcl_CreateCommand(), Tcl_CreateInterp(), Tcl_CreateObjCommand(), Tcl_DeleteCommandFromToken(), Tcl_ExposeCommand(), Tcl_GetCommandFullName(), Tcl_GetCommandName(), Tcl_HideCommand(), TclRenameCommand(), and TclResetShadowedCmdRefs().ImportRef* Command::importRefPtr

Definition at line 1097 of file tclInt.h.
Referenced by DeleteImportedCmd(), Tcl_CreateCommand(), Tcl_CreateInterp(), Tcl_CreateObjCommand(), Tcl_DeleteCommandFromToken(), and Tcl_Import().Namespace* Command::nsPtr

Definition at line 1074 of file tclInt.h.
Referenced by Tcl_CreateCommand(), Tcl_CreateInterp(), Tcl_CreateObjCommand(), Tcl_ExposeCommand(), Tcl_GetCommandFullName(), Tcl_GetCommandInfoFromToken(), Tcl_HideCommand(), TclCompileScript(), TclObjInterpProc(), TclRenameCommand(), and TclResetShadowedCmdRefs().ClientData Command::objClientData

Definition at line 1088 of file tclInt.h.
Referenced by InvokeImportedCmd(), ProcBodyTestProcObjCmd(), Tcl_CreateCommand(), Tcl_CreateInterp(), Tcl_CreateObjCommand(), Tcl_ForgetImport(), Tcl_GetCommandInfoFromToken(), Tcl_Import(), Tcl_SetCommandInfoFromToken(), TclEvalObjvInternal(), TclGetOriginalCommand(), TclInvokeObjectCommand(), TclObjInvoke(), and TclPreventAliasLoop().Tcl_ObjCmdProc* Command::objProc

Definition at line 1087 of file tclInt.h.
Referenced by InvokeImportedCmd(), ProcBodyTestProcObjCmd(), Tcl_CreateCommand(), Tcl_CreateInterp(), Tcl_CreateObjCommand(), Tcl_DeleteCommandFromToken(), Tcl_GetCommandInfoFromToken(), Tcl_Import(), Tcl_SetCommandInfoFromToken(), TclEvalObjvInternal(), TclInvokeObjectCommand(), TclObjInvoke(), and TclPreventAliasLoop().Tcl_CmdProc* Command::proc

Definition at line 1089 of file tclInt.h.
Referenced by ProcBodyTestProcObjCmd(), StringTraceProc(), Tcl_CreateCommand(), Tcl_CreateInterp(), Tcl_CreateObjCommand(), Tcl_GetCommandInfoFromToken(), Tcl_SetCommandInfoFromToken(), TclFindProc(), and TclInvokeStringCommand().int Command::refCount

Definition at line 1076 of file tclInt.h.
Referenced by CallCommandTraces(), SetCmdNameFromAny(), Tcl_CreateCommand(), Tcl_CreateInterp(), Tcl_CreateObjCommand(), TclEvalObjvInternal(), and TclSetCmdNameObj().CommandTrace* Command::tracePtr

Definition at line 1104 of file tclInt.h.
Referenced by CallCommandTraces(), Tcl_CommandTraceInfo(), Tcl_CreateCommand(), Tcl_CreateInterp(), Tcl_CreateObjCommand(), Tcl_DeleteCommandFromToken(), Tcl_TraceCommand(), Tcl_UntraceCommand(), and TclCheckExecutionTraces().
The documentation for this struct was generated from the following file:
generic/tclInt.h

CommandTrace Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 323 of file tclInt.h.Public Attributes
Tcl_CommandTraceProc * traceProc
ClientData clientData
int flags
CommandTrace * nextPtr
int refCount

Member Data Documentation
ClientData CommandTrace::clientData

Definition at line 326 of file tclInt.h.
Referenced by CallCommandTraces(), Tcl_CommandTraceInfo(), Tcl_TraceCommand(), Tcl_UntraceCommand(), and TclCheckExecutionTraces().int CommandTrace::flags

Definition at line 327 of file tclInt.h.
Referenced by CallCommandTraces(), Tcl_TraceCommand(), and Tcl_UntraceCommand().struct CommandTrace* CommandTrace::nextPtr

Definition at line 330 of file tclInt.h.
Referenced by CallCommandTraces(), Tcl_CommandTraceInfo(), Tcl_DeleteCommandFromToken(), Tcl_TraceCommand(), Tcl_UntraceCommand(), and TclCheckExecutionTraces().int CommandTrace::refCount

Definition at line 332 of file tclInt.h.
Referenced by CallCommandTraces(), Tcl_DeleteCommandFromToken(), Tcl_TraceCommand(), and Tcl_UntraceCommand().Tcl_CommandTraceProc* CommandTrace::traceProc

Definition at line 324 of file tclInt.h.
Referenced by CallCommandTraces(), Tcl_CommandTraceInfo(), Tcl_TraceCommand(), Tcl_UntraceCommand(), and TclCheckExecutionTraces().
The documentation for this struct was generated from the following file:
generic/tclInt.h

CompiledLocal Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 631 of file tclInt.h.Public Attributes
CompiledLocal * nextPtr
int nameLength
int frameIndex
int flags
Tcl_Obj * defValuePtr
Tcl_ResolvedVarInfo * resolveInfo
char name [4]

Member Data Documentation
Tcl_Obj* CompiledLocal::defValuePtr

Definition at line 646 of file tclInt.h.
Referenced by InfoDefaultCmd(), TclCreateProc(), TclFindCompiledLocal(), TclObjInterpProc(), and TclProcCleanupProc().int CompiledLocal::flags

Definition at line 641 of file tclInt.h.
Referenced by TclCreateProc(), TclFindCompiledLocal(), and TclInitCompiledLocals().int CompiledLocal::frameIndex

Definition at line 639 of file tclInt.h.
Referenced by TclCreateProc(), and TclFindCompiledLocal().char CompiledLocal::name[4]

Definition at line 656 of file tclInt.h.
Referenced by InfoArgsCmd(), InfoDefaultCmd(), TclCreateProc(), TclFindCompiledLocal(), TclInitCompiledLocals(), TclObjInterpProc(), TclPrintInstruction(), and UpdateLocalVarName().int CompiledLocal::nameLength

Definition at line 636 of file tclInt.h.
Referenced by TclCreateProc(), TclFindCompiledLocal(), TclInitCompiledLocals(), TclLookupSimpleVar(), and UpdateLocalVarName().struct CompiledLocal* CompiledLocal::nextPtr

Definition at line 632 of file tclInt.h.
Referenced by AppendLocals(), InfoArgsCmd(), InfoDefaultCmd(), TclCreateProc(), TclFindCompiledLocal(), TclInitCompiledLocals(), TclLookupSimpleVar(), TclObjInterpProc(), TclPrintInstruction(), TclProcCleanupProc(), and UpdateLocalVarName().Tcl_ResolvedVarInfo* CompiledLocal::resolveInfo

Definition at line 649 of file tclInt.h.
Referenced by TclCreateProc(), TclFindCompiledLocal(), TclInitCompiledLocals(), and TclProcCleanupProc().
The documentation for this struct was generated from the following file:
generic/tclInt.h

CompileEnv Struct Reference
#include <tclCompile.h>

Detailed Description

Definition at line 188 of file tclCompile.h.Public Attributes
Interp * iPtr
char * source
int numSrcBytes
Proc * procPtr
int numCommands
int exceptDepth
int maxExceptDepth
int maxStackDepth
int currStackDepth
LiteralTable localLitTable
unsigned char * codeStart
unsigned char * codeNext
unsigned char * codeEnd
int mallocedCodeArray
LiteralEntry * literalArrayPtr
int literalArrayNext
int literalArrayEnd
int mallocedLiteralArray
ExceptionRange * exceptArrayPtr
int exceptArrayNext
int exceptArrayEnd
int mallocedExceptArray
CmdLocation * cmdMapPtr
int cmdMapEnd
int mallocedCmdMap
AuxData * auxDataArrayPtr
int auxDataArrayNext
int auxDataArrayEnd
int mallocedAuxDataArray
unsigned char staticCodeSpace [COMPILEENV_INIT_CODE_BYTES]
LiteralEntry staticLiteralSpace [COMPILEENV_INIT_NUM_OBJECTS]
ExceptionRange staticExceptArraySpace [COMPILEENV_INIT_EXCEPT_RANGES]
CmdLocation staticCmdMapSpace [COMPILEENV_INIT_CMD_MAP_SIZE]
AuxData staticAuxDataArraySpace [COMPILEENV_INIT_AUX_DATA_SIZE]

Member Data Documentation
int CompileEnv::auxDataArrayEnd

Definition at line 254 of file tclCompile.h.int CompileEnv::auxDataArrayNext

Definition at line 250 of file tclCompile.h.
Referenced by TclSetByteCodeFromAny().AuxData* CompileEnv::auxDataArrayPtr

Definition at line 249 of file tclCompile.h.
Referenced by TclSetByteCodeFromAny().int CompileEnv::cmdMapEnd

Definition at line 246 of file tclCompile.h.CmdLocation* CompileEnv::cmdMapPtr

Definition at line 242 of file tclCompile.h.
Referenced by TclCompileScript().unsigned char* CompileEnv::codeEnd

Definition at line 220 of file tclCompile.h.
Referenced by TclExpandCodeArray().unsigned char* CompileEnv::codeNext

Definition at line 219 of file tclCompile.h.
Referenced by CompileCondExpr(), CompileLandOrLorExpr(), Tcl_ExprObj(), TclCompileCatchCmd(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileScript(), TclCompileTokens(), TclCompileWhileCmd(), and TclExpandCodeArray().unsigned char* CompileEnv::codeStart

Definition at line 218 of file tclCompile.h.
Referenced by CompileCondExpr(), CompileLandOrLorExpr(), Tcl_ExprObj(), TclCompileCatchCmd(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileScript(), TclCompileWhileCmd(), and TclExpandCodeArray().int CompileEnv::currStackDepth

Definition at line 212 of file tclCompile.h.
Referenced by CompileCondExpr(), CompileLandOrLorExpr(), CompileMathFuncCall(), TclCompileCatchCmd(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileIfCmd(), TclCompileNoOp(), and TclCompileWhileCmd().int CompileEnv::exceptArrayEnd

Definition at line 237 of file tclCompile.h.int CompileEnv::exceptArrayNext

Definition at line 233 of file tclCompile.h.
Referenced by TclCompileReturnCmd().ExceptionRange* CompileEnv::exceptArrayPtr

Definition at line 230 of file tclCompile.h.
Referenced by TclCompileCatchCmd(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileReturnCmd(), and TclCompileWhileCmd().int CompileEnv::exceptDepth

Definition at line 205 of file tclCompile.h.
Referenced by TclCompileCatchCmd(), TclCompileForCmd(), TclCompileForeachCmd(), and TclCompileWhileCmd().Interp* CompileEnv::iPtr

Definition at line 189 of file tclCompile.h.int CompileEnv::literalArrayEnd

Definition at line 227 of file tclCompile.h.int CompileEnv::literalArrayNext

Definition at line 226 of file tclCompile.h.
Referenced by TclSetByteCodeFromAny().LiteralEntry* CompileEnv::literalArrayPtr

Definition at line 224 of file tclCompile.h.
Referenced by TclCompileScript(), and TclSetByteCodeFromAny().LiteralTable CompileEnv::localLitTable

Definition at line 213 of file tclCompile.h.
Referenced by Tcl_ExprObj(), and TclSetByteCodeFromAny().int CompileEnv::mallocedAuxDataArray

Definition at line 255 of file tclCompile.h.int CompileEnv::mallocedCmdMap

Definition at line 247 of file tclCompile.h.int CompileEnv::mallocedCodeArray

Definition at line 222 of file tclCompile.h.
Referenced by TclExpandCodeArray().int CompileEnv::mallocedExceptArray

Definition at line 239 of file tclCompile.h.int CompileEnv::mallocedLiteralArray

Definition at line 228 of file tclCompile.h.int CompileEnv::maxExceptDepth

Definition at line 207 of file tclCompile.h.
Referenced by TclCompileCatchCmd(), TclCompileForCmd(), TclCompileForeachCmd(), and TclCompileWhileCmd().int CompileEnv::maxStackDepth

Definition at line 209 of file tclCompile.h.
Referenced by CompileMathFuncCall().int CompileEnv::numCommands

Definition at line 204 of file tclCompile.h.
Referenced by TclCompileScript().int CompileEnv::numSrcBytes

Definition at line 198 of file tclCompile.h.
Referenced by Tcl_ExprObj(), and TclSetByteCodeFromAny().Proc* CompileEnv::procPtr

Definition at line 199 of file tclCompile.h.
Referenced by TclCompileCatchCmd(), TclCompileForeachCmd(), TclCompileLappendCmd(), TclCompileListCmd(), TclCompileReturnCmd(), TclCompileScript(), TclCompileTokens(), and TclCompileVariableCmd().char* CompileEnv::source

Definition at line 194 of file tclCompile.h.
Referenced by TclCompileScript().AuxData CompileEnv::staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE]

Definition at line 265 of file tclCompile.h.CmdLocation CompileEnv::staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE]

Definition at line 263 of file tclCompile.h.unsigned char CompileEnv::staticCodeSpace[COMPILEENV_INIT_CODE_BYTES]

Definition at line 257 of file tclCompile.h.ExceptionRange CompileEnv::staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES]

Definition at line 261 of file tclCompile.h.LiteralEntry CompileEnv::staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS]

Definition at line 259 of file tclCompile.h.
The documentation for this struct was generated from the following file:
generic/tclCompile.h

CompoundVarTrace Struct Reference

Detailed Description

Definition at line 40 of file tclCmdMZ.c.Public Attributes
VarTrace trace
TraceVarInfo tvar

Member Data Documentation
VarTrace CompoundVarTrace::trace

Definition at line 41 of file tclCmdMZ.c.
Referenced by TclTraceVariableObjCmd().TraceVarInfo CompoundVarTrace::tvar

Definition at line 42 of file tclCmdMZ.c.
Referenced by TclTraceVariableObjCmd().
The documentation for this struct was generated from the following file:
generic/tclCmdMZ.c

ConsoleEvent Struct Reference

Detailed Description

Definition at line 130 of file tclWinConsole.c.Public Attributes
Tcl_Event header
ConsoleInfo * infoPtr

Member Data Documentation
Tcl_Event ConsoleEvent::header

Definition at line 131 of file tclWinConsole.c.
Referenced by ConsoleCheckProc().ConsoleInfo* ConsoleEvent::infoPtr

Definition at line 133 of file tclWinConsole.c.
Referenced by ConsoleCheckProc(), and ConsoleEventProc().
The documentation for this struct was generated from the following file:
win/tclWinConsole.c

Conversation Struct Reference

Detailed Description

Definition at line 47 of file tclWinDde.c.Public Attributes
Conversation * nextPtr
RegisteredInterp * riPtr
HCONV hConv
Tcl_Obj * returnPackagePtr

Member Data Documentation
HCONV Conversation::hConv

Definition at line 51 of file tclWinDde.c.
Referenced by DdeServerProc().struct Conversation* Conversation::nextPtr

Definition at line 48 of file tclWinDde.c.
Referenced by DdeServerProc().Tcl_Obj* Conversation::returnPackagePtr

Definition at line 52 of file tclWinDde.c.
Referenced by DdeServerProc().RegisteredInterp* Conversation::riPtr

Definition at line 50 of file tclWinDde.c.
Referenced by DdeServerProc().
The documentation for this struct was generated from the following file:
win/tclWinDde.c

CopyState Struct Reference
#include <tclIO.h>

Detailed Description

Definition at line 40 of file tclIO.h.Public Attributes
Channel * readPtr
Channel * writePtr
int readFlags
int writeFlags
int toRead
int total
Tcl_Interp * interp
Tcl_Obj * cmdPtr
int bufSize
char buffer [1]

Member Data Documentation
char CopyState::buffer[1]

Definition at line 50 of file tclIO.h.int CopyState::bufSize

Definition at line 49 of file tclIO.h.
Referenced by TclCopyChannel().Tcl_Obj* CopyState::cmdPtr

Definition at line 48 of file tclIO.h.
Referenced by TclCopyChannel().Tcl_Interp* CopyState::interp

Definition at line 47 of file tclIO.h.
Referenced by TclCopyChannel().int CopyState::readFlags

Definition at line 43 of file tclIO.h.
Referenced by TclCopyChannel().struct Channel* CopyState::readPtr

Definition at line 41 of file tclIO.h.
Referenced by TclCopyChannel().int CopyState::toRead

Definition at line 45 of file tclIO.h.
Referenced by TclCopyChannel().int CopyState::total

Definition at line 46 of file tclIO.h.
Referenced by TclCopyChannel().int CopyState::writeFlags

Definition at line 44 of file tclIO.h.
Referenced by TclCopyChannel().struct Channel* CopyState::writePtr

Definition at line 42 of file tclIO.h.
Referenced by TclCopyChannel().
The documentation for this struct was generated from the following file:
generic/tclIO.h

crange Struct Reference

Detailed Description

Definition at line 121 of file regc_locale.c.Public Attributes
chr start
chr end

Member Data Documentation
chr crange::end

Definition at line 123 of file regc_locale.c.chr crange::start

Definition at line 122 of file regc_locale.c.
The documentation for this struct was generated from the following file:
generic/regc_locale.c

cvec Struct Reference
#include <regguts.h>

Detailed Description

Definition at line 256 of file regguts.h.Public Attributes
int nchrs
int chrspace
chr * chrs
int nranges
int rangespace
chr * ranges
int nmcces
int mccespace
int nmccechrs
chr * mcces [1]

Member Data Documentation
chr* cvec::chrs

Definition at line 259 of file regguts.h.
Referenced by chrnamed(), dovec(), and newcvec().int cvec::chrspace

Definition at line 258 of file regguts.h.
Referenced by addmcce(), and newcvec().chr* cvec::mcces[1]

Definition at line 266 of file regguts.h.
Referenced by dovec(), leaders(), and newcvec().int cvec::mccespace

Definition at line 264 of file regguts.h.
Referenced by newcvec().int cvec::nchrs

Definition at line 257 of file regguts.h.
Referenced by chrnamed(), dovec(), and range().int cvec::nmccechrs

Definition at line 265 of file regguts.h.int cvec::nmcces

Definition at line 263 of file regguts.h.
Referenced by dovec(), and leaders().int cvec::nranges

Definition at line 260 of file regguts.h.
Referenced by dovec().chr* cvec::ranges

Definition at line 262 of file regguts.h.
Referenced by dovec(), and newcvec().int cvec::rangespace

Definition at line 261 of file regguts.h.
Referenced by newcvec().
The documentation for this struct was generated from the following file:
generic/regguts.h

ddeEnumServices Struct Reference

Detailed Description

Definition at line 780 of file tclWinDde.c.Public Attributes
Tcl_Interp * interp
int result
ATOM service
ATOM topic
HWND hwnd

Member Data Documentation
HWND ddeEnumServices::hwnd

Definition at line 785 of file tclWinDde.c.
Referenced by DdeCreateClient(), and DdeEnumWindowsCallback().Tcl_Interp* ddeEnumServices::interp

Definition at line 781 of file tclWinDde.c.
Referenced by DdeGetServicesList(), and DdeServicesOnAck().int ddeEnumServices::result

Definition at line 782 of file tclWinDde.c.
Referenced by DdeGetServicesList().ATOM ddeEnumServices::service

Definition at line 783 of file tclWinDde.c.
Referenced by DdeEnumWindowsCallback(), DdeGetServicesList(), and DdeServicesOnAck().ATOM ddeEnumServices::topic

Definition at line 784 of file tclWinDde.c.
Referenced by DdeEnumWindowsCallback(), DdeGetServicesList(), and DdeServicesOnAck().
The documentation for this struct was generated from the following file:
win/tclWinDde.c

DelCmd Struct Reference

Detailed Description

Definition at line 85 of file tclTest.c.Public Attributes
Tcl_Interp * interp
char * deleteCmd

Member Data Documentation
char* DelCmd::deleteCmd

Definition at line 87 of file tclTest.c.
Referenced by DelCmdProc(), DelDeleteProc(), and TestdelCmd().Tcl_Interp* DelCmd::interp

Definition at line 86 of file tclTest.c.
Referenced by DelDeleteProc(), and TestdelCmd().
The documentation for this struct was generated from the following file:
generic/tclTest.c

Detached Struct Reference

Detailed Description

Definition at line 27 of file tclPipe.c.Public Attributes
Tcl_Pid pid
Detached * nextPtr

Member Data Documentation
struct Detached* Detached::nextPtr

Definition at line 30 of file tclPipe.c.
Referenced by Tcl_DetachPids(), and Tcl_ReapDetachedProcs().Tcl_Pid Detached::pid

Definition at line 28 of file tclPipe.c.
Referenced by Tcl_DetachPids(), Tcl_ReapDetachedProcs(), TclCleanupChildren(), and TclCreatePipeline().
The documentation for this struct was generated from the following file:
generic/tclPipe.c

dfa Struct Reference

Detailed Description

Definition at line 59 of file regexec.c.Public Attributes
int nssets
int nssused
int nstates
int ncolors
int wordsper
sset * ssets
unsigned * statesarea
unsigned * work
sset ** outsarea
arcp * incarea
cnfa * cnfa
colormap * cm
chr * lastpost
chr * lastnopr
sset * search
int cptsmalloced
char * mallocarea

Member Data Documentation
struct colormap* dfa::cm

Definition at line 71 of file regexec.c.
Referenced by cfind(), find(), longest(), newdfa(), and shortest().struct cnfa* dfa::cnfa

Definition at line 70 of file regexec.c.
Referenced by cfind(), find(), initialize(), longest(), miss(), newdfa(), and shortest().int dfa::cptsmalloced

Definition at line 75 of file regexec.c.
Referenced by newdfa().struct arcp* dfa::incarea

Definition at line 69 of file regexec.c.
Referenced by newdfa(), and pickss().chr* dfa::lastnopr

Definition at line 73 of file regexec.c.
Referenced by getvacant(), initialize(), lastcold(), and newdfa().chr* dfa::lastpost

Definition at line 72 of file regexec.c.
Referenced by getvacant(), initialize(), longest(), and newdfa().char* dfa::mallocarea

Definition at line 76 of file regexec.c.
Referenced by newdfa().int dfa::ncolors

Definition at line 63 of file regexec.c.
Referenced by getvacant(), newdfa(), and pickss().int dfa::nssets

Definition at line 60 of file regexec.c.
Referenced by newdfa(), and pickss().int dfa::nssused

Definition at line 61 of file regexec.c.
Referenced by initialize(), lastcold(), longest(), newdfa(), and pickss().int dfa::nstates

Definition at line 62 of file regexec.c.
Referenced by miss(), and newdfa().struct sset** dfa::outsarea

Definition at line 68 of file regexec.c.
Referenced by newdfa(), and pickss().struct sset* dfa::search

Definition at line 74 of file regexec.c.
Referenced by newdfa(), and pickss().struct sset* dfa::ssets

Definition at line 65 of file regexec.c.
Referenced by getvacant(), initialize(), lastcold(), longest(), newdfa(), pickss(), and shortest().unsigned* dfa::statesarea

Definition at line 66 of file regexec.c.
Referenced by newdfa(), and pickss().int dfa::wordsper

Definition at line 64 of file regexec.c.
Referenced by initialize(), miss(), newdfa(), and pickss().unsigned* dfa::work

Definition at line 67 of file regexec.c.
Referenced by miss(), and newdfa().
The documentation for this struct was generated from the following file:
generic/regexec.c

dirent Struct Reference
#include <dirent2.h>

Detailed Description

Definition at line 31 of file dirent2.h.Public Attributes
long d_ino
short d_reclen
short d_namlen
char d_name [MAXNAMLEN+1]

Member Data Documentation
long dirent::d_ino

Definition at line 32 of file dirent2.h.char dirent::d_name[MAXNAMLEN+1]

Definition at line 35 of file dirent2.h.
Referenced by DoRenameFile(), TclpMatchInDirectory(), and TraverseUnixTree().short dirent::d_namlen

Definition at line 34 of file dirent2.h.short dirent::d_reclen

Definition at line 33 of file dirent2.h.
The documentation for this struct was generated from the following file:
compat/dirent2.h

dl_info Struct Reference
#include <dlfcn.h>

Detailed Description

Definition at line 51 of file dlfcn.h.Public Member Functions
void init _ANSI_ARGS_ ((void))
void fini _ANSI_ARGS_ ((void))

Member Function Documentation
void fini dl_info::_ANSI_ARGS_ ((void))
void init dl_info::_ANSI_ARGS_ ((void))

The documentation for this struct was generated from the following file:
compat/dlfcn.h

DNRState Struct Reference

Detailed Description

Definition at line 96 of file tclMacSock.c.Public Attributes
hostInfo hostInfo
int done
ProcessSerialNumber psn

Member Data Documentation
int DNRState::done

Definition at line 98 of file tclMacSock.c.
Referenced by DNRCompletionRoutine(), GetHostFromString(), and ResolveAddress().struct hostInfo DNRState::hostInfo

Definition at line 97 of file tclMacSock.c.
Referenced by GetHostFromString(), and ResolveAddress().ProcessSerialNumber DNRState::psn

Definition at line 99 of file tclMacSock.c.
Referenced by DNRCompletionRoutine(), GetHostFromString(), and ResolveAddress().
The documentation for this struct was generated from the following file:
mac/tclMacSock.c

DUMMY_REPARSE_BUFFER Struct Reference

Detailed Description

Definition at line 136 of file tclWinFile.c.Public Attributes
REPARSE_DATA_BUFFER dummy
WCHAR dummyBuf [MAX_PATH *3]

Member Data Documentation
REPARSE_DATA_BUFFER DUMMY_REPARSE_BUFFER::dummy

Definition at line 137 of file tclWinFile.c.WCHAR DUMMY_REPARSE_BUFFER::dummyBuf[MAX_PATH *3]

Definition at line 138 of file tclWinFile.c.
The documentation for this struct was generated from the following file:
win/tclWinFile.c

ErrAssocData Struct Reference

Detailed Description

Definition at line 49 of file tclEvent.c.Public Attributes
BgError * firstBgPtr
BgError * lastBgPtr

Member Data Documentation
BgError* ErrAssocData::firstBgPtr

Definition at line 50 of file tclEvent.c.
Referenced by BgErrorDeleteProc(), and Tcl_BackgroundError().BgError* ErrAssocData::lastBgPtr

Definition at line 53 of file tclEvent.c.
Referenced by Tcl_BackgroundError().
The documentation for this struct was generated from the following file:
generic/tclEvent.c

EscapeEncodingData Struct Reference

Detailed Description

Definition at line 106 of file tclEncoding.c.Public Attributes
int fallback
unsigned int initLen
char init [16]
unsigned int finalLen
char final [16]
char prefixBytes [256]
int numSubTables
EscapeSubTable subTables [1]

Member Data Documentation
int EscapeEncodingData::fallback

Definition at line 107 of file tclEncoding.c.char EscapeEncodingData::final[16]

Definition at line 114 of file tclEncoding.c.
Referenced by EscapeFromUtfProc(), EscapeToUtfProc(), and LoadEscapeEncoding().unsigned int EscapeEncodingData::finalLen

Definition at line 113 of file tclEncoding.c.
Referenced by EscapeFromUtfProc(), EscapeToUtfProc(), and LoadEscapeEncoding().char EscapeEncodingData::init[16]

Definition at line 111 of file tclEncoding.c.
Referenced by EscapeFromUtfProc(), EscapeToUtfProc(), and LoadEscapeEncoding().unsigned int EscapeEncodingData::initLen

Definition at line 110 of file tclEncoding.c.
Referenced by EscapeFromUtfProc(), EscapeToUtfProc(), and LoadEscapeEncoding().int EscapeEncodingData::numSubTables

Definition at line 121 of file tclEncoding.c.
Referenced by EscapeFreeProc(), EscapeFromUtfProc(), EscapeToUtfProc(), and LoadEscapeEncoding().char EscapeEncodingData::prefixBytes[256]

Definition at line 116 of file tclEncoding.c.
Referenced by EscapeToUtfProc(), and LoadEscapeEncoding().EscapeSubTable EscapeEncodingData::subTables[1]

Definition at line 122 of file tclEncoding.c.
Referenced by EscapeFreeProc(), EscapeFromUtfProc(), EscapeToUtfProc(), and LoadEscapeEncoding().
The documentation for this struct was generated from the following file:
generic/tclEncoding.c

EscapeSubTable Struct Reference

Detailed Description

Definition at line 97 of file tclEncoding.c.Public Attributes
unsigned int sequenceLen
char sequence [16]
char name [32]
Encoding * encodingPtr

Member Data Documentation
Encoding* EscapeSubTable::encodingPtr

Definition at line 101 of file tclEncoding.c.
Referenced by EscapeFreeProc(), GetTableEncoding(), and LoadEscapeEncoding().char EscapeSubTable::name[32]

Definition at line 100 of file tclEncoding.c.
Referenced by GetTableEncoding(), and LoadEscapeEncoding().char EscapeSubTable::sequence[16]

Definition at line 99 of file tclEncoding.c.
Referenced by EscapeFromUtfProc(), EscapeToUtfProc(), and LoadEscapeEncoding().unsigned int EscapeSubTable::sequenceLen

Definition at line 98 of file tclEncoding.c.
Referenced by EscapeFromUtfProc(), EscapeToUtfProc(), and LoadEscapeEncoding().
The documentation for this struct was generated from the following file:
generic/tclEncoding.c

EventScriptRecord Struct Reference
#include <tclIO.h>

Detailed Description

Definition at line 108 of file tclIO.h.Public Attributes
Channel * chanPtr
Tcl_Obj * scriptPtr
Tcl_Interp * interp
int mask
EventScriptRecord * nextPtr

Member Data Documentation
struct Channel* EventScriptRecord::chanPtr

Definition at line 109 of file tclIO.h.
Referenced by CreateScriptRecord(), TclChannelEventScriptInvoker(), and TestChannelEventCmd().Tcl_Interp* EventScriptRecord::interp

Definition at line 114 of file tclIO.h.
Referenced by CleanupChannelHandlers(), CreateScriptRecord(), DeleteChannelTable(), DeleteScriptRecord(), Tcl_FileEventObjCmd(), TclChannelEventScriptInvoker(), and TestChannelEventCmd().int EventScriptRecord::mask

Definition at line 115 of file tclIO.h.
Referenced by CreateScriptRecord(), DeleteScriptRecord(), Tcl_FileEventObjCmd(), TclChannelEventScriptInvoker(), and TestChannelEventCmd().struct EventScriptRecord* EventScriptRecord::nextPtr

Definition at line 117 of file tclIO.h.
Referenced by CleanupChannelHandlers(), CreateScriptRecord(), DeleteChannelTable(), DeleteScriptRecord(), Tcl_ClearChannelHandlers(), Tcl_FileEventObjCmd(), and TestChannelEventCmd().Tcl_Obj* EventScriptRecord::scriptPtr

Definition at line 113 of file tclIO.h.
Referenced by CreateScriptRecord(), Tcl_ClearChannelHandlers(), Tcl_FileEventObjCmd(), TclChannelEventScriptInvoker(), and TestChannelEventCmd().
The documentation for this struct was generated from the following file:
generic/tclIO.h

EventSource Struct Reference

Detailed Description

Definition at line 30 of file tclNotify.c.Public Attributes
Tcl_EventSetupProc * setupProc
Tcl_EventCheckProc * checkProc
ClientData clientData
EventSource * nextPtr

Member Data Documentation
Tcl_EventCheckProc* EventSource::checkProc

Definition at line 32 of file tclNotify.c.
Referenced by Tcl_CreateEventSource(), Tcl_DeleteEventSource(), Tcl_DoOneEvent(), and Tcl_ServiceAll().ClientData EventSource::clientData

Definition at line 33 of file tclNotify.c.
Referenced by Tcl_CreateEventSource(), Tcl_DeleteEventSource(), Tcl_DoOneEvent(), and Tcl_ServiceAll().struct EventSource* EventSource::nextPtr

Definition at line 34 of file tclNotify.c.
Referenced by Tcl_CreateEventSource(), Tcl_DeleteEventSource(), Tcl_DoOneEvent(), and Tcl_ServiceAll().Tcl_EventSetupProc* EventSource::setupProc

Definition at line 31 of file tclNotify.c.
Referenced by Tcl_CreateEventSource(), Tcl_DeleteEventSource(), Tcl_DoOneEvent(), and Tcl_ServiceAll().
The documentation for this struct was generated from the following file:
generic/tclNotify.c

ExceptionRange Struct Reference
#include <tclCompile.h>

Detailed Description

Definition at line 91 of file tclCompile.h.Public Attributes
ExceptionRangeType type
int nestingLevel
int codeOffset
int numCodeBytes
int breakOffset
int continueOffset
int catchOffset

Member Data Documentation
int ExceptionRange::breakOffset

Definition at line 99 of file tclCompile.h.
Referenced by TclCompileForCmd(), TclCompileForeachCmd(), TclCompileWhileCmd(), TclCreateExceptRange(), and TclExecuteByteCode().int ExceptionRange::catchOffset

Definition at line 105 of file tclCompile.h.
Referenced by TclCompileCatchCmd(), TclCreateExceptRange(), and TclExecuteByteCode().int ExceptionRange::codeOffset

Definition at line 96 of file tclCompile.h.
Referenced by GetExceptRangeForPc(), TclCompileCatchCmd(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileWhileCmd(), TclCreateExceptRange(), and TclExecuteByteCode().int ExceptionRange::continueOffset

Definition at line 101 of file tclCompile.h.
Referenced by TclCompileForCmd(), TclCompileForeachCmd(), TclCompileWhileCmd(), TclCreateExceptRange(), and TclExecuteByteCode().int ExceptionRange::nestingLevel

Definition at line 93 of file tclCompile.h.
Referenced by TclCreateExceptRange().int ExceptionRange::numCodeBytes

Definition at line 98 of file tclCompile.h.
Referenced by GetExceptRangeForPc(), TclCompileCatchCmd(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileWhileCmd(), and TclCreateExceptRange().ExceptionRangeType ExceptionRange::type

Definition at line 92 of file tclCompile.h.
Referenced by GetExceptRangeForPc(), TclCreateExceptRange(), and TclExecuteByteCode().
The documentation for this struct was generated from the following file:
generic/tclCompile.h

ExecEnv Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 919 of file tclInt.h.Public Attributes
Tcl_Obj ** stackPtr
int stackTop
int stackEnd
Tcl_Obj * errorInfo
Tcl_Obj * errorCode

Member Data Documentation
Tcl_Obj* ExecEnv::errorCode

Definition at line 926 of file tclInt.h.
Referenced by Tcl_AddObjErrorInfo(), and TclCreateExecEnv().Tcl_Obj* ExecEnv::errorInfo

Definition at line 925 of file tclInt.h.
Referenced by Tcl_AddObjErrorInfo(), and TclCreateExecEnv().int ExecEnv::stackEnd

Definition at line 924 of file tclInt.h.
Referenced by TclCreateExecEnv(), and TclExecuteByteCode().Tcl_Obj** ExecEnv::stackPtr

Definition at line 920 of file tclInt.h.
Referenced by TclCreateExecEnv(), and TclExecuteByteCode().int ExecEnv::stackTop

Definition at line 922 of file tclInt.h.
Referenced by TclCreateExecEnv(), and TclExecuteByteCode().
The documentation for this struct was generated from the following file:
generic/tclInt.h

ExitHandler Struct Reference

Detailed Description

Definition at line 63 of file tclEvent.c.Public Attributes
Tcl_ExitProc * proc
ClientData clientData
ExitHandler * nextPtr

Member Data Documentation
ClientData ExitHandler::clientData

Definition at line 65 of file tclEvent.c.
Referenced by Tcl_CreateExitHandler(), Tcl_CreateThreadExitHandler(), Tcl_DeleteThreadExitHandler(), Tcl_Finalize(), and Tcl_FinalizeThread().struct ExitHandler* ExitHandler::nextPtr

Definition at line 66 of file tclEvent.c.
Referenced by Tcl_CreateExitHandler(), Tcl_CreateThreadExitHandler(), Tcl_DeleteExitHandler(), Tcl_DeleteThreadExitHandler(), Tcl_Finalize(), and Tcl_FinalizeThread().Tcl_ExitProc* ExitHandler::proc

Definition at line 64 of file tclEvent.c.
Referenced by Tcl_CreateExitHandler(), Tcl_CreateThreadExitHandler(), Tcl_DeleteThreadExitHandler(), Tcl_Finalize(), and Tcl_FinalizeThread().
The documentation for this struct was generated from the following file:
generic/tclEvent.c

ExitToShellDataStruct Struct Reference

Detailed Description

Definition at line 73 of file tclMacExit.c.Public Attributes
unsigned long a5
ExitToShellUPPList * userProcs
ExitToShellUPP oldProc

Member Data Documentation
unsigned long ExitToShellDataStruct::a5

Definition at line 74 of file tclMacExit.c.
Referenced by ExitToShellPatchRoutine(), and TclMacInitExitToShell().ExitToShellUPP ExitToShellDataStruct::oldProc

Definition at line 76 of file tclMacExit.c.
Referenced by ExitToShellPatchRoutine(), and TclMacInitExitToShell().ExitToShellUPPList* ExitToShellDataStruct::userProcs

Definition at line 75 of file tclMacExit.c.
Referenced by TclMacExitHandler(), TclMacInitExitToShell(), and TclMacInstallExitToShellPatch().
The documentation for this struct was generated from the following file:
mac/tclMacExit.c

ExitToShellUPPList Struct Reference

Detailed Description

Definition at line 58 of file tclMacExit.c.Public Attributes
ExitToShellUPPList * nextProc
ExitToShellUPP userProc

Member Data Documentation
struct ExitToShellUPPList* ExitToShellUPPList::nextProc

Definition at line 59 of file tclMacExit.c.
Referenced by TclMacExitHandler(), and TclMacInstallExitToShellPatch().ExitToShellUPP ExitToShellUPPList::userProc

Definition at line 60 of file tclMacExit.c.
Referenced by TclMacExitHandler(), and TclMacInstallExitToShellPatch().
The documentation for this struct was generated from the following file:
mac/tclMacExit.c

Export Struct Reference

Detailed Description

Definition at line 49 of file tclLoadAix.c.Public Attributes
char * name
void * addr

Member Data Documentation
void* Export::addr

Definition at line 51 of file tclLoadAix.c.
Referenced by dlsym(), and readExports().char* Export::name

Definition at line 50 of file tclLoadAix.c.
Referenced by dlclose(), dlsym(), and readExports().
The documentation for this struct was generated from the following file:
unix/tclLoadAix.c

ExprInfo Struct Reference

Detailed Description

Definition at line 50 of file tclCompExpr.c.Public Attributes
Tcl_Interp * interp
Tcl_Parse * parsePtr
CONST char * expr
CONST char * lastChar
int hasOperators

Member Data Documentation
CONST char* ExprInfo::expr

Definition at line 54 of file tclCompExpr.c.
Referenced by TclCompileExpr().int ExprInfo::hasOperators

Definition at line 57 of file tclCompExpr.c.
Referenced by CompileCondExpr(), CompileSubExpr(), and TclCompileExpr().Tcl_Interp* ExprInfo::interp

Definition at line 51 of file tclCompExpr.c.
Referenced by CompileMathFuncCall(), CompileSubExpr(), and TclCompileExpr().CONST char* ExprInfo::lastChar

Definition at line 56 of file tclCompExpr.c.
Referenced by TclCompileExpr().Tcl_Parse* ExprInfo::parsePtr

Definition at line 52 of file tclCompExpr.c.
Referenced by TclCompileExpr().
The documentation for this struct was generated from the following file:
generic/tclCompExpr.c

FileEvent Struct Reference

Detailed Description

Definition at line 68 of file tclMacChan.c.Public Attributes
Tcl_Event header
FileState * infoPtr
FileInfo * infoPtr

Member Data Documentation
Tcl_Event FileEvent::header

Definition at line 69 of file tclMacChan.c.
Referenced by FileCheckProc().FileInfo* FileEvent::infoPtr

Definition at line 66 of file tclWinChan.c.FileState* FileEvent::infoPtr

Definition at line 71 of file tclMacChan.c.
Referenced by FileCheckProc(), and FileEventProc().
The documentation for this struct was generated from the following files:
mac/tclMacChan.c
win/tclWinChan.c

FileHandler Struct Reference

Detailed Description

Definition at line 31 of file tclUnixNotfy.c.Public Attributes
int fd
int mask
int readyMask
Tcl_FileProc * proc
ClientData clientData
FileHandler * nextPtr
XtInputId read
XtInputId write
XtInputId except
Tcl_FileProc * proc
FileHandler * nextPtr

Member Data Documentation
ClientData FileHandler::clientData

Definition at line 40 of file tclUnixNotfy.c.
Referenced by CreateFileHandler(), FileHandlerEventProc(), and Tcl_CreateFileHandler().XtInputId FileHandler::except

Definition at line 31 of file tclXtNotify.c.
Referenced by CreateFileHandler(), DeleteFileHandler(), and FileProc().int FileHandler::fd

Definition at line 32 of file tclUnixNotfy.c.
Referenced by CreateFileHandler(), DeleteFileHandler(), FileHandlerEventProc(), FileProc(), Tcl_CreateFileHandler(), Tcl_DeleteFileHandler(), and Tcl_WaitForEvent().int FileHandler::mask

Definition at line 33 of file tclUnixNotfy.c.
Referenced by CreateFileHandler(), DeleteFileHandler(), FileHandlerEventProc(), FileProc(), Tcl_CreateFileHandler(), and Tcl_DeleteFileHandler().struct FileHandler* FileHandler::nextPtr

Definition at line 35 of file tclXtNotify.c.struct FileHandler* FileHandler::nextPtr

Definition at line 41 of file tclUnixNotfy.c.
Referenced by CreateFileHandler(), DeleteFileHandler(), FileHandlerEventProc(), Tcl_CreateFileHandler(), Tcl_DeleteFileHandler(), and Tcl_WaitForEvent().Tcl_FileProc* FileHandler::proc

Definition at line 32 of file tclXtNotify.c.Tcl_FileProc* FileHandler::proc

Definition at line 38 of file tclUnixNotfy.c.
Referenced by CreateFileHandler(), FileHandlerEventProc(), and Tcl_CreateFileHandler().XtInputId FileHandler::read

Definition at line 29 of file tclXtNotify.c.
Referenced by CreateFileHandler(), DeleteFileHandler(), and FileProc().int FileHandler::readyMask

Definition at line 35 of file tclUnixNotfy.c.
Referenced by CreateFileHandler(), FileHandlerEventProc(), FileProc(), Tcl_CreateFileHandler(), and Tcl_WaitForEvent().XtInputId FileHandler::write

Definition at line 30 of file tclXtNotify.c.
Referenced by CreateFileHandler(), DeleteFileHandler(), and FileProc().
The documentation for this struct was generated from the following files:
unix/tclUnixNotfy.c
unix/tclXtNotify.c

FileHandlerEvent Struct Reference

Detailed Description

Definition at line 49 of file tclUnixNotfy.c.Public Attributes
Tcl_Event header
int fd

Member Data Documentation
int FileHandlerEvent::fd

Definition at line 52 of file tclUnixNotfy.c.
Referenced by FileHandlerEventProc(), FileProc(), and Tcl_WaitForEvent().Tcl_Event FileHandlerEvent::header

Definition at line 50 of file tclUnixNotfy.c.
Referenced by FileProc(), and Tcl_WaitForEvent().
The documentation for this struct was generated from the following files:
unix/tclUnixNotfy.c
unix/tclXtNotify.c

FileInfo Struct Reference

Detailed Description

Definition at line 33 of file tclWinChan.c.Public Attributes
Tcl_Channel channel
int validMask
int watchMask
int flags
HANDLE handle
FileInfo * nextPtr
int dirty

Member Data Documentation
Tcl_Channel FileInfo::channel

Definition at line 34 of file tclWinChan.c.
Referenced by FileEventProc(), and TclWinOpenFileChannel().int FileInfo::dirty

Definition at line 44 of file tclWinChan.c.
Referenced by FileOutputProc(), TclWinFlushDirtyChannels(), and TclWinOpenFileChannel().int FileInfo::flags

Definition at line 41 of file tclWinChan.c.
Referenced by FileBlockProc(), FileCheckProc(), FileEventProc(), FileOutputProc(), and TclWinOpenFileChannel().HANDLE FileInfo::handle

Definition at line 42 of file tclWinChan.c.
Referenced by FileCloseProc(), FileGetHandleProc(), FileInputProc(), FileOutputProc(), FileSeekProc(), FileWideSeekProc(), TclWinFlushDirtyChannels(), and TclWinOpenFileChannel().struct FileInfo* FileInfo::nextPtr

Definition at line 43 of file tclWinChan.c.
Referenced by FileCheckProc(), FileCloseProc(), FileEventProc(), FileSetupProc(), FileThreadActionProc(), TclWinFlushDirtyChannels(), and TclWinOpenFileChannel().int FileInfo::validMask

Definition at line 35 of file tclWinChan.c.
Referenced by FileGetHandleProc(), FileWatchProc(), and TclWinOpenFileChannel().int FileInfo::watchMask

Definition at line 38 of file tclWinChan.c.
Referenced by FileCheckProc(), FileEventProc(), FileSetupProc(), FileWatchProc(), and TclWinOpenFileChannel().
The documentation for this struct was generated from the following file:
win/tclWinChan.c

FileState Struct Reference

Detailed Description

Definition at line 41 of file tclMacChan.c.Public Attributes
short fileRef
Tcl_Channel fileChan
int watchMask
int appendMode
int volumeRef
int pending
FileState * nextPtr
Tcl_Channel channel
int fd
int validMask

Member Data Documentation
int FileState::appendMode

Definition at line 46 of file tclMacChan.c.
Referenced by FileOutput().Tcl_Channel FileState::channel

Definition at line 125 of file tclUnixChan.c.
Referenced by FileWatchProc(), Tcl_MakeFileChannel(), and TclpOpenFileChannel().int FileState::fd

Definition at line 126 of file tclUnixChan.c.
Referenced by FileBlockModeProc(), FileCloseProc(), FileGetHandleProc(), FileInputProc(), FileOutputProc(), FileSeekProc(), FileWatchProc(), FileWideSeekProc(), Tcl_MakeFileChannel(), and TclpOpenFileChannel().Tcl_Channel FileState::fileChan

Definition at line 43 of file tclMacChan.c.
Referenced by FileEventProc().short FileState::fileRef

Definition at line 42 of file tclMacChan.c.
Referenced by FileClose(), FileInput(), FileOutput(), and FileSeek().struct FileState* FileState::nextPtr

Definition at line 49 of file tclMacChan.c.
Referenced by FileCheckProc(), FileEventProc(), FileSetupProc(), FileThreadActionProc(), Tcl_MakeFileChannel(), and TclpOpenFileChannel().int FileState::pending

Definition at line 48 of file tclMacChan.c.
Referenced by FileCheckProc(), and FileEventProc().int FileState::validMask

Definition at line 127 of file tclUnixChan.c.
Referenced by FileGetHandleProc(), FileWatchProc(), Tcl_MakeFileChannel(), and TclpOpenFileChannel().int FileState::volumeRef

Definition at line 47 of file tclMacChan.c.
Referenced by FileClose(), and OpenFileChannel().int FileState::watchMask

Definition at line 44 of file tclMacChan.c.
Referenced by CommonWatch(), FileCheckProc(), FileEventProc(), and FileSetupProc().
The documentation for this struct was generated from the following files:
mac/tclMacChan.c
unix/tclUnixChan.c

FilesystemRecord Struct Reference

Detailed Description

Definition at line 42 of file tclIOUtil.c.Public Attributes
ClientData clientData
Tcl_Filesystem * fsPtr
int fileRefCount
FilesystemRecord * nextPtr
FilesystemRecord * prevPtr

Member Data Documentation
ClientData FilesystemRecord::clientData

Definition at line 43 of file tclIOUtil.c.
Referenced by Tcl_FSData(), and Tcl_FSRegister().int FilesystemRecord::fileRefCount

Definition at line 47 of file tclIOUtil.c.
Referenced by DupFsPathInternalRep(), FreeFsPathInternalRep(), FsThrExitProc(), Tcl_FSNewNativePath(), Tcl_FSRegister(), Tcl_FSUnregister(), TclFinalizeFilesystem(), and TclFSSetPathDetails().Tcl_Filesystem* FilesystemRecord::fsPtr

Definition at line 45 of file tclIOUtil.c.
Referenced by DupFsPathInternalRep(), FreeFsPathInternalRep(), FsListMounts(), GetPathType(), Tcl_FSData(), Tcl_FSGetCwd(), Tcl_FSGetFileSystemForPath(), Tcl_FSGetInternalRep(), Tcl_FSGetNormalizedPath(), Tcl_FSJoinPath(), Tcl_FSListVolumes(), Tcl_FSRegister(), Tcl_FSUnregister(), TclFinalizeFilesystem(), TclFSEnsureEpochOk(), TclFSInternalToNormalized(), and TclFSNormalizeToUniquePath().struct FilesystemRecord* FilesystemRecord::nextPtr

Definition at line 49 of file tclIOUtil.c.
Referenced by FsListMounts(), FsThrExitProc(), GetPathType(), Tcl_FSData(), Tcl_FSGetCwd(), Tcl_FSGetFileSystemForPath(), Tcl_FSListVolumes(), Tcl_FSRegister(), Tcl_FSUnregister(), TclFinalizeFilesystem(), TclFSInternalToNormalized(), and TclFSNormalizeToUniquePath().struct FilesystemRecord* FilesystemRecord::prevPtr

Definition at line 52 of file tclIOUtil.c.
Referenced by Tcl_FSRegister(), and Tcl_FSUnregister().
The documentation for this struct was generated from the following file:
generic/tclIOUtil.c

fns Struct Reference
#include <regguts.h>

Detailed Description

Definition at line 398 of file regguts.h.Public Member Functions
VOID FUNCPTR (free,(regex_t *))

Member Function Documentation
VOID fns::FUNCPTR (free, (regex_t *))

The documentation for this struct was generated from the following file:
generic/regguts.h

ForeachInfo Struct Reference
#include <tclCompile.h>

Detailed Description

Definition at line 693 of file tclCompile.h.Public Attributes
int numLists
int firstValueTemp
int loopCtTemp
ForeachVarList * varLists [1]

Member Data Documentation
int ForeachInfo::firstValueTemp

Definition at line 696 of file tclCompile.h.
Referenced by DupForeachInfo(), TclCompileForeachCmd(), and TclExecuteByteCode().int ForeachInfo::loopCtTemp

Definition at line 698 of file tclCompile.h.
Referenced by DupForeachInfo(), TclCompileForeachCmd(), and TclExecuteByteCode().int ForeachInfo::numLists

Definition at line 694 of file tclCompile.h.
Referenced by DupForeachInfo(), FreeForeachInfo(), TclCompileForeachCmd(), and TclExecuteByteCode().ForeachVarList* ForeachInfo::varLists[1]

Definition at line 702 of file tclCompile.h.
Referenced by DupForeachInfo(), FreeForeachInfo(), TclCompileForeachCmd(), and TclExecuteByteCode().
The documentation for this struct was generated from the following file:
generic/tclCompile.h

ForeachVarList Struct Reference
#include <tclCompile.h>

Detailed Description

Definition at line 676 of file tclCompile.h.Public Attributes
int numVars
int varIndexes [1]

Member Data Documentation
int ForeachVarList::numVars

Definition at line 677 of file tclCompile.h.
Referenced by DupForeachInfo(), and TclExecuteByteCode().int ForeachVarList::varIndexes[1]

Definition at line 678 of file tclCompile.h.
Referenced by DupForeachInfo().
The documentation for this struct was generated from the following file:
generic/tclCompile.h

FsDivertLoad Struct Reference

Detailed Description

Definition at line 528 of file tclIOUtil.c.Public Attributes
Tcl_LoadHandle loadHandle
Tcl_FSUnloadFileProc * unloadProcPtr
Tcl_Obj * divertedFile
Tcl_Filesystem * divertedFilesystem
ClientData divertedFileNativeRep

Member Data Documentation
Tcl_Obj* FsDivertLoad::divertedFile

Definition at line 531 of file tclIOUtil.c.
Referenced by FSUnloadTempFile(), and Tcl_FSLoadFile().ClientData FsDivertLoad::divertedFileNativeRep

Definition at line 533 of file tclIOUtil.c.
Referenced by FSUnloadTempFile(), and Tcl_FSLoadFile().Tcl_Filesystem* FsDivertLoad::divertedFilesystem

Definition at line 532 of file tclIOUtil.c.
Referenced by FSUnloadTempFile(), and Tcl_FSLoadFile().Tcl_LoadHandle FsDivertLoad::loadHandle

Definition at line 529 of file tclIOUtil.c.
Referenced by FSUnloadTempFile(), and Tcl_FSLoadFile().Tcl_FSUnloadFileProc* FsDivertLoad::unloadProcPtr

Definition at line 530 of file tclIOUtil.c.
Referenced by FSUnloadTempFile(), and Tcl_FSLoadFile().
The documentation for this struct was generated from the following file:
generic/tclIOUtil.c

FsPath Struct Reference

Detailed Description

Definition at line 4635 of file tclIOUtil.c.Public Attributes
Tcl_Obj * translatedPathPtr
Tcl_Obj * normPathPtr
Tcl_Obj * cwdPtr
int flags
ClientData nativePathPtr
int filesystemEpoch
FilesystemRecord * fsRecPtr

Member Data Documentation
Tcl_Obj* FsPath::cwdPtr

Definition at line 4649 of file tclIOUtil.c.
Referenced by DupFsPathInternalRep(), FreeFsPathInternalRep(), FSGetPathType(), SetFsPathFromAny(), Tcl_FSGetNormalizedPath(), Tcl_FSNewNativePath(), TclFSMakePathFromNormalized(), TclFSMakePathRelative(), TclNewFSPathObj(), and UpdateStringOfFsPath().int FsPath::filesystemEpoch

Definition at line 4656 of file tclIOUtil.c.
Referenced by DupFsPathInternalRep(), SetFsPathFromAny(), Tcl_FSConvertToPathType(), Tcl_FSNewNativePath(), TclFSEnsureEpochOk(), TclFSMakePathFromNormalized(), TclFSMakePathRelative(), TclFSSetPathDetails(), and TclNewFSPathObj().int FsPath::flags

Definition at line 4653 of file tclIOUtil.c.
Referenced by DupFsPathInternalRep().struct FilesystemRecord* FsPath::fsRecPtr

Definition at line 4660 of file tclIOUtil.c.
Referenced by DupFsPathInternalRep(), FreeFsPathInternalRep(), SetFsPathFromAny(), Tcl_FSGetInternalRep(), Tcl_FSGetNormalizedPath(), Tcl_FSNewNativePath(), TclFSEnsureEpochOk(), TclFSMakePathFromNormalized(), TclFSMakePathRelative(), TclFSSetPathDetails(), and TclNewFSPathObj().ClientData FsPath::nativePathPtr

Definition at line 4654 of file tclIOUtil.c.
Referenced by DupFsPathInternalRep(), FreeFsPathInternalRep(), SetFsPathFromAny(), Tcl_FSGetInternalRep(), Tcl_FSGetNormalizedPath(), Tcl_FSNewNativePath(), TclFSMakePathFromNormalized(), TclFSMakePathRelative(), TclFSSetPathDetails(), and TclNewFSPathObj().Tcl_Obj* FsPath::normPathPtr

Definition at line 4642 of file tclIOUtil.c.
Referenced by DupFsPathInternalRep(), FreeFsPathInternalRep(), SetFsPathFromAny(), Tcl_FSGetNormalizedPath(), Tcl_FSGetTranslatedPath(), Tcl_FSNewNativePath(), TclFSMakePathFromNormalized(), TclFSMakePathRelative(), TclNewFSPathObj(), and UpdateStringOfFsPath().Tcl_Obj* FsPath::translatedPathPtr

Definition at line 4636 of file tclIOUtil.c.
Referenced by DupFsPathInternalRep(), FreeFsPathInternalRep(), SetFsPathFromAny(), Tcl_FSGetNormalizedPath(), Tcl_FSGetTranslatedPath(), Tcl_FSNewNativePath(), TclFSMakePathFromNormalized(), TclFSMakePathRelative(), and TclNewFSPathObj().
The documentation for this struct was generated from the following file:
generic/tclIOUtil.c

GetsState Struct Reference
#include <tclIO.h>

Detailed Description

Definition at line 394 of file tclIO.h.Public Attributes
Tcl_Obj * objPtr
char ** dstPtr
Tcl_Encoding encoding
ChannelBuffer * bufPtr
Tcl_EncodingState state
int rawRead
int bytesWrote
int charsWrote
int totalChars

Member Data Documentation
ChannelBuffer* GetsState::bufPtr

Definition at line 401 of file tclIO.h.
Referenced by FilterInputBytes(), PeekAhead(), and Tcl_GetsObj().int GetsState::bytesWrote

Definition at line 408 of file tclIO.h.
Referenced by FilterInputBytes(), PeekAhead(), and Tcl_GetsObj().int GetsState::charsWrote

Definition at line 411 of file tclIO.h.
Referenced by FilterInputBytes(), PeekAhead(), and Tcl_GetsObj().char** GetsState::dstPtr

Definition at line 397 of file tclIO.h.
Referenced by FilterInputBytes(), PeekAhead(), and Tcl_GetsObj().Tcl_Encoding GetsState::encoding

Definition at line 399 of file tclIO.h.
Referenced by FilterInputBytes(), and Tcl_GetsObj().Tcl_Obj* GetsState::objPtr

Definition at line 395 of file tclIO.h.
Referenced by FilterInputBytes(), and Tcl_GetsObj().int GetsState::rawRead

Definition at line 406 of file tclIO.h.
Referenced by FilterInputBytes(), PeekAhead(), and Tcl_GetsObj().Tcl_EncodingState GetsState::state

Definition at line 403 of file tclIO.h.
Referenced by FilterInputBytes(), and Tcl_GetsObj().int GetsState::totalChars

Definition at line 414 of file tclIO.h.
Referenced by FilterInputBytes(), PeekAhead(), and Tcl_GetsObj().
The documentation for this struct was generated from the following file:
generic/tclIO.h

guts Struct Reference
#include <regguts.h>

Detailed Description

Definition at line 407 of file regguts.h.Public Member Functions
int FUNCPTR (compare,(CONST chr *, CONST chr *, size_t))
Public Attributes
int magic
int cflags
long info
size_t nsub
subre * tree
cnfa search
int ntree
colormap cmap
subre * lacons
int nlacons

Member Function Documentation
int guts::FUNCPTR (compare, (CONST chr *, CONST chr *, size_t))

Member Data Documentation
int guts::cflags

Definition at line 410 of file regguts.h.
Referenced by compile(), and exec().struct colormap guts::cmap

Definition at line 416 of file regguts.h.
Referenced by compile(), dump(), exec(), and rfree().long guts::info

Definition at line 411 of file regguts.h.
Referenced by compile(), and exec().struct subre* guts::lacons

Definition at line 418 of file regguts.h.
Referenced by compile(), dump(), and rfree().int guts::magic

Definition at line 408 of file regguts.h.
Referenced by compile(), dump(), and rfree().int guts::nlacons

Definition at line 419 of file regguts.h.
Referenced by compile(), dump(), and rfree().size_t guts::nsub

Definition at line 412 of file regguts.h.
Referenced by compile(), and exec().int guts::ntree

Definition at line 415 of file regguts.h.
Referenced by compile(), dump(), and exec().struct cnfa guts::search

Definition at line 414 of file regguts.h.
Referenced by compile(), dump(), and rfree().struct subre* guts::tree

Definition at line 413 of file regguts.h.
Referenced by compile(), dump(), exec(), and rfree().
The documentation for this struct was generated from the following file:
generic/regguts.h

IdleHandler Struct Reference

Detailed Description

Definition at line 78 of file tclTimer.c.Public Attributes
Tcl_IdleProc * proc
ClientData clientData
int generation
IdleHandler * nextPtr

Member Data Documentation
ClientData IdleHandler::clientData

Definition at line 80 of file tclTimer.c.
Referenced by Tcl_CancelIdleCall(), Tcl_DoWhenIdle(), and TclServiceIdle().int IdleHandler::generation

Definition at line 81 of file tclTimer.c.
Referenced by Tcl_DoWhenIdle(), and TclServiceIdle().struct IdleHandler* IdleHandler::nextPtr

Definition at line 83 of file tclTimer.c.
Referenced by Tcl_CancelIdleCall(), Tcl_DoWhenIdle(), and TclServiceIdle().Tcl_IdleProc* IdleHandler::proc

Definition at line 79 of file tclTimer.c.
Referenced by Tcl_CancelIdleCall(), Tcl_DoWhenIdle(), and TclServiceIdle().
The documentation for this struct was generated from the following file:
generic/tclTimer.c

ImportedCmdData Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 1049 of file tclInt.h.Public Attributes
Command * realCmdPtr
Command * selfPtr

Member Data Documentation
struct Command* ImportedCmdData::realCmdPtr

Definition at line 1050 of file tclInt.h.
Referenced by DeleteImportedCmd(), InvokeImportedCmd(), Tcl_CreateCommand(), Tcl_CreateObjCommand(), Tcl_ForgetImport(), Tcl_Import(), and TclGetOriginalCommand().struct Command* ImportedCmdData::selfPtr

Definition at line 1052 of file tclInt.h.
Referenced by DeleteImportedCmd().
The documentation for this struct was generated from the following file:
generic/tclInt.h

ImportRef Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 1030 of file tclInt.h.Public Attributes
Command * importedCmdPtr
ImportRef * nextPtr

Member Data Documentation
struct Command* ImportRef::importedCmdPtr

Definition at line 1031 of file tclInt.h.
Referenced by DeleteImportedCmd(), Tcl_CreateCommand(), Tcl_CreateObjCommand(), Tcl_DeleteCommandFromToken(), and Tcl_Import().struct ImportRef* ImportRef::nextPtr

Definition at line 1036 of file tclInt.h.
Referenced by DeleteImportedCmd(), Tcl_CreateCommand(), Tcl_CreateObjCommand(), Tcl_DeleteCommandFromToken(), and Tcl_Import().
The documentation for this struct was generated from the following file:
generic/tclInt.h

IndexRep Struct Reference

Detailed Description

Definition at line 51 of file tclIndexObj.c.Public Attributes
VOID * tablePtr
int offset
int index

Member Data Documentation
int IndexRep::index

Definition at line 54 of file tclIndexObj.c.
Referenced by Tcl_GetIndexFromObj(), Tcl_GetIndexFromObjStruct(), and TestindexobjCmd().int IndexRep::offset

Definition at line 53 of file tclIndexObj.c.
Referenced by Tcl_GetIndexFromObj(), Tcl_GetIndexFromObjStruct(), and TestindexobjCmd().VOID* IndexRep::tablePtr

Definition at line 52 of file tclIndexObj.c.
Referenced by Tcl_GetIndexFromObj(), Tcl_GetIndexFromObjStruct(), and TestindexobjCmd().
The documentation for this struct was generated from the following file:
generic/tclIndexObj.c

InstructionDesc Struct Reference
#include <tclCompile.h>

Detailed Description

Definition at line 547 of file tclCompile.h.Public Attributes
char * name
int numBytes
int stackEffect
int numOperands
InstOperandType opTypes [MAX_INSTRUCTION_OPERANDS]

Member Data Documentation
char* InstructionDesc::name

Definition at line 548 of file tclCompile.h.
Referenced by TclPrintInstruction().int InstructionDesc::numBytes

Definition at line 549 of file tclCompile.h.
Referenced by TclPrintInstruction().int InstructionDesc::numOperands

Definition at line 556 of file tclCompile.h.
Referenced by TclPrintInstruction().InstOperandType InstructionDesc::opTypes[MAX_INSTRUCTION_OPERANDS]

Definition at line 557 of file tclCompile.h.
Referenced by TclPrintInstruction().int InstructionDesc::stackEffect

Definition at line 550 of file tclCompile.h.
The documentation for this struct was generated from the following file:
generic/tclCompile.h

InteractiveState Struct Reference

Detailed Description

Definition at line 50 of file tclMain.c.Public Attributes
Tcl_Channel input
int tty
Tcl_Obj * commandPtr
PromptType prompt
Tcl_Interp * interp

Member Data Documentation
Tcl_Obj* InteractiveState::commandPtr

Definition at line 56 of file tclMain.c.
Referenced by StdinProc(), and Tcl_Main().Tcl_Channel InteractiveState::input

Definition at line 51 of file tclMain.c.
Referenced by StdinProc(), and Tcl_Main().Tcl_Interp* InteractiveState::interp

Definition at line 59 of file tclMain.c.
Referenced by StdinProc(), and Tcl_Main().PromptType InteractiveState::prompt

Definition at line 58 of file tclMain.c.
Referenced by StdinProc(), and Tcl_Main().int InteractiveState::tty

Definition at line 53 of file tclMain.c.
Referenced by StdinProc(), and Tcl_Main().
The documentation for this struct was generated from the following file:
generic/tclMain.c

Interp Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 1185 of file tclInt.h.Public Attributes
char * result
Tcl_FreeProc * freeProc
int errorLine
TclStubs * stubTable
TclHandle handle
Namespace * globalNsPtr
Tcl_HashTable * hiddenCmdTablePtr
ClientData interpInfo
Tcl_HashTable mathFuncTable
int numLevels
int maxNestingDepth
CallFrame * framePtr
CallFrame * varFramePtr
ActiveVarTrace * activeVarTracePtr
int returnCode
char * errorInfo
char * errorCode
char * appendResult
int appendAvl
int appendUsed
Tcl_HashTable packageTable
char * packageUnknown
int cmdCount
int evalFlags
int termOffset
LiteralTable literalTable
int compileEpoch
Proc * compiledProcPtr
ResolverScheme * resolverPtr
Tcl_Obj * scriptFile
int flags
long randSeed
Trace * tracePtr
Tcl_HashTable * assocData
ExecEnv * execEnvPtr
Tcl_Obj * emptyObjPtr
char resultSpace [TCL_RESULT_SIZE+1]
Tcl_Obj * objResultPtr
Tcl_ThreadId threadId
ActiveCommandTrace * activeCmdTracePtr
ActiveInterpTrace * activeInterpTracePtr
int tracesForbiddingInline

Member Data Documentation
ActiveCommandTrace* Interp::activeCmdTracePtr

Definition at line 1356 of file tclInt.h.
Referenced by Tcl_CreateInterp(), Tcl_UntraceCommand(), and TclCheckExecutionTraces().ActiveInterpTrace* Interp::activeInterpTracePtr

Definition at line 1359 of file tclInt.h.
Referenced by Tcl_CreateInterp(), Tcl_DeleteTrace(), and TclCheckInterpTraces().ActiveVarTrace* Interp::activeVarTracePtr

Definition at line 1263 of file tclInt.h.
Referenced by Tcl_CreateInterp(), Tcl_UntraceVar2(), and UnsetVarStruct().int Interp::appendAvl

Definition at line 1281 of file tclInt.h.
Referenced by Tcl_AppendElement(), Tcl_AppendResultVA(), Tcl_CreateInterp(), Tcl_RestoreResult(), and Tcl_SaveResult().char* Interp::appendResult

Definition at line 1278 of file tclInt.h.
Referenced by DeleteInterpProc(), Tcl_AppendElement(), Tcl_AppendResultVA(), Tcl_CreateInterp(), Tcl_RestoreResult(), and Tcl_SaveResult().int Interp::appendUsed

Definition at line 1283 of file tclInt.h.
Referenced by Tcl_AppendElement(), Tcl_AppendResultVA(), Tcl_CreateInterp(), Tcl_RestoreResult(), and Tcl_SaveResult().Tcl_HashTable* Interp::assocData

Definition at line 1339 of file tclInt.h.
Referenced by DeleteInterpProc(), Tcl_CallWhenDeleted(), Tcl_CreateInterp(), Tcl_DeleteAssocData(), Tcl_DontCallWhenDeleted(), Tcl_GetAssocData(), and Tcl_SetAssocData().int Interp::cmdCount

Definition at line 1303 of file tclInt.h.
Referenced by InfoCmdCountCmd(), Tcl_CreateInterp(), TclCompEvalObj(), TclEvalObjvInternal(), and TclObjInvoke().Proc* Interp::compiledProcPtr

Definition at line 1322 of file tclInt.h.
Referenced by ProcCompileProc(), Tcl_CreateInterp(), and TclInitCompileEnv().int Interp::compileEpoch

Definition at line 1317 of file tclInt.h.
Referenced by ProcCompileProc(), Tcl_AddInterpResolvers(), Tcl_CreateInterp(), Tcl_CreateMathFunc(), Tcl_CreateObjTrace(), Tcl_DeleteCommandFromToken(), Tcl_DeleteTrace(), Tcl_ExposeCommand(), Tcl_ExprObj(), Tcl_HideCommand(), Tcl_RemoveInterpResolvers(), TclCompEvalObj(), TclInitByteCodeObj(), and TclRenameCommand().Tcl_Obj* Interp::emptyObjPtr

Definition at line 1345 of file tclInt.h.
Referenced by DeleteInterpProc(), Tcl_CreateInterp(), and TclPtrSetVar().char* Interp::errorCode

Definition at line 1270 of file tclInt.h.
Referenced by DeleteInterpProc(), Tcl_CreateInterp(), and Tcl_ReturnObjCmd().char* Interp::errorInfo

Definition at line 1268 of file tclInt.h.
Referenced by DeleteInterpProc(), Tcl_CreateInterp(), and Tcl_ReturnObjCmd().int Interp::errorLine

Definition at line 1213 of file tclInt.h.
Referenced by LogCompilationInfo(), ProcessProcResultCode(), Tcl_CreateInterp(), Tcl_LogCommandInfo(), and TclCompEvalObj().int Interp::evalFlags

Definition at line 1305 of file tclInt.h.
Referenced by Tcl_AllowExceptions(), Tcl_CreateInterp(), Tcl_EvalEx(), Tcl_EvalObjEx(), Tcl_EvalObjv(), Tcl_SubstObj(), and TclSetByteCodeFromAny().struct ExecEnv* Interp::execEnvPtr

Definition at line 1342 of file tclInt.h.
Referenced by DeleteInterpProc(), Tcl_AddObjErrorInfo(), Tcl_CreateInterp(), and TclExecuteByteCode().int Interp::flags

Definition at line 1336 of file tclInt.h.
Referenced by DeleteInterpProc(), ExprRandFunc(), ExprSrandFunc(), LogCompilationInfo(), Tcl_AddObjErrorInfo(), Tcl_CreateCommand(), Tcl_CreateInterp(), Tcl_CreateObjCommand(), Tcl_CreateObjTrace(), Tcl_DeleteInterp(), Tcl_DeleteTrace(), Tcl_ErrorObjCmd(), Tcl_EvalEx(), Tcl_EvalObjEx(), Tcl_ExposeCommand(), Tcl_HideCommand(), Tcl_IsSafe(), Tcl_LogCommandInfo(), Tcl_MakeSafe(), Tcl_SetErrorCodeVA(), Tcl_SetObjErrorCode(), TclCheckInterpTraces(), TclCompEvalObj(), TclCompileScript(), TclEvalObjvInternal(), TclExecuteByteCode(), TclInterpReady(), TclObjInvoke(), TclTransferResult(), TestevalexObjCmd(), and TraceExecutionProc().CallFrame* Interp::framePtr

Definition at line 1255 of file tclInt.h.
Referenced by Tcl_CreateInterp(), Tcl_PopCallFrame(), and Tcl_PushCallFrame().Tcl_FreeProc* Interp::freeProc

Definition at line 1206 of file tclInt.h.
Referenced by Tcl_CreateInterp(), Tcl_DStringGetResult(), Tcl_FreeResult(), Tcl_GetObjResult(), Tcl_RestoreResult(), Tcl_SaveResult(), Tcl_SetObjResult(), and Tcl_SetResult().Namespace* Interp::globalNsPtr

Definition at line 1227 of file tclInt.h.
Referenced by DeleteInterpProc(), GetTimesCmd(), SetCmdNameFromAny(), Tcl_AddInterpResolvers(), Tcl_CreateCommand(), Tcl_CreateInterp(), Tcl_CreateNamespace(), Tcl_CreateObjCommand(), Tcl_ExposeCommand(), Tcl_GetCommandFromObj(), Tcl_GetCommandFullName(), Tcl_GetCurrentNamespace(), Tcl_GetGlobalNamespace(), Tcl_GetVariableFullName(), Tcl_HideCommand(), Tcl_Import(), Tcl_ProcObjCmd(), Tcl_RemoveInterpResolvers(), TclCompEvalObj(), TclDeleteNamespaceVars(), TclEvalObjvInternal(), TclGetNamespaceForQualName(), TclLookupSimpleVar(), TclObjLookupVar(), TclRenameCommand(), and TclSetCmdNameObj().TclHandle Interp::handle

Definition at line 1224 of file tclInt.h.
Referenced by DeleteInterpProc(), Tcl_CreateInterp(), and TclInitByteCodeObj().Tcl_HashTable* Interp::hiddenCmdTablePtr

Definition at line 1228 of file tclInt.h.
Referenced by DeleteInterpProc(), Tcl_CreateInterp(), Tcl_ExposeCommand(), and Tcl_HideCommand().ClientData Interp::interpInfo

Definition at line 1232 of file tclInt.h.
Referenced by Tcl_CreateInterp().LiteralTable Interp::literalTable

Definition at line 1311 of file tclInt.h.
Referenced by DeleteInterpProc(), Tcl_CreateInterp(), TclLookupLiteralEntry(), TclRegisterLiteral(), and TclReleaseLiteral().Tcl_HashTable Interp::mathFuncTable

Definition at line 1235 of file tclInt.h.
Referenced by CompileMathFuncCall(), DeleteInterpProc(), ExprCallMathFunc(), ParsePrimaryExpr(), Tcl_CreateInterp(), Tcl_CreateMathFunc(), Tcl_GetMathFuncInfo(), and Tcl_ListMathFuncs().int Interp::maxNestingDepth

Definition at line 1252 of file tclInt.h.
Referenced by Tcl_CreateInterp(), Tcl_SetRecursionLimit(), and TclInterpReady().int Interp::numLevels

Definition at line 1247 of file tclInt.h.
Referenced by DeleteInterpProc(), SlaveRecursionLimit(), Tcl_CreateInterp(), Tcl_EvalEx(), Tcl_EvalObjEx(), Tcl_EvalObjv(), Tcl_SubstObj(), TclCheckInterpTraces(), TclCompEvalObj(), TclEvalObjvInternal(), TclExecuteByteCode(), TclInterpReady(), and TestcmdtraceCmd().Tcl_Obj* Interp::objResultPtr

Definition at line 1351 of file tclInt.h.
Referenced by DeleteInterpProc(), Tcl_AddObjErrorInfo(), Tcl_CreateInterp(), Tcl_GetObjResult(), Tcl_RestoreResult(), Tcl_SaveResult(), Tcl_SetObjResult(), and TclExecuteByteCode().Tcl_HashTable Interp::packageTable

Definition at line 1290 of file tclInt.h.
Referenced by FindPackage(), Tcl_CreateInterp(), Tcl_PackageObjCmd(), and Tcl_PkgPresentEx().char* Interp::packageUnknown

Definition at line 1294 of file tclInt.h.
Referenced by Tcl_CreateInterp(), and Tcl_PackageObjCmd().long Interp::randSeed

Definition at line 1337 of file tclInt.h.
Referenced by ExprRandFunc(), and ExprSrandFunc().ResolverScheme* Interp::resolverPtr

Definition at line 1327 of file tclInt.h.
Referenced by DeleteInterpProc(), Tcl_AddInterpResolvers(), Tcl_CreateInterp(), Tcl_FindCommand(), Tcl_FindNamespaceVar(), Tcl_GetInterpResolvers(), Tcl_RemoveInterpResolvers(), TclInitCompiledLocals(), TclLookupSimpleVar(), and TclObjLookupVar().char* Interp::result

Definition at line 1203 of file tclInt.h.
Referenced by Tcl_AddObjErrorInfo(), Tcl_AppendElement(), Tcl_AppendResultVA(), Tcl_CreateInterp(), Tcl_DStringGetResult(), Tcl_FreeResult(), Tcl_GetObjResult(), Tcl_RestoreResult(), Tcl_SaveResult(), Tcl_SetObjResult(), Tcl_SetResult(), and TclEvalObjvInternal().char Interp::resultSpace[TCL_RESULT_SIZE+1]

Definition at line 1349 of file tclInt.h.
Referenced by Tcl_CreateInterp(), Tcl_DStringGetResult(), Tcl_GetObjResult(), Tcl_RestoreResult(), Tcl_SaveResult(), Tcl_SetObjResult(), and Tcl_SetResult().int Interp::returnCode

Definition at line 1266 of file tclInt.h.
Referenced by Tcl_CreateInterp(), Tcl_ReturnObjCmd(), TraceCommandProc(), and TraceExecutionProc().Tcl_Obj* Interp::scriptFile

Definition at line 1333 of file tclInt.h.
Referenced by InfoScriptCmd(), Tcl_CreateInterp(), and Tcl_FSEvalFile().struct TclStubs* Interp::stubTable

Definition at line 1216 of file tclInt.h.
Referenced by HasStubSupport(), and Tcl_CreateInterp().int Interp::termOffset

Definition at line 1309 of file tclInt.h.
Referenced by Tcl_CreateInterp(), Tcl_EvalEx(), Tcl_ExprObj(), Tcl_SubstObj(), TclCompEvalObj(), TclCompileScript(), and TclSetByteCodeFromAny().Tcl_ThreadId Interp::threadId

Definition at line 1354 of file tclInt.h.
Referenced by Tcl_CreateInterp().Trace* Interp::tracePtr

Definition at line 1338 of file tclInt.h.
Referenced by DeleteInterpProc(), Tcl_CreateInterp(), Tcl_CreateObjTrace(), Tcl_DeleteTrace(), Tcl_EvalObjv(), TclCheckInterpTraces(), TclEvalObjvInternal(), and TclExecuteByteCode().int Interp::tracesForbiddingInline

Definition at line 1363 of file tclInt.h.
Referenced by Tcl_CreateInterp(), Tcl_CreateObjTrace(), and Tcl_DeleteTrace().CallFrame* Interp::varFramePtr

Definition at line 1258 of file tclInt.h.
Referenced by AppendLocals(), GetNamespaceFromObj(), InfoLevelCmd(), InfoLocalsCmd(), InfoVarsCmd(), ObjMakeUpvar(), SetCmdNameFromAny(), Tcl_CreateInterp(), Tcl_CreateNamespace(), Tcl_EvalEx(), Tcl_EvalObjEx(), Tcl_GetCommandFromObj(), Tcl_GetCurrentNamespace(), Tcl_GlobalEval(), Tcl_GlobalObjCmd(), Tcl_PopCallFrame(), Tcl_PushCallFrame(), Tcl_UplevelObjCmd(), Tcl_VariableObjCmd(), TclCheckExecutionTraces(), TclCompEvalObj(), TclEvalObjvInternal(), TclExecuteByteCode(), TclGetFrame(), TclGetNamespaceForQualName(), TclGlobalInvoke(), TclLookupSimpleVar(), TclObjInvokeGlobal(), TclObjLookupVar(), and TclSetCmdNameObj().
The documentation for this struct was generated from the following file:
generic/tclInt.h

InterpInfo Struct Reference

Detailed Description

Definition at line 141 of file tclInterp.c.Public Attributes
Master master
Slave slave

Member Data Documentation
Master InterpInfo::master

Definition at line 142 of file tclInterp.c.
Referenced by GetInterp(), InterpInfoDeleteProc(), SlaveCreate(), Tcl_GetInterpPath(), Tcl_InterpObjCmd(), and TclInterpInit().Slave InterpInfo::slave

Definition at line 144 of file tclInterp.c.
Referenced by InterpInfoDeleteProc(), Tcl_GetAlias(), Tcl_GetAliasObj(), Tcl_GetInterpPath(), Tcl_InterpObjCmd(), and TclInterpInit().
The documentation for this struct was generated from the following file:
generic/tclInterp.c

JumpFixup Struct Reference
#include <tclCompile.h>

Detailed Description

Definition at line 640 of file tclCompile.h.Public Attributes
TclJumpType jumpType
int codeOffset
int cmdIndex
int exceptIndex

Member Data Documentation
int JumpFixup::cmdIndex

Definition at line 644 of file tclCompile.h.
Referenced by TclEmitForwardJump(), and TclFixupForwardJump().int JumpFixup::codeOffset

Definition at line 642 of file tclCompile.h.
Referenced by CompileCondExpr(), CompileLandOrLorExpr(), TclCompileCatchCmd(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileWhileCmd(), TclEmitForwardJump(), and TclFixupForwardJump().int JumpFixup::exceptIndex

Definition at line 649 of file tclCompile.h.
Referenced by TclEmitForwardJump(), and TclFixupForwardJump().TclJumpType JumpFixup::jumpType

Definition at line 641 of file tclCompile.h.
Referenced by TclEmitForwardJump(), and TclFixupForwardJump().
The documentation for this struct was generated from the following file:
generic/tclCompile.h

JumpFixupArray Struct Reference
#include <tclCompile.h>

Detailed Description

Definition at line 659 of file tclCompile.h.Public Attributes
JumpFixup * fixup
int next
int end
int mallocedArray
JumpFixup staticFixupSpace [JUMPFIXUP_INIT_ENTRIES]

Member Data Documentation
int JumpFixupArray::end

Definition at line 662 of file tclCompile.h.JumpFixup* JumpFixupArray::fixup

Definition at line 660 of file tclCompile.h.int JumpFixupArray::mallocedArray

Definition at line 663 of file tclCompile.h.int JumpFixupArray::next

Definition at line 661 of file tclCompile.h.JumpFixup JumpFixupArray::staticFixupSpace[JUMPFIXUP_INIT_ENTRIES]

Definition at line 665 of file tclCompile.h.
The documentation for this struct was generated from the following file:
generic/tclCompile.h

Link Struct Reference

Detailed Description

Definition at line 27 of file tclLink.c.Public Attributes
Tcl_Interp * interp
Tcl_Obj * varName
char * addr
int type
union {
  int i
  double d
  Tcl_WideInt w
} lastValue
int flags

Member Data Documentation
char* Link::addr

Definition at line 33 of file tclLink.c.
Referenced by LinkTraceProc(), and Tcl_LinkVar().double Link::d

Definition at line 37 of file tclLink.c.
Referenced by LinkTraceProc().int Link::flags

Definition at line 41 of file tclLink.c.
Referenced by LinkTraceProc(), Tcl_LinkVar(), and Tcl_UpdateLinkedVar().int Link::i

Definition at line 36 of file tclLink.c.
Referenced by LinkTraceProc().Tcl_Interp* Link::interp

Definition at line 28 of file tclLink.c.
Referenced by Tcl_LinkVar().union { ... }   Link::lastValue

Referenced by LinkTraceProc().int Link::type

Definition at line 34 of file tclLink.c.
Referenced by LinkTraceProc(), and Tcl_LinkVar().Tcl_Obj* Link::varName

Definition at line 29 of file tclLink.c.
Referenced by LinkTraceProc(), Tcl_LinkVar(), and Tcl_UpdateLinkedVar().Tcl_WideInt Link::w

Definition at line 38 of file tclLink.c.
Referenced by LinkTraceProc().
The documentation for this struct was generated from the following file:
generic/tclLink.c

List Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 1531 of file tclInt.h.Public Attributes
int maxElemCount
int elemCount
Tcl_Obj ** elements

Member Data Documentation
int List::elemCount

Definition at line 1533 of file tclInt.h.
Referenced by DupListInternalRep(), FreeListInternalRep(), SetListFromAny(), Tcl_EvalObjEx(), Tcl_LappendObjCmd(), Tcl_ListObjAppendElement(), Tcl_ListObjAppendList(), Tcl_ListObjGetElements(), Tcl_ListObjIndex(), Tcl_ListObjLength(), Tcl_ListObjReplace(), Tcl_NewListObj(), Tcl_SetListObj(), TclListObjSetElement(), and UpdateStringOfList().Tcl_Obj** List::elements

Definition at line 1534 of file tclInt.h.
Referenced by DupListInternalRep(), FreeListInternalRep(), SetListFromAny(), Tcl_EvalObjEx(), Tcl_LappendObjCmd(), Tcl_ListObjAppendElement(), Tcl_ListObjGetElements(), Tcl_ListObjIndex(), Tcl_ListObjReplace(), Tcl_NewListObj(), Tcl_SetListObj(), TclListObjSetElement(), and UpdateStringOfList().int List::maxElemCount

Definition at line 1532 of file tclInt.h.
Referenced by DupListInternalRep(), SetListFromAny(), Tcl_LappendObjCmd(), Tcl_ListObjAppendElement(), Tcl_ListObjReplace(), Tcl_NewListObj(), and Tcl_SetListObj().
The documentation for this struct was generated from the following file:
generic/tclInt.h

listEl Struct Reference

Detailed Description

Definition at line 70 of file tclMacAlloc.c.Public Attributes
Handle memoryHandle
listEl * next
listEl * prec

Member Data Documentation
Handle listEl::memoryHandle

Definition at line 71 of file tclMacAlloc.c.
Referenced by CleanUpExitProc(), FreeAllMemory(), TclpSysAlloc(), TclpSysFree(), and TclpSysRealloc().struct listEl* listEl::next

Definition at line 72 of file tclMacAlloc.c.
Referenced by CleanUpExitProc(), FreeAllMemory(), TclpSysAlloc(), and TclpSysFree().struct listEl* listEl::prec

Definition at line 73 of file tclMacAlloc.c.
Referenced by TclpSysAlloc(), and TclpSysFree().
The documentation for this struct was generated from the following file:
mac/tclMacAlloc.c

LiteralEntry Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 945 of file tclInt.h.Public Attributes
LiteralEntry * nextPtr
Tcl_Obj * objPtr
int refCount

Member Data Documentation
struct LiteralEntry* LiteralEntry::nextPtr

Definition at line 946 of file tclInt.h.
Referenced by AddLocalLiteralEntry(), RebuildLiteralTable(), TclAddLiteralObj(), TclHideLiteral(), TclLookupLiteralEntry(), TclRegisterLiteral(), and TclReleaseLiteral().Tcl_Obj* LiteralEntry::objPtr

Definition at line 949 of file tclInt.h.
Referenced by AddLocalLiteralEntry(), RebuildLiteralTable(), Tcl_ExprObj(), TclAddLiteralObj(), TclCompileScript(), TclDeleteLiteralTable(), TclHideLiteral(), TclLookupLiteralEntry(), TclRegisterLiteral(), TclReleaseLiteral(), and TclSetByteCodeFromAny().int LiteralEntry::refCount

Definition at line 952 of file tclInt.h.
Referenced by AddLocalLiteralEntry(), TclAddLiteralObj(), TclRegisterLiteral(), and TclReleaseLiteral().
The documentation for this struct was generated from the following file:
generic/tclInt.h

LiteralTable Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 961 of file tclInt.h.Public Attributes
LiteralEntry ** buckets
LiteralEntry * staticBuckets [TCL_SMALL_HASH_TABLE]
int numBuckets
int numEntries
int rebuildSize
int mask

Member Data Documentation
LiteralEntry** LiteralTable::buckets

Definition at line 962 of file tclInt.h.
Referenced by AddLocalLiteralEntry(), ExpandLocalLiteralArray(), Tcl_ExprObj(), TclDeleteLiteralTable(), TclHideLiteral(), TclLookupLiteralEntry(), TclRegisterLiteral(), and TclReleaseLiteral().int LiteralTable::mask

Definition at line 975 of file tclInt.h.
Referenced by TclHideLiteral(), TclLookupLiteralEntry(), TclRegisterLiteral(), and TclReleaseLiteral().int LiteralTable::numBuckets

Definition at line 969 of file tclInt.h.
Referenced by AddLocalLiteralEntry(), ExpandLocalLiteralArray(), TclDeleteLiteralTable(), and TclRegisterLiteral().int LiteralTable::numEntries

Definition at line 971 of file tclInt.h.
Referenced by AddLocalLiteralEntry(), TclDeleteLiteralTable(), TclHideLiteral(), TclRegisterLiteral(), and TclReleaseLiteral().int LiteralTable::rebuildSize

Definition at line 973 of file tclInt.h.
Referenced by AddLocalLiteralEntry(), and TclRegisterLiteral().LiteralEntry* LiteralTable::staticBuckets[TCL_SMALL_HASH_TABLE]

Definition at line 965 of file tclInt.h.
Referenced by Tcl_ExprObj(), and TclDeleteLiteralTable().
The documentation for this struct was generated from the following file:
generic/tclInt.h

LoadedPackage Struct Reference

Detailed Description

Definition at line 26 of file tclLoad.c.Public Attributes
char * fileName
char * packageName
Tcl_LoadHandle loadHandle
Tcl_PackageInitProc * initProc
Tcl_PackageInitProc * safeInitProc
Tcl_FSUnloadFileProc * unLoadProcPtr
LoadedPackage * nextPtr

Member Data Documentation
char* LoadedPackage::fileName

Definition at line 27 of file tclLoad.c.
Referenced by Tcl_LoadObjCmd(), TclFinalizeLoad(), and TclGetLoadedPackages().Tcl_PackageInitProc* LoadedPackage::initProc

Definition at line 39 of file tclLoad.c.
Referenced by Tcl_StaticPackage().Tcl_LoadHandle LoadedPackage::loadHandle

Definition at line 35 of file tclLoad.c.
Referenced by TclFinalizeLoad().struct LoadedPackage* LoadedPackage::nextPtr

Definition at line 55 of file tclLoad.c.
Referenced by Tcl_LoadObjCmd(), Tcl_StaticPackage(), TclFinalizeLoad(), and TclGetLoadedPackages().char* LoadedPackage::packageName

Definition at line 31 of file tclLoad.c.
Referenced by Tcl_LoadObjCmd(), Tcl_StaticPackage(), TclFinalizeLoad(), and TclGetLoadedPackages().Tcl_PackageInitProc* LoadedPackage::safeInitProc

Definition at line 43 of file tclLoad.c.
Referenced by Tcl_StaticPackage().Tcl_FSUnloadFileProc* LoadedPackage::unLoadProcPtr

Definition at line 50 of file tclLoad.c.
Referenced by TclFinalizeLoad().
The documentation for this struct was generated from the following file:
generic/tclLoad.c

LocaleTable Struct Reference

Detailed Description

Definition at line 83 of file tclUnixInit.c.Public Attributes
CONST char * lang
CONST char * encoding

Member Data Documentation
CONST char* LocaleTable::encoding

Definition at line 85 of file tclUnixInit.c.CONST char* LocaleTable::lang

Definition at line 84 of file tclUnixInit.c.
The documentation for this struct was generated from the following file:
unix/tclUnixInit.c

Map Struct Reference

Detailed Description

Definition at line 81 of file tclMacInit.c.Public Attributes
int numKey
char * strKey

Member Data Documentation
int Map::numKey

Definition at line 82 of file tclMacInit.c.
Referenced by TclMacGetFontEncoding().char* Map::strKey

Definition at line 83 of file tclMacInit.c.
Referenced by TclMacGetFontEncoding().
The documentation for this struct was generated from the following file:
mac/tclMacInit.c

Master Struct Reference

Detailed Description

Definition at line 124 of file tclInterp.c.Public Attributes
Tcl_HashTable slaveTable
Tcl_HashTable targetTable

Member Data Documentation
Tcl_HashTable Master::slaveTable

Definition at line 125 of file tclInterp.c.
Referenced by GetInterp(), InterpInfoDeleteProc(), SlaveCreate(), Tcl_GetInterpPath(), Tcl_InterpObjCmd(), and TclInterpInit().Tcl_HashTable Master::targetTable

Definition at line 127 of file tclInterp.c.
Referenced by AliasCreate(), InterpInfoDeleteProc(), and TclInterpInit().
The documentation for this struct was generated from the following file:
generic/tclInterp.c

MathFunc Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 830 of file tclInt.h.Public Attributes
int builtinFuncIndex
int numArgs
Tcl_ValueType argTypes [MAX_MATH_ARGS]
Tcl_MathProc * proc
ClientData clientData

Member Data Documentation
Tcl_ValueType MathFunc::argTypes[MAX_MATH_ARGS]

Definition at line 839 of file tclInt.h.
Referenced by ExprCallMathFunc(), Tcl_CreateMathFunc(), and Tcl_GetMathFuncInfo().int MathFunc::builtinFuncIndex

Definition at line 831 of file tclInt.h.
Referenced by CompileMathFuncCall(), Tcl_CreateMathFunc(), and Tcl_GetMathFuncInfo().ClientData MathFunc::clientData

Definition at line 843 of file tclInt.h.
Referenced by Tcl_CreateMathFunc().int MathFunc::numArgs

Definition at line 838 of file tclInt.h.
Referenced by CompileMathFuncCall(), ExprCallMathFunc(), Tcl_CreateMathFunc(), and Tcl_GetMathFuncInfo().Tcl_MathProc* MathFunc::proc

Definition at line 841 of file tclInt.h.
Referenced by Tcl_CreateMathFunc().
The documentation for this struct was generated from the following file:
generic/tclInt.h

Module Struct Reference

Detailed Description

Definition at line 66 of file tclLoadAix.c.Public Attributes
Module * next
char * name
int refCnt
void * entry
dl_info * info
CdtorPtr cdtors
int nExports
ExportPtr exports

Member Data Documentation
CdtorPtr Module::cdtors

Definition at line 72 of file tclLoadAix.c.
Referenced by dlclose().void* Module::entry

Definition at line 70 of file tclLoadAix.c.
Referenced by dlclose(), and readExports().ExportPtr Module::exports

Definition at line 74 of file tclLoadAix.c.
Referenced by dlclose(), dlsym(), and readExports().struct dl_info* Module::info

Definition at line 71 of file tclLoadAix.c.
Referenced by dlclose().char* Module::name

Definition at line 68 of file tclLoadAix.c.
Referenced by dlopen(), and readExports().int Module::nExports

Definition at line 73 of file tclLoadAix.c.
Referenced by dlclose(), dlsym(), and readExports().struct Module* Module::next

Definition at line 67 of file tclLoadAix.c.
Referenced by dlclose(), and dlopen().int Module::refCnt

Definition at line 69 of file tclLoadAix.c.
Referenced by dlclose(), and dlopen().
The documentation for this struct was generated from the following file:
unix/tclLoadAix.c

MountPointMap Struct Reference

Detailed Description

Definition at line 217 of file tclWin32Dll.c.Public Attributes
CONST WCHAR * volumeName
char driveLetter
MountPointMap * nextPtr

Member Data Documentation
char MountPointMap::driveLetter

Definition at line 219 of file tclWin32Dll.c.
Referenced by TclWinDriveLetterForVolMountPoint().struct MountPointMap* MountPointMap::nextPtr

Definition at line 221 of file tclWin32Dll.c.
Referenced by TclWinDriveLetterForVolMountPoint(), and TclWinResetInterfaceEncodings().CONST WCHAR* MountPointMap::volumeName

Definition at line 218 of file tclWin32Dll.c.
Referenced by TclWinDriveLetterForVolMountPoint(), and TclWinResetInterfaceEncodings().
The documentation for this struct was generated from the following file:
win/tclWin32Dll.c

Namespace Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 168 of file tclInt.h.Public Attributes
char * name
char * fullName
ClientData clientData
Tcl_NamespaceDeleteProc * deleteProc
Namespace * parentPtr
Tcl_HashTable childTable
long nsId
Tcl_Interp * interp
int flags
int activationCount
int refCount
Tcl_HashTable cmdTable
Tcl_HashTable varTable
char ** exportArrayPtr
int numExportPatterns
int maxExportPatterns
int cmdRefEpoch
int resolverEpoch
Tcl_ResolveCmdProc * cmdResProc
Tcl_ResolveVarProc * varResProc
Tcl_ResolveCompiledVarProc * compiledVarResProc

Member Data Documentation
int Namespace::activationCount

Definition at line 192 of file tclInt.h.
Referenced by Tcl_CreateNamespace(), Tcl_DeleteNamespace(), Tcl_PopCallFrame(), and Tcl_PushCallFrame().Tcl_HashTable Namespace::childTable

Definition at line 183 of file tclInt.h.
Referenced by NamespaceChildrenCmd(), Tcl_CreateNamespace(), Tcl_DeleteNamespace(), TclGetNamespaceForQualName(), and TclResetShadowedCmdRefs().ClientData Namespace::clientData

Definition at line 175 of file tclInt.h.
Referenced by Tcl_CreateNamespace().int Namespace::cmdRefEpoch

Definition at line 222 of file tclInt.h.
Referenced by SetCmdNameFromAny(), Tcl_CreateNamespace(), Tcl_GetCommandFromObj(), Tcl_SetNamespaceResolvers(), TclResetShadowedCmdRefs(), and TclSetCmdNameObj().Tcl_ResolveCmdProc* Namespace::cmdResProc

Definition at line 234 of file tclInt.h.
Referenced by Tcl_CreateNamespace(), Tcl_FindCommand(), Tcl_GetNamespaceResolvers(), and Tcl_SetNamespaceResolvers().Tcl_HashTable Namespace::cmdTable

Definition at line 200 of file tclInt.h.
Referenced by GetTimesCmd(), InfoCommandsCmd(), InfoProcsCmd(), Tcl_CreateCommand(), Tcl_CreateInterp(), Tcl_CreateNamespace(), Tcl_CreateObjCommand(), Tcl_ExposeCommand(), Tcl_ForgetImport(), Tcl_Import(), TclRenameCommand(), and TclResetShadowedCmdRefs().Tcl_ResolveCompiledVarProc* Namespace::compiledVarResProc

Definition at line 247 of file tclInt.h.
Referenced by Tcl_CreateNamespace(), Tcl_GetNamespaceResolvers(), Tcl_SetNamespaceResolvers(), and TclInitCompiledLocals().Tcl_NamespaceDeleteProc* Namespace::deleteProc

Definition at line 177 of file tclInt.h.
Referenced by Tcl_CreateNamespace().char** Namespace::exportArrayPtr

Definition at line 211 of file tclInt.h.
Referenced by Tcl_AppendExportList(), Tcl_CreateNamespace(), Tcl_Export(), and Tcl_Import().int Namespace::flags

Definition at line 189 of file tclInt.h.
Referenced by GetNamespaceFromObj(), Tcl_CreateNamespace(), Tcl_DeleteNamespace(), Tcl_PopCallFrame(), and Tcl_PushCallFrame().char* Namespace::fullName

Definition at line 173 of file tclInt.h.
Referenced by NamespaceChildrenCmd(), NamespaceCodeCmd(), NamespaceCurrentCmd(), Tcl_CreateNamespace(), Tcl_GetCommandFullName(), Tcl_Import(), Tcl_ProcObjCmd(), and TclRenameCommand().Tcl_Interp* Namespace::interp

Definition at line 187 of file tclInt.h.
Referenced by Tcl_CreateNamespace(), Tcl_DeleteNamespace(), and TclInitCompiledLocals().int Namespace::maxExportPatterns

Definition at line 220 of file tclInt.h.
Referenced by Tcl_CreateNamespace(), and Tcl_Export().char* Namespace::name

Definition at line 169 of file tclInt.h.
Referenced by Tcl_CreateNamespace(), Tcl_DeleteNamespace(), Tcl_Import(), and TclResetShadowedCmdRefs().long Namespace::nsId

Definition at line 186 of file tclInt.h.
Referenced by SetCmdNameFromAny(), SetNsNameFromAny(), Tcl_CreateNamespace(), Tcl_GetCommandFromObj(), and TclSetCmdNameObj().int Namespace::numExportPatterns

Definition at line 218 of file tclInt.h.
Referenced by Tcl_AppendExportList(), Tcl_CreateNamespace(), Tcl_Export(), and Tcl_Import().struct Namespace* Namespace::parentPtr

Definition at line 180 of file tclInt.h.
Referenced by Tcl_CreateNamespace(), Tcl_DeleteNamespace(), and TclResetShadowedCmdRefs().int Namespace::refCount

Definition at line 197 of file tclInt.h.
Referenced by SetNsNameFromAny(), and Tcl_CreateNamespace().int Namespace::resolverEpoch

Definition at line 227 of file tclInt.h.
Referenced by Tcl_CreateNamespace(), Tcl_SetNamespaceResolvers(), TclCompEvalObj(), TclInitByteCodeObj(), and TclResetShadowedCmdRefs().Tcl_ResolveVarProc* Namespace::varResProc

Definition at line 240 of file tclInt.h.
Referenced by Tcl_CreateNamespace(), Tcl_FindNamespaceVar(), Tcl_GetNamespaceResolvers(), Tcl_SetNamespaceResolvers(), TclLookupSimpleVar(), and TclObjLookupVar().Tcl_HashTable Namespace::varTable

Definition at line 208 of file tclInt.h.
Referenced by InfoGlobalsCmd(), InfoVarsCmd(), Tcl_CreateNamespace(), TclDeleteVars(), and TclLookupSimpleVar().
The documentation for this struct was generated from the following file:
generic/tclInt.h

NextChannelHandler Struct Reference
#include <tclIO.h>

Detailed Description

Definition at line 369 of file tclIO.h.Public Attributes
ChannelHandler * nextHandlerPtr
NextChannelHandler * nestedHandlerPtr

Member Data Documentation
struct NextChannelHandler* NextChannelHandler::nestedHandlerPtr

Definition at line 372 of file tclIO.h.
Referenced by Tcl_ClearChannelHandlers(), Tcl_DeleteChannelHandler(), and Tcl_NotifyChannel().ChannelHandler* NextChannelHandler::nextHandlerPtr

Definition at line 370 of file tclIO.h.
Referenced by Tcl_ClearChannelHandlers(), Tcl_DeleteChannelHandler(), and Tcl_NotifyChannel().
The documentation for this struct was generated from the following file:
generic/tclIO.h

nfa Struct Reference
#include <regguts.h>

Detailed Description

Definition at line 317 of file regguts.h.Public Attributes
state * pre
state * init
state * final
state * post
int nstates
state * states
state * slast
state * free
colormap * cm
color bos [2]
color eos [2]
vars * v
nfa * parent

Member Data Documentation
color nfa::bos[2]

Definition at line 327 of file regguts.h.
Referenced by makesearch().struct colormap* nfa::cm

Definition at line 326 of file regguts.h.
Referenced by makesearch(), and newnfa().color nfa::eos[2]

Definition at line 328 of file regguts.h.struct state* nfa::final

Definition at line 320 of file regguts.h.
Referenced by nfanode().struct state* nfa::free

Definition at line 325 of file regguts.h.struct state* nfa::init

Definition at line 319 of file regguts.h.
Referenced by newnfa(), and nfanode().int nfa::nstates

Definition at line 322 of file regguts.h.struct nfa* nfa::parent

Definition at line 330 of file regguts.h.
Referenced by newnfa().struct state* nfa::post

Definition at line 321 of file regguts.h.struct state* nfa::pre

Definition at line 318 of file regguts.h.
Referenced by makesearch().struct state* nfa::slast

Definition at line 324 of file regguts.h.struct state* nfa::states

Definition at line 323 of file regguts.h.struct vars* nfa::v

Definition at line 329 of file regguts.h.
The documentation for this struct was generated from the following file:
generic/regguts.h

NotifierState Struct Reference

Detailed Description

Definition at line 58 of file tclXtNotify.c.Public Attributes
XtAppContext appContext
int appContextCreated
XtIntervalId currentTimeout
FileHandler * firstFileHandlerPtr

Member Data Documentation
XtAppContext NotifierState::appContext

Definition at line 59 of file tclXtNotify.c.int NotifierState::appContextCreated

Definition at line 62 of file tclXtNotify.c.XtIntervalId NotifierState::currentTimeout

Definition at line 63 of file tclXtNotify.c.FileHandler* NotifierState::firstFileHandlerPtr

Definition at line 64 of file tclXtNotify.c.
The documentation for this struct was generated from the following file:
unix/tclXtNotify.c

OemId Struct Reference

Detailed Description

Definition at line 25 of file tclWinInit.c.Public Attributes
WORD wProcessorArchitecture
WORD wReserved

Member Data Documentation
WORD OemId::wProcessorArchitecture

Definition at line 26 of file tclWinInit.c.
Referenced by TclpSetVariables().WORD OemId::wReserved

Definition at line 27 of file tclWinInit.c.
The documentation for this struct was generated from the following file:
win/tclWinInit.c

olddirect Struct Reference

Detailed Description

Definition at line 49 of file opendir.c.Public Attributes
ino_t od_ino
char od_name [ODIRSIZ]

Member Data Documentation
ino_t olddirect::od_ino

Definition at line 50 of file opendir.c.char olddirect::od_name[ODIRSIZ]

Definition at line 51 of file opendir.c.
The documentation for this struct was generated from the following file:
compat/opendir.c

OpenFileChannelProc Struct Reference

Detailed Description

Definition at line 330 of file tclIOUtil.c.Public Attributes
TclOpenFileChannelProc_ * proc
OpenFileChannelProc * nextPtr

Member Data Documentation
struct OpenFileChannelProc* OpenFileChannelProc::nextPtr

Definition at line 333 of file tclIOUtil.c.
Referenced by Tcl_FSOpenFileChannel(), TclOpenFileChannelDeleteProc(), and TclOpenFileChannelInsertProc().TclOpenFileChannelProc_* OpenFileChannelProc::proc

Definition at line 331 of file tclIOUtil.c.
Referenced by Tcl_FSOpenFileChannel(), TclOpenFileChannelDeleteProc(), and TclOpenFileChannelInsertProc().
The documentation for this struct was generated from the following file:
generic/tclIOUtil.c

OpenResourceFork Struct Reference

Detailed Description

Definition at line 62 of file tclMacResource.c.Public Attributes
short fileRef
int flags

Member Data Documentation
short OpenResourceFork::fileRef

Definition at line 63 of file tclMacResource.c.
Referenced by GetRsrcRefFromObj(), Tcl_MacFindResource(), Tcl_ResourceObjCmd(), TclMacRegisterResourceFork(), and TclMacUnRegisterResourceFork().int OpenResourceFork::flags

Definition at line 64 of file tclMacResource.c.
Referenced by TclMacRegisterResourceFork(), and TclMacUnRegisterResourceFork().
The documentation for this struct was generated from the following file:
mac/tclMacResource.c

Package Struct Reference

Detailed Description

Definition at line 44 of file tclPkg.c.Public Attributes
char * version
PkgAvail * availPtr
ClientData clientData

Member Data Documentation
PkgAvail* Package::availPtr

Definition at line 49 of file tclPkg.c.
Referenced by FindPackage(), Tcl_PackageObjCmd(), and TclFreePackageInfo().ClientData Package::clientData

Definition at line 51 of file tclPkg.c.
Referenced by FindPackage(), Tcl_PkgPresentEx(), and Tcl_PkgProvideEx().char* Package::version

Definition at line 45 of file tclPkg.c.
Referenced by FindPackage(), Tcl_PackageObjCmd(), Tcl_PkgPresentEx(), Tcl_PkgProvideEx(), and TclFreePackageInfo().
The documentation for this struct was generated from the following file:
generic/tclPkg.c

ParseInfo Struct Reference

Detailed Description

Definition at line 53 of file tclParseExpr.c.Public Attributes
Tcl_Parse * parsePtr
int lexeme
CONST char * start
int size
CONST char * next
CONST char * prevEnd
CONST char * originalExpr
CONST char * lastChar

Member Data Documentation
CONST char* ParseInfo::lastChar

Definition at line 68 of file tclParseExpr.c.
Referenced by Tcl_ParseExpr().int ParseInfo::lexeme

Definition at line 56 of file tclParseExpr.c.
Referenced by Tcl_ParseExpr().CONST char* ParseInfo::next

Definition at line 61 of file tclParseExpr.c.
Referenced by Tcl_ParseExpr().CONST char* ParseInfo::originalExpr

Definition at line 66 of file tclParseExpr.c.
Referenced by Tcl_ParseExpr().Tcl_Parse* ParseInfo::parsePtr

Definition at line 54 of file tclParseExpr.c.
Referenced by PrependSubExprTokens(), and Tcl_ParseExpr().CONST char* ParseInfo::prevEnd

Definition at line 63 of file tclParseExpr.c.
Referenced by Tcl_ParseExpr().int ParseInfo::size

Definition at line 60 of file tclParseExpr.c.
Referenced by ParsePrimaryExpr(), and Tcl_ParseExpr().CONST char* ParseInfo::start

Definition at line 59 of file tclParseExpr.c.
Referenced by ParsePrimaryExpr(), and Tcl_ParseExpr().
The documentation for this struct was generated from the following file:
generic/tclParseExpr.c

Pipe Struct Reference

Detailed Description

Definition at line 40 of file tclUnixTest.c.Public Attributes
TclFile readFile
TclFile writeFile
int readCount
int writeCount

Member Data Documentation
int Pipe::readCount

Definition at line 45 of file tclUnixTest.c.
Referenced by TestfilehandlerCmd(), and TestFileHandlerProc().TclFile Pipe::readFile

Definition at line 41 of file tclUnixTest.c.
Referenced by TestfilehandlerCmd().int Pipe::writeCount

Definition at line 48 of file tclUnixTest.c.
Referenced by TestfilehandlerCmd(), and TestFileHandlerProc().TclFile Pipe::writeFile

Definition at line 43 of file tclUnixTest.c.
Referenced by TestfilehandlerCmd().
The documentation for this struct was generated from the following file:
unix/tclUnixTest.c

PipeEvent Struct Reference

Detailed Description

Definition at line 169 of file tclWinPipe.c.Public Attributes
Tcl_Event header
PipeInfo * infoPtr

Member Data Documentation
Tcl_Event PipeEvent::header

Definition at line 170 of file tclWinPipe.c.
Referenced by PipeCheckProc().PipeInfo* PipeEvent::infoPtr

Definition at line 172 of file tclWinPipe.c.
Referenced by PipeCheckProc(), and PipeEventProc().
The documentation for this struct was generated from the following file:
win/tclWinPipe.c

pipeinfo Struct Reference

Detailed Description

Definition at line 46 of file nmakehlp.c.Public Attributes
HANDLE pipe
char buffer [STATICBUFFERSIZE]

Member Data Documentation
char pipeinfo::buffer[STATICBUFFERSIZE]

Definition at line 48 of file nmakehlp.c.
Referenced by CheckForCompilerFeature(), CheckForLinkerFeature(), and ReadFromPipe().HANDLE pipeinfo::pipe

Definition at line 47 of file nmakehlp.c.
Referenced by CheckForCompilerFeature(), CheckForLinkerFeature(), and ReadFromPipe().
The documentation for this struct was generated from the following file:
win/nmakehlp.c

PipeInfo Struct Reference

Detailed Description

Definition at line 94 of file tclWinPipe.c.Public Attributes
PipeInfo * nextPtr
Tcl_Channel channel
int validMask
int watchMask
int flags
TclFile readFile
TclFile writeFile
TclFile errorFile
int numPids
Tcl_Pid * pidPtr
Tcl_ThreadId threadId
HANDLE writeThread
HANDLE readThread
HANDLE writable
HANDLE readable
HANDLE startWriter
HANDLE stopWriter
HANDLE startReader
HANDLE stopReader
DWORD writeError
char * writeBuf
int writeBufLen
int toWrite
int readFlags
char extraByte

Member Data Documentation
Tcl_Channel PipeInfo::channel

Definition at line 96 of file tclWinPipe.c.
Referenced by PipeEventProc(), PipeThreadActionProc(), and TclpCreateCommandChannel().TclFile PipeInfo::errorFile

Definition at line 106 of file tclWinPipe.c.
Referenced by PipeClose2Proc(), and TclpCreateCommandChannel().char PipeInfo::extraByte

Definition at line 147 of file tclWinPipe.c.
Referenced by PipeInputProc(), and PipeReaderThread().int PipeInfo::flags

Definition at line 103 of file tclWinPipe.c.
Referenced by PipeBlockModeProc(), PipeCheckProc(), PipeClose2Proc(), PipeEventProc(), PipeInputProc(), PipeOutputProc(), and TclpCreateCommandChannel().struct PipeInfo* PipeInfo::nextPtr

Definition at line 95 of file tclWinPipe.c.
Referenced by PipeCheckProc(), PipeClose2Proc(), PipeEventProc(), PipeSetupProc(), and PipeWatchProc().int PipeInfo::numPids

Definition at line 107 of file tclWinPipe.c.
Referenced by PipeClose2Proc(), Tcl_PidObjCmd(), TclGetAndDetachPids(), and TclpCreateCommandChannel().Tcl_Pid* PipeInfo::pidPtr

Definition at line 108 of file tclWinPipe.c.
Referenced by PipeClose2Proc(), Tcl_PidObjCmd(), TclGetAndDetachPids(), and TclpCreateCommandChannel().HANDLE PipeInfo::readable

Definition at line 117 of file tclWinPipe.c.
Referenced by PipeClose2Proc(), PipeReaderThread(), TclpCreateCommandChannel(), and WaitForRead().TclFile PipeInfo::readFile

Definition at line 104 of file tclWinPipe.c.
Referenced by PipeCheckProc(), PipeClose2Proc(), PipeGetHandleProc(), PipeInputProc(), PipeReaderThread(), PipeSetupProc(), TclpCreateCommandChannel(), and WaitForRead().int PipeInfo::readFlags

Definition at line 144 of file tclWinPipe.c.
Referenced by PipeEventProc(), PipeInputProc(), PipeReaderThread(), TclpCreateCommandChannel(), and WaitForRead().HANDLE PipeInfo::readThread

Definition at line 113 of file tclWinPipe.c.
Referenced by PipeClose2Proc(), and TclpCreateCommandChannel().HANDLE PipeInfo::startReader

Definition at line 125 of file tclWinPipe.c.
Referenced by PipeClose2Proc(), PipeReaderThread(), TclpCreateCommandChannel(), and WaitForRead().HANDLE PipeInfo::startWriter

Definition at line 120 of file tclWinPipe.c.
Referenced by PipeClose2Proc(), PipeOutputProc(), PipeWriterThread(), and TclpCreateCommandChannel().HANDLE PipeInfo::stopReader

Definition at line 128 of file tclWinPipe.c.
Referenced by PipeClose2Proc(), PipeReaderThread(), and TclpCreateCommandChannel().HANDLE PipeInfo::stopWriter

Definition at line 123 of file tclWinPipe.c.
Referenced by PipeClose2Proc(), PipeWriterThread(), and TclpCreateCommandChannel().Tcl_ThreadId PipeInfo::threadId

Definition at line 109 of file tclWinPipe.c.
Referenced by PipeReaderThread(), PipeThreadActionProc(), PipeWriterThread(), and TclpCreateCommandChannel().int PipeInfo::toWrite

Definition at line 142 of file tclWinPipe.c.
Referenced by PipeOutputProc(), and PipeWriterThread().int PipeInfo::validMask

Definition at line 97 of file tclWinPipe.c.
Referenced by PipeClose2Proc(), PipeWatchProc(), and TclpCreateCommandChannel().int PipeInfo::watchMask

Definition at line 100 of file tclWinPipe.c.
Referenced by PipeCheckProc(), PipeClose2Proc(), PipeEventProc(), PipeSetupProc(), PipeWatchProc(), and TclpCreateCommandChannel().HANDLE PipeInfo::writable

Definition at line 114 of file tclWinPipe.c.
Referenced by PipeCheckProc(), PipeClose2Proc(), PipeEventProc(), PipeOutputProc(), PipeSetupProc(), PipeWriterThread(), and TclpCreateCommandChannel().char* PipeInfo::writeBuf

Definition at line 136 of file tclWinPipe.c.
Referenced by PipeClose2Proc(), PipeOutputProc(), PipeWriterThread(), and TclpCreateCommandChannel().int PipeInfo::writeBufLen

Definition at line 139 of file tclWinPipe.c.
Referenced by PipeOutputProc(), and TclpCreateCommandChannel().DWORD PipeInfo::writeError

Definition at line 130 of file tclWinPipe.c.
Referenced by PipeOutputProc(), PipeWriterThread(), and TclpCreateCommandChannel().TclFile PipeInfo::writeFile

Definition at line 105 of file tclWinPipe.c.
Referenced by PipeCheckProc(), PipeClose2Proc(), PipeGetHandleProc(), PipeOutputProc(), PipeSetupProc(), PipeWriterThread(), and TclpCreateCommandChannel().HANDLE PipeInfo::writeThread

Definition at line 112 of file tclWinPipe.c.
Referenced by PipeClose2Proc(), and TclpCreateCommandChannel().
The documentation for this struct was generated from the following file:
win/tclWinPipe.c

PipeState Struct Reference

Detailed Description

Definition at line 36 of file tclUnixPipe.c.Public Attributes
Tcl_Channel channel
TclFile inFile
TclFile outFile
TclFile errorFile
int numPids
Tcl_Pid * pidPtr
int isNonBlocking

Member Data Documentation
Tcl_Channel PipeState::channel

Definition at line 37 of file tclUnixPipe.c.
Referenced by PipeWatchProc().TclFile PipeState::errorFile

Definition at line 40 of file tclUnixPipe.c.
Referenced by PipeCloseProc().TclFile PipeState::inFile

Definition at line 38 of file tclUnixPipe.c.
Referenced by PipeBlockModeProc(), PipeCloseProc(), PipeGetHandleProc(), PipeInputProc(), and PipeWatchProc().int PipeState::isNonBlocking

Definition at line 44 of file tclUnixPipe.c.
Referenced by PipeBlockModeProc(), and PipeCloseProc().int PipeState::numPids

Definition at line 41 of file tclUnixPipe.c.
Referenced by PipeCloseProc(), Tcl_PidObjCmd(), and TclGetAndDetachPids().TclFile PipeState::outFile

Definition at line 39 of file tclUnixPipe.c.
Referenced by PipeBlockModeProc(), PipeCloseProc(), PipeGetHandleProc(), PipeOutputProc(), and PipeWatchProc().Tcl_Pid* PipeState::pidPtr

Definition at line 42 of file tclUnixPipe.c.
Referenced by PipeCloseProc(), Tcl_PidObjCmd(), and TclGetAndDetachPids().
The documentation for this struct was generated from the following file:
unix/tclUnixPipe.c

PkgAvail Struct Reference

Detailed Description

Definition at line 28 of file tclPkg.c.Public Attributes
char * version
char * script
PkgAvail * nextPtr

Member Data Documentation
struct PkgAvail* PkgAvail::nextPtr

Definition at line 33 of file tclPkg.c.
Referenced by Tcl_PackageObjCmd(), and TclFreePackageInfo().char* PkgAvail::script

Definition at line 30 of file tclPkg.c.
Referenced by Tcl_PackageObjCmd(), and TclFreePackageInfo().char* PkgAvail::version

Definition at line 29 of file tclPkg.c.
Referenced by Tcl_PackageObjCmd(), and TclFreePackageInfo().
The documentation for this struct was generated from the following file:
generic/tclPkg.c

PortInfo Struct Reference

Detailed Description

Definition at line 57 of file tclMacSock.c.Public Attributes
char * name
int port

Member Data Documentation
char* PortInfo::name

Definition at line 58 of file tclMacSock.c.
Referenced by TclSockGetPort().int PortInfo::port

Definition at line 59 of file tclMacSock.c.
The documentation for this struct was generated from the following file:
mac/tclMacSock.c

Proc Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 669 of file tclInt.h.Public Attributes
Interp * iPtr
int refCount
Command * cmdPtr
Tcl_Obj * bodyPtr
int numArgs
int numCompiledLocals
CompiledLocal * firstLocalPtr
CompiledLocal * lastLocalPtr

Member Data Documentation
Tcl_Obj* Proc::bodyPtr

Definition at line 681 of file tclInt.h.
Referenced by InfoBodyCmd(), TclCreateProc(), and TclObjInterpProc().struct Command* Proc::cmdPtr

Definition at line 677 of file tclInt.h.
Referenced by ProcCompileProc(), TclCompileScript(), and TclObjInterpProc().CompiledLocal* Proc::firstLocalPtr

Definition at line 687 of file tclInt.h.
Referenced by AppendLocals(), InfoArgsCmd(), InfoDefaultCmd(), ProcCompileProc(), TclCreateProc(), TclInitCompiledLocals(), TclLookupSimpleVar(), TclObjInterpProc(), TclPrintInstruction(), and UpdateLocalVarName().struct Interp* Proc::iPtr

Definition at line 670 of file tclInt.h.
Referenced by ProcCompileProc(), and TclCreateProc().CompiledLocal* Proc::lastLocalPtr

Definition at line 692 of file tclInt.h.
Referenced by TclCreateProc().int Proc::numArgs

Definition at line 683 of file tclInt.h.
Referenced by ProcCompileProc(), TclCreateProc(), and TclObjInterpProc().int Proc::numCompiledLocals

Definition at line 684 of file tclInt.h.
Referenced by TclCreateProc(), TclLookupSimpleVar(), TclObjInterpProc(), and TclPrintInstruction().int Proc::refCount

Definition at line 672 of file tclInt.h.
Referenced by DupLocalVarName(), FreeLocalVarName(), ProcBodyDup(), ProcBodyFree(), ProcCompileProc(), TclCreateProc(), TclObjLookupVar(), and TclProcDeleteProc().
The documentation for this struct was generated from the following file:
generic/tclInt.h

ProcInfo Struct Reference

Detailed Description

Definition at line 68 of file tclWinPipe.c.Public Attributes
HANDLE hProcess
DWORD dwProcessId
ProcInfo * nextPtr

Member Data Documentation
DWORD ProcInfo::dwProcessId

Definition at line 70 of file tclWinPipe.c.
Referenced by TclpGetPid(), and TclWinAddProcess().HANDLE ProcInfo::hProcess

Definition at line 69 of file tclWinPipe.c.
Referenced by Tcl_WaitPid(), TclpGetPid(), and TclWinAddProcess().struct ProcInfo* ProcInfo::nextPtr

Definition at line 71 of file tclWinPipe.c.
Referenced by Tcl_WaitPid(), TclpGetPid(), and TclWinAddProcess().
The documentation for this struct was generated from the following file:
win/tclWinPipe.c

ptrs Struct Reference
#include <regguts.h>

Detailed Description

Definition at line 196 of file regguts.h.Public Attributes
tree * pptr [BYTTAB]

Member Data Documentation
union tree* ptrs::pptr[BYTTAB]

Definition at line 197 of file regguts.h.
The documentation for this struct was generated from the following file:
generic/regguts.h

Reference Struct Reference

Detailed Description

Definition at line 26 of file tclPreserve.c.Public Attributes
ClientData clientData
int refCount
int mustFree
Tcl_FreeProc * freeProc

Member Data Documentation
ClientData Reference::clientData

Definition at line 27 of file tclPreserve.c.
Referenced by Tcl_EventuallyFree(), Tcl_Preserve(), and Tcl_Release().Tcl_FreeProc* Reference::freeProc

Definition at line 34 of file tclPreserve.c.
Referenced by Tcl_Release().int Reference::mustFree

Definition at line 30 of file tclPreserve.c.
Referenced by Tcl_EventuallyFree(), and Tcl_Release().int Reference::refCount

Definition at line 28 of file tclPreserve.c.
Referenced by Tcl_Preserve(), and Tcl_Release().
The documentation for this struct was generated from the following file:
generic/tclPreserve.c

regex_t Struct Reference
#include <regex.h>

Detailed Description

Definition at line 165 of file regex.h.Public Attributes
int re_magic
size_t re_nsub
long re_info
int re_csize
char * re_endp
char * re_guts
char * re_fns

Member Data Documentation
int regex_t::re_csize

Definition at line 183 of file regex.h.char* regex_t::re_endp

Definition at line 184 of file regex.h.char* regex_t::re_fns

Definition at line 187 of file regex.h.char* regex_t::re_guts

Definition at line 186 of file regex.h.long regex_t::re_info

Definition at line 168 of file regex.h.
Referenced by TclRegAbout().int regex_t::re_magic

Definition at line 166 of file regex.h.size_t regex_t::re_nsub

Definition at line 167 of file regex.h.
Referenced by CompileRegexp(), RegExpExecUniChar(), Tcl_RegExpGetInfo(), Tcl_RegExpRange(), TclRegAbout(), and TclRegExpRangeUniChar().
The documentation for this struct was generated from the following file:
generic/regex.h

RegisteredInterp Struct Reference

Detailed Description

Definition at line 35 of file tclWinDde.c.Public Attributes
RegisteredInterp * nextPtr
char * name
Tcl_Interp * interp

Member Data Documentation
Tcl_Interp* RegisteredInterp::interp

Definition at line 40 of file tclWinDde.c.
Referenced by DdeServerProc(), DdeSetServerName(), and ExecuteRemoteObject().char* RegisteredInterp::name

Definition at line 39 of file tclWinDde.c.
Referenced by DdeServerProc(), DdeSetServerName(), DeleteProc(), and Tcl_DdeObjCmd().struct RegisteredInterp* RegisteredInterp::nextPtr

Definition at line 36 of file tclWinDde.c.
Referenced by DdeServerProc(), DdeSetServerName(), DeleteProc(), and Tcl_DdeObjCmd().
The documentation for this struct was generated from the following file:
win/tclWinDde.c

regmatch_t Struct Reference
#include <regex.h>

Detailed Description

Definition at line 191 of file regex.h.Public Attributes
regoff_t rm_so
regoff_t rm_eo

Member Data Documentation
regoff_t regmatch_t::rm_eo

Definition at line 193 of file regex.h.
Referenced by CompileRegexp(), regexec(), Tcl_RegExpRange(), and TclRegExpRangeUniChar().regoff_t regmatch_t::rm_so

Definition at line 192 of file regex.h.
Referenced by CompileRegexp(), regexec(), Tcl_RegExpGetInfo(), Tcl_RegExpRange(), and TclRegExpRangeUniChar().
The documentation for this struct was generated from the following file:
generic/regex.h

RegWinProcs Struct Reference

Detailed Description

Definition at line 80 of file tclWinReg.c.Public Member Functions
LONG (WINAPI *regConnectRegistryProc)(CONST TCHAR *
LONG (WINAPI *regCreateKeyExProc)(HKEY
CONST TCHAR TCHAR SECURITY_ATTRIBUTES HKEY DWORD * LONG (WINAPI *regDeleteKeyProc)(HKEY
CONST TCHAR TCHAR SECURITY_ATTRIBUTES HKEY DWORD *CONST TCHAR * LONG (WINAPI *regDeleteValueProc)(HKEY
CONST TCHAR TCHAR SECURITY_ATTRIBUTES HKEY DWORD *CONST TCHAR *CONST TCHAR * LONG (WINAPI *regEnumKeyProc)(HKEY
LONG (WINAPI *regEnumKeyExProc)(HKEY
TCHAR DWORD DWORD TCHAR DWORD FILETIME * LONG (WINAPI *regEnumValueProc)(HKEY
TCHAR DWORD DWORD TCHAR DWORD FILETIME TCHAR DWORD DWORD DWORD BYTE DWORD * LONG (WINAPI *regOpenKeyExProc)(HKEY
TCHAR DWORD DWORD TCHAR DWORD FILETIME TCHAR DWORD DWORD DWORD BYTE DWORD *CONST TCHAR HKEY * LONG (WINAPI *regQueryInfoKeyProc)(HKEY
TCHAR DWORD DWORD TCHAR DWORD FILETIME TCHAR DWORD DWORD DWORD BYTE DWORD *CONST TCHAR HKEY *TCHAR DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD FILETIME * LONG (WINAPI *regQueryValueExProc)(HKEY
TCHAR DWORD DWORD TCHAR DWORD FILETIME TCHAR DWORD DWORD DWORD BYTE DWORD *CONST TCHAR HKEY *TCHAR DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD FILETIME *CONST TCHAR DWORD DWORD BYTE DWORD * LONG (WINAPI *regSetValueExProc)(HKEY
Public Attributes
int useWide
HKEY
PHKEY
CONST TCHAR DWORD
CONST TCHAR TCHAR DWORD
CONST TCHAR TCHAR REGSAM
CONST TCHAR TCHAR SECURITY_ATTRIBUTES HKEY DWORD *CONST TCHAR *CONST TCHAR * DWORD
CONST TCHAR TCHAR SECURITY_ATTRIBUTES HKEY DWORD *CONST TCHAR *CONST TCHAR TCHAR DWORD
DWORD
TCHAR DWORD DWORD TCHAR DWORD FILETIME * DWORD
TCHAR DWORD DWORD TCHAR DWORD FILETIME TCHAR DWORD DWORD DWORD BYTE DWORD *CONST TCHAR DWORD
TCHAR DWORD DWORD TCHAR DWORD FILETIME TCHAR DWORD DWORD DWORD BYTE DWORD *CONST TCHAR REGSAM
TCHAR DWORD DWORD TCHAR DWORD FILETIME TCHAR DWORD DWORD DWORD BYTE DWORD *CONST TCHAR HKEY *TCHAR DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD FILETIME *CONST TCHAR DWORD DWORD BYTE DWORD *CONST TCHAR DWORD
TCHAR DWORD DWORD TCHAR DWORD FILETIME TCHAR DWORD DWORD DWORD BYTE DWORD *CONST TCHAR HKEY *TCHAR DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD FILETIME *CONST TCHAR DWORD DWORD BYTE DWORD *CONST TCHAR DWORD
TCHAR DWORD DWORD TCHAR DWORD FILETIME TCHAR DWORD DWORD DWORD BYTE DWORD *CONST TCHAR HKEY *TCHAR DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD FILETIME *CONST TCHAR DWORD DWORD BYTE DWORD *CONST TCHAR CONST BYTE DWORD

Member Function Documentation
TCHAR DWORD DWORD TCHAR DWORD FILETIME TCHAR DWORD DWORD DWORD BYTE DWORD* CONST TCHAR HKEY* TCHAR DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD FILETIME* CONST TCHAR DWORD DWORD BYTE DWORD* RegWinProcs::LONG (WINAPI * regSetValueExProc)
TCHAR DWORD DWORD TCHAR DWORD FILETIME TCHAR DWORD DWORD DWORD BYTE DWORD* CONST TCHAR HKEY* TCHAR DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD FILETIME* RegWinProcs::LONG (WINAPI * regQueryValueExProc)
TCHAR DWORD DWORD TCHAR DWORD FILETIME TCHAR DWORD DWORD DWORD BYTE DWORD* CONST TCHAR HKEY* RegWinProcs::LONG (WINAPI * regQueryInfoKeyProc)
TCHAR DWORD DWORD TCHAR DWORD FILETIME TCHAR DWORD DWORD DWORD BYTE DWORD* RegWinProcs::LONG (WINAPI * regOpenKeyExProc)
TCHAR DWORD DWORD TCHAR DWORD FILETIME* RegWinProcs::LONG (WINAPI * regEnumValueProc)
RegWinProcs::LONG (WINAPI * regEnumKeyExProc)
CONST TCHAR TCHAR SECURITY_ATTRIBUTES HKEY DWORD* CONST TCHAR* CONST TCHAR* RegWinProcs::LONG (WINAPI * regEnumKeyProc)
CONST TCHAR TCHAR SECURITY_ATTRIBUTES HKEY DWORD* CONST TCHAR* RegWinProcs::LONG (WINAPI * regDeleteValueProc)
CONST TCHAR TCHAR SECURITY_ATTRIBUTES HKEY DWORD* RegWinProcs::LONG (WINAPI * regDeleteKeyProc)
RegWinProcs::LONG (WINAPI * regCreateKeyExProc)
RegWinProcs::LONG (WINAPI * regConnectRegistryProc)

Member Data Documentation
TCHAR DWORD DWORD TCHAR DWORD FILETIME TCHAR DWORD DWORD DWORD BYTE DWORD* CONST TCHAR HKEY* TCHAR DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD FILETIME* CONST TCHAR DWORD DWORD BYTE DWORD* CONST TCHAR CONST BYTE RegWinProcs::DWORD

Definition at line 100 of file tclWinReg.c.TCHAR DWORD DWORD TCHAR DWORD FILETIME TCHAR DWORD DWORD DWORD BYTE DWORD* CONST TCHAR HKEY* TCHAR DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD FILETIME* CONST TCHAR DWORD DWORD BYTE DWORD* CONST TCHAR RegWinProcs::DWORD

Definition at line 100 of file tclWinReg.c.TCHAR DWORD DWORD TCHAR DWORD FILETIME TCHAR DWORD DWORD DWORD BYTE DWORD* CONST TCHAR HKEY* TCHAR DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD DWORD FILETIME* CONST TCHAR DWORD DWORD BYTE DWORD* CONST TCHAR RegWinProcs::DWORD

Definition at line 100 of file tclWinReg.c.TCHAR DWORD DWORD TCHAR DWORD FILETIME TCHAR DWORD DWORD DWORD BYTE DWORD* CONST TCHAR RegWinProcs::DWORD

Definition at line 93 of file tclWinReg.c.TCHAR DWORD DWORD TCHAR DWORD FILETIME* RegWinProcs::DWORD

Definition at line 91 of file tclWinReg.c.RegWinProcs::DWORD

Definition at line 89 of file tclWinReg.c.CONST TCHAR TCHAR SECURITY_ATTRIBUTES HKEY DWORD* CONST TCHAR* CONST TCHAR TCHAR RegWinProcs::DWORD

Definition at line 88 of file tclWinReg.c.CONST TCHAR TCHAR SECURITY_ATTRIBUTES HKEY DWORD* CONST TCHAR* CONST TCHAR* RegWinProcs::DWORD

Definition at line 88 of file tclWinReg.c.CONST TCHAR TCHAR RegWinProcs::DWORD

Definition at line 84 of file tclWinReg.c.CONST TCHAR RegWinProcs::DWORD

Definition at line 84 of file tclWinReg.c.RegWinProcs::HKEY

Definition at line 83 of file tclWinReg.c.RegWinProcs::PHKEY

Definition at line 83 of file tclWinReg.c.TCHAR DWORD DWORD TCHAR DWORD FILETIME TCHAR DWORD DWORD DWORD BYTE DWORD* CONST TCHAR RegWinProcs::REGSAM

Definition at line 93 of file tclWinReg.c.CONST TCHAR TCHAR RegWinProcs::REGSAM

Definition at line 84 of file tclWinReg.c.int RegWinProcs::useWide

Definition at line 81 of file tclWinReg.c.
Referenced by GetValue(), GetValueNames(), RecursiveDeleteKey(), and SetValue().
The documentation for this struct was generated from the following file:
win/tclWinReg.c

rerr Struct Reference

Detailed Description

Definition at line 38 of file regerror.c.Public Attributes
int code
char * name
char * explain

Member Data Documentation
int rerr::code

Definition at line 39 of file regerror.c.char* rerr::explain

Definition at line 41 of file regerror.c.char* rerr::name

Definition at line 40 of file regerror.c.
The documentation for this struct was generated from the following file:
generic/regerror.c

ResolvedCmdName Struct Reference

Detailed Description

Definition at line 187 of file tclObj.c.Public Attributes
Command * cmdPtr
Namespace * refNsPtr
long refNsId
int refNsCmdEpoch
int cmdEpoch
int refCount

Member Data Documentation
int ResolvedCmdName::cmdEpoch

Definition at line 202 of file tclObj.c.
Referenced by SetCmdNameFromAny(), Tcl_GetCommandFromObj(), and TclSetCmdNameObj().Command* ResolvedCmdName::cmdPtr

Definition at line 188 of file tclObj.c.
Referenced by FreeCmdNameInternalRep(), SetCmdNameFromAny(), Tcl_GetCommandFromObj(), and TclSetCmdNameObj().int ResolvedCmdName::refCount

Definition at line 208 of file tclObj.c.
Referenced by DupCmdNameInternalRep(), FreeCmdNameInternalRep(), SetCmdNameFromAny(), and TclSetCmdNameObj().int ResolvedCmdName::refNsCmdEpoch

Definition at line 197 of file tclObj.c.
Referenced by SetCmdNameFromAny(), Tcl_GetCommandFromObj(), and TclSetCmdNameObj().long ResolvedCmdName::refNsId

Definition at line 192 of file tclObj.c.
Referenced by SetCmdNameFromAny(), Tcl_GetCommandFromObj(), and TclSetCmdNameObj().Namespace* ResolvedCmdName::refNsPtr

Definition at line 189 of file tclObj.c.
Referenced by SetCmdNameFromAny(), Tcl_GetCommandFromObj(), and TclSetCmdNameObj().
The documentation for this struct was generated from the following file:
generic/tclObj.c

ResolverScheme Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 1147 of file tclInt.h.Public Attributes
char * name
Tcl_ResolveCmdProc * cmdResProc
Tcl_ResolveVarProc * varResProc
Tcl_ResolveCompiledVarProc * compiledVarResProc
ResolverScheme * nextPtr

Member Data Documentation
Tcl_ResolveCmdProc* ResolverScheme::cmdResProc

Definition at line 1149 of file tclInt.h.
Referenced by Tcl_AddInterpResolvers(), Tcl_FindCommand(), Tcl_GetInterpResolvers(), and Tcl_RemoveInterpResolvers().Tcl_ResolveCompiledVarProc* ResolverScheme::compiledVarResProc

Definition at line 1156 of file tclInt.h.
Referenced by Tcl_AddInterpResolvers(), Tcl_GetInterpResolvers(), Tcl_RemoveInterpResolvers(), and TclInitCompiledLocals().char* ResolverScheme::name

Definition at line 1148 of file tclInt.h.
Referenced by DeleteInterpProc(), Tcl_AddInterpResolvers(), Tcl_GetInterpResolvers(), and Tcl_RemoveInterpResolvers().struct ResolverScheme* ResolverScheme::nextPtr

Definition at line 1160 of file tclInt.h.
Referenced by DeleteInterpProc(), Tcl_AddInterpResolvers(), Tcl_FindCommand(), Tcl_FindNamespaceVar(), Tcl_GetInterpResolvers(), Tcl_RemoveInterpResolvers(), TclInitCompiledLocals(), and TclLookupSimpleVar().Tcl_ResolveVarProc* ResolverScheme::varResProc

Definition at line 1152 of file tclInt.h.
Referenced by Tcl_AddInterpResolvers(), Tcl_FindNamespaceVar(), Tcl_GetInterpResolvers(), and TclLookupSimpleVar().
The documentation for this struct was generated from the following file:
generic/tclInt.h

ResultBuffer Struct Reference

Detailed Description

Definition at line 161 of file tclIOGT.c.Public Attributes
unsigned char * buf
int allocated
int used

Member Data Documentation
int ResultBuffer::allocated

Definition at line 163 of file tclIOGT.c.unsigned char* ResultBuffer::buf

Definition at line 162 of file tclIOGT.c.int ResultBuffer::used

Definition at line 164 of file tclIOGT.c.
Referenced by ResultClear(), ResultInit(), and ResultLength().
The documentation for this struct was generated from the following file:
generic/tclIOGT.c

rm_detail_t Struct Reference
#include <regex.h>

Detailed Description

Definition at line 197 of file regex.h.Public Attributes
regmatch_t rm_extend

Member Data Documentation
regmatch_t rm_detail_t::rm_extend

Definition at line 198 of file regex.h.
Referenced by CompileRegexp(), Tcl_RegExpGetInfo(), and TclRegExpRangeUniChar().
The documentation for this struct was generated from the following file:
generic/regex.h

SelectMasks Struct Reference

Detailed Description

Definition at line 65 of file tclUnixNotfy.c.Public Attributes
fd_set readable
fd_set writable
fd_set exceptional

Member Data Documentation
fd_set SelectMasks::exceptional

Definition at line 68 of file tclUnixNotfy.c.
Referenced by Tcl_CreateFileHandler(), Tcl_DeleteFileHandler(), and Tcl_WaitForEvent().fd_set SelectMasks::readable

Definition at line 66 of file tclUnixNotfy.c.
Referenced by Tcl_CreateFileHandler(), Tcl_DeleteFileHandler(), and Tcl_WaitForEvent().fd_set SelectMasks::writable

Definition at line 67 of file tclUnixNotfy.c.
Referenced by Tcl_CreateFileHandler(), Tcl_DeleteFileHandler(), and Tcl_WaitForEvent().
The documentation for this struct was generated from the following file:
unix/tclUnixNotfy.c

SerialEvent Struct Reference

Detailed Description

Definition at line 144 of file tclWinSerial.c.Public Attributes
Tcl_Event header
SerialInfo * infoPtr

Member Data Documentation
Tcl_Event SerialEvent::header

Definition at line 145 of file tclWinSerial.c.
Referenced by SerialCheckProc().SerialInfo* SerialEvent::infoPtr

Definition at line 147 of file tclWinSerial.c.
Referenced by SerialCheckProc(), and SerialEventProc().
The documentation for this struct was generated from the following file:
win/tclWinSerial.c

Slave Struct Reference

Detailed Description

Definition at line 74 of file tclInterp.c.Public Attributes
Tcl_Interp * masterInterp
Tcl_HashEntry * slaveEntryPtr
Tcl_Interp * slaveInterp
Tcl_Command interpCmd
Tcl_HashTable aliasTable

Member Data Documentation
Tcl_HashTable Slave::aliasTable

Definition at line 84 of file tclInterp.c.
Referenced by AliasCreate(), AliasDelete(), AliasDescribe(), AliasList(), InterpInfoDeleteProc(), SlaveCreate(), Tcl_GetAlias(), Tcl_GetAliasObj(), Tcl_InterpObjCmd(), and TclInterpInit().Tcl_Command Slave::interpCmd

Definition at line 83 of file tclInterp.c.
Referenced by InterpInfoDeleteProc(), SlaveCreate(), SlaveObjCmdDeleteProc(), Tcl_InterpObjCmd(), and TclInterpInit().Tcl_Interp* Slave::masterInterp

Definition at line 75 of file tclInterp.c.
Referenced by InterpInfoDeleteProc(), SlaveCreate(), Tcl_GetInterpPath(), Tcl_GetMaster(), Tcl_InterpObjCmd(), and TclInterpInit().Tcl_HashEntry* Slave::slaveEntryPtr

Definition at line 76 of file tclInterp.c.
Referenced by SlaveCreate(), SlaveObjCmdDeleteProc(), Tcl_GetInterpPath(), and TclInterpInit().Tcl_Interp* Slave::slaveInterp

Definition at line 82 of file tclInterp.c.
Referenced by GetInterp(), InterpInfoDeleteProc(), SlaveCreate(), SlaveObjCmdDeleteProc(), and TclInterpInit().
The documentation for this struct was generated from the following file:
generic/tclInterp.c

smalldfa Struct Reference

Detailed Description

Definition at line 84 of file regexec.c.Public Attributes
dfa dfa
sset ssets [FEWSTATES *2]
unsigned statesarea [FEWSTATES *2+WORK]
sset * outsarea [FEWSTATES *2 *FEWCOLORS]
arcp incarea [FEWSTATES *2 *FEWCOLORS]

Member Data Documentation
struct dfa smalldfa::dfa

Definition at line 85 of file regexec.c.
Referenced by newdfa().struct arcp smalldfa::incarea[FEWSTATES *2 *FEWCOLORS]

Definition at line 89 of file regexec.c.
Referenced by newdfa().struct sset* smalldfa::outsarea[FEWSTATES *2 *FEWCOLORS]

Definition at line 88 of file regexec.c.
Referenced by newdfa().struct sset smalldfa::ssets[FEWSTATES *2]

Definition at line 86 of file regexec.c.
Referenced by newdfa().unsigned smalldfa::statesarea[FEWSTATES *2+WORK]

Definition at line 87 of file regexec.c.
Referenced by newdfa().
The documentation for this struct was generated from the following file:
generic/regexec.c

SocketEvent Struct Reference

Detailed Description

Definition at line 126 of file tclMacSock.c.Public Attributes
Tcl_Event header
TcpState * statePtr
StreamPtr tcpStream
SOCKET socket

Member Data Documentation
Tcl_Event SocketEvent::header

Definition at line 127 of file tclMacSock.c.
Referenced by SocketCheckProc().SOCKET SocketEvent::socket

Definition at line 188 of file tclWinSock.c.
Referenced by SocketCheckProc(), and SocketEventProc().TcpState* SocketEvent::statePtr

Definition at line 129 of file tclMacSock.c.
Referenced by SocketCheckProc(), and SocketEventProc().StreamPtr SocketEvent::tcpStream

Definition at line 130 of file tclMacSock.c.
Referenced by SocketCheckProc(), and SocketEventProc().
The documentation for this struct was generated from the following files:
mac/tclMacSock.c
win/tclWinSock.c

SocketInfo Struct Reference

Detailed Description

Definition at line 151 of file tclWinSock.c.Public Attributes
Tcl_Channel channel
SOCKET socket
int flags
int watchEvents
int readyEvents
int selectEvents
int acceptEventCount
Tcl_TcpAcceptProc * acceptProc
ClientData acceptProcData
int lastError
SocketInfo * nextPtr

Member Data Documentation
int SocketInfo::acceptEventCount

Definition at line 170 of file tclWinSock.c.
Referenced by NewSocketInfo(), and SocketProc().Tcl_TcpAcceptProc* SocketInfo::acceptProc

Definition at line 173 of file tclWinSock.c.
Referenced by NewSocketInfo(), Tcl_OpenTcpServer(), and TcpWatchProc().ClientData SocketInfo::acceptProcData

Definition at line 174 of file tclWinSock.c.
Referenced by Tcl_OpenTcpServer().Tcl_Channel SocketInfo::channel

Definition at line 152 of file tclWinSock.c.
Referenced by SocketEventProc(), Tcl_OpenTcpClient(), and Tcl_OpenTcpServer().int SocketInfo::flags

Definition at line 155 of file tclWinSock.c.
Referenced by CreateSocket(), NewSocketInfo(), SocketCheckProc(), SocketEventProc(), SocketProc(), TcpBlockProc(), TcpInputProc(), and TcpOutputProc().int SocketInfo::lastError

Definition at line 175 of file tclWinSock.c.
Referenced by NewSocketInfo(), SocketEventProc(), and SocketProc().struct SocketInfo* SocketInfo::nextPtr

Definition at line 176 of file tclWinSock.c.
Referenced by NewSocketInfo(), SocketCheckProc(), SocketEventProc(), SocketProc(), SocketSetupProc(), and TcpThreadActionProc().int SocketInfo::readyEvents

Definition at line 161 of file tclWinSock.c.
Referenced by NewSocketInfo(), SocketCheckProc(), SocketEventProc(), SocketProc(), SocketSetupProc(), and TcpWatchProc().int SocketInfo::selectEvents

Definition at line 165 of file tclWinSock.c.
Referenced by CreateSocket(), NewSocketInfo(), SocketProc(), Tcl_MakeTcpClientChannel(), and TcpAccept().SOCKET SocketInfo::socket

Definition at line 154 of file tclWinSock.c.
Referenced by NewSocketInfo(), SocketCheckProc(), SocketEventProc(), SocketProc(), Tcl_OpenTcpClient(), Tcl_OpenTcpServer(), TcpCloseProc(), TcpGetOptionProc(), and TcpSetOptionProc().int SocketInfo::watchEvents

Definition at line 157 of file tclWinSock.c.
Referenced by CreateSocket(), NewSocketInfo(), SocketCheckProc(), SocketEventProc(), SocketSetupProc(), and TcpWatchProc().
The documentation for this struct was generated from the following file:
win/tclWinSock.c

SortElement Struct Reference

Detailed Description

Definition at line 31 of file tclCmdIL.c.Public Attributes
Tcl_Obj * objPtr
int count
SortElement * nextPtr

Member Data Documentation
int SortElement::count

Definition at line 33 of file tclCmdIL.c.
Referenced by MergeLists().struct SortElement* SortElement::nextPtr

Definition at line 34 of file tclCmdIL.c.
Referenced by MergeLists(), and MergeSort().Tcl_Obj* SortElement::objPtr

Definition at line 32 of file tclCmdIL.c.
Referenced by MergeLists().
The documentation for this struct was generated from the following file:
generic/tclCmdIL.c

SortInfo Struct Reference

Detailed Description

Definition at line 46 of file tclCmdIL.c.Public Attributes
int isIncreasing
int sortMode
Tcl_Obj * compareCmdPtr
int index
Tcl_Interp * interp
int resultCode

Member Data Documentation
Tcl_Obj* SortInfo::compareCmdPtr

Definition at line 50 of file tclCmdIL.c.
Referenced by SortCompare(), and Tcl_LsortObjCmd().int SortInfo::index

Definition at line 53 of file tclCmdIL.c.
Referenced by SortCompare(), and Tcl_LsortObjCmd().Tcl_Interp* SortInfo::interp

Definition at line 57 of file tclCmdIL.c.
Referenced by SortCompare(), and Tcl_LsortObjCmd().int SortInfo::isIncreasing

Definition at line 47 of file tclCmdIL.c.
Referenced by SortCompare(), and Tcl_LsortObjCmd().int SortInfo::resultCode

Definition at line 59 of file tclCmdIL.c.
Referenced by SortCompare(), and Tcl_LsortObjCmd().int SortInfo::sortMode

Definition at line 48 of file tclCmdIL.c.
Referenced by SortCompare(), and Tcl_LsortObjCmd().
The documentation for this struct was generated from the following file:
generic/tclCmdIL.c

sset Struct Reference

Detailed Description

Definition at line 42 of file regexec.c.Public Attributes
unsigned * states
unsigned hash
int flags
arcp ins
chr * lastseen
sset ** outs
arcp * inchain

Member Data Documentation
int sset::flags

Definition at line 48 of file regexec.c.
Referenced by getvacant(), initialize(), lastcold(), longest(), pickss(), and shortest().unsigned sset::hash

Definition at line 44 of file regexec.c.
Referenced by initialize().struct arcp* sset::inchain

Definition at line 56 of file regexec.c.
Referenced by getvacant(), and pickss().struct arcp sset::ins

Definition at line 53 of file regexec.c.
Referenced by getvacant(), and pickss().chr* sset::lastseen

Definition at line 54 of file regexec.c.
Referenced by getvacant(), initialize(), lastcold(), longest(), pickss(), and shortest().struct sset** sset::outs

Definition at line 55 of file regexec.c.
Referenced by getvacant(), longest(), miss(), pickss(), and shortest().unsigned* sset::states

Definition at line 43 of file regexec.c.
Referenced by initialize(), miss(), and pickss().
The documentation for this struct was generated from the following file:
generic/regexec.c

state Struct Reference
#include <regguts.h>

Detailed Description

Definition at line 301 of file regguts.h.Public Attributes
int no
char flag
int nins
arc * ins
int nouts
arc * outs
arc * free
state * tmp
state * next
state * prev
arcbatch oas
int noas

Member Data Documentation
char state::flag

Definition at line 304 of file regguts.h.
Referenced by cleanup(), freestate(), newfstate(), newstate(), pull(), and push().struct arc* state::free

Definition at line 309 of file regguts.h.
Referenced by allocarc(), dovec(), freearc(), freenfa(), freestate(), and newstate().struct arc* state::ins

Definition at line 306 of file regguts.h.
Referenced by copyins(), destroystate(), dropstate(), freearc(), makesearch(), markcanreach(), moveins(), newarc(), newstate(), pull(), push(), and pushfwd().struct state* state::next

Definition at line 311 of file regguts.h.
Referenced by cleanup(), compact(), destroystate(), dumpnfa(), fixempties(), freenfa(), freestate(), newstate(), pullback(), and pushfwd().int state::nins

Definition at line 305 of file regguts.h.
Referenced by cbracket(), delsub(), deltraverse(), freearc(), freenfa(), freestate(), moveins(), newarc(), newstate(), parseqatom(), pull(), push(), and unempty().int state::no

Definition at line 302 of file regguts.h.
Referenced by cleanup(), compact(), delsub(), deltraverse(), destroystate(), fixempties(), freestate(), newstate(), pullback(), and pushfwd().int state::noas

Definition at line 314 of file regguts.h.
Referenced by allocarc(), and newstate().int state::nouts

Definition at line 307 of file regguts.h.
Referenced by cbracket(), compact(), delsub(), deltraverse(), freearc(), freenfa(), freestate(), newarc(), newstate(), parseqatom(), pull(), push(), and unempty().struct arcbatch state::oas

Definition at line 313 of file regguts.h.
Referenced by allocarc(), destroystate(), and newstate().struct arc* state::outs

Definition at line 308 of file regguts.h.
Referenced by analyze(), cbracket(), cleartraverse(), cloneouts(), compact(), copyouts(), deltraverse(), destroystate(), dropstate(), duptraverse(), fixempties(), freearc(), makesearch(), markreachable(), moveouts(), newarc(), newstate(), pull(), pullback(), and push().struct state* state::prev

Definition at line 312 of file regguts.h.
Referenced by freestate(), and newstate().struct state* state::tmp

Definition at line 310 of file regguts.h.
Referenced by cleanup(), cleartraverse(), delsub(), deltraverse(), dupnfa(), duptraverse(), makesearch(), markcanreach(), markreachable(), and newstate().
The documentation for this struct was generated from the following file:
generic/regguts.h

StatProc Struct Reference

Detailed Description

Definition at line 320 of file tclIOUtil.c.Public Attributes
TclStatProc_ * proc
StatProc * nextPtr

Member Data Documentation
struct StatProc* StatProc::nextPtr

Definition at line 322 of file tclIOUtil.c.
Referenced by Tcl_FSStat(), TclStatDeleteProc(), and TclStatInsertProc().TclStatProc_* StatProc::proc

Definition at line 321 of file tclIOUtil.c.
Referenced by Tcl_FSStat(), TclStatDeleteProc(), and TclStatInsertProc().
The documentation for this struct was generated from the following file:
generic/tclIOUtil.c

String Struct Reference

Detailed Description

Definition at line 87 of file tclStringObj.c.Public Attributes
int numChars
size_t allocated
size_t uallocated
int hasUnicode
Tcl_UniChar unicode [2]

Member Data Documentation
size_t String::allocated

Definition at line 93 of file tclStringObj.c.
Referenced by AppendUtfToUtfRep(), DupStringInternalRep(), SetStringFromAny(), Tcl_AppendStringsToObjVA(), Tcl_AttemptSetObjLength(), Tcl_NewUnicodeObj(), Tcl_SetObjLength(), Tcl_SetUnicodeObj(), and UpdateStringOfString().int String::hasUnicode

Definition at line 99 of file tclStringObj.c.
Referenced by AppendUtfToUtfRep(), DupStringInternalRep(), FillUnicodeRep(), SetStringFromAny(), Tcl_AppendObjToObj(), Tcl_AppendToObj(), Tcl_AppendUnicodeToObj(), Tcl_AttemptSetObjLength(), Tcl_GetCharLength(), Tcl_GetUniChar(), Tcl_GetUnicode(), Tcl_GetUnicodeFromObj(), Tcl_NewUnicodeObj(), Tcl_SetObjLength(), and Tcl_SetUnicodeObj().int String::numChars

Definition at line 88 of file tclStringObj.c.
Referenced by AppendUnicodeToUnicodeRep(), AppendUtfToUtfRep(), DupStringInternalRep(), FillUnicodeRep(), SetStringFromAny(), Tcl_AppendObjToObj(), Tcl_AttemptSetObjLength(), Tcl_GetCharLength(), Tcl_GetRange(), Tcl_GetUniChar(), Tcl_GetUnicode(), Tcl_GetUnicodeFromObj(), Tcl_NewUnicodeObj(), Tcl_SetObjLength(), Tcl_SetUnicodeObj(), and UpdateStringOfString().size_t String::uallocated

Definition at line 96 of file tclStringObj.c.
Referenced by AppendUnicodeToUnicodeRep(), DupStringInternalRep(), FillUnicodeRep(), SetStringFromAny(), Tcl_AttemptSetObjLength(), Tcl_NewUnicodeObj(), Tcl_SetObjLength(), and Tcl_SetUnicodeObj().Tcl_UniChar String::unicode[2]

Definition at line 101 of file tclStringObj.c.
Referenced by AppendUnicodeToUnicodeRep(), DupStringInternalRep(), FillUnicodeRep(), Tcl_AppendObjToObj(), Tcl_AttemptSetObjLength(), Tcl_GetRange(), Tcl_GetUniChar(), Tcl_GetUnicode(), Tcl_GetUnicodeFromObj(), Tcl_NewUnicodeObj(), Tcl_SetObjLength(), Tcl_SetUnicodeObj(), and UpdateStringOfString().
The documentation for this struct was generated from the following file:
generic/tclStringObj.c

StringTraceData Struct Reference

Detailed Description

Definition at line 258 of file tclBasic.c.Public Attributes
ClientData clientData
Tcl_CmdTraceProc * proc

Member Data Documentation
ClientData StringTraceData::clientData

Definition at line 259 of file tclBasic.c.
Referenced by StringTraceProc().Tcl_CmdTraceProc* StringTraceData::proc

Definition at line 260 of file tclBasic.c.
Referenced by StringTraceProc().
The documentation for this struct was generated from the following file:
generic/tclBasic.c

subre Struct Reference
#include <regguts.h>

Detailed Description

Definition at line 363 of file regguts.h.Public Attributes
char op
char flags
short retry
int subno
short min
short max
subre * left
subre * right
state * begin
state * end
cnfa cnfa
subre * chain

Member Data Documentation
struct state* subre::begin

Definition at line 386 of file regguts.h.
Referenced by newlacon(), nfanode(), nfatree(), parseqatom(), and subre().struct subre* subre::chain

Definition at line 389 of file regguts.h.
Referenced by cleanst(), and subre().struct cnfa subre::cnfa

Definition at line 388 of file regguts.h.
Referenced by altdissect(), caltdissect(), ccondissect(), condissect(), crevdissect(), dump(), exec(), freelacons(), freesrnode(), lacon(), newlacon(), nfanode(), and subre().struct state* subre::end

Definition at line 387 of file regguts.h.
Referenced by newlacon(), nfanode(), parseqatom(), and subre().char subre::flags

Definition at line 365 of file regguts.h.
Referenced by ccondissect(), cleanst(), condissect(), crevdissect(), freesrnode(), parse(), parseqatom(), and subre().struct subre* subre::left

Definition at line 384 of file regguts.h.
Referenced by altdissect(), caltdissect(), ccondissect(), cdissect(), condissect(), crevdissect(), dissect(), freesrnode(), freesubre(), nfatree(), optst(), parse(), parsebranch(), parseqatom(), subre(), and zapmem().short subre::max

Definition at line 383 of file regguts.h.
Referenced by cbrdissect(), parseqatom(), and subre().short subre::min

Definition at line 382 of file regguts.h.
Referenced by cbrdissect(), parseqatom(), and subre().char subre::op

Definition at line 364 of file regguts.h.
Referenced by altdissect(), caltdissect(), cbrdissect(), ccondissect(), cdissect(), condissect(), crevdissect(), dissect(), parse(), parseqatom(), subre(), and zapmem().short subre::retry

Definition at line 380 of file regguts.h.
Referenced by caltdissect(), cbrdissect(), ccondissect(), crevdissect(), subre(), and zapmem().struct subre* subre::right

Definition at line 385 of file regguts.h.
Referenced by altdissect(), caltdissect(), ccondissect(), cdissect(), condissect(), crevdissect(), dissect(), freesubre(), nfatree(), optst(), parse(), parsebranch(), parseqatom(), subre(), and zapmem().int subre::subno

Definition at line 381 of file regguts.h.
Referenced by cbrdissect(), cdissect(), dissect(), dump(), lacon(), newlacon(), parseqatom(), subre(), subset(), and zapmem().
The documentation for this struct was generated from the following file:
generic/regguts.h

SyncObjRecord Struct Reference

Detailed Description

Definition at line 27 of file tclThread.c.Public Attributes
int num
int max
char ** list

Member Data Documentation
char** SyncObjRecord::list

Definition at line 30 of file tclThread.c.
Referenced by ForgetSyncObject(), RememberSyncObject(), TclFinalizeSynchronization(), and TclFinalizeThreadData().int SyncObjRecord::max

Definition at line 29 of file tclThread.c.
Referenced by RememberSyncObject().int SyncObjRecord::num

Definition at line 28 of file tclThread.c.
Referenced by ForgetSyncObject(), RememberSyncObject(), TclFinalizeSynchronization(), and TclFinalizeThreadData().
The documentation for this struct was generated from the following file:
generic/tclThread.c

TableEncodingData Struct Reference

Detailed Description

Definition at line 64 of file tclEncoding.c.Public Attributes
int fallback
char prefixBytes [256]
unsigned short ** toUnicode
unsigned short ** fromUnicode

Member Data Documentation
int TableEncodingData::fallback

Definition at line 65 of file tclEncoding.c.
Referenced by EscapeFromUtfProc(), LoadTableEncoding(), and TableFromUtfProc().unsigned short** TableEncodingData::fromUnicode

Definition at line 78 of file tclEncoding.c.
Referenced by EscapeFromUtfProc(), TableFreeProc(), and TableFromUtfProc().char TableEncodingData::prefixBytes[256]

Definition at line 68 of file tclEncoding.c.
Referenced by EscapeFromUtfProc(), LoadTableEncoding(), TableFromUtfProc(), and TableToUtfProc().unsigned short** TableEncodingData::toUnicode

Definition at line 72 of file tclEncoding.c.
Referenced by LoadTableEncoding(), TableFreeProc(), and TableToUtfProc().
The documentation for this struct was generated from the following file:
generic/tclEncoding.c

Target Struct Reference

Detailed Description

Definition at line 103 of file tclInterp.c.Public Attributes
Tcl_Command slaveCmd
Tcl_Interp * slaveInterp

Member Data Documentation
Tcl_Command Target::slaveCmd

Definition at line 104 of file tclInterp.c.
Referenced by AliasCreate(), and InterpInfoDeleteProc().Tcl_Interp* Target::slaveInterp

Definition at line 105 of file tclInterp.c.
Referenced by AliasCreate(), and InterpInfoDeleteProc().
The documentation for this struct was generated from the following file:
generic/tclInterp.c

Tcl_CallFrame Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 929 of file tcl.h.Public Attributes
Tcl_Namespace * nsPtr
int dummy1
int dummy2
char * dummy3
char * dummy4
char * dummy5
int dummy6
char * dummy7
char * dummy8
int dummy9
char * dummy10

Member Data Documentation
int Tcl_CallFrame::dummy1

Definition at line 931 of file tcl.h.char* Tcl_CallFrame::dummy10

Definition at line 940 of file tcl.h.int Tcl_CallFrame::dummy2

Definition at line 932 of file tcl.h.char* Tcl_CallFrame::dummy3

Definition at line 933 of file tcl.h.char* Tcl_CallFrame::dummy4

Definition at line 934 of file tcl.h.char* Tcl_CallFrame::dummy5

Definition at line 935 of file tcl.h.int Tcl_CallFrame::dummy6

Definition at line 936 of file tcl.h.char* Tcl_CallFrame::dummy7

Definition at line 937 of file tcl.h.char* Tcl_CallFrame::dummy8

Definition at line 938 of file tcl.h.int Tcl_CallFrame::dummy9

Definition at line 939 of file tcl.h.Tcl_Namespace* Tcl_CallFrame::nsPtr

Definition at line 930 of file tcl.h.
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_ChannelType Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 1537 of file tcl.h.Public Attributes
char * typeName
Tcl_ChannelTypeVersion version
Tcl_DriverCloseProc * closeProc
Tcl_DriverInputProc * inputProc
Tcl_DriverOutputProc * outputProc
Tcl_DriverSeekProc * seekProc
Tcl_DriverSetOptionProc * setOptionProc
Tcl_DriverGetOptionProc * getOptionProc
Tcl_DriverWatchProc * watchProc
Tcl_DriverGetHandleProc * getHandleProc
Tcl_DriverClose2Proc * close2Proc
Tcl_DriverBlockModeProc * blockModeProc
Tcl_DriverFlushProc * flushProc
Tcl_DriverHandlerProc * handlerProc
Tcl_DriverWideSeekProc * wideSeekProc
Tcl_DriverThreadActionProc * threadActionProc

Member Data Documentation
Tcl_DriverBlockModeProc* Tcl_ChannelType::blockModeProc

Definition at line 1565 of file tcl.h.Tcl_DriverClose2Proc* Tcl_ChannelType::close2Proc

Definition at line 1561 of file tcl.h.
Referenced by Tcl_Close(), and Tcl_UnstackChannel().Tcl_DriverCloseProc* Tcl_ChannelType::closeProc

Definition at line 1542 of file tcl.h.
Referenced by Tcl_Close(), and Tcl_UnstackChannel().Tcl_DriverFlushProc* Tcl_ChannelType::flushProc

Definition at line 1571 of file tcl.h.Tcl_DriverGetHandleProc* Tcl_ChannelType::getHandleProc

Definition at line 1558 of file tcl.h.
Referenced by Tcl_GetChannelHandle().Tcl_DriverGetOptionProc* Tcl_ChannelType::getOptionProc

Definition at line 1554 of file tcl.h.
Referenced by Tcl_GetChannelOption().Tcl_DriverHandlerProc* Tcl_ChannelType::handlerProc

Definition at line 1573 of file tcl.h.Tcl_DriverInputProc* Tcl_ChannelType::inputProc

Definition at line 1546 of file tcl.h.Tcl_DriverOutputProc* Tcl_ChannelType::outputProc

Definition at line 1548 of file tcl.h.
Referenced by CloseChannel(), FlushChannel(), and Tcl_WriteRaw().Tcl_DriverSeekProc* Tcl_ChannelType::seekProc

Definition at line 1550 of file tcl.h.
Referenced by Tcl_Seek(), and Tcl_Tell().Tcl_DriverSetOptionProc* Tcl_ChannelType::setOptionProc

Definition at line 1552 of file tcl.h.
Referenced by Tcl_SetChannelOption().Tcl_DriverThreadActionProc* Tcl_ChannelType::threadActionProc

Definition at line 1590 of file tcl.h.char* Tcl_ChannelType::typeName

Definition at line 1538 of file tcl.h.
Referenced by Tcl_GetOpenFile().Tcl_ChannelTypeVersion Tcl_ChannelType::version

Definition at line 1541 of file tcl.h.Tcl_DriverWatchProc* Tcl_ChannelType::watchProc

Definition at line 1556 of file tcl.h.
Referenced by FlushChannel().Tcl_DriverWideSeekProc* Tcl_ChannelType::wideSeekProc

Definition at line 1579 of file tcl.h.
Referenced by Tcl_Seek(), and Tcl_Tell().
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_CmdInfo Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 959 of file tcl.h.Public Attributes
int isNativeObjectProc
Tcl_ObjCmdProc * objProc
ClientData objClientData
Tcl_CmdProc * proc
ClientData clientData
Tcl_CmdDeleteProc * deleteProc
ClientData deleteData
Tcl_Namespace * namespacePtr

Member Data Documentation
ClientData Tcl_CmdInfo::clientData

Definition at line 967 of file tcl.h.
Referenced by Tcl_GetCommandInfoFromToken(), and TestcmdinfoCmd().ClientData Tcl_CmdInfo::deleteData

Definition at line 971 of file tcl.h.
Referenced by Tcl_GetCommandInfoFromToken(), and TestcmdinfoCmd().Tcl_CmdDeleteProc* Tcl_CmdInfo::deleteProc

Definition at line 968 of file tcl.h.
Referenced by Tcl_GetCommandInfoFromToken(), and TestcmdinfoCmd().int Tcl_CmdInfo::isNativeObjectProc

Definition at line 960 of file tcl.h.
Referenced by Tcl_GetCommandInfoFromToken(), and TestcmdinfoCmd().Tcl_Namespace* Tcl_CmdInfo::namespacePtr

Definition at line 973 of file tcl.h.
Referenced by CreatedCommandProc(), CreatedCommandProc2(), Tcl_ForgetImport(), Tcl_GetCommandInfoFromToken(), and TestcmdinfoCmd().ClientData Tcl_CmdInfo::objClientData

Definition at line 965 of file tcl.h.
Referenced by Tcl_GetCommandInfoFromToken(), and TestcmdinfoCmd().Tcl_ObjCmdProc* Tcl_CmdInfo::objProc

Definition at line 964 of file tcl.h.
Referenced by Tcl_GetCommandInfoFromToken(), and TestcmdinfoCmd().Tcl_CmdProc* Tcl_CmdInfo::proc

Definition at line 966 of file tcl.h.
Referenced by Tcl_GetCommandInfoFromToken(), and TestcmdinfoCmd().
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_DString Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 986 of file tcl.h.Public Attributes
char * string
int length
int spaceAvl
char staticSpace [TCL_DSTRING_STATIC_SIZE]

Member Data Documentation
int Tcl_DString::length

Definition at line 989 of file tcl.h.
Referenced by FileRCVariables(), and MakeFolderEnvVar().int Tcl_DString::spaceAvl

Definition at line 991 of file tcl.h.
Referenced by Tcl_ExternalToUtfDString(), and Tcl_UtfToExternalDString().char Tcl_DString::staticSpace[TCL_DSTRING_STATIC_SIZE]

Definition at line 993 of file tcl.h.
Referenced by MakeFolderEnvVar().char* Tcl_DString::string

Definition at line 987 of file tcl.h.
Referenced by FileRCVariables(), FormatClock(), MakeFolderEnvVar(), prepareScriptData(), and TcpGetOptionProc().
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_DyldLoadHandle Struct Reference

Detailed Description

Definition at line 33 of file tclLoadDyld.c.Public Attributes
CONST struct mach_header * dyldLibHeader
Tcl_DyldModuleHandle * modulePtr

Member Data Documentation
CONST struct mach_header* Tcl_DyldLoadHandle::dyldLibHeader

Definition at line 34 of file tclLoadDyld.c.
Referenced by TclpDlopen(), and TclpFindSymbol().Tcl_DyldModuleHandle* Tcl_DyldLoadHandle::modulePtr

Definition at line 35 of file tclLoadDyld.c.
Referenced by TclpDlopen(), TclpFindSymbol(), and TclpUnloadFile().
The documentation for this struct was generated from the following file:
unix/tclLoadDyld.c

Tcl_DyldModuleHandle Struct Reference

Detailed Description

Definition at line 28 of file tclLoadDyld.c.Public Attributes
Tcl_DyldModuleHandle * nextPtr
NSModule module

Member Data Documentation
NSModule Tcl_DyldModuleHandle::module

Definition at line 30 of file tclLoadDyld.c.
Referenced by TclpDlopen(), TclpFindSymbol(), and TclpUnloadFile().struct Tcl_DyldModuleHandle* Tcl_DyldModuleHandle::nextPtr

Definition at line 29 of file tclLoadDyld.c.
Referenced by TclpDlopen(), TclpFindSymbol(), and TclpUnloadFile().
The documentation for this struct was generated from the following file:
unix/tclLoadDyld.c

Tcl_EncodingType Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 1943 of file tcl.h.Public Attributes
CONST char * encodingName
Tcl_EncodingConvertProc * toUtfProc
Tcl_EncodingConvertProc * fromUtfProc
Tcl_EncodingFreeProc * freeProc
ClientData clientData
int nullSize

Member Data Documentation
ClientData Tcl_EncodingType::clientData

Definition at line 1956 of file tcl.h.
Referenced by TclInitEncodingSubsystem(), and TestencodingObjCmd().CONST char* Tcl_EncodingType::encodingName

Definition at line 1944 of file tcl.h.
Referenced by TclInitEncodingSubsystem(), and TestencodingObjCmd().Tcl_EncodingFreeProc* Tcl_EncodingType::freeProc

Definition at line 1953 of file tcl.h.
Referenced by TclInitEncodingSubsystem(), and TestencodingObjCmd().Tcl_EncodingConvertProc* Tcl_EncodingType::fromUtfProc

Definition at line 1950 of file tcl.h.
Referenced by TclInitEncodingSubsystem(), and TestencodingObjCmd().int Tcl_EncodingType::nullSize

Definition at line 1958 of file tcl.h.
Referenced by TclInitEncodingSubsystem(), and TestencodingObjCmd().Tcl_EncodingConvertProc* Tcl_EncodingType::toUtfProc

Definition at line 1947 of file tcl.h.
Referenced by TclInitEncodingSubsystem(), and TestencodingObjCmd().
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_Event Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 1377 of file tcl.h.Public Attributes
Tcl_EventProc * proc
Tcl_Event * nextPtr

Member Data Documentation
struct Tcl_Event* Tcl_Event::nextPtr

Definition at line 1379 of file tcl.h.
Referenced by QueueEvent(), Tcl_DeleteEvents(), Tcl_ServiceEvent(), TclFinalizeNotifier(), and TesteventObjCmd().Tcl_EventProc* Tcl_Event::proc

Definition at line 1378 of file tcl.h.
Referenced by ConsoleCheckProc(), FileCheckProc(), FileProc(), PipeCheckProc(), SerialCheckProc(), SocketCheckProc(), Tcl_ServiceEvent(), Tcl_WaitForEvent(), TesteventDeleteProc(), TesteventObjCmd(), and TimerCheckProc().
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_Filesystem Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 1737 of file tcl.h.Public Attributes
CONST char * typeName
int structureLength
Tcl_FSVersion version
Tcl_FSPathInFilesystemProc * pathInFilesystemProc
Tcl_FSDupInternalRepProc * dupInternalRepProc
Tcl_FSFreeInternalRepProc * freeInternalRepProc
Tcl_FSInternalToNormalizedProc * internalToNormalizedProc
Tcl_FSCreateInternalRepProc * createInternalRepProc
Tcl_FSNormalizePathProc * normalizePathProc
Tcl_FSFilesystemPathTypeProc * filesystemPathTypeProc
Tcl_FSFilesystemSeparatorProc * filesystemSeparatorProc
Tcl_FSStatProc * statProc
Tcl_FSAccessProc * accessProc
Tcl_FSOpenFileChannelProc * openFileChannelProc
Tcl_FSMatchInDirectoryProc * matchInDirectoryProc
Tcl_FSUtimeProc * utimeProc
Tcl_FSLinkProc * linkProc
Tcl_FSListVolumesProc * listVolumesProc
Tcl_FSFileAttrStringsProc * fileAttrStringsProc
Tcl_FSFileAttrsGetProc * fileAttrsGetProc
Tcl_FSFileAttrsSetProc * fileAttrsSetProc
Tcl_FSCreateDirectoryProc * createDirectoryProc
Tcl_FSRemoveDirectoryProc * removeDirectoryProc
Tcl_FSDeleteFileProc * deleteFileProc
Tcl_FSCopyFileProc * copyFileProc
Tcl_FSRenameFileProc * renameFileProc
Tcl_FSCopyDirectoryProc * copyDirectoryProc
Tcl_FSLstatProc * lstatProc
Tcl_FSLoadFileProc * loadFileProc
Tcl_FSGetCwdProc * getCwdProc
Tcl_FSChdirProc * chdirProc

Member Data Documentation
Tcl_FSAccessProc* Tcl_Filesystem::accessProc

Definition at line 1786 of file tcl.h.
Referenced by Tcl_FSAccess().Tcl_FSChdirProc* Tcl_Filesystem::chdirProc

Definition at line 1891 of file tcl.h.
Referenced by Tcl_FSChdir().Tcl_FSCopyDirectoryProc* Tcl_Filesystem::copyDirectoryProc

Definition at line 1865 of file tcl.h.
Referenced by Tcl_FSCopyDirectory().Tcl_FSCopyFileProc* Tcl_Filesystem::copyFileProc

Definition at line 1852 of file tcl.h.
Referenced by Tcl_FSCopyFile().Tcl_FSCreateDirectoryProc* Tcl_Filesystem::createDirectoryProc

Definition at line 1837 of file tcl.h.
Referenced by Tcl_FSCreateDirectory().Tcl_FSCreateInternalRepProc* Tcl_Filesystem::createInternalRepProc

Definition at line 1759 of file tcl.h.
Referenced by Tcl_FSGetInternalRep().Tcl_FSDeleteFileProc* Tcl_Filesystem::deleteFileProc

Definition at line 1847 of file tcl.h.
Referenced by FSUnloadTempFile(), and Tcl_FSDeleteFile().Tcl_FSDupInternalRepProc* Tcl_Filesystem::dupInternalRepProc

Definition at line 1747 of file tcl.h.
Referenced by DupFsPathInternalRep(), and Tcl_FSGetNormalizedPath().Tcl_FSFileAttrsGetProc* Tcl_Filesystem::fileAttrsGetProc

Definition at line 1829 of file tcl.h.
Referenced by Tcl_FSFileAttrsGet().Tcl_FSFileAttrsSetProc* Tcl_Filesystem::fileAttrsSetProc

Definition at line 1833 of file tcl.h.
Referenced by Tcl_FSFileAttrsSet().Tcl_FSFileAttrStringsProc* Tcl_Filesystem::fileAttrStringsProc

Definition at line 1822 of file tcl.h.
Referenced by Tcl_FSFileAttrStrings().Tcl_FSFilesystemPathTypeProc* Tcl_Filesystem::filesystemPathTypeProc

Definition at line 1773 of file tcl.h.
Referenced by Tcl_FSFileSystemInfo().Tcl_FSFilesystemSeparatorProc* Tcl_Filesystem::filesystemSeparatorProc

Definition at line 1776 of file tcl.h.
Referenced by Tcl_FSJoinPath(), Tcl_FSPathSeparator(), and Tcl_FSSplitPath().Tcl_FSFreeInternalRepProc* Tcl_Filesystem::freeInternalRepProc

Definition at line 1750 of file tcl.h.
Referenced by FreeFsPathInternalRep().Tcl_FSGetCwdProc* Tcl_Filesystem::getCwdProc

Definition at line 1883 of file tcl.h.
Referenced by Tcl_FSGetCwd().Tcl_FSInternalToNormalizedProc* Tcl_Filesystem::internalToNormalizedProc

Definition at line 1754 of file tcl.h.Tcl_FSLinkProc* Tcl_Filesystem::linkProc

Definition at line 1812 of file tcl.h.
Referenced by Tcl_FSLink().Tcl_FSListVolumesProc* Tcl_Filesystem::listVolumesProc

Definition at line 1817 of file tcl.h.
Referenced by GetPathType(), and Tcl_FSListVolumes().Tcl_FSLoadFileProc* Tcl_Filesystem::loadFileProc

Definition at line 1877 of file tcl.h.
Referenced by Tcl_FSLoadFile().Tcl_FSLstatProc* Tcl_Filesystem::lstatProc

Definition at line 1872 of file tcl.h.
Referenced by Tcl_FSLstat().Tcl_FSMatchInDirectoryProc* Tcl_Filesystem::matchInDirectoryProc

Definition at line 1799 of file tcl.h.
Referenced by FsListMounts(), and Tcl_FSMatchInDirectory().Tcl_FSNormalizePathProc* Tcl_Filesystem::normalizePathProc

Definition at line 1767 of file tcl.h.
Referenced by TclFSNormalizeToUniquePath().Tcl_FSOpenFileChannelProc* Tcl_Filesystem::openFileChannelProc

Definition at line 1792 of file tcl.h.
Referenced by Tcl_FSOpenFileChannel().Tcl_FSPathInFilesystemProc* Tcl_Filesystem::pathInFilesystemProc

Definition at line 1743 of file tcl.h.
Referenced by Tcl_FSGetFileSystemForPath().Tcl_FSRemoveDirectoryProc* Tcl_Filesystem::removeDirectoryProc

Definition at line 1842 of file tcl.h.
Referenced by Tcl_FSRemoveDirectory().Tcl_FSRenameFileProc* Tcl_Filesystem::renameFileProc

Definition at line 1859 of file tcl.h.
Referenced by Tcl_FSRenameFile().Tcl_FSStatProc* Tcl_Filesystem::statProc

Definition at line 1780 of file tcl.h.
Referenced by Tcl_FSLstat(), and Tcl_FSStat().int Tcl_Filesystem::structureLength

Definition at line 1739 of file tcl.h.CONST char* Tcl_Filesystem::typeName

Definition at line 1738 of file tcl.h.
Referenced by Tcl_FSFileSystemInfo().Tcl_FSUtimeProc* Tcl_Filesystem::utimeProc

Definition at line 1805 of file tcl.h.
Referenced by Tcl_FSUtime().Tcl_FSVersion Tcl_Filesystem::version

Definition at line 1741 of file tcl.h.
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_GlobTypeData Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 1620 of file tcl.h.Public Attributes
int type
int perm
Tcl_Obj * macType
Tcl_Obj * macCreator

Member Data Documentation
Tcl_Obj* Tcl_GlobTypeData::macCreator

Definition at line 1628 of file tcl.h.
Referenced by Tcl_GlobObjCmd().Tcl_Obj* Tcl_GlobTypeData::macType

Definition at line 1626 of file tcl.h.
Referenced by Tcl_GlobObjCmd().int Tcl_GlobTypeData::perm

Definition at line 1624 of file tcl.h.
Referenced by Tcl_GlobObjCmd().int Tcl_GlobTypeData::type

Definition at line 1622 of file tcl.h.
Referenced by Tcl_GlobObjCmd().
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_HashEntry Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 1142 of file tcl.h.Public Attributes
Tcl_HashEntry * nextPtr
Tcl_HashTable * tablePtr
VOID * hash
ClientData clientData
union {
  char * oneWordValue
  Tcl_Obj * objPtr
  int words [1]
  char string [4]
} key

Member Data Documentation
ClientData Tcl_HashEntry::clientData

Definition at line 1161 of file tcl.h.
Referenced by Tcl_CreateHashEntry().VOID* Tcl_HashEntry::hash

Definition at line 1149 of file tcl.h.
Referenced by RebuildTable(), Tcl_CreateHashEntry(), and Tcl_FindHashEntry().union { ... }   Tcl_HashEntry::key

Referenced by AllocArrayEntry(), AllocObjEntry(), AllocStringEntry(), CompareArrayKeys(), CompareObjKeys(), CompareStringKeys(), Tcl_CreateHashEntry(), and Tcl_FindHashEntry().Tcl_HashEntry* Tcl_HashEntry::nextPtr

Definition at line 1143 of file tcl.h.
Referenced by RebuildTable(), Tcl_CreateHashEntry(), Tcl_DeleteHashEntry(), Tcl_DeleteHashTable(), Tcl_FindHashEntry(), Tcl_HashStats(), and Tcl_NextHashEntry().Tcl_Obj* Tcl_HashEntry::objPtr

Definition at line 1165 of file tcl.h.char* Tcl_HashEntry::oneWordValue

Definition at line 1164 of file tcl.h.
Referenced by AllocObjEntry(), CompareObjKeys(), Tcl_CreateHashEntry(), and Tcl_FindHashEntry().char Tcl_HashEntry::string[4]

Definition at line 1170 of file tcl.h.
Referenced by AllocStringEntry(), and CompareStringKeys().Tcl_HashTable* Tcl_HashEntry::tablePtr

Definition at line 1146 of file tcl.h.
Referenced by CompareArrayKeys(), Tcl_CreateHashEntry(), Tcl_GetCommandFullName(), Tcl_GetCommandName(), Tcl_NextHashEntry(), TclDeleteVars(), and TclResetShadowedCmdRefs().int Tcl_HashEntry::words[1]

Definition at line 1166 of file tcl.h.
Referenced by AllocArrayEntry(), and CompareArrayKeys().
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_HashKeyType Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 1194 of file tcl.h.Public Attributes
int version
int flags
Tcl_HashKeyProc * hashKeyProc
Tcl_CompareHashKeysProc * compareKeysProc
Tcl_AllocHashEntryProc * allocEntryProc
Tcl_FreeHashEntryProc * freeEntryProc

Member Data Documentation
Tcl_AllocHashEntryProc* Tcl_HashKeyType::allocEntryProc

Definition at line 1222 of file tcl.h.
Referenced by Tcl_CreateHashEntry().Tcl_CompareHashKeysProc* Tcl_HashKeyType::compareKeysProc

Definition at line 1211 of file tcl.h.
Referenced by Tcl_CreateHashEntry(), and Tcl_FindHashEntry().int Tcl_HashKeyType::flags

Definition at line 1201 of file tcl.h.
Referenced by RebuildTable(), Tcl_CreateHashEntry(), Tcl_DeleteHashEntry(), and Tcl_FindHashEntry().Tcl_FreeHashEntryProc* Tcl_HashKeyType::freeEntryProc

Definition at line 1229 of file tcl.h.
Referenced by Tcl_DeleteHashEntry(), and Tcl_DeleteHashTable().Tcl_HashKeyProc* Tcl_HashKeyType::hashKeyProc

Definition at line 1206 of file tcl.h.
Referenced by RebuildTable(), Tcl_CreateHashEntry(), Tcl_DeleteHashEntry(), and Tcl_FindHashEntry().int Tcl_HashKeyType::version

Definition at line 1195 of file tcl.h.
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_HashSearch Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 1278 of file tcl.h.Public Attributes
Tcl_HashTable * tablePtr
int nextIndex
Tcl_HashEntry * nextEntryPtr

Member Data Documentation
Tcl_HashEntry* Tcl_HashSearch::nextEntryPtr

Definition at line 1282 of file tcl.h.
Referenced by Tcl_FirstHashEntry().int Tcl_HashSearch::nextIndex

Definition at line 1280 of file tcl.h.
Referenced by Tcl_FirstHashEntry().Tcl_HashTable* Tcl_HashSearch::tablePtr

Definition at line 1279 of file tcl.h.
Referenced by Tcl_FirstHashEntry().
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_HashTable Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 1239 of file tcl.h.Public Member Functions
Tcl_HashEntry *findProc _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, CONST char *key))
Tcl_HashEntry *createProc _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, CONST char *key, int *newPtr))
Public Attributes
Tcl_HashEntry ** buckets
Tcl_HashEntry * staticBuckets [TCL_SMALL_HASH_TABLE]
int numBuckets
int numEntries
int rebuildSize
int downShift
int mask
int keyType
Tcl_HashKeyType * typePtr

Member Function Documentation
Tcl_HashEntry* createProc Tcl_HashTable::_ANSI_ARGS_ ((Tcl_HashTable *tablePtr, CONST char *key, int *newPtr))
Tcl_HashEntry* findProc Tcl_HashTable::_ANSI_ARGS_ ((Tcl_HashTable *tablePtr, CONST char *key))

Member Data Documentation
Tcl_HashEntry** Tcl_HashTable::buckets

Definition at line 1240 of file tcl.h.
Referenced by Tcl_DeleteHashEntry(), and Tcl_NextHashEntry().int Tcl_HashTable::downShift

Definition at line 1252 of file tcl.h.int Tcl_HashTable::keyType

Definition at line 1257 of file tcl.h.
Referenced by Tcl_DeleteHashEntry().int Tcl_HashTable::mask

Definition at line 1255 of file tcl.h.
Referenced by Tcl_DeleteHashEntry().int Tcl_HashTable::numBuckets

Definition at line 1246 of file tcl.h.
Referenced by Tcl_NextHashEntry().int Tcl_HashTable::numEntries

Definition at line 1248 of file tcl.h.
Referenced by InterpInfoDeleteProc(), ScanNumber(), and Tcl_DeleteHashEntry().int Tcl_HashTable::rebuildSize

Definition at line 1250 of file tcl.h.Tcl_HashEntry* Tcl_HashTable::staticBuckets[TCL_SMALL_HASH_TABLE]

Definition at line 1243 of file tcl.h.Tcl_HashKeyType* Tcl_HashTable::typePtr

Definition at line 1269 of file tcl.h.
Referenced by Tcl_DeleteHashEntry().
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_Interp Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 479 of file tcl.h.Public Member Functions
void freeProc _ANSI_ARGS_ ((char *blockPtr))
Public Attributes
char * result
int errorLine

Member Function Documentation
void freeProc Tcl_Interp::_ANSI_ARGS_ ((char *blockPtr))

Member Data Documentation
int Tcl_Interp::errorLine

Definition at line 490 of file tcl.h.
Referenced by NamespaceEvalCmd(), NamespaceInscopeCmd(), Tcl_CaseObjCmd(), Tcl_EvalObjCmd(), Tcl_ForeachObjCmd(), Tcl_ForObjCmd(), Tcl_MacEvalResource(), Tcl_SwitchObjCmd(), Tcl_UplevelObjCmd(), and Tcl_WhileObjCmd().char* Tcl_Interp::result

Definition at line 480 of file tcl.h.
Referenced by SetupAppendBuffer(), Tcl_ResetResult(), and TestdstringCmd().
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_Namespace Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 888 of file tcl.h.Public Attributes
char * name
char * fullName
ClientData clientData
Tcl_NamespaceDeleteProc * deleteProc
Tcl_Namespace * parentPtr

Member Data Documentation
ClientData Tcl_Namespace::clientData

Definition at line 895 of file tcl.h.Tcl_NamespaceDeleteProc* Tcl_Namespace::deleteProc

Definition at line 897 of file tcl.h.char* Tcl_Namespace::fullName

Definition at line 893 of file tcl.h.
Referenced by CreatedCommandProc(), CreatedCommandProc2(), NamespaceEvalCmd(), NamespaceInscopeCmd(), NamespaceParentCmd(), and TestcmdinfoCmd().char* Tcl_Namespace::name

Definition at line 889 of file tcl.h.struct Tcl_Namespace* Tcl_Namespace::parentPtr

Definition at line 900 of file tcl.h.
Referenced by NamespaceParentCmd().
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_NotifierProcs Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 1927 of file tcl.h.Public Attributes
Tcl_SetTimerProc * setTimerProc
Tcl_WaitForEventProc * waitForEventProc
Tcl_CreateFileHandlerProc * createFileHandlerProc
Tcl_DeleteFileHandlerProc * deleteFileHandlerProc
Tcl_InitNotifierProc * initNotifierProc
Tcl_FinalizeNotifierProc * finalizeNotifierProc
Tcl_AlertNotifierProc * alertNotifierProc
Tcl_ServiceModeHookProc * serviceModeHookProc

Member Data Documentation
Tcl_AlertNotifierProc* Tcl_NotifierProcs::alertNotifierProc

Definition at line 1934 of file tcl.h.Tcl_CreateFileHandlerProc* Tcl_NotifierProcs::createFileHandlerProc

Definition at line 1930 of file tcl.h.
Referenced by Tcl_CreateFileHandler().Tcl_DeleteFileHandlerProc* Tcl_NotifierProcs::deleteFileHandlerProc

Definition at line 1931 of file tcl.h.
Referenced by Tcl_DeleteFileHandler().Tcl_FinalizeNotifierProc* Tcl_NotifierProcs::finalizeNotifierProc

Definition at line 1933 of file tcl.h.Tcl_InitNotifierProc* Tcl_NotifierProcs::initNotifierProc

Definition at line 1932 of file tcl.h.Tcl_ServiceModeHookProc* Tcl_NotifierProcs::serviceModeHookProc

Definition at line 1935 of file tcl.h.Tcl_SetTimerProc* Tcl_NotifierProcs::setTimerProc

Definition at line 1928 of file tcl.h.
Referenced by Tcl_SetTimer().Tcl_WaitForEventProc* Tcl_NotifierProcs::waitForEventProc

Definition at line 1929 of file tcl.h.
Referenced by Tcl_WaitForEvent().
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_Obj Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 773 of file tcl.h.Public Attributes
int refCount
char * bytes
int length
Tcl_ObjType * typePtr
union {
  long longValue
  double doubleValue
  VOID * otherValuePtr
  Tcl_WideInt wideValue
  struct {
    VOID * ptr1
    VOID * ptr2
  } twoPtrValue
} internalRep

Member Data Documentation
char* Tcl_Obj::bytes

Definition at line 775 of file tcl.h.
Referenced by FilterInputBytes(), IllegalExprOperandType(), InfoBodyCmd(), ReadChars(), ResetObjResult(), SetListFromAny(), Tcl_ConcatObj(), Tcl_DuplicateObj(), Tcl_FSConvertToPathType(), Tcl_FSGetNormalizedPath(), Tcl_FSNewNativePath(), Tcl_GetsObj(), Tcl_NewBooleanObj(), Tcl_NewDoubleObj(), Tcl_NewIntObj(), Tcl_NewLongObj(), Tcl_NewOSTypeObj(), Tcl_NewWideIntObj(), TclExecuteByteCode(), TclFSMakePathFromNormalized(), TclFSMakePathRelative(), TclRegisterLiteral(), and UpdateStringOfFsPath().double Tcl_Obj::doubleValue

Definition at line 794 of file tcl.h.
Referenced by ExprAbsFunc(), ExprIntFunc(), ExprRoundFunc(), ExprWideFunc(), Tcl_NewDoubleObj(), and TclExecuteByteCode().union { ... }   Tcl_Obj::internalRep

Referenced by DupEncodingIntRep(), DupListInternalRep(), DupLocalVarName(), DupNsVarName(), DupOSTypeInternalRep(), DupParsedVarName(), DupRegexpInternalRep(), ExprAbsFunc(), ExprCallMathFunc(), ExprIntFunc(), ExprRoundFunc(), ExprWideFunc(), FreeLocalVarName(), FreeNsVarName(), GetNamespaceFromObj(), ParseSearchId(), ProcBodyDup(), ProcCompileProc(), SetArraySearchObj(), SetEndOffsetFromAny(), SetListFromAny(), SetOSTypeFromAny(), Tcl_DuplicateObj(), Tcl_GetIndexFromObj(), Tcl_GetIndexFromObjStruct(), Tcl_GetOSTypeFromObj(), Tcl_GetRegExpFromObj(), Tcl_LappendObjCmd(), Tcl_ListObjAppendElement(), Tcl_ListObjReplace(), Tcl_NewBooleanObj(), Tcl_NewDoubleObj(), Tcl_NewIntObj(), Tcl_NewListObj(), Tcl_NewLongObj(), Tcl_NewOSTypeObj(), Tcl_NewWideIntObj(), Tcl_SetListObj(), Tcl_SetOSTypeObj(), TclAllocateFreeObjects(), TclCompEvalObj(), TclCreateProc(), TclExecuteByteCode(), TclGetEncodingFromObj(), TclGetIntForIndex(), TclListObjSetElement(), TclLsetFlat(), TclLsetList(), TclNewProcBodyObj(), TclObjLookupVar(), TclPtrIncrVar(), TclRegisterLiteral(), and UpdateLocalVarName().int Tcl_Obj::length

Definition at line 786 of file tcl.h.
Referenced by CompareObjKeys(), FilterInputBytes(), HashObjKey(), IllegalExprOperandType(), InfoBodyCmd(), ReadChars(), ResetObjResult(), SetListFromAny(), TclExecuteByteCode(), TclRegisterLiteral(), and UpdateStringOfFsPath().long Tcl_Obj::longValue

Definition at line 793 of file tcl.h.
Referenced by DupOSTypeInternalRep(), ExprAbsFunc(), ExprCallMathFunc(), ExprIntFunc(), ExprWideFunc(), SetEndOffsetFromAny(), SetOSTypeFromAny(), Tcl_GetOSTypeFromObj(), Tcl_NewBooleanObj(), Tcl_NewIntObj(), Tcl_NewLongObj(), Tcl_NewOSTypeObj(), Tcl_SetOSTypeObj(), TclExecuteByteCode(), TclGetIntForIndex(), TclPtrIncrVar(), and TclRegisterLiteral().VOID* Tcl_Obj::otherValuePtr

Definition at line 795 of file tcl.h.
Referenced by DupEncodingIntRep(), DupRegexpInternalRep(), GetNamespaceFromObj(), ProcBodyDup(), ProcCompileProc(), Tcl_GetIndexFromObj(), Tcl_GetIndexFromObjStruct(), Tcl_GetRegExpFromObj(), TclAllocateFreeObjects(), TclCompEvalObj(), TclCreateProc(), TclGetEncodingFromObj(), and TclNewProcBodyObj().VOID* Tcl_Obj::ptr1

Definition at line 798 of file tcl.h.VOID* Tcl_Obj::ptr2

Definition at line 799 of file tcl.h.int Tcl_Obj::refCount

Definition at line 774 of file tcl.h.
Referenced by CallVarTraces(), DupNsVarName(), FreeNsVarName(), NewVar(), Tcl_ArrayObjCmd(), Tcl_LappendObjCmd(), Tcl_VariableObjCmd(), TclDeleteNamespaceVars(), TclDeleteVars(), TclInitCompiledLocals(), TclObjLookupVar(), and TclObjUnsetVar2().struct { ... }   Tcl_Obj::twoPtrValue

Referenced by DupListInternalRep(), DupLocalVarName(), DupNsVarName(), DupParsedVarName(), FreeLocalVarName(), FreeNsVarName(), ParseSearchId(), SetArraySearchObj(), SetListFromAny(), Tcl_LappendObjCmd(), Tcl_ListObjAppendElement(), Tcl_ListObjReplace(), Tcl_NewListObj(), Tcl_SetListObj(), TclListObjSetElement(), TclLsetFlat(), TclLsetList(), TclObjLookupVar(), and UpdateLocalVarName().Tcl_ObjType* Tcl_Obj::typePtr

Definition at line 788 of file tcl.h.
Referenced by DupByteArrayInternalRep(), DupFsPathInternalRep(), DupListInternalRep(), DupLocalVarName(), DupNsVarName(), DupOSTypeInternalRep(), DupParsedVarName(), DupRegexpInternalRep(), ExprAbsFunc(), ExprBinaryFunc(), ExprCallMathFunc(), ExprDoubleFunc(), ExprIntFunc(), ExprRoundFunc(), ExprUnaryFunc(), ExprWideFunc(), GetNamespaceFromObj(), ProcBodyDup(), ProcCompileProc(), ResetObjResult(), SetArraySearchObj(), SetByteArrayFromAny(), SetEndOffsetFromAny(), SetFsPathFromAny(), SetIntFromAny(), SetListFromAny(), SetNsNameFromAny(), SetOSTypeFromAny(), SetStringFromAny(), Tcl_AppendObjToObj(), Tcl_ConcatObj(), Tcl_ConvertToType(), Tcl_DuplicateObj(), Tcl_FSConvertToPathType(), Tcl_FSGetNormalizedPath(), Tcl_FSNewNativePath(), Tcl_GetIndexFromObj(), Tcl_GetIndexFromObjStruct(), Tcl_GetOSTypeFromObj(), Tcl_GetRegExpFromObj(), Tcl_LappendObjCmd(), Tcl_ListObjAppendElement(), Tcl_ListObjReplace(), Tcl_LrangeObjCmd(), Tcl_NewBooleanObj(), Tcl_NewDoubleObj(), Tcl_NewIntObj(), Tcl_NewListObj(), Tcl_NewLongObj(), Tcl_NewOSTypeObj(), Tcl_NewUnicodeObj(), Tcl_NewWideIntObj(), Tcl_SetOSTypeObj(), Tcl_StringObjCmd(), TclCompEvalObj(), TclCreateProc(), TclExecuteByteCode(), TclFSMakePathFromNormalized(), TclFSMakePathRelative(), TclGetEncodingFromObj(), TclLindexFlat(), TclLindexList(), TclListObjSetElement(), TclLsetList(), TclNewProcBodyObj(), TclObjLookupVar(), TclObjUnsetVar2(), TclPtrIncrVar(), TclRegisterLiteral(), and VerifyExprObjType().Tcl_WideInt Tcl_Obj::wideValue

Definition at line 796 of file tcl.h.
Referenced by Tcl_NewWideIntObj().
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_ObjType Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 747 of file tcl.h.Public Attributes
char * name
Tcl_FreeInternalRepProc * freeIntRepProc
Tcl_DupInternalRepProc * dupIntRepProc
Tcl_UpdateStringProc * updateStringProc
Tcl_SetFromAnyProc * setFromAnyProc

Member Data Documentation
Tcl_DupInternalRepProc* Tcl_ObjType::dupIntRepProc

Definition at line 753 of file tcl.h.
Referenced by Tcl_DuplicateObj().Tcl_FreeInternalRepProc* Tcl_ObjType::freeIntRepProc

Definition at line 749 of file tcl.h.
Referenced by ProcCompileProc(), ResetObjResult(), SetArraySearchObj(), SetBooleanFromAny(), SetByteArrayFromAny(), SetDoubleFromAny(), SetEndOffsetFromAny(), SetFsPathFromAny(), SetIntOrWideFromAny(), SetListFromAny(), SetNsNameFromAny(), SetOSTypeFromAny(), SetWideIntFromAny(), Tcl_ExprObj(), Tcl_FSNewNativePath(), Tcl_GetRegExpFromObj(), Tcl_SetBooleanObj(), Tcl_SetByteArrayObj(), Tcl_SetDoubleObj(), Tcl_SetIntObj(), Tcl_SetListObj(), Tcl_SetLongObj(), Tcl_SetOSTypeObj(), Tcl_SetStringObj(), Tcl_SetUnicodeObj(), Tcl_SetWideIntObj(), TclCompEvalObj(), TclFreeObj(), TclFSMakePathFromNormalized(), TclFSMakePathRelative(), TclGetEncodingFromObj(), TclObjLookupVar(), TclObjUnsetVar2(), and TclSetCmdNameObj().char* Tcl_ObjType::name

Definition at line 748 of file tcl.h.
Referenced by TclExecuteByteCode().Tcl_SetFromAnyProc* Tcl_ObjType::setFromAnyProc

Definition at line 759 of file tcl.h.
Referenced by GetNamespaceFromObj(), Tcl_ConvertToType(), Tcl_GetCommandFromObj(), Tcl_LappendObjCmd(), and TclCompEvalObj().Tcl_UpdateStringProc* Tcl_ObjType::updateStringProc

Definition at line 756 of file tcl.h.
Referenced by SetStringFromAny(), Tcl_FSNewNativePath(), TclFSMakePathFromNormalized(), and TclFSMakePathRelative().
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_Parse Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 2127 of file tcl.h.Public Attributes
CONST char * commentStart
int commentSize
CONST char * commandStart
int commandSize
int numWords
Tcl_Token * tokenPtr
int numTokens
int tokensAvailable
int errorType
CONST char * string
CONST char * end
Tcl_Interp * interp
CONST char * term
int incomplete
Tcl_Token staticTokens [NUM_STATIC_TOKENS]

Member Data Documentation
int Tcl_Parse::commandSize

Definition at line 2136 of file tcl.h.
Referenced by ParsePrimaryExpr(), ParseTokens(), PrintParse(), and Tcl_ParseExpr().CONST char* Tcl_Parse::commandStart

Definition at line 2135 of file tcl.h.
Referenced by ParsePrimaryExpr(), ParseTokens(), PrintParse(), and Tcl_ParseExpr().int Tcl_Parse::commentSize

Definition at line 2131 of file tcl.h.
Referenced by ParseComment(), PrintParse(), and Tcl_ParseExpr().CONST char* Tcl_Parse::commentStart

Definition at line 2128 of file tcl.h.
Referenced by ParseComment(), PrintParse(), and Tcl_ParseExpr().CONST char* Tcl_Parse::end

Definition at line 2161 of file tcl.h.
Referenced by GetLexeme(), ParsePrimaryExpr(), ParseTokens(), Tcl_ParseExpr(), and Tcl_ParseVarName().int Tcl_Parse::errorType

Definition at line 2150 of file tcl.h.
Referenced by GetLexeme(), ParsePrimaryExpr(), ParseTokens(), and Tcl_ParseVarName().int Tcl_Parse::incomplete

Definition at line 2171 of file tcl.h.
Referenced by ParsePrimaryExpr(), ParseTokens(), Tcl_ParseExpr(), Tcl_ParseVarName(), and TclParseWhiteSpace().Tcl_Interp* Tcl_Parse::interp

Definition at line 2163 of file tcl.h.
Referenced by GetLexeme(), ParsePrimaryExpr(), ParseTokens(), Tcl_ParseExpr(), and Tcl_ParseVarName().int Tcl_Parse::numTokens

Definition at line 2147 of file tcl.h.
Referenced by ParseAddExpr(), ParseBitAndExpr(), ParseBitOrExpr(), ParseBitXorExpr(), ParseCondExpr(), ParseEqualityExpr(), ParseLandExpr(), ParseLorExpr(), ParseMultiplyExpr(), ParsePrimaryExpr(), ParseRelationalExpr(), ParseShiftExpr(), ParseTokens(), ParseUnaryExpr(), PrependSubExprTokens(), PrintParse(), Tcl_ParseExpr(), and Tcl_ParseVarName().int Tcl_Parse::numWords

Definition at line 2140 of file tcl.h.
Referenced by PrintParse(), Tcl_ParseExpr(), Tcl_ParseVarName(), TclCompileAppendCmd(), TclCompileBreakCmd(), TclCompileCatchCmd(), TclCompileContinueCmd(), TclCompileExprCmd(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileIfCmd(), TclCompileIncrCmd(), TclCompileLappendCmd(), TclCompileLindexCmd(), TclCompileListCmd(), TclCompileLlengthCmd(), TclCompileLsetCmd(), TclCompileNoOp(), TclCompileRegexpCmd(), TclCompileReturnCmd(), TclCompileSetCmd(), TclCompileStringCmd(), TclCompileVariableCmd(), and TclCompileWhileCmd().Tcl_Token Tcl_Parse::staticTokens[NUM_STATIC_TOKENS]

Definition at line 2175 of file tcl.h.
Referenced by ParsePrimaryExpr(), ParseTokens(), Tcl_ParseExpr(), and Tcl_ParseVarName().CONST char* Tcl_Parse::string

Definition at line 2159 of file tcl.h.
Referenced by Tcl_ParseExpr(), and Tcl_ParseVarName().CONST char* Tcl_Parse::term

Definition at line 2165 of file tcl.h.
Referenced by GetLexeme(), ParsePrimaryExpr(), ParseTokens(), Tcl_ParseExpr(), and Tcl_ParseVarName().Tcl_Token* Tcl_Parse::tokenPtr

Definition at line 2142 of file tcl.h.
Referenced by ParseCondExpr(), ParsePrimaryExpr(), ParseTokens(), PrependSubExprTokens(), PrintParse(), Tcl_ParseExpr(), Tcl_ParseVarName(), TclCompileAppendCmd(), TclCompileCatchCmd(), TclCompileExprCmd(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileIfCmd(), TclCompileIncrCmd(), TclCompileLappendCmd(), TclCompileLindexCmd(), TclCompileListCmd(), TclCompileLlengthCmd(), TclCompileLsetCmd(), TclCompileNoOp(), TclCompileRegexpCmd(), TclCompileReturnCmd(), TclCompileSetCmd(), TclCompileStringCmd(), TclCompileVariableCmd(), and TclCompileWhileCmd().int Tcl_Parse::tokensAvailable

Definition at line 2148 of file tcl.h.
Referenced by ParseCondExpr(), ParsePrimaryExpr(), ParseTokens(), PrependSubExprTokens(), Tcl_ParseExpr(), and Tcl_ParseVarName().
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_RegExpIndices Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 590 of file tcl.h.Public Attributes
long start
long end

Member Data Documentation
long Tcl_RegExpIndices::end

Definition at line 592 of file tcl.h.
Referenced by Tcl_RegexpObjCmd(), Tcl_RegsubObjCmd(), and TestregexpObjCmd().long Tcl_RegExpIndices::start

Definition at line 591 of file tcl.h.
Referenced by Tcl_RegexpObjCmd(), Tcl_RegsubObjCmd(), and TestregexpObjCmd().
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_RegExpInfo Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 596 of file tcl.h.Public Attributes
int nsubs
Tcl_RegExpIndices * matches
long extendStart
long reserved

Member Data Documentation
long Tcl_RegExpInfo::extendStart

Definition at line 601 of file tcl.h.
Referenced by Tcl_RegExpGetInfo(), and TestregexpObjCmd().Tcl_RegExpIndices* Tcl_RegExpInfo::matches

Definition at line 599 of file tcl.h.
Referenced by Tcl_RegExpGetInfo(), Tcl_RegexpObjCmd(), Tcl_RegsubObjCmd(), and TestregexpObjCmd().int Tcl_RegExpInfo::nsubs

Definition at line 597 of file tcl.h.
Referenced by Tcl_RegExpGetInfo(), Tcl_RegexpObjCmd(), Tcl_RegsubObjCmd(), and TestregexpObjCmd().long Tcl_RegExpInfo::reserved

Definition at line 603 of file tcl.h.
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_ResolvedVarInfo Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 125 of file tclInt.h.Public Attributes
Tcl_ResolveRuntimeVarProc * fetchProc
Tcl_ResolveVarDeleteProc * deleteProc

Member Data Documentation
Tcl_ResolveVarDeleteProc* Tcl_ResolvedVarInfo::deleteProc

Definition at line 127 of file tclInt.h.
Referenced by TclProcCleanupProc().Tcl_ResolveRuntimeVarProc* Tcl_ResolvedVarInfo::fetchProc

Definition at line 126 of file tclInt.h.
Referenced by TclInitCompiledLocals().
The documentation for this struct was generated from the following file:
generic/tclInt.h

Tcl_ResolverInfo Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 144 of file tclInt.h.Public Attributes
Tcl_ResolveCmdProc * cmdResProc
Tcl_ResolveVarProc * varResProc
Tcl_ResolveCompiledVarProc * compiledVarResProc

Member Data Documentation
Tcl_ResolveCmdProc* Tcl_ResolverInfo::cmdResProc

Definition at line 145 of file tclInt.h.
Referenced by Tcl_GetInterpResolvers(), and Tcl_GetNamespaceResolvers().Tcl_ResolveCompiledVarProc* Tcl_ResolverInfo::compiledVarResProc

Definition at line 150 of file tclInt.h.
Referenced by Tcl_GetInterpResolvers(), and Tcl_GetNamespaceResolvers().Tcl_ResolveVarProc* Tcl_ResolverInfo::varResProc

Definition at line 147 of file tclInt.h.
Referenced by Tcl_GetInterpResolvers(), and Tcl_GetNamespaceResolvers().
The documentation for this struct was generated from the following file:
generic/tclInt.h

Tcl_SavedResult Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 871 of file tcl.h.Public Attributes
char * result
Tcl_FreeProc * freeProc
Tcl_Obj * objResultPtr
char * appendResult
int appendAvl
int appendUsed
char resultSpace [TCL_RESULT_SIZE+1]

Member Data Documentation
int Tcl_SavedResult::appendAvl

Definition at line 876 of file tcl.h.char* Tcl_SavedResult::appendResult

Definition at line 875 of file tcl.h.int Tcl_SavedResult::appendUsed

Definition at line 877 of file tcl.h.Tcl_FreeProc* Tcl_SavedResult::freeProc

Definition at line 873 of file tcl.h.Tcl_Obj* Tcl_SavedResult::objResultPtr

Definition at line 874 of file tcl.h.char* Tcl_SavedResult::result

Definition at line 872 of file tcl.h.char Tcl_SavedResult::resultSpace[TCL_RESULT_SIZE+1]

Definition at line 878 of file tcl.h.
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_Time Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 1403 of file tcl.h.Public Attributes
long sec
long usec

Member Data Documentation
long Tcl_Time::sec

Definition at line 1404 of file tcl.h.
Referenced by GetTimesCmd(), SerialBlockTime(), SerialGetMilliseconds(), Tcl_CreateTimerHandler(), TCL_DECLARE_MUTEX(), Tcl_DoOneEvent(), Tcl_DoWhenIdle(), Tcl_GetTime(), Tcl_SetMaxBlockTime(), Tcl_SetTimer(), Tcl_Sleep(), Tcl_TimeObjCmd(), Tcl_WaitForEvent(), TclCleanupByteCode(), TclpGetClicks(), TclpGetSeconds(), TclServiceIdle(), TclUnixWaitForFile(), TestwinclockCmd(), TimerCheckProc(), TimerHandlerEventProc(), TimerSetupProc(), and WaitForEvent().long Tcl_Time::usec

Definition at line 1405 of file tcl.h.
Referenced by GetTimesCmd(), SerialBlockTime(), SerialGetMilliseconds(), Tcl_CreateTimerHandler(), TCL_DECLARE_MUTEX(), Tcl_DoOneEvent(), Tcl_DoWhenIdle(), Tcl_GetTime(), Tcl_SetMaxBlockTime(), Tcl_SetTimer(), Tcl_Sleep(), Tcl_TimeObjCmd(), Tcl_WaitForEvent(), TclCleanupByteCode(), TclpGetClicks(), TclServiceIdle(), TclUnixWaitForFile(), TestwinclockCmd(), TimerCheckProc(), TimerHandlerEventProc(), TimerSetupProc(), and WaitForEvent().
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_Token Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 2011 of file tcl.h.Public Attributes
int type
CONST char * start
int size
int numComponents

Member Data Documentation
int Tcl_Token::numComponents

Definition at line 2016 of file tcl.h.
Referenced by CompileCondExpr(), CompileLandOrLorExpr(), CompileMathFuncCall(), CompileSubExpr(), ParseCondExpr(), ParsePrimaryExpr(), ParseTokens(), PrintParse(), Tcl_EvalEx(), Tcl_EvalTokensStandard(), Tcl_ParseBraces(), Tcl_ParseCommand(), Tcl_ParseVarName(), TclCompileAppendCmd(), TclCompileCatchCmd(), TclCompileExprCmd(), TclCompileExprWords(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileIncrCmd(), TclCompileLappendCmd(), TclCompileLindexCmd(), TclCompileListCmd(), TclCompileLlengthCmd(), TclCompileLsetCmd(), TclCompileNoOp(), TclCompileRegexpCmd(), TclCompileReturnCmd(), TclCompileScript(), TclCompileSetCmd(), TclCompileStringCmd(), TclCompileTokens(), TclCompileVariableCmd(), TclCompileWhileCmd(), and TclPushVarName().int Tcl_Token::size

Definition at line 2015 of file tcl.h.
Referenced by CompileSubExpr(), ParseCondExpr(), ParsePrimaryExpr(), ParseTokens(), PrintParse(), Tcl_EvalTokensStandard(), Tcl_ParseBraces(), Tcl_ParseCommand(), Tcl_ParseVarName(), TclCompileCatchCmd(), TclCompileCmdWord(), TclCompileExprWords(), TclCompileIncrCmd(), TclCompileRegexpCmd(), TclCompileStringCmd(), TclCompileTokens(), TclCompileVariableCmd(), and TclPushVarName().CONST char* Tcl_Token::start

Definition at line 2014 of file tcl.h.
Referenced by CompileSubExpr(), ParsePrimaryExpr(), ParseTokens(), PrintParse(), Tcl_EvalTokensStandard(), Tcl_ParseBraces(), Tcl_ParseCommand(), Tcl_ParseVarName(), TclCompileCatchCmd(), TclCompileCmdWord(), TclCompileExprWords(), TclCompileIncrCmd(), TclCompileStringCmd(), TclCompileTokens(), TclCompileVariableCmd(), and TclPushVarName().int Tcl_Token::type

Definition at line 2012 of file tcl.h.
Referenced by CompileSubExpr(), ParsePrimaryExpr(), ParseTokens(), PrintParse(), Tcl_EvalTokensStandard(), Tcl_ParseBraces(), Tcl_ParseCommand(), Tcl_ParseVarName(), TclCompileAppendCmd(), TclCompileCatchCmd(), TclCompileCmdWord(), TclCompileExprWords(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileIfCmd(), TclCompileIncrCmd(), TclCompileLappendCmd(), TclCompileLindexCmd(), TclCompileListCmd(), TclCompileLlengthCmd(), TclCompileLsetCmd(), TclCompileNoOp(), TclCompileRegexpCmd(), TclCompileReturnCmd(), TclCompileScript(), TclCompileSetCmd(), TclCompileStringCmd(), TclCompileTokens(), TclCompileVariableCmd(), TclCompileWhileCmd(), and TclPushVarName().
The documentation for this struct was generated from the following file:
generic/tcl.h

Tcl_Value Struct Reference
#include <tcl.h>

Detailed Description

Definition at line 656 of file tcl.h.Public Attributes
Tcl_ValueType type
long intValue
double doubleValue
Tcl_WideInt wideValue

Member Data Documentation
double Tcl_Value::doubleValue

Definition at line 660 of file tcl.h.long Tcl_Value::intValue

Definition at line 659 of file tcl.h.Tcl_ValueType Tcl_Value::type

Definition at line 657 of file tcl.h.Tcl_WideInt Tcl_Value::wideValue

Definition at line 661 of file tcl.h.
The documentation for this struct was generated from the following file:
generic/tcl.h

TclDatetoktype Struct Reference

Detailed Description

Definition at line 1030 of file tclDate.c.Public Attributes
char * t_name
int t_val

Member Data Documentation
char* TclDatetoktype::t_name

Definition at line 1034 of file tclDate.c.int TclDatetoktype::t_val

Definition at line 1034 of file tclDate.c.
Referenced by TclDateparse().
The documentation for this struct was generated from the following file:
generic/tclDate.c

TclEncoding Struct Reference

Detailed Description

Definition at line 96 of file tclTest.c.Public Attributes
Tcl_Interp * interp
char * toUtfCmd
char * fromUtfCmd

Member Data Documentation
char* TclEncoding::fromUtfCmd

Definition at line 99 of file tclTest.c.
Referenced by EncodingFreeProc(), EncodingFromUtfProc(), and TestencodingObjCmd().Tcl_Interp* TclEncoding::interp

Definition at line 97 of file tclTest.c.
Referenced by EncodingFromUtfProc(), EncodingToUtfProc(), and TestencodingObjCmd().char* TclEncoding::toUtfCmd

Definition at line 98 of file tclTest.c.
Referenced by EncodingFreeProc(), EncodingToUtfProc(), and TestencodingObjCmd().
The documentation for this struct was generated from the following file:
generic/tclTest.c

TclFileAttrProcs Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 1551 of file tclInt.h.Public Attributes
TclGetFileAttrProc * getProc
TclSetFileAttrProc * setProc

Member Data Documentation
TclGetFileAttrProc* TclFileAttrProcs::getProc

Definition at line 1552 of file tclInt.h.TclSetFileAttrProc* TclFileAttrProcs::setProc

Definition at line 1553 of file tclInt.h.
The documentation for this struct was generated from the following file:
generic/tclInt.h

TclIntPlatStubs Struct Reference
#include <tclIntPlatDecls.h>

Detailed Description

Definition at line 220 of file tclIntPlatDecls.h.Public Member Functions
void tclGetAndDetachPids _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan))
int tclpCloseFile _ANSI_ARGS_ ((TclFile file))
Tcl_Channel tclpCreateCommandChannel _ANSI_ARGS_ ((TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr))
int tclpCreatePipe _ANSI_ARGS_ ((TclFile *readPipe, TclFile *writePipe))
int tclpCreateProcess _ANSI_ARGS_ ((Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr))
TclFile tclpMakeFile _ANSI_ARGS_ ((Tcl_Channel channel, int direction))
TclFile tclpOpenFile _ANSI_ARGS_ ((CONST char *fname, int mode))
int tclUnixWaitForFile _ANSI_ARGS_ ((int fd, int mask, int timeout))
TclFile tclpCreateTempFile _ANSI_ARGS_ ((CONST char *contents))
Tcl_DirEntry *tclpReaddir _ANSI_ARGS_ ((DIR *dir))
tm *tclpLocaltime_unix _ANSI_ARGS_ ((CONST TclpTime_t clock))
tm *tclpGmtime_unix _ANSI_ARGS_ ((CONST TclpTime_t clock))
char *tclpInetNtoa _ANSI_ARGS_ ((struct in_addr addr))
Public Attributes
int magic
TclIntPlatStubHooks * hooks
void * reserved5

Member Function Documentation
char* tclpInetNtoa TclIntPlatStubs::_ANSI_ARGS_ ((struct in_addr addr))
struct tm* tclpGmtime_unix TclIntPlatStubs::_ANSI_ARGS_ ((CONST TclpTime_t clock))
struct tm* tclpLocaltime_unix TclIntPlatStubs::_ANSI_ARGS_ ((CONST TclpTime_t clock))
Tcl_DirEntry* tclpReaddir TclIntPlatStubs::_ANSI_ARGS_ ((DIR *dir))
TclFile tclpCreateTempFile TclIntPlatStubs::_ANSI_ARGS_ ((CONST char *contents))
int tclUnixWaitForFile TclIntPlatStubs::_ANSI_ARGS_ ((int fd, int mask, int timeout))
TclFile tclpOpenFile TclIntPlatStubs::_ANSI_ARGS_ ((CONST char *fname, int mode))
TclFile tclpMakeFile TclIntPlatStubs::_ANSI_ARGS_ ((Tcl_Channel channel, int direction))
int tclpCreateProcess TclIntPlatStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr))
int tclpCreatePipe TclIntPlatStubs::_ANSI_ARGS_ ((TclFile *readPipe, TclFile *writePipe))
Tcl_Channel tclpCreateCommandChannel TclIntPlatStubs::_ANSI_ARGS_ ((TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr))
int tclpCloseFile TclIntPlatStubs::_ANSI_ARGS_ ((TclFile file))
void tclGetAndDetachPids TclIntPlatStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan))

Member Data Documentation
struct TclIntPlatStubHooks* TclIntPlatStubs::hooks

Definition at line 222 of file tclIntPlatDecls.h.int TclIntPlatStubs::magic

Definition at line 221 of file tclIntPlatDecls.h.void* TclIntPlatStubs::reserved5

Definition at line 230 of file tclIntPlatDecls.h.
The documentation for this struct was generated from the following file:
generic/tclIntPlatDecls.h

TclIntStubs Struct Reference
#include <tclIntDecls.h>

Detailed Description

Definition at line 536 of file tclIntDecls.h.Public Member Functions
int tclAccessDeleteProc _ANSI_ARGS_ ((TclAccessProc_ *proc))
int tclAccessInsertProc _ANSI_ARGS_ ((TclAccessProc_ *proc))
void tclAllocateFreeObjects _ANSI_ARGS_ ((void))
int tclCleanupChildren _ANSI_ARGS_ ((Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan))
void tclCleanupCommand _ANSI_ARGS_ ((Command *cmdPtr))
int tclCopyAndCollapse _ANSI_ARGS_ ((int count, CONST char *src, char *dst))
int tclCopyChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr))
int tclCreatePipeline _ANSI_ARGS_ ((Tcl_Interp *interp, int argc, CONST char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr))
int tclCreateProc _ANSI_ARGS_ ((Tcl_Interp *interp, Namespace *nsPtr, CONST char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr))
void tclDeleteCompiledLocalVars _ANSI_ARGS_ ((Interp *iPtr, CallFrame *framePtr))
void tclDeleteVars _ANSI_ARGS_ ((Interp *iPtr, Tcl_HashTable *tablePtr))
int tclDoGlob _ANSI_ARGS_ ((Tcl_Interp *interp, char *separators, Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types))
void tclDumpMemoryInfo _ANSI_ARGS_ ((FILE *outFile))
void tclExprFloatError _ANSI_ARGS_ ((Tcl_Interp *interp, double value))
int tclFindElement _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *listStr, int listLength, CONST char **elementPtr, CONST char **nextPtr, int *sizePtr, int *bracePtr))
Proc *tclFindProc _ANSI_ARGS_ ((Interp *iPtr, CONST char *procName))
int tclFormatInt _ANSI_ARGS_ ((char *buffer, long n))
void tclFreePackageInfo _ANSI_ARGS_ ((Interp *iPtr))
int tclGetDate _ANSI_ARGS_ ((char *p, Tcl_WideInt now, long zone, Tcl_WideInt *timePtr))
Tcl_Channel tclpGetDefaultStdChannel _ANSI_ARGS_ ((int type))
char *tclGetExtension _ANSI_ARGS_ ((char *name))
int tclGetFrame _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, CallFrame **framePtrPtr))
TclCmdProcType tclGetInterpProc _ANSI_ARGS_ ((void))
int tclGetIntForIndex _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr))
int tclGetLong _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, long *longPtr))
int tclGetLoadedPackages _ANSI_ARGS_ ((Tcl_Interp *interp, char *targetName))
int tclGetNamespaceForQualName _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, CONST char **simpleNamePtr))
TclObjCmdProcType tclGetObjInterpProc _ANSI_ARGS_ ((void))
int tclGetOpenMode _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int *seekFlagPtr))
Tcl_Command tclGetOriginalCommand _ANSI_ARGS_ ((Tcl_Command command))
char *tclpGetUserHome _ANSI_ARGS_ ((CONST char *name, Tcl_DString *bufferPtr))
int tclGlobalInvoke _ANSI_ARGS_ ((Tcl_Interp *interp, int argc, CONST84 char **argv, int flags))
int tclGuessPackageName _ANSI_ARGS_ ((CONST char *fileName, Tcl_DString *bufPtr))
int tclHideUnsafeCommands _ANSI_ARGS_ ((Tcl_Interp *interp))
int tclInExit _ANSI_ARGS_ ((void))
Tcl_Obj *tclIncrVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, long incrAmount, int part1NotParsed))
void tclInitCompiledLocals _ANSI_ARGS_ ((Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr))
int tclInterpInit _ANSI_ARGS_ ((Tcl_Interp *interp))
int tclInvoke _ANSI_ARGS_ ((Tcl_Interp *interp, int argc, CONST84 char **argv, int flags))
int tclInvokeObjectCommand _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv))
int tclInvokeStringCommand _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
Proc *tclIsProc _ANSI_ARGS_ ((Command *cmdPtr))
Var *tclLookupVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, CONST char *msg, int createPart1, int createPart2, Var **arrayPtrPtr))
int tclNeedSpace _ANSI_ARGS_ ((CONST char *start, CONST char *end))
Tcl_Obj *tclNewProcBodyObj _ANSI_ARGS_ ((Proc *procPtr))
int tclObjCommandComplete _ANSI_ARGS_ ((Tcl_Obj *cmdPtr))
int tclObjInterpProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
int tclObjInvoke _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags))
int tclObjInvokeGlobal _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags))
int tclOpenFileChannelDeleteProc _ANSI_ARGS_ ((TclOpenFileChannelProc_ *proc))
int tclOpenFileChannelInsertProc _ANSI_ARGS_ ((TclOpenFileChannelProc_ *proc))
char *tclpAlloc _ANSI_ARGS_ ((unsigned int size))
void tclpFree _ANSI_ARGS_ ((char *ptr))
unsigned long tclpGetClicks _ANSI_ARGS_ ((void))
unsigned long tclpGetSeconds _ANSI_ARGS_ ((void))
void tclpGetTime _ANSI_ARGS_ ((Tcl_Time *time))
int tclpGetTimeZone _ANSI_ARGS_ ((Tcl_WideInt time))
char *tclpRealloc _ANSI_ARGS_ ((char *ptr, unsigned int size))
char *tclPrecTraceProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags))
int tclPreventAliasLoop _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd))
void tclProcCleanupProc _ANSI_ARGS_ ((Proc *procPtr))
int tclProcCompileProc _ANSI_ARGS_ ((Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description, CONST char *procName))
void tclProcDeleteProc _ANSI_ARGS_ ((ClientData clientData))
int tclProcInterpProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv))
int tclRenameCommand _ANSI_ARGS_ ((Tcl_Interp *interp, char *oldName, char *newName))
void tclResetShadowedCmdRefs _ANSI_ARGS_ ((Tcl_Interp *interp, Command *newCmdPtr))
int tclServiceIdle _ANSI_ARGS_ ((void))
char *tclSetPreInitScript _ANSI_ARGS_ ((char *string))
void tclSetupEnv _ANSI_ARGS_ ((Tcl_Interp *interp))
int tclSockGetPort _ANSI_ARGS_ ((Tcl_Interp *interp, char *str, char *proto, int *portPtr))
int tclSockMinimumBuffers _ANSI_ARGS_ ((int sock, int size))
int tclStatDeleteProc _ANSI_ARGS_ ((TclStatProc_ *proc))
int tclStatInsertProc _ANSI_ARGS_ ((TclStatProc_ *proc))
void tclTeardownNamespace _ANSI_ARGS_ ((Namespace *nsPtr))
int tclUpdateReturnInfo _ANSI_ARGS_ ((Interp *iPtr))
void tcl_AddInterpResolvers _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc))
int tcl_AppendExportList _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr))
Tcl_Namespace *tcl_CreateNamespace _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc))
void tcl_DeleteNamespace _ANSI_ARGS_ ((Tcl_Namespace *nsPtr))
int tcl_Export _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int resetListFirst))
Tcl_Command tcl_FindCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags))
Tcl_Namespace *tcl_FindNamespace _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags))
int tcl_GetInterpResolvers _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_ResolverInfo *resInfo))
int tcl_GetNamespaceResolvers _ANSI_ARGS_ ((Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo))
Tcl_Var tcl_FindNamespaceVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags))
int tcl_ForgetImport _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern))
Tcl_Command tcl_GetCommandFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
void tcl_GetCommandFullName _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr))
Tcl_Namespace *tcl_GetCurrentNamespace _ANSI_ARGS_ ((Tcl_Interp *interp))
Tcl_Namespace *tcl_GetGlobalNamespace _ANSI_ARGS_ ((Tcl_Interp *interp))
void tcl_GetVariableFullName _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr))
int tcl_Import _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int allowOverwrite))
void tcl_PopCallFrame _ANSI_ARGS_ ((Tcl_Interp *interp))
int tcl_PushCallFrame _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame))
int tcl_RemoveInterpResolvers _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name))
void tcl_SetNamespaceResolvers _ANSI_ARGS_ ((Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc))
int tclpHasSockets _ANSI_ARGS_ ((Tcl_Interp *interp))
tm *tclpGetDate _ANSI_ARGS_ ((TclpTime_t time, int useGMT))
size_t tclpStrftime _ANSI_ARGS_ ((char *s, size_t maxsize, CONST char *format, CONST struct tm *t, int useGMT))
int tclpCheckStackSpace _ANSI_ARGS_ ((void))
CONST84_RETURN char *tclGetEnv _ANSI_ARGS_ ((CONST char *name, Tcl_DString *valuePtr))
int tclLooksLikeInt _ANSI_ARGS_ ((CONST char *bytes, int length))
CONST84_RETURN char *tclpGetCwd _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_DString *cwdPtr))
int tclSetByteCodeFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData))
int tclAddLiteralObj _ANSI_ARGS_ ((struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr))
void tclHideLiteral _ANSI_ARGS_ ((Tcl_Interp *interp, struct CompileEnv *envPtr, int index))
AuxDataType *tclGetAuxDataType _ANSI_ARGS_ ((char *typeName))
TclHandle tclHandleCreate _ANSI_ARGS_ ((VOID *ptr))
void tclHandleFree _ANSI_ARGS_ ((TclHandle handle))
TclHandle tclHandlePreserve _ANSI_ARGS_ ((TclHandle handle))
void tclHandleRelease _ANSI_ARGS_ ((TclHandle handle))
int tclRegAbout _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_RegExp re))
void tclRegExpRangeUniChar _ANSI_ARGS_ ((Tcl_RegExp re, int index, int *startPtr, int *endPtr))
void tclSetLibraryPath _ANSI_ARGS_ ((Tcl_Obj *pathPtr))
Tcl_Obj *tclGetLibraryPath _ANSI_ARGS_ ((void))
void tclRegError _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *msg, int status))
Var *tclVarTraceExists _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName))
void tclSetStartupScriptFileName _ANSI_ARGS_ ((CONST char *filename))
CONST84_RETURN char *tclGetStartupScriptFileName _ANSI_ARGS_ ((void))
int tclChannelTransform _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr))
void tclChannelEventScriptInvoker _ANSI_ARGS_ ((ClientData clientData, int flags))
void *tclGetInstructionTable _ANSI_ARGS_ ((void))
void tclExpandCodeArray _ANSI_ARGS_ ((void *envPtr))
void tclpSetInitialEncodings _ANSI_ARGS_ ((void))
int tclListObjSetElement _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr))
void tclSetStartupScriptPath _ANSI_ARGS_ ((Tcl_Obj *pathPtr))
Tcl_Obj *tclGetStartupScriptPath _ANSI_ARGS_ ((void))
int tclpUtfNcmp2 _ANSI_ARGS_ ((CONST char *s1, CONST char *s2, unsigned long n))
int tclCheckInterpTraces _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[]))
int tclCheckExecutionTraces _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[]))
int tclInThreadExit _ANSI_ARGS_ ((void))
int tclUniCharMatch _ANSI_ARGS_ ((CONST Tcl_UniChar *string, int strLen, CONST Tcl_UniChar *pattern, int ptnLen, int nocase))
tm *tclpLocaltime _ANSI_ARGS_ ((CONST TclpTime_t clock))
tm *tclpGmtime _ANSI_ARGS_ ((CONST TclpTime_t clock))
int tclMatchIsTrivial _ANSI_ARGS_ ((CONST char *pattern))
Public Attributes
int magic
TclIntStubHooks * hooks
void * reserved0
void * reserved4
void * reserved15
void * reserved17
void * reserved18
void * reserved19
void * reserved20
void * reserved21
void * reserved26
void * reserved29
void * reserved30
void * reserved35
void * reserved47
void * reserved48
void * reserved56
void * reserved57
void * reserved59
void * reserved68
void * reserved70
void * reserved71
void * reserved72
void * reserved73
void * reserved79
void * reserved80
void * reserved82
void * reserved83
void * reserved84
void * reserved85
void * reserved86
void * reserved87
void * reserved90
void * reserved95
void * reserved99
void * reserved100
void * reserved105
void * reserved110
void * reserved136
void * reserved137
void * reserved139
void * reserved154
void * reserved155
void * reserved160
void * reserved174
void * reserved175
void * reserved176
void * reserved177
void * reserved178
void * reserved179
void * reserved180
void * reserved181
void * reserved184
void * reserved185
void * reserved186
void * reserved187
void * reserved188
void * reserved189
void * reserved190
void * reserved191
void * reserved192
void * reserved193
void * reserved194
void * reserved195
void * reserved196
void * reserved197
void * reserved198

Member Function Documentation
int tclMatchIsTrivial TclIntStubs::_ANSI_ARGS_ ((CONST char *pattern))
struct tm* tclpGmtime TclIntStubs::_ANSI_ARGS_ ((CONST TclpTime_t clock))
struct tm* tclpLocaltime TclIntStubs::_ANSI_ARGS_ ((CONST TclpTime_t clock))
int tclUniCharMatch TclIntStubs::_ANSI_ARGS_ ((CONST Tcl_UniChar *string, int strLen, CONST Tcl_UniChar *pattern, int ptnLen, int nocase))
int tclInThreadExit TclIntStubs::_ANSI_ARGS_ ((void))
int tclCheckExecutionTraces TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[]))
int tclCheckInterpTraces TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[]))
int tclpUtfNcmp2 TclIntStubs::_ANSI_ARGS_ ((CONST char *s1, CONST char *s2, unsigned long n))
Tcl_Obj* tclGetStartupScriptPath TclIntStubs::_ANSI_ARGS_ ((void))
void tclSetStartupScriptPath TclIntStubs::_ANSI_ARGS_ ((Tcl_Obj *pathPtr))
int tclListObjSetElement TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr))
void tclpSetInitialEncodings TclIntStubs::_ANSI_ARGS_ ((void))
void tclExpandCodeArray TclIntStubs::_ANSI_ARGS_ ((void *envPtr))
void* tclGetInstructionTable TclIntStubs::_ANSI_ARGS_ ((void))
void tclChannelEventScriptInvoker TclIntStubs::_ANSI_ARGS_ ((ClientData clientData, int flags))
int tclChannelTransform TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr))
CONST84_RETURN char* tclGetStartupScriptFileName TclIntStubs::_ANSI_ARGS_ ((void))
void tclSetStartupScriptFileName TclIntStubs::_ANSI_ARGS_ ((CONST char *filename))
Var* tclVarTraceExists TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName))
void tclRegError TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *msg, int status))
Tcl_Obj* tclGetLibraryPath TclIntStubs::_ANSI_ARGS_ ((void))
void tclSetLibraryPath TclIntStubs::_ANSI_ARGS_ ((Tcl_Obj *pathPtr))
void tclRegExpRangeUniChar TclIntStubs::_ANSI_ARGS_ ((Tcl_RegExp re, int index, int *startPtr, int *endPtr))
int tclRegAbout TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_RegExp re))
void tclHandleRelease TclIntStubs::_ANSI_ARGS_ ((TclHandle handle))
TclHandle tclHandlePreserve TclIntStubs::_ANSI_ARGS_ ((TclHandle handle))
void tclHandleFree TclIntStubs::_ANSI_ARGS_ ((TclHandle handle))
TclHandle tclHandleCreate TclIntStubs::_ANSI_ARGS_ ((VOID *ptr))
struct AuxDataType* tclGetAuxDataType TclIntStubs::_ANSI_ARGS_ ((char *typeName))
void tclHideLiteral TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, struct CompileEnv *envPtr, int index))
int tclAddLiteralObj TclIntStubs::_ANSI_ARGS_ ((struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr))
int tclSetByteCodeFromAny TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData))
CONST84_RETURN char* tclpGetCwd TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_DString *cwdPtr))
int tclLooksLikeInt TclIntStubs::_ANSI_ARGS_ ((CONST char *bytes, int length))
CONST84_RETURN char* tclGetEnv TclIntStubs::_ANSI_ARGS_ ((CONST char *name, Tcl_DString *valuePtr))
int tclpCheckStackSpace TclIntStubs::_ANSI_ARGS_ ((void))
size_t tclpStrftime TclIntStubs::_ANSI_ARGS_ ((char *s, size_t maxsize, CONST char *format, CONST struct tm *t, int useGMT))
struct tm* tclpGetDate TclIntStubs::_ANSI_ARGS_ ((TclpTime_t time, int useGMT))
int tclpHasSockets TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
void tcl_SetNamespaceResolvers TclIntStubs::_ANSI_ARGS_ ((Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc))
int tcl_RemoveInterpResolvers TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name))
int tcl_PushCallFrame TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame))
void tcl_PopCallFrame TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
int tcl_Import TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int allowOverwrite))
void tcl_GetVariableFullName TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr))
Tcl_Namespace* tcl_GetGlobalNamespace TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
Tcl_Namespace* tcl_GetCurrentNamespace TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
void tcl_GetCommandFullName TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr))
Tcl_Command tcl_GetCommandFromObj TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
int tcl_ForgetImport TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern))
Tcl_Var tcl_FindNamespaceVar TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags))
int tcl_GetNamespaceResolvers TclIntStubs::_ANSI_ARGS_ ((Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo))
int tcl_GetInterpResolvers TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_ResolverInfo *resInfo))
Tcl_Namespace* tcl_FindNamespace TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags))
Tcl_Command tcl_FindCommand TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags))
int tcl_Export TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int resetListFirst))
void tcl_DeleteNamespace TclIntStubs::_ANSI_ARGS_ ((Tcl_Namespace *nsPtr))
Tcl_Namespace* tcl_CreateNamespace TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc))
int tcl_AppendExportList TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr))
void tcl_AddInterpResolvers TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc))
int tclUpdateReturnInfo TclIntStubs::_ANSI_ARGS_ ((Interp *iPtr))
void tclTeardownNamespace TclIntStubs::_ANSI_ARGS_ ((Namespace *nsPtr))
int tclStatInsertProc TclIntStubs::_ANSI_ARGS_ ((TclStatProc_ *proc))
int tclStatDeleteProc TclIntStubs::_ANSI_ARGS_ ((TclStatProc_ *proc))
int tclSockMinimumBuffers TclIntStubs::_ANSI_ARGS_ ((int sock, int size))
int tclSockGetPort TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, char *str, char *proto, int *portPtr))
void tclSetupEnv TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
char* tclSetPreInitScript TclIntStubs::_ANSI_ARGS_ ((char *string))
int tclServiceIdle TclIntStubs::_ANSI_ARGS_ ((void))
void tclResetShadowedCmdRefs TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Command *newCmdPtr))
int tclRenameCommand TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, char *oldName, char *newName))
int tclProcInterpProc TclIntStubs::_ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv))
void tclProcDeleteProc TclIntStubs::_ANSI_ARGS_ ((ClientData clientData))
int tclProcCompileProc TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description, CONST char *procName))
void tclProcCleanupProc TclIntStubs::_ANSI_ARGS_ ((Proc *procPtr))
int tclPreventAliasLoop TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd))
char* tclPrecTraceProc TclIntStubs::_ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags))
char* tclpRealloc TclIntStubs::_ANSI_ARGS_ ((char *ptr, unsigned int size))
int tclpGetTimeZone TclIntStubs::_ANSI_ARGS_ ((Tcl_WideInt time))
void tclpGetTime TclIntStubs::_ANSI_ARGS_ ((Tcl_Time *time))
unsigned long tclpGetSeconds TclIntStubs::_ANSI_ARGS_ ((void))
unsigned long tclpGetClicks TclIntStubs::_ANSI_ARGS_ ((void))
void tclpFree TclIntStubs::_ANSI_ARGS_ ((char *ptr))
char* tclpAlloc TclIntStubs::_ANSI_ARGS_ ((unsigned int size))
int tclOpenFileChannelInsertProc TclIntStubs::_ANSI_ARGS_ ((TclOpenFileChannelProc_ *proc))
int tclOpenFileChannelDeleteProc TclIntStubs::_ANSI_ARGS_ ((TclOpenFileChannelProc_ *proc))
int tclObjInvokeGlobal TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags))
int tclObjInvoke TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags))
int tclObjInterpProc TclIntStubs::_ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
int tclObjCommandComplete TclIntStubs::_ANSI_ARGS_ ((Tcl_Obj *cmdPtr))
Tcl_Obj* tclNewProcBodyObj TclIntStubs::_ANSI_ARGS_ ((Proc *procPtr))
int tclNeedSpace TclIntStubs::_ANSI_ARGS_ ((CONST char *start, CONST char *end))
Var* tclLookupVar TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, CONST char *msg, int createPart1, int createPart2, Var **arrayPtrPtr))
Proc* tclIsProc TclIntStubs::_ANSI_ARGS_ ((Command *cmdPtr))
int tclInvokeStringCommand TclIntStubs::_ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
int tclInvokeObjectCommand TclIntStubs::_ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv))
int tclInvoke TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, int argc, CONST84 char **argv, int flags))
int tclInterpInit TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
void tclInitCompiledLocals TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr))
Tcl_Obj* tclIncrVar2 TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, long incrAmount, int part1NotParsed))
int tclInExit TclIntStubs::_ANSI_ARGS_ ((void))
int tclHideUnsafeCommands TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
int tclGuessPackageName TclIntStubs::_ANSI_ARGS_ ((CONST char *fileName, Tcl_DString *bufPtr))
int tclGlobalInvoke TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, int argc, CONST84 char **argv, int flags))
char* tclpGetUserHome TclIntStubs::_ANSI_ARGS_ ((CONST char *name, Tcl_DString *bufferPtr))
Tcl_Command tclGetOriginalCommand TclIntStubs::_ANSI_ARGS_ ((Tcl_Command command))
int tclGetOpenMode TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int *seekFlagPtr))
TclObjCmdProcType tclGetObjInterpProc TclIntStubs::_ANSI_ARGS_ ((void))
int tclGetNamespaceForQualName TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, CONST char **simpleNamePtr))
int tclGetLoadedPackages TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, char *targetName))
int tclGetLong TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, long *longPtr))
int tclGetIntForIndex TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr))
TclCmdProcType tclGetInterpProc TclIntStubs::_ANSI_ARGS_ ((void))
int tclGetFrame TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, CallFrame **framePtrPtr))
char* tclGetExtension TclIntStubs::_ANSI_ARGS_ ((char *name))
Tcl_Channel tclpGetDefaultStdChannel TclIntStubs::_ANSI_ARGS_ ((int type))
int tclGetDate TclIntStubs::_ANSI_ARGS_ ((char *p, Tcl_WideInt now, long zone, Tcl_WideInt *timePtr))
void tclFreePackageInfo TclIntStubs::_ANSI_ARGS_ ((Interp *iPtr))
int tclFormatInt TclIntStubs::_ANSI_ARGS_ ((char *buffer, long n))
Proc* tclFindProc TclIntStubs::_ANSI_ARGS_ ((Interp *iPtr, CONST char *procName))
int tclFindElement TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *listStr, int listLength, CONST char **elementPtr, CONST char **nextPtr, int *sizePtr, int *bracePtr))
void tclExprFloatError TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, double value))
void tclDumpMemoryInfo TclIntStubs::_ANSI_ARGS_ ((FILE *outFile))
int tclDoGlob TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, char *separators, Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types))
void tclDeleteVars TclIntStubs::_ANSI_ARGS_ ((Interp *iPtr, Tcl_HashTable *tablePtr))
void tclDeleteCompiledLocalVars TclIntStubs::_ANSI_ARGS_ ((Interp *iPtr, CallFrame *framePtr))
int tclCreateProc TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Namespace *nsPtr, CONST char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr))
int tclCreatePipeline TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, int argc, CONST char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr))
int tclCopyChannel TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr))
int tclCopyAndCollapse TclIntStubs::_ANSI_ARGS_ ((int count, CONST char *src, char *dst))
void tclCleanupCommand TclIntStubs::_ANSI_ARGS_ ((Command *cmdPtr))
int tclCleanupChildren TclIntStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan))
void tclAllocateFreeObjects TclIntStubs::_ANSI_ARGS_ ((void))
int tclAccessInsertProc TclIntStubs::_ANSI_ARGS_ ((TclAccessProc_ *proc))
int tclAccessDeleteProc TclIntStubs::_ANSI_ARGS_ ((TclAccessProc_ *proc))

Member Data Documentation
struct TclIntStubHooks* TclIntStubs::hooks

Definition at line 538 of file tclIntDecls.h.int TclIntStubs::magic

Definition at line 537 of file tclIntDecls.h.void* TclIntStubs::reserved0

Definition at line 540 of file tclIntDecls.h.void* TclIntStubs::reserved100

Definition at line 656 of file tclIntDecls.h.void* TclIntStubs::reserved105

Definition at line 669 of file tclIntDecls.h.void* TclIntStubs::reserved110

Definition at line 674 of file tclIntDecls.h.void* TclIntStubs::reserved136

Definition at line 700 of file tclIntDecls.h.void* TclIntStubs::reserved137

Definition at line 701 of file tclIntDecls.h.void* TclIntStubs::reserved139

Definition at line 703 of file tclIntDecls.h.void* TclIntStubs::reserved15

Definition at line 571 of file tclIntDecls.h.void* TclIntStubs::reserved154

Definition at line 718 of file tclIntDecls.h.void* TclIntStubs::reserved155

Definition at line 719 of file tclIntDecls.h.void* TclIntStubs::reserved160

Definition at line 724 of file tclIntDecls.h.void* TclIntStubs::reserved17

Definition at line 573 of file tclIntDecls.h.void* TclIntStubs::reserved174

Definition at line 738 of file tclIntDecls.h.void* TclIntStubs::reserved175

Definition at line 739 of file tclIntDecls.h.void* TclIntStubs::reserved176

Definition at line 740 of file tclIntDecls.h.void* TclIntStubs::reserved177

Definition at line 741 of file tclIntDecls.h.void* TclIntStubs::reserved178

Definition at line 742 of file tclIntDecls.h.void* TclIntStubs::reserved179

Definition at line 743 of file tclIntDecls.h.void* TclIntStubs::reserved18

Definition at line 574 of file tclIntDecls.h.void* TclIntStubs::reserved180

Definition at line 744 of file tclIntDecls.h.void* TclIntStubs::reserved181

Definition at line 745 of file tclIntDecls.h.void* TclIntStubs::reserved184

Definition at line 748 of file tclIntDecls.h.void* TclIntStubs::reserved185

Definition at line 749 of file tclIntDecls.h.void* TclIntStubs::reserved186

Definition at line 750 of file tclIntDecls.h.void* TclIntStubs::reserved187

Definition at line 751 of file tclIntDecls.h.void* TclIntStubs::reserved188

Definition at line 752 of file tclIntDecls.h.void* TclIntStubs::reserved189

Definition at line 753 of file tclIntDecls.h.void* TclIntStubs::reserved19

Definition at line 575 of file tclIntDecls.h.void* TclIntStubs::reserved190

Definition at line 754 of file tclIntDecls.h.void* TclIntStubs::reserved191

Definition at line 755 of file tclIntDecls.h.void* TclIntStubs::reserved192

Definition at line 756 of file tclIntDecls.h.void* TclIntStubs::reserved193

Definition at line 757 of file tclIntDecls.h.void* TclIntStubs::reserved194

Definition at line 758 of file tclIntDecls.h.void* TclIntStubs::reserved195

Definition at line 759 of file tclIntDecls.h.void* TclIntStubs::reserved196

Definition at line 760 of file tclIntDecls.h.void* TclIntStubs::reserved197

Definition at line 761 of file tclIntDecls.h.void* TclIntStubs::reserved198

Definition at line 762 of file tclIntDecls.h.void* TclIntStubs::reserved20

Definition at line 576 of file tclIntDecls.h.void* TclIntStubs::reserved21

Definition at line 577 of file tclIntDecls.h.void* TclIntStubs::reserved26

Definition at line 582 of file tclIntDecls.h.void* TclIntStubs::reserved29

Definition at line 585 of file tclIntDecls.h.void* TclIntStubs::reserved30

Definition at line 586 of file tclIntDecls.h.void* TclIntStubs::reserved35

Definition at line 591 of file tclIntDecls.h.void* TclIntStubs::reserved4

Definition at line 544 of file tclIntDecls.h.void* TclIntStubs::reserved47

Definition at line 603 of file tclIntDecls.h.void* TclIntStubs::reserved48

Definition at line 604 of file tclIntDecls.h.void* TclIntStubs::reserved56

Definition at line 612 of file tclIntDecls.h.void* TclIntStubs::reserved57

Definition at line 613 of file tclIntDecls.h.void* TclIntStubs::reserved59

Definition at line 615 of file tclIntDecls.h.void* TclIntStubs::reserved68

Definition at line 624 of file tclIntDecls.h.void* TclIntStubs::reserved70

Definition at line 626 of file tclIntDecls.h.void* TclIntStubs::reserved71

Definition at line 627 of file tclIntDecls.h.void* TclIntStubs::reserved72

Definition at line 628 of file tclIntDecls.h.void* TclIntStubs::reserved73

Definition at line 629 of file tclIntDecls.h.void* TclIntStubs::reserved79

Definition at line 635 of file tclIntDecls.h.void* TclIntStubs::reserved80

Definition at line 636 of file tclIntDecls.h.void* TclIntStubs::reserved82

Definition at line 638 of file tclIntDecls.h.void* TclIntStubs::reserved83

Definition at line 639 of file tclIntDecls.h.void* TclIntStubs::reserved84

Definition at line 640 of file tclIntDecls.h.void* TclIntStubs::reserved85

Definition at line 641 of file tclIntDecls.h.void* TclIntStubs::reserved86

Definition at line 642 of file tclIntDecls.h.void* TclIntStubs::reserved87

Definition at line 643 of file tclIntDecls.h.void* TclIntStubs::reserved90

Definition at line 646 of file tclIntDecls.h.void* TclIntStubs::reserved95

Definition at line 651 of file tclIntDecls.h.void* TclIntStubs::reserved99

Definition at line 655 of file tclIntDecls.h.
The documentation for this struct was generated from the following file:
generic/tclIntDecls.h

TclMacLoadInfo Struct Reference

Detailed Description

Definition at line 89 of file tclMacLoad.c.Public Attributes
int loaded
CFragConnectionID connID
FSSpec fileSpec

Member Data Documentation
CFragConnectionID TclMacLoadInfo::connID

Definition at line 91 of file tclMacLoad.c.
Referenced by TclpDlopen(), TclpFindSymbol(), TclpUnloadFile(), and TryToLoad().FSSpec TclMacLoadInfo::fileSpec

Definition at line 92 of file tclMacLoad.c.
Referenced by TclpDlopen(), and TryToLoad().int TclMacLoadInfo::loaded

Definition at line 90 of file tclMacLoad.c.
Referenced by TclpDlopen(), TclpFindSymbol(), TclpUnloadFile(), and TryToLoad().
The documentation for this struct was generated from the following file:
mac/tclMacLoad.c

TclMacThrdData Struct Reference

Detailed Description

Definition at line 24 of file tclMacThrd.c.Public Attributes
ThreadID threadID
VOID * data
TclMacThrdData * next

Member Data Documentation
VOID* TclMacThrdData::data

Definition at line 26 of file tclMacThrd.c.struct TclMacThrdData* TclMacThrdData::next

Definition at line 27 of file tclMacThrd.c.ThreadID TclMacThrdData::threadID

Definition at line 25 of file tclMacThrd.c.
The documentation for this struct was generated from the following file:
mac/tclMacThrd.c

tclOSAComponent Struct Reference

Detailed Description

Definition at line 61 of file tclMacOSA.c.Public Attributes
char * theName
ComponentInstance theComponent
long componentFlags
OSType languageID
char * languageName
Tcl_HashTable contextTable
Tcl_HashTable scriptTable
Tcl_Interp * theInterp
OSAActiveUPP defActiveProc
long defRefCon

Member Data Documentation
long tclOSAComponent::componentFlags

Definition at line 64 of file tclMacOSA.c.
Referenced by TclOSACompileCmd(), tclOSADecompileCmd(), tclOSAExecuteCmd(), and tclOSAMakeNewComponent().Tcl_HashTable tclOSAComponent::contextTable

Definition at line 67 of file tclMacOSA.c.
Referenced by tclOSAAddContext(), tclOSAClose(), tclOSADeleteContext(), tclOSAGetContextID(), tclOSAInfoCmd(), and tclOSAMakeNewComponent().OSAActiveUPP tclOSAComponent::defActiveProc

Definition at line 70 of file tclMacOSA.c.
Referenced by TclOSAActiveProc().long tclOSAComponent::defRefCon

Definition at line 71 of file tclMacOSA.c.
Referenced by TclOSAActiveProc().OSType tclOSAComponent::languageID

Definition at line 65 of file tclMacOSA.c.
Referenced by tclOSAAddScript(), tclOSAExecuteCmd(), and tclOSAMakeNewComponent().char* tclOSAComponent::languageName

Definition at line 66 of file tclMacOSA.c.
Referenced by tclOSAClose(), tclOSAInfoCmd(), and tclOSAMakeNewComponent().Tcl_HashTable tclOSAComponent::scriptTable

Definition at line 68 of file tclMacOSA.c.
Referenced by tclOSAAddScript(), tclOSAClose(), tclOSADeleteScript(), tclOSAGetScript(), tclOSAInfoCmd(), and tclOSAMakeNewComponent().ComponentInstance tclOSAComponent::theComponent

Definition at line 63 of file tclMacOSA.c.
Referenced by tclOSAAddScript(), tclOSAClose(), TclOSACompileCmd(), tclOSADecompileCmd(), tclOSADeleteContext(), tclOSADeleteScript(), tclOSAExecuteCmd(), tclOSALoad(), tclOSALoadCmd(), tclOSAMakeContext(), tclOSAMakeNewComponent(), tclOSARunCmd(), and tclOSAStore().Tcl_Interp* tclOSAComponent::theInterp

Definition at line 69 of file tclMacOSA.c.
Referenced by tclOSAClose(), and tclOSAMakeNewComponent().char* tclOSAComponent::theName

Definition at line 62 of file tclMacOSA.c.
Referenced by tclOSAClose(), tclOSAMakeNewComponent(), and tclOSARunCmd().
The documentation for this struct was generated from the following file:
mac/tclMacOSA.c

tclOSAContext Struct Reference

Detailed Description

Definition at line 57 of file tclMacOSA.c.Public Attributes
OSAID contextID

Member Data Documentation
OSAID tclOSAContext::contextID

Definition at line 58 of file tclMacOSA.c.
Referenced by tclOSAAddContext(), tclOSADeleteContext(), and tclOSAGetContextID().
The documentation for this struct was generated from the following file:
mac/tclMacOSA.c

tclOSAScript Struct Reference

Detailed Description

Definition at line 51 of file tclMacOSA.c.Public Attributes
OSAID scriptID
OSType languageID
long modeFlags

Member Data Documentation
OSType tclOSAScript::languageID

Definition at line 53 of file tclMacOSA.c.
Referenced by tclOSAAddScript().long tclOSAScript::modeFlags

Definition at line 54 of file tclMacOSA.c.
Referenced by tclOSAAddScript().OSAID tclOSAScript::scriptID

Definition at line 52 of file tclMacOSA.c.
Referenced by tclOSAAddScript(), tclOSAClose(), tclOSADeleteScript(), and tclOSAGetScriptID().
The documentation for this struct was generated from the following file:
mac/tclMacOSA.c

TclPlatStubs Struct Reference
#include <tclPlatDecls.h>

Detailed Description

Definition at line 93 of file tclPlatDecls.h.Public Attributes
int magic
TclPlatStubHooks * hooks

Member Data Documentation
struct TclPlatStubHooks* TclPlatStubs::hooks

Definition at line 95 of file tclPlatDecls.h.int TclPlatStubs::magic

Definition at line 94 of file tclPlatDecls.h.
The documentation for this struct was generated from the following file:
generic/tclPlatDecls.h

TclRegexp Struct Reference
#include <tclRegexp.h>

Detailed Description

Definition at line 35 of file tclRegexp.h.Public Attributes
int flags
regex_t re
CONST char * string
Tcl_Obj * objPtr
regmatch_t * matches
rm_detail_t details
int refCount

Member Data Documentation
rm_detail_t TclRegexp::details

Definition at line 45 of file tclRegexp.h.
Referenced by CompileRegexp(), RegExpExecUniChar(), Tcl_RegExpGetInfo(), and TclRegExpRangeUniChar().int TclRegexp::flags

Definition at line 36 of file tclRegexp.h.
Referenced by CompileRegexp(), Tcl_GetRegExpFromObj(), and TclRegExpRangeUniChar().regmatch_t* TclRegexp::matches

Definition at line 41 of file tclRegexp.h.
Referenced by CompileRegexp(), RegExpExecUniChar(), Tcl_RegExpGetInfo(), Tcl_RegExpRange(), and TclRegExpRangeUniChar().Tcl_Obj* TclRegexp::objPtr

Definition at line 40 of file tclRegexp.h.
Referenced by CompileRegexp(), Tcl_RegExpExec(), Tcl_RegExpExecObj(), and Tcl_RegExpRange().regex_t TclRegexp::re

Definition at line 37 of file tclRegexp.h.
Referenced by CompileRegexp(), RegExpExecUniChar(), Tcl_RegExpGetInfo(), Tcl_RegExpMatch(), Tcl_RegExpMatchObj(), Tcl_RegExpRange(), TclRegAbout(), and TclRegExpRangeUniChar().int TclRegexp::refCount

Definition at line 47 of file tclRegexp.h.
Referenced by CompileRegexp(), DupRegexpInternalRep(), FinalizeRegexp(), FreeRegexpInternalRep(), and Tcl_GetRegExpFromObj().CONST char* TclRegexp::string

Definition at line 39 of file tclRegexp.h.
Referenced by CompileRegexp(), Tcl_RegExpExec(), Tcl_RegExpExecObj(), and Tcl_RegExpRange().
The documentation for this struct was generated from the following file:
generic/tclRegexp.h

TclStubHooks Struct Reference
#include <tclDecls.h>

Detailed Description

Definition at line 1654 of file tclDecls.h.Public Attributes
TclPlatStubs * tclPlatStubs
TclIntStubs * tclIntStubs
TclIntPlatStubs * tclIntPlatStubs

Member Data Documentation
struct TclIntPlatStubs* TclStubHooks::tclIntPlatStubs

Definition at line 1657 of file tclDecls.h.
Referenced by Tcl_InitStubs().struct TclIntStubs* TclStubHooks::tclIntStubs

Definition at line 1656 of file tclDecls.h.
Referenced by Tcl_InitStubs().struct TclPlatStubs* TclStubHooks::tclPlatStubs

Definition at line 1655 of file tclDecls.h.
Referenced by Tcl_InitStubs().
The documentation for this struct was generated from the following file:
generic/tclDecls.h

TclStubs Struct Reference
#include <tclDecls.h>

Detailed Description

Definition at line 1660 of file tclDecls.h.Public Member Functions
int tcl_PkgProvideEx _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version, ClientData clientData))
CONST84_RETURN char *tcl_PkgRequireEx _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr))
void tcl_Panic _ANSI_ARGS_ (TCL_VARARGS(CONST char *, format))
char *tcl_Alloc _ANSI_ARGS_ ((unsigned int size))
void tcl_Free _ANSI_ARGS_ ((char *ptr))
char *tcl_Realloc _ANSI_ARGS_ ((char *ptr, unsigned int size))
char *tcl_DbCkalloc _ANSI_ARGS_ ((unsigned int size, CONST char *file, int line))
int tcl_DbCkfree _ANSI_ARGS_ ((char *ptr, CONST char *file, int line))
char *tcl_DbCkrealloc _ANSI_ARGS_ ((char *ptr, unsigned int size, CONST char *file, int line))
void tcl_CreateFileHandler _ANSI_ARGS_ ((int fd, int mask, Tcl_FileProc *proc, ClientData clientData))
void tcl_DeleteFileHandler _ANSI_ARGS_ ((int fd))
void tcl_SetTimer _ANSI_ARGS_ ((Tcl_Time *timePtr))
void tcl_Sleep _ANSI_ARGS_ ((int ms))
int tcl_WaitForEvent _ANSI_ARGS_ ((Tcl_Time *timePtr))
int tcl_AppendAllObjTypes _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
void tcl_AppendStringsToObj _ANSI_ARGS_ (TCL_VARARGS(Tcl_Obj *, objPtr))
void tcl_AppendToObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST char *bytes, int length))
Tcl_Obj *tcl_ConcatObj _ANSI_ARGS_ ((int objc, Tcl_Obj *CONST objv[]))
int tcl_ConvertToType _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_ObjType *typePtr))
void tcl_DbDecrRefCount _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST char *file, int line))
void tcl_DbIncrRefCount _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST char *file, int line))
int tcl_DbIsShared _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST char *file, int line))
Tcl_Obj *tcl_DbNewBooleanObj _ANSI_ARGS_ ((int boolValue, CONST char *file, int line))
Tcl_Obj *tcl_DbNewByteArrayObj _ANSI_ARGS_ ((CONST unsigned char *bytes, int length, CONST char *file, int line))
Tcl_Obj *tcl_DbNewDoubleObj _ANSI_ARGS_ ((double doubleValue, CONST char *file, int line))
Tcl_Obj *tcl_DbNewListObj _ANSI_ARGS_ ((int objc, Tcl_Obj *CONST *objv, CONST char *file, int line))
Tcl_Obj *tcl_DbNewLongObj _ANSI_ARGS_ ((long longValue, CONST char *file, int line))
Tcl_Obj *tcl_DbNewObj _ANSI_ARGS_ ((CONST char *file, int line))
Tcl_Obj *tcl_DbNewStringObj _ANSI_ARGS_ ((CONST char *bytes, int length, CONST char *file, int line))
Tcl_Obj *tcl_DuplicateObj _ANSI_ARGS_ ((Tcl_Obj *objPtr))
void tclFreeObj _ANSI_ARGS_ ((Tcl_Obj *objPtr))
int tcl_GetBoolean _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int *boolPtr))
int tcl_GetBooleanFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr))
unsigned char *tcl_GetByteArrayFromObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, int *lengthPtr))
int tcl_GetDouble _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, double *doublePtr))
int tcl_GetDoubleFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr))
int tcl_GetIndexFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char **tablePtr, CONST char *msg, int flags, int *indexPtr))
int tcl_GetInt _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int *intPtr))
int tcl_GetIntFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr))
int tcl_GetLongFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr))
Tcl_ObjType *tcl_GetObjType _ANSI_ARGS_ ((CONST char *typeName))
char *tcl_GetStringFromObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, int *lengthPtr))
void tcl_InvalidateStringRep _ANSI_ARGS_ ((Tcl_Obj *objPtr))
int tcl_ListObjAppendList _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr))
int tcl_ListObjAppendElement _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr))
int tcl_ListObjGetElements _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr))
int tcl_ListObjIndex _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr))
int tcl_ListObjLength _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr))
int tcl_ListObjReplace _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *CONST objv[]))
Tcl_Obj *tcl_NewBooleanObj _ANSI_ARGS_ ((int boolValue))
Tcl_Obj *tcl_NewByteArrayObj _ANSI_ARGS_ ((CONST unsigned char *bytes, int length))
Tcl_Obj *tcl_NewDoubleObj _ANSI_ARGS_ ((double doubleValue))
Tcl_Obj *tcl_NewIntObj _ANSI_ARGS_ ((int intValue))
Tcl_Obj *tcl_NewListObj _ANSI_ARGS_ ((int objc, Tcl_Obj *CONST objv[]))
Tcl_Obj *tcl_NewLongObj _ANSI_ARGS_ ((long longValue))
Tcl_Obj *tcl_NewObj _ANSI_ARGS_ ((void))
Tcl_Obj *tcl_NewStringObj _ANSI_ARGS_ ((CONST char *bytes, int length))
void tcl_SetBooleanObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, int boolValue))
unsigned char *tcl_SetByteArrayLength _ANSI_ARGS_ ((Tcl_Obj *objPtr, int length))
void tcl_SetByteArrayObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST unsigned char *bytes, int length))
void tcl_SetDoubleObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, double doubleValue))
void tcl_SetIntObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, int intValue))
void tcl_SetListObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, int objc, Tcl_Obj *CONST objv[]))
void tcl_SetLongObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, long longValue))
void tcl_SetObjLength _ANSI_ARGS_ ((Tcl_Obj *objPtr, int length))
void tcl_SetStringObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST char *bytes, int length))
void tcl_AddErrorInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *message))
void tcl_AddObjErrorInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *message, int length))
void tcl_AllowExceptions _ANSI_ARGS_ ((Tcl_Interp *interp))
void tcl_AppendElement _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string))
void tcl_AppendResult _ANSI_ARGS_ (TCL_VARARGS(Tcl_Interp *, interp))
Tcl_AsyncHandler tcl_AsyncCreate _ANSI_ARGS_ ((Tcl_AsyncProc *proc, ClientData clientData))
void tcl_AsyncDelete _ANSI_ARGS_ ((Tcl_AsyncHandler async))
int tcl_AsyncInvoke _ANSI_ARGS_ ((Tcl_Interp *interp, int code))
void tcl_AsyncMark _ANSI_ARGS_ ((Tcl_AsyncHandler async))
int tcl_AsyncReady _ANSI_ARGS_ ((void))
void tcl_BackgroundError _ANSI_ARGS_ ((Tcl_Interp *interp))
char tcl_Backslash _ANSI_ARGS_ ((CONST char *src, int *readPtr))
int tcl_BadChannelOption _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *optionName, CONST char *optionList))
void tcl_CallWhenDeleted _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData))
void tcl_CancelIdleCall _ANSI_ARGS_ ((Tcl_IdleProc *idleProc, ClientData clientData))
int tcl_Close _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan))
int tcl_CommandComplete _ANSI_ARGS_ ((CONST char *cmd))
char *tcl_Concat _ANSI_ARGS_ ((int argc, CONST84 char *CONST *argv))
int tcl_ConvertElement _ANSI_ARGS_ ((CONST char *src, char *dst, int flags))
int tcl_ConvertCountedElement _ANSI_ARGS_ ((CONST char *src, int length, char *dst, int flags))
int tcl_CreateAlias _ANSI_ARGS_ ((Tcl_Interp *slave, CONST char *slaveCmd, Tcl_Interp *target, CONST char *targetCmd, int argc, CONST84 char *CONST *argv))
int tcl_CreateAliasObj _ANSI_ARGS_ ((Tcl_Interp *slave, CONST char *slaveCmd, Tcl_Interp *target, CONST char *targetCmd, int objc, Tcl_Obj *CONST objv[]))
Tcl_Channel tcl_CreateChannel _ANSI_ARGS_ ((Tcl_ChannelType *typePtr, CONST char *chanName, ClientData instanceData, int mask))
void tcl_CreateChannelHandler _ANSI_ARGS_ ((Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData))
void tcl_CreateCloseHandler _ANSI_ARGS_ ((Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData))
Tcl_Command tcl_CreateCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc))
void tcl_CreateEventSource _ANSI_ARGS_ ((Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData))
void tcl_CreateExitHandler _ANSI_ARGS_ ((Tcl_ExitProc *proc, ClientData clientData))
Tcl_Interp *tcl_CreateInterp _ANSI_ARGS_ ((void))
void tcl_CreateMathFunc _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData))
Tcl_Command tcl_CreateObjCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc))
Tcl_Interp *tcl_CreateSlave _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *slaveName, int isSafe))
Tcl_TimerToken tcl_CreateTimerHandler _ANSI_ARGS_ ((int milliseconds, Tcl_TimerProc *proc, ClientData clientData))
Tcl_Trace tcl_CreateTrace _ANSI_ARGS_ ((Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData))
void tcl_DeleteAssocData _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name))
void tcl_DeleteChannelHandler _ANSI_ARGS_ ((Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData))
void tcl_DeleteCloseHandler _ANSI_ARGS_ ((Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData))
int tcl_DeleteCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName))
int tcl_DeleteCommandFromToken _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Command command))
void tcl_DeleteEvents _ANSI_ARGS_ ((Tcl_EventDeleteProc *proc, ClientData clientData))
void tcl_DeleteEventSource _ANSI_ARGS_ ((Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData))
void tcl_DeleteExitHandler _ANSI_ARGS_ ((Tcl_ExitProc *proc, ClientData clientData))
void tcl_DeleteHashEntry _ANSI_ARGS_ ((Tcl_HashEntry *entryPtr))
void tcl_DeleteHashTable _ANSI_ARGS_ ((Tcl_HashTable *tablePtr))
void tcl_DeleteInterp _ANSI_ARGS_ ((Tcl_Interp *interp))
void tcl_DetachPids _ANSI_ARGS_ ((int numPids, Tcl_Pid *pidPtr))
void tcl_DeleteTimerHandler _ANSI_ARGS_ ((Tcl_TimerToken token))
void tcl_DeleteTrace _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Trace trace))
void tcl_DontCallWhenDeleted _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData))
int tcl_DoOneEvent _ANSI_ARGS_ ((int flags))
void tcl_DoWhenIdle _ANSI_ARGS_ ((Tcl_IdleProc *proc, ClientData clientData))
char *tcl_DStringAppend _ANSI_ARGS_ ((Tcl_DString *dsPtr, CONST char *str, int length))
char *tcl_DStringAppendElement _ANSI_ARGS_ ((Tcl_DString *dsPtr, CONST char *string))
void tcl_DStringEndSublist _ANSI_ARGS_ ((Tcl_DString *dsPtr))
void tcl_DStringFree _ANSI_ARGS_ ((Tcl_DString *dsPtr))
void tcl_DStringGetResult _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_DString *dsPtr))
void tcl_DStringInit _ANSI_ARGS_ ((Tcl_DString *dsPtr))
void tcl_DStringResult _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_DString *dsPtr))
void tcl_DStringSetLength _ANSI_ARGS_ ((Tcl_DString *dsPtr, int length))
void tcl_DStringStartSublist _ANSI_ARGS_ ((Tcl_DString *dsPtr))
int tcl_Eof _ANSI_ARGS_ ((Tcl_Channel chan))
CONST84_RETURN char *tcl_ErrnoId _ANSI_ARGS_ ((void))
CONST84_RETURN char *tcl_ErrnoMsg _ANSI_ARGS_ ((int err))
int tcl_Eval _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string))
int tcl_EvalFile _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *fileName))
int tcl_EvalObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
void tcl_EventuallyFree _ANSI_ARGS_ ((ClientData clientData, Tcl_FreeProc *freeProc))
void tcl_Exit _ANSI_ARGS_ ((int status))
int tcl_ExposeCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *hiddenCmdToken, CONST char *cmdName))
int tcl_ExprBoolean _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int *ptr))
int tcl_ExprBooleanObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr))
int tcl_ExprDouble _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, double *ptr))
int tcl_ExprDoubleObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr))
int tcl_ExprLong _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, long *ptr))
int tcl_ExprLongObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr))
int tcl_ExprObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr))
int tcl_ExprString _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string))
void tcl_Finalize _ANSI_ARGS_ ((void))
void tcl_FindExecutable _ANSI_ARGS_ ((CONST char *argv0))
Tcl_HashEntry *tcl_FirstHashEntry _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr))
int tcl_Flush _ANSI_ARGS_ ((Tcl_Channel chan))
void tcl_FreeResult _ANSI_ARGS_ ((Tcl_Interp *interp))
int tcl_GetAlias _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr))
int tcl_GetAliasObj _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv))
ClientData tcl_GetAssocData _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_InterpDeleteProc **procPtr))
Tcl_Channel tcl_GetChannel _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *chanName, int *modePtr))
int tcl_GetChannelBufferSize _ANSI_ARGS_ ((Tcl_Channel chan))
int tcl_GetChannelHandle _ANSI_ARGS_ ((Tcl_Channel chan, int direction, ClientData *handlePtr))
ClientData tcl_GetChannelInstanceData _ANSI_ARGS_ ((Tcl_Channel chan))
int tcl_GetChannelMode _ANSI_ARGS_ ((Tcl_Channel chan))
CONST84_RETURN char *tcl_GetChannelName _ANSI_ARGS_ ((Tcl_Channel chan))
int tcl_GetChannelOption _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, Tcl_DString *dsPtr))
Tcl_ChannelType *tcl_GetChannelType _ANSI_ARGS_ ((Tcl_Channel chan))
int tcl_GetCommandInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, Tcl_CmdInfo *infoPtr))
CONST84_RETURN char *tcl_GetCommandName _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Command command))
int tcl_GetErrno _ANSI_ARGS_ ((void))
CONST84_RETURN char *tcl_GetHostName _ANSI_ARGS_ ((void))
int tcl_GetInterpPath _ANSI_ARGS_ ((Tcl_Interp *askInterp, Tcl_Interp *slaveInterp))
Tcl_Interp *tcl_GetMaster _ANSI_ARGS_ ((Tcl_Interp *interp))
CONST char *tcl_GetNameOfExecutable _ANSI_ARGS_ ((void))
Tcl_Obj *tcl_GetObjResult _ANSI_ARGS_ ((Tcl_Interp *interp))
int tcl_GetOpenFile _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int forWriting, int checkUsage, ClientData *filePtr))
Tcl_PathType tcl_GetPathType _ANSI_ARGS_ ((CONST char *path))
int tcl_Gets _ANSI_ARGS_ ((Tcl_Channel chan, Tcl_DString *dsPtr))
int tcl_GetsObj _ANSI_ARGS_ ((Tcl_Channel chan, Tcl_Obj *objPtr))
int tcl_GetServiceMode _ANSI_ARGS_ ((void))
Tcl_Interp *tcl_GetSlave _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *slaveName))
Tcl_Channel tcl_GetStdChannel _ANSI_ARGS_ ((int type))
CONST84_RETURN char *tcl_GetStringResult _ANSI_ARGS_ ((Tcl_Interp *interp))
CONST84_RETURN char *tcl_GetVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags))
CONST84_RETURN char *tcl_GetVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags))
int tcl_GlobalEval _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *command))
int tcl_GlobalEvalObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
int tcl_HideCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, CONST char *hiddenCmdToken))
int tcl_Init _ANSI_ARGS_ ((Tcl_Interp *interp))
void tcl_InitHashTable _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, int keyType))
int tcl_InputBlocked _ANSI_ARGS_ ((Tcl_Channel chan))
int tcl_InputBuffered _ANSI_ARGS_ ((Tcl_Channel chan))
int tcl_InterpDeleted _ANSI_ARGS_ ((Tcl_Interp *interp))
int tcl_IsSafe _ANSI_ARGS_ ((Tcl_Interp *interp))
char *tcl_JoinPath _ANSI_ARGS_ ((int argc, CONST84 char *CONST *argv, Tcl_DString *resultPtr))
int tcl_LinkVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, char *addr, int type))
Tcl_Channel tcl_MakeFileChannel _ANSI_ARGS_ ((ClientData handle, int mode))
int tcl_MakeSafe _ANSI_ARGS_ ((Tcl_Interp *interp))
Tcl_Channel tcl_MakeTcpClientChannel _ANSI_ARGS_ ((ClientData tcpSocket))
char *tcl_Merge _ANSI_ARGS_ ((int argc, CONST84 char *CONST *argv))
Tcl_HashEntry *tcl_NextHashEntry _ANSI_ARGS_ ((Tcl_HashSearch *searchPtr))
void tcl_NotifyChannel _ANSI_ARGS_ ((Tcl_Channel channel, int mask))
Tcl_Obj *tcl_ObjGetVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags))
Tcl_Obj *tcl_ObjSetVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags))
Tcl_Channel tcl_OpenCommandChannel _ANSI_ARGS_ ((Tcl_Interp *interp, int argc, CONST84 char **argv, int flags))
Tcl_Channel tcl_OpenFileChannel _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *fileName, CONST char *modeString, int permissions))
Tcl_Channel tcl_OpenTcpClient _ANSI_ARGS_ ((Tcl_Interp *interp, int port, CONST char *address, CONST char *myaddr, int myport, int async))
Tcl_Channel tcl_OpenTcpServer _ANSI_ARGS_ ((Tcl_Interp *interp, int port, CONST char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData))
void tcl_Preserve _ANSI_ARGS_ ((ClientData data))
void tcl_PrintDouble _ANSI_ARGS_ ((Tcl_Interp *interp, double value, char *dst))
int tcl_PutEnv _ANSI_ARGS_ ((CONST char *string))
CONST84_RETURN char *tcl_PosixError _ANSI_ARGS_ ((Tcl_Interp *interp))
void tcl_QueueEvent _ANSI_ARGS_ ((Tcl_Event *evPtr, Tcl_QueuePosition position))
int tcl_Read _ANSI_ARGS_ ((Tcl_Channel chan, char *bufPtr, int toRead))
void tcl_ReapDetachedProcs _ANSI_ARGS_ ((void))
int tcl_RecordAndEval _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmd, int flags))
int tcl_RecordAndEvalObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags))
void tcl_RegisterChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan))
void tcl_RegisterObjType _ANSI_ARGS_ ((Tcl_ObjType *typePtr))
Tcl_RegExp tcl_RegExpCompile _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string))
int tcl_RegExpExec _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_RegExp regexp, CONST char *str, CONST char *start))
int tcl_RegExpMatch _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, CONST char *pattern))
void tcl_RegExpRange _ANSI_ARGS_ ((Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr))
void tcl_Release _ANSI_ARGS_ ((ClientData clientData))
void tcl_ResetResult _ANSI_ARGS_ ((Tcl_Interp *interp))
int tcl_ScanElement _ANSI_ARGS_ ((CONST char *str, int *flagPtr))
int tcl_ScanCountedElement _ANSI_ARGS_ ((CONST char *str, int length, int *flagPtr))
int tcl_SeekOld _ANSI_ARGS_ ((Tcl_Channel chan, int offset, int mode))
int tcl_ServiceAll _ANSI_ARGS_ ((void))
int tcl_ServiceEvent _ANSI_ARGS_ ((int flags))
void tcl_SetAssocData _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_InterpDeleteProc *proc, ClientData clientData))
void tcl_SetChannelBufferSize _ANSI_ARGS_ ((Tcl_Channel chan, int sz))
int tcl_SetChannelOption _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, CONST char *newValue))
int tcl_SetCommandInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, CONST Tcl_CmdInfo *infoPtr))
void tcl_SetErrno _ANSI_ARGS_ ((int err))
void tcl_SetErrorCode _ANSI_ARGS_ (TCL_VARARGS(Tcl_Interp *, interp))
void tcl_SetMaxBlockTime _ANSI_ARGS_ ((Tcl_Time *timePtr))
void tcl_SetPanicProc _ANSI_ARGS_ ((Tcl_PanicProc *panicProc))
int tcl_SetRecursionLimit _ANSI_ARGS_ ((Tcl_Interp *interp, int depth))
void tcl_SetResult _ANSI_ARGS_ ((Tcl_Interp *interp, char *str, Tcl_FreeProc *freeProc))
int tcl_SetServiceMode _ANSI_ARGS_ ((int mode))
void tcl_SetObjErrorCode _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *errorObjPtr))
void tcl_SetObjResult _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *resultObjPtr))
void tcl_SetStdChannel _ANSI_ARGS_ ((Tcl_Channel channel, int type))
CONST84_RETURN char *tcl_SetVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, CONST char *newValue, int flags))
CONST84_RETURN char *tcl_SetVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, CONST char *newValue, int flags))
CONST84_RETURN char *tcl_SignalId _ANSI_ARGS_ ((int sig))
CONST84_RETURN char *tcl_SignalMsg _ANSI_ARGS_ ((int sig))
void tcl_SourceRCFile _ANSI_ARGS_ ((Tcl_Interp *interp))
int tcl_SplitList _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *listStr, int *argcPtr, CONST84 char ***argvPtr))
void tcl_SplitPath _ANSI_ARGS_ ((CONST char *path, int *argcPtr, CONST84 char ***argvPtr))
void tcl_StaticPackage _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc))
int tcl_StringMatch _ANSI_ARGS_ ((CONST char *str, CONST char *pattern))
int tcl_TellOld _ANSI_ARGS_ ((Tcl_Channel chan))
int tcl_TraceVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData))
int tcl_TraceVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData))
char *tcl_TranslateFileName _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_DString *bufferPtr))
int tcl_Ungets _ANSI_ARGS_ ((Tcl_Channel chan, CONST char *str, int len, int atHead))
void tcl_UnlinkVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName))
int tcl_UnregisterChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan))
int tcl_UnsetVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags))
int tcl_UnsetVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags))
void tcl_UntraceVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData))
void tcl_UntraceVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData))
void tcl_UpdateLinkedVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName))
int tcl_UpVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *frameName, CONST char *varName, CONST char *localName, int flags))
int tcl_UpVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *frameName, CONST char *part1, CONST char *part2, CONST char *localName, int flags))
int tcl_VarEval _ANSI_ARGS_ (TCL_VARARGS(Tcl_Interp *, interp))
ClientData tcl_VarTraceInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData))
ClientData tcl_VarTraceInfo2 _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData))
int tcl_Write _ANSI_ARGS_ ((Tcl_Channel chan, CONST char *s, int slen))
void tcl_WrongNumArgs _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], CONST char *message))
int tcl_DumpActiveMemory _ANSI_ARGS_ ((CONST char *fileName))
void tcl_ValidateAllMemory _ANSI_ARGS_ ((CONST char *file, int line))
void tcl_AppendResultVA _ANSI_ARGS_ ((Tcl_Interp *interp, va_list argList))
void tcl_AppendStringsToObjVA _ANSI_ARGS_ ((Tcl_Obj *objPtr, va_list argList))
CONST84_RETURN char *tcl_HashStats _ANSI_ARGS_ ((Tcl_HashTable *tablePtr))
CONST84_RETURN char *tcl_ParseVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, CONST84 char **termPtr))
CONST84_RETURN char *tcl_PkgPresent _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version, int exact))
CONST84_RETURN char *tcl_PkgPresentEx _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr))
int tcl_PkgProvide _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version))
CONST84_RETURN char *tcl_PkgRequire _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version, int exact))
void tcl_SetErrorCodeVA _ANSI_ARGS_ ((Tcl_Interp *interp, va_list argList))
int tcl_VarEvalVA _ANSI_ARGS_ ((Tcl_Interp *interp, va_list argList))
Tcl_Pid tcl_WaitPid _ANSI_ARGS_ ((Tcl_Pid pid, int *statPtr, int options))
void tcl_PanicVA _ANSI_ARGS_ ((CONST char *format, va_list argList))
void tcl_GetVersion _ANSI_ARGS_ ((int *major, int *minor, int *patchLevel, int *type))
void tcl_InitMemory _ANSI_ARGS_ ((Tcl_Interp *interp))
Tcl_Channel tcl_StackChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan))
int tcl_UnstackChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan))
Tcl_Channel tcl_GetStackedChannel _ANSI_ARGS_ ((Tcl_Channel chan))
void tcl_SetMainLoop _ANSI_ARGS_ ((Tcl_MainLoopProc *proc))
void tcl_AppendObjToObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr))
Tcl_Encoding tcl_CreateEncoding _ANSI_ARGS_ ((Tcl_EncodingType *typePtr))
void tcl_CreateThreadExitHandler _ANSI_ARGS_ ((Tcl_ExitProc *proc, ClientData clientData))
void tcl_DeleteThreadExitHandler _ANSI_ARGS_ ((Tcl_ExitProc *proc, ClientData clientData))
void tcl_DiscardResult _ANSI_ARGS_ ((Tcl_SavedResult *statePtr))
int tcl_EvalEx _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *script, int numBytes, int flags))
int tcl_EvalObjv _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags))
int tcl_EvalObjEx _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int flags))
void tcl_ExitThread _ANSI_ARGS_ ((int status))
int tcl_ExternalToUtf _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Encoding encoding, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr))
char *tcl_ExternalToUtfDString _ANSI_ARGS_ ((Tcl_Encoding encoding, CONST char *src, int srcLen, Tcl_DString *dsPtr))
void tcl_FinalizeThread _ANSI_ARGS_ ((void))
void tcl_FinalizeNotifier _ANSI_ARGS_ ((ClientData clientData))
void tcl_FreeEncoding _ANSI_ARGS_ ((Tcl_Encoding encoding))
Tcl_ThreadId tcl_GetCurrentThread _ANSI_ARGS_ ((void))
Tcl_Encoding tcl_GetEncoding _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name))
CONST84_RETURN char *tcl_GetEncodingName _ANSI_ARGS_ ((Tcl_Encoding encoding))
void tcl_GetEncodingNames _ANSI_ARGS_ ((Tcl_Interp *interp))
int tcl_GetIndexFromObjStruct _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, CONST VOID *tablePtr, int offset, CONST char *msg, int flags, int *indexPtr))
VOID *tcl_GetThreadData _ANSI_ARGS_ ((Tcl_ThreadDataKey *keyPtr, int size))
Tcl_Obj *tcl_GetVar2Ex _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags))
ClientData tcl_InitNotifier _ANSI_ARGS_ ((void))
void tcl_MutexLock _ANSI_ARGS_ ((Tcl_Mutex *mutexPtr))
void tcl_MutexUnlock _ANSI_ARGS_ ((Tcl_Mutex *mutexPtr))
void tcl_ConditionNotify _ANSI_ARGS_ ((Tcl_Condition *condPtr))
void tcl_ConditionWait _ANSI_ARGS_ ((Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, Tcl_Time *timePtr))
int tcl_NumUtfChars _ANSI_ARGS_ ((CONST char *src, int len))
int tcl_ReadChars _ANSI_ARGS_ ((Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag))
void tcl_RestoreResult _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_SavedResult *statePtr))
void tcl_SaveResult _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_SavedResult *statePtr))
int tcl_SetSystemEncoding _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name))
Tcl_Obj *tcl_SetVar2Ex _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, Tcl_Obj *newValuePtr, int flags))
void tcl_ThreadAlert _ANSI_ARGS_ ((Tcl_ThreadId threadId))
void tcl_ThreadQueueEvent _ANSI_ARGS_ ((Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position))
Tcl_UniChar tcl_UniCharAtIndex _ANSI_ARGS_ ((CONST char *src, int index))
Tcl_UniChar tcl_UniCharToLower _ANSI_ARGS_ ((int ch))
Tcl_UniChar tcl_UniCharToTitle _ANSI_ARGS_ ((int ch))
Tcl_UniChar tcl_UniCharToUpper _ANSI_ARGS_ ((int ch))
int tcl_UniCharToUtf _ANSI_ARGS_ ((int ch, char *buf))
CONST84_RETURN char *tcl_UtfAtIndex _ANSI_ARGS_ ((CONST char *src, int index))
int tcl_UtfCharComplete _ANSI_ARGS_ ((CONST char *src, int len))
int tcl_UtfBackslash _ANSI_ARGS_ ((CONST char *src, int *readPtr, char *dst))
CONST84_RETURN char *tcl_UtfFindFirst _ANSI_ARGS_ ((CONST char *src, int ch))
CONST84_RETURN char *tcl_UtfFindLast _ANSI_ARGS_ ((CONST char *src, int ch))
CONST84_RETURN char *tcl_UtfNext _ANSI_ARGS_ ((CONST char *src))
CONST84_RETURN char *tcl_UtfPrev _ANSI_ARGS_ ((CONST char *src, CONST char *start))
int tcl_UtfToExternal _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Encoding encoding, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr))
char *tcl_UtfToExternalDString _ANSI_ARGS_ ((Tcl_Encoding encoding, CONST char *src, int srcLen, Tcl_DString *dsPtr))
int tcl_UtfToLower _ANSI_ARGS_ ((char *src))
int tcl_UtfToTitle _ANSI_ARGS_ ((char *src))
int tcl_UtfToUniChar _ANSI_ARGS_ ((CONST char *src, Tcl_UniChar *chPtr))
int tcl_UtfToUpper _ANSI_ARGS_ ((char *src))
int tcl_WriteChars _ANSI_ARGS_ ((Tcl_Channel chan, CONST char *src, int srcLen))
int tcl_WriteObj _ANSI_ARGS_ ((Tcl_Channel chan, Tcl_Obj *objPtr))
char *tcl_GetString _ANSI_ARGS_ ((Tcl_Obj *objPtr))
CONST84_RETURN char *tcl_GetDefaultEncodingDir _ANSI_ARGS_ ((void))
void tcl_SetDefaultEncodingDir _ANSI_ARGS_ ((CONST char *path))
void tcl_AlertNotifier _ANSI_ARGS_ ((ClientData clientData))
void tcl_ServiceModeHook _ANSI_ARGS_ ((int mode))
int tcl_UniCharIsAlnum _ANSI_ARGS_ ((int ch))
int tcl_UniCharIsAlpha _ANSI_ARGS_ ((int ch))
int tcl_UniCharIsDigit _ANSI_ARGS_ ((int ch))
int tcl_UniCharIsLower _ANSI_ARGS_ ((int ch))
int tcl_UniCharIsSpace _ANSI_ARGS_ ((int ch))
int tcl_UniCharIsUpper _ANSI_ARGS_ ((int ch))
int tcl_UniCharIsWordChar _ANSI_ARGS_ ((int ch))
int tcl_UniCharLen _ANSI_ARGS_ ((CONST Tcl_UniChar *str))
int tcl_UniCharNcmp _ANSI_ARGS_ ((CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct, unsigned long n))
char *tcl_UniCharToUtfDString _ANSI_ARGS_ ((CONST Tcl_UniChar *string, int numChars, Tcl_DString *dsPtr))
Tcl_UniChar *tcl_UtfToUniCharDString _ANSI_ARGS_ ((CONST char *string, int length, Tcl_DString *dsPtr))
Tcl_RegExp tcl_GetRegExpFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *patObj, int flags))
Tcl_Obj *tcl_EvalTokens _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Token *tokenPtr, int count))
void tcl_FreeParse _ANSI_ARGS_ ((Tcl_Parse *parsePtr))
void tcl_LogCommandInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *script, CONST char *command, int length))
int tcl_ParseBraces _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr))
int tcl_ParseCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string, int numBytes, int nested, Tcl_Parse *parsePtr))
int tcl_ParseExpr _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr))
int tcl_ParseQuotedString _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr))
int tcl_ParseVarName _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr, int append))
char *tcl_GetCwd _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_DString *cwdPtr))
int tcl_Chdir _ANSI_ARGS_ ((CONST char *dirName))
int tcl_Access _ANSI_ARGS_ ((CONST char *path, int mode))
int tcl_Stat _ANSI_ARGS_ ((CONST char *path, struct stat *bufPtr))
int tcl_UtfNcmp _ANSI_ARGS_ ((CONST char *s1, CONST char *s2, unsigned long n))
int tcl_UtfNcasecmp _ANSI_ARGS_ ((CONST char *s1, CONST char *s2, unsigned long n))
int tcl_StringCaseMatch _ANSI_ARGS_ ((CONST char *str, CONST char *pattern, int nocase))
int tcl_UniCharIsControl _ANSI_ARGS_ ((int ch))
int tcl_UniCharIsGraph _ANSI_ARGS_ ((int ch))
int tcl_UniCharIsPrint _ANSI_ARGS_ ((int ch))
int tcl_UniCharIsPunct _ANSI_ARGS_ ((int ch))
int tcl_RegExpExecObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *objPtr, int offset, int nmatches, int flags))
void tcl_RegExpGetInfo _ANSI_ARGS_ ((Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr))
Tcl_Obj *tcl_NewUnicodeObj _ANSI_ARGS_ ((CONST Tcl_UniChar *unicode, int numChars))
void tcl_SetUnicodeObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int numChars))
int tcl_GetCharLength _ANSI_ARGS_ ((Tcl_Obj *objPtr))
Tcl_UniChar tcl_GetUniChar _ANSI_ARGS_ ((Tcl_Obj *objPtr, int index))
Tcl_UniChar *tcl_GetUnicode _ANSI_ARGS_ ((Tcl_Obj *objPtr))
Tcl_Obj *tcl_GetRange _ANSI_ARGS_ ((Tcl_Obj *objPtr, int first, int last))
void tcl_AppendUnicodeToObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int length))
int tcl_RegExpMatchObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Obj *patternObj))
void tcl_SetNotifier _ANSI_ARGS_ ((Tcl_NotifierProcs *notifierProcPtr))
Tcl_Mutex *tcl_GetAllocMutex _ANSI_ARGS_ ((void))
int tcl_GetChannelNames _ANSI_ARGS_ ((Tcl_Interp *interp))
int tcl_GetChannelNamesEx _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *pattern))
int tcl_ProcObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
void tcl_ConditionFinalize _ANSI_ARGS_ ((Tcl_Condition *condPtr))
void tcl_MutexFinalize _ANSI_ARGS_ ((Tcl_Mutex *mutex))
int tcl_CreateThread _ANSI_ARGS_ ((Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags))
int tcl_ReadRaw _ANSI_ARGS_ ((Tcl_Channel chan, char *dst, int bytesToRead))
int tcl_WriteRaw _ANSI_ARGS_ ((Tcl_Channel chan, CONST char *src, int srcLen))
Tcl_Channel tcl_GetTopChannel _ANSI_ARGS_ ((Tcl_Channel chan))
int tcl_ChannelBuffered _ANSI_ARGS_ ((Tcl_Channel chan))
CONST84_RETURN char *tcl_ChannelName _ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_ChannelTypeVersion tcl_ChannelVersion _ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverBlockModeProc *tcl_ChannelBlockModeProc _ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverCloseProc *tcl_ChannelCloseProc _ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverClose2Proc *tcl_ChannelClose2Proc _ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverInputProc *tcl_ChannelInputProc _ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverOutputProc *tcl_ChannelOutputProc _ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverSeekProc *tcl_ChannelSeekProc _ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverSetOptionProc *tcl_ChannelSetOptionProc _ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverGetOptionProc *tcl_ChannelGetOptionProc _ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverWatchProc *tcl_ChannelWatchProc _ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverGetHandleProc *tcl_ChannelGetHandleProc _ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverFlushProc *tcl_ChannelFlushProc _ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverHandlerProc *tcl_ChannelHandlerProc _ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
int tcl_JoinThread _ANSI_ARGS_ ((Tcl_ThreadId threadId, int *result))
int tcl_IsChannelShared _ANSI_ARGS_ ((Tcl_Channel channel))
int tcl_IsChannelRegistered _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel channel))
void tcl_CutChannel _ANSI_ARGS_ ((Tcl_Channel channel))
void tcl_SpliceChannel _ANSI_ARGS_ ((Tcl_Channel channel))
void tcl_ClearChannelHandlers _ANSI_ARGS_ ((Tcl_Channel channel))
int tcl_IsChannelExisting _ANSI_ARGS_ ((CONST char *channelName))
int tcl_UniCharNcasecmp _ANSI_ARGS_ ((CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct, unsigned long n))
int tcl_UniCharCaseMatch _ANSI_ARGS_ ((CONST Tcl_UniChar *ustr, CONST Tcl_UniChar *pattern, int nocase))
Tcl_HashEntry *tcl_FindHashEntry _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, CONST char *key))
Tcl_HashEntry *tcl_CreateHashEntry _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, CONST char *key, int *newPtr))
void tcl_InitCustomHashTable _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, int keyType, Tcl_HashKeyType *typePtr))
void tcl_InitObjHashTable _ANSI_ARGS_ ((Tcl_HashTable *tablePtr))
ClientData tcl_CommandTraceInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData))
int tcl_TraceCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData))
void tcl_UntraceCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData))
char *tcl_AttemptAlloc _ANSI_ARGS_ ((unsigned int size))
char *tcl_AttemptDbCkalloc _ANSI_ARGS_ ((unsigned int size, CONST char *file, int line))
char *tcl_AttemptRealloc _ANSI_ARGS_ ((char *ptr, unsigned int size))
char *tcl_AttemptDbCkrealloc _ANSI_ARGS_ ((char *ptr, unsigned int size, CONST char *file, int line))
int tcl_AttemptSetObjLength _ANSI_ARGS_ ((Tcl_Obj *objPtr, int length))
Tcl_ThreadId tcl_GetChannelThread _ANSI_ARGS_ ((Tcl_Channel channel))
Tcl_UniChar *tcl_GetUnicodeFromObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, int *lengthPtr))
int tcl_GetMathFuncInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr))
Tcl_Obj *tcl_ListMathFuncs _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *pattern))
Tcl_Obj *tcl_SubstObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int flags))
int tcl_DetachChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel channel))
int tcl_IsStandardChannel _ANSI_ARGS_ ((Tcl_Channel channel))
int tcl_FSCopyFile _ANSI_ARGS_ ((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr))
int tcl_FSCopyDirectory _ANSI_ARGS_ ((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr))
int tcl_FSCreateDirectory _ANSI_ARGS_ ((Tcl_Obj *pathPtr))
int tcl_FSDeleteFile _ANSI_ARGS_ ((Tcl_Obj *pathPtr))
int tcl_FSLoadFile _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *sym1, CONST char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr))
int tcl_FSMatchInDirectory _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types))
Tcl_Obj *tcl_FSLink _ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction))
int tcl_FSRemoveDirectory _ANSI_ARGS_ ((Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr))
int tcl_FSRenameFile _ANSI_ARGS_ ((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr))
int tcl_FSLstat _ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_StatBuf *buf))
int tcl_FSUtime _ANSI_ARGS_ ((Tcl_Obj *pathPtr, struct utimbuf *tval))
int tcl_FSFileAttrsGet _ANSI_ARGS_ ((Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef))
int tcl_FSFileAttrsSet _ANSI_ARGS_ ((Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr))
CONST char **tcl_FSFileAttrStrings _ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef))
int tcl_FSStat _ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_StatBuf *buf))
int tcl_FSAccess _ANSI_ARGS_ ((Tcl_Obj *pathPtr, int mode))
Tcl_Channel tcl_FSOpenFileChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *modeString, int permissions))
Tcl_Obj *tcl_FSGetCwd _ANSI_ARGS_ ((Tcl_Interp *interp))
int tcl_FSChdir _ANSI_ARGS_ ((Tcl_Obj *pathPtr))
int tcl_FSConvertToPathType _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr))
Tcl_Obj *tcl_FSJoinPath _ANSI_ARGS_ ((Tcl_Obj *listObj, int elements))
Tcl_Obj *tcl_FSSplitPath _ANSI_ARGS_ ((Tcl_Obj *pathPtr, int *lenPtr))
int tcl_FSEqualPaths _ANSI_ARGS_ ((Tcl_Obj *firstPtr, Tcl_Obj *secondPtr))
Tcl_Obj *tcl_FSGetNormalizedPath _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathObjPtr))
Tcl_Obj *tcl_FSJoinToPath _ANSI_ARGS_ ((Tcl_Obj *basePtr, int objc, Tcl_Obj *CONST objv[]))
ClientData tcl_FSGetInternalRep _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr, Tcl_Filesystem *fsPtr))
Tcl_Obj *tcl_FSGetTranslatedPath _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr))
int tcl_FSEvalFile _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *fileName))
Tcl_Obj *tcl_FSNewNativePath _ANSI_ARGS_ ((Tcl_Filesystem *fromFilesystem, ClientData clientData))
CONST char *tcl_FSGetNativePath _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr))
Tcl_Obj *tcl_FSFileSystemInfo _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr))
Tcl_Obj *tcl_FSPathSeparator _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr))
Tcl_Obj *tcl_FSListVolumes _ANSI_ARGS_ ((void))
int tcl_FSRegister _ANSI_ARGS_ ((ClientData clientData, Tcl_Filesystem *fsPtr))
int tcl_FSUnregister _ANSI_ARGS_ ((Tcl_Filesystem *fsPtr))
ClientData tcl_FSData _ANSI_ARGS_ ((Tcl_Filesystem *fsPtr))
CONST char *tcl_FSGetTranslatedStringPath _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr))
Tcl_Filesystem *tcl_FSGetFileSystemForPath _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr))
Tcl_PathType tcl_FSGetPathType _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr))
int tcl_OutputBuffered _ANSI_ARGS_ ((Tcl_Channel chan))
void tcl_FSMountsChanged _ANSI_ARGS_ ((Tcl_Filesystem *fsPtr))
int tcl_EvalTokensStandard _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Token *tokenPtr, int count))
void tcl_GetTime _ANSI_ARGS_ ((Tcl_Time *timeBuf))
Tcl_Trace tcl_CreateObjTrace _ANSI_ARGS_ ((Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc))
int tcl_GetCommandInfoFromToken _ANSI_ARGS_ ((Tcl_Command token, Tcl_CmdInfo *infoPtr))
int tcl_SetCommandInfoFromToken _ANSI_ARGS_ ((Tcl_Command token, CONST Tcl_CmdInfo *infoPtr))
Tcl_Obj *tcl_DbNewWideIntObj _ANSI_ARGS_ ((Tcl_WideInt wideValue, CONST char *file, int line))
int tcl_GetWideIntFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr))
Tcl_Obj *tcl_NewWideIntObj _ANSI_ARGS_ ((Tcl_WideInt wideValue))
void tcl_SetWideIntObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, Tcl_WideInt wideValue))
Tcl_StatBuf *tcl_AllocStatBuf _ANSI_ARGS_ ((void))
Tcl_WideInt tcl_Seek _ANSI_ARGS_ ((Tcl_Channel chan, Tcl_WideInt offset, int mode))
Tcl_WideInt tcl_Tell _ANSI_ARGS_ ((Tcl_Channel chan))
Tcl_DriverWideSeekProc *tcl_ChannelWideSeekProc _ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverThreadActionProc *tcl_ChannelThreadActionProc _ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
int tcl_PkgRequireProc _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, int objc, Tcl_Obj *CONST objv[], ClientData *clientDataPtr))
Public Attributes
int magic
TclStubHooks * hooks
void * reserved188
void * reserved285
void * reserved494
void * reserved495
void * reserved496
void * reserved497
void * reserved498
void * reserved499
void * reserved500
void * reserved501
void * reserved502
void * reserved503
void * reserved504
void * reserved505
void * reserved506
void * reserved507
void * reserved508
void * reserved509
void * reserved510
void * reserved511
void * reserved512
void * reserved513
void * reserved514
void * reserved515
void * reserved516
void * reserved517
void * reserved518
void * reserved519
void * reserved520
void * reserved521
void * reserved522
void * reserved523
void * reserved524
void * reserved525
void * reserved526
void * reserved527
void * reserved528
void * reserved529
void * reserved530
void * reserved531
void * reserved532
void * reserved533
void * reserved534
void * reserved535
void * reserved536
void * reserved537
void * reserved538
void * reserved539
void * reserved540
void * reserved541
void * reserved542
void * reserved543
void * reserved544
void * reserved545
void * reserved546
void * reserved547
void * reserved548
void * reserved549
void * reserved550
void * reserved551
void * reserved552
void * reserved553
void * reserved555
void * reserved556
void * reserved557
void * reserved558
void * reserved559
void * reserved560
void * reserved561
void * reserved562
void * reserved563
void * reserved564
void * reserved565
void * reserved566
void * reserved567
void * reserved568
void * reserved569
void * reserved570
void * reserved571
void * reserved572

Member Function Documentation
int tcl_PkgRequireProc TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, int objc, Tcl_Obj *CONST objv[], ClientData *clientDataPtr))
Tcl_DriverThreadActionProc* tcl_ChannelThreadActionProc TclStubs::_ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverWideSeekProc* tcl_ChannelWideSeekProc TclStubs::_ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_WideInt tcl_Tell TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan))
Tcl_WideInt tcl_Seek TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan, Tcl_WideInt offset, int mode))
Tcl_StatBuf* tcl_AllocStatBuf TclStubs::_ANSI_ARGS_ ((void))
void tcl_SetWideIntObj TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, Tcl_WideInt wideValue))
Tcl_Obj* tcl_NewWideIntObj TclStubs::_ANSI_ARGS_ ((Tcl_WideInt wideValue))
int tcl_GetWideIntFromObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr))
Tcl_Obj* tcl_DbNewWideIntObj TclStubs::_ANSI_ARGS_ ((Tcl_WideInt wideValue, CONST char *file, int line))
int tcl_SetCommandInfoFromToken TclStubs::_ANSI_ARGS_ ((Tcl_Command token, CONST Tcl_CmdInfo *infoPtr))
int tcl_GetCommandInfoFromToken TclStubs::_ANSI_ARGS_ ((Tcl_Command token, Tcl_CmdInfo *infoPtr))
Tcl_Trace tcl_CreateObjTrace TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc))
void tcl_GetTime TclStubs::_ANSI_ARGS_ ((Tcl_Time *timeBuf))
int tcl_EvalTokensStandard TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Token *tokenPtr, int count))
void tcl_FSMountsChanged TclStubs::_ANSI_ARGS_ ((Tcl_Filesystem *fsPtr))
int tcl_OutputBuffered TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan))
Tcl_PathType tcl_FSGetPathType TclStubs::_ANSI_ARGS_ ((Tcl_Obj *pathObjPtr))
Tcl_Filesystem* tcl_FSGetFileSystemForPath TclStubs::_ANSI_ARGS_ ((Tcl_Obj *pathObjPtr))
CONST char* tcl_FSGetTranslatedStringPath TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr))
ClientData tcl_FSData TclStubs::_ANSI_ARGS_ ((Tcl_Filesystem *fsPtr))
int tcl_FSUnregister TclStubs::_ANSI_ARGS_ ((Tcl_Filesystem *fsPtr))
int tcl_FSRegister TclStubs::_ANSI_ARGS_ ((ClientData clientData, Tcl_Filesystem *fsPtr))
Tcl_Obj* tcl_FSListVolumes TclStubs::_ANSI_ARGS_ ((void))
Tcl_Obj* tcl_FSPathSeparator TclStubs::_ANSI_ARGS_ ((Tcl_Obj *pathObjPtr))
Tcl_Obj* tcl_FSFileSystemInfo TclStubs::_ANSI_ARGS_ ((Tcl_Obj *pathObjPtr))
CONST char* tcl_FSGetNativePath TclStubs::_ANSI_ARGS_ ((Tcl_Obj *pathObjPtr))
Tcl_Obj* tcl_FSNewNativePath TclStubs::_ANSI_ARGS_ ((Tcl_Filesystem *fromFilesystem, ClientData clientData))
int tcl_FSEvalFile TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *fileName))
Tcl_Obj* tcl_FSGetTranslatedPath TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr))
ClientData tcl_FSGetInternalRep TclStubs::_ANSI_ARGS_ ((Tcl_Obj *pathObjPtr, Tcl_Filesystem *fsPtr))
Tcl_Obj* tcl_FSJoinToPath TclStubs::_ANSI_ARGS_ ((Tcl_Obj *basePtr, int objc, Tcl_Obj *CONST objv[]))
Tcl_Obj* tcl_FSGetNormalizedPath TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathObjPtr))
int tcl_FSEqualPaths TclStubs::_ANSI_ARGS_ ((Tcl_Obj *firstPtr, Tcl_Obj *secondPtr))
Tcl_Obj* tcl_FSSplitPath TclStubs::_ANSI_ARGS_ ((Tcl_Obj *pathPtr, int *lenPtr))
Tcl_Obj* tcl_FSJoinPath TclStubs::_ANSI_ARGS_ ((Tcl_Obj *listObj, int elements))
int tcl_FSConvertToPathType TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr))
int tcl_FSChdir TclStubs::_ANSI_ARGS_ ((Tcl_Obj *pathPtr))
Tcl_Obj* tcl_FSGetCwd TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
Tcl_Channel tcl_FSOpenFileChannel TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *modeString, int permissions))
int tcl_FSAccess TclStubs::_ANSI_ARGS_ ((Tcl_Obj *pathPtr, int mode))
int tcl_FSStat TclStubs::_ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_StatBuf *buf))
CONST char** tcl_FSFileAttrStrings TclStubs::_ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef))
int tcl_FSFileAttrsSet TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr))
int tcl_FSFileAttrsGet TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef))
int tcl_FSUtime TclStubs::_ANSI_ARGS_ ((Tcl_Obj *pathPtr, struct utimbuf *tval))
int tcl_FSLstat TclStubs::_ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_StatBuf *buf))
int tcl_FSRenameFile TclStubs::_ANSI_ARGS_ ((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr))
int tcl_FSRemoveDirectory TclStubs::_ANSI_ARGS_ ((Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr))
Tcl_Obj* tcl_FSLink TclStubs::_ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction))
int tcl_FSMatchInDirectory TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types))
int tcl_FSLoadFile TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *sym1, CONST char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr))
int tcl_FSDeleteFile TclStubs::_ANSI_ARGS_ ((Tcl_Obj *pathPtr))
int tcl_FSCreateDirectory TclStubs::_ANSI_ARGS_ ((Tcl_Obj *pathPtr))
int tcl_FSCopyDirectory TclStubs::_ANSI_ARGS_ ((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr))
int tcl_FSCopyFile TclStubs::_ANSI_ARGS_ ((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr))
int tcl_IsStandardChannel TclStubs::_ANSI_ARGS_ ((Tcl_Channel channel))
int tcl_DetachChannel TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel channel))
Tcl_Obj* tcl_SubstObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int flags))
Tcl_Obj* tcl_ListMathFuncs TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *pattern))
int tcl_GetMathFuncInfo TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr))
Tcl_UniChar* tcl_GetUnicodeFromObj TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, int *lengthPtr))
Tcl_ThreadId tcl_GetChannelThread TclStubs::_ANSI_ARGS_ ((Tcl_Channel channel))
int tcl_AttemptSetObjLength TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, int length))
char* tcl_AttemptDbCkrealloc TclStubs::_ANSI_ARGS_ ((char *ptr, unsigned int size, CONST char *file, int line))
char* tcl_AttemptRealloc TclStubs::_ANSI_ARGS_ ((char *ptr, unsigned int size))
char* tcl_AttemptDbCkalloc TclStubs::_ANSI_ARGS_ ((unsigned int size, CONST char *file, int line))
char* tcl_AttemptAlloc TclStubs::_ANSI_ARGS_ ((unsigned int size))
void tcl_UntraceCommand TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData))
int tcl_TraceCommand TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData))
ClientData tcl_CommandTraceInfo TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData))
void tcl_InitObjHashTable TclStubs::_ANSI_ARGS_ ((Tcl_HashTable *tablePtr))
void tcl_InitCustomHashTable TclStubs::_ANSI_ARGS_ ((Tcl_HashTable *tablePtr, int keyType, Tcl_HashKeyType *typePtr))
Tcl_HashEntry* tcl_CreateHashEntry TclStubs::_ANSI_ARGS_ ((Tcl_HashTable *tablePtr, CONST char *key, int *newPtr))
Tcl_HashEntry* tcl_FindHashEntry TclStubs::_ANSI_ARGS_ ((Tcl_HashTable *tablePtr, CONST char *key))
int tcl_UniCharCaseMatch TclStubs::_ANSI_ARGS_ ((CONST Tcl_UniChar *ustr, CONST Tcl_UniChar *pattern, int nocase))
int tcl_UniCharNcasecmp TclStubs::_ANSI_ARGS_ ((CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct, unsigned long n))
int tcl_IsChannelExisting TclStubs::_ANSI_ARGS_ ((CONST char *channelName))
void tcl_ClearChannelHandlers TclStubs::_ANSI_ARGS_ ((Tcl_Channel channel))
void tcl_SpliceChannel TclStubs::_ANSI_ARGS_ ((Tcl_Channel channel))
void tcl_CutChannel TclStubs::_ANSI_ARGS_ ((Tcl_Channel channel))
int tcl_IsChannelRegistered TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel channel))
int tcl_IsChannelShared TclStubs::_ANSI_ARGS_ ((Tcl_Channel channel))
int tcl_JoinThread TclStubs::_ANSI_ARGS_ ((Tcl_ThreadId threadId, int *result))
Tcl_DriverHandlerProc* tcl_ChannelHandlerProc TclStubs::_ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverFlushProc* tcl_ChannelFlushProc TclStubs::_ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverGetHandleProc* tcl_ChannelGetHandleProc TclStubs::_ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverWatchProc* tcl_ChannelWatchProc TclStubs::_ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverGetOptionProc* tcl_ChannelGetOptionProc TclStubs::_ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverSetOptionProc* tcl_ChannelSetOptionProc TclStubs::_ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverSeekProc* tcl_ChannelSeekProc TclStubs::_ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverOutputProc* tcl_ChannelOutputProc TclStubs::_ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverInputProc* tcl_ChannelInputProc TclStubs::_ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverClose2Proc* tcl_ChannelClose2Proc TclStubs::_ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverCloseProc* tcl_ChannelCloseProc TclStubs::_ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_DriverBlockModeProc* tcl_ChannelBlockModeProc TclStubs::_ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
Tcl_ChannelTypeVersion tcl_ChannelVersion TclStubs::_ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
CONST84_RETURN char* tcl_ChannelName TclStubs::_ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
int tcl_ChannelBuffered TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan))
Tcl_Channel tcl_GetTopChannel TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan))
int tcl_WriteRaw TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan, CONST char *src, int srcLen))
int tcl_ReadRaw TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan, char *dst, int bytesToRead))
int tcl_CreateThread TclStubs::_ANSI_ARGS_ ((Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags))
void tcl_MutexFinalize TclStubs::_ANSI_ARGS_ ((Tcl_Mutex *mutex))
void tcl_ConditionFinalize TclStubs::_ANSI_ARGS_ ((Tcl_Condition *condPtr))
int tcl_ProcObjCmd TclStubs::_ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
int tcl_GetChannelNamesEx TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *pattern))
int tcl_GetChannelNames TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
Tcl_Mutex* tcl_GetAllocMutex TclStubs::_ANSI_ARGS_ ((void))
void tcl_SetNotifier TclStubs::_ANSI_ARGS_ ((Tcl_NotifierProcs *notifierProcPtr))
int tcl_RegExpMatchObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Obj *patternObj))
void tcl_AppendUnicodeToObj TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int length))
Tcl_Obj* tcl_GetRange TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, int first, int last))
Tcl_UniChar* tcl_GetUnicode TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr))
Tcl_UniChar tcl_GetUniChar TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, int index))
int tcl_GetCharLength TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr))
void tcl_SetUnicodeObj TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int numChars))
Tcl_Obj* tcl_NewUnicodeObj TclStubs::_ANSI_ARGS_ ((CONST Tcl_UniChar *unicode, int numChars))
void tcl_RegExpGetInfo TclStubs::_ANSI_ARGS_ ((Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr))
int tcl_RegExpExecObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *objPtr, int offset, int nmatches, int flags))
int tcl_UniCharIsPunct TclStubs::_ANSI_ARGS_ ((int ch))
int tcl_UniCharIsPrint TclStubs::_ANSI_ARGS_ ((int ch))
int tcl_UniCharIsGraph TclStubs::_ANSI_ARGS_ ((int ch))
int tcl_UniCharIsControl TclStubs::_ANSI_ARGS_ ((int ch))
int tcl_StringCaseMatch TclStubs::_ANSI_ARGS_ ((CONST char *str, CONST char *pattern, int nocase))
int tcl_UtfNcasecmp TclStubs::_ANSI_ARGS_ ((CONST char *s1, CONST char *s2, unsigned long n))
int tcl_UtfNcmp TclStubs::_ANSI_ARGS_ ((CONST char *s1, CONST char *s2, unsigned long n))
int tcl_Stat TclStubs::_ANSI_ARGS_ ((CONST char *path, struct stat *bufPtr))
int tcl_Access TclStubs::_ANSI_ARGS_ ((CONST char *path, int mode))
int tcl_Chdir TclStubs::_ANSI_ARGS_ ((CONST char *dirName))
char* tcl_GetCwd TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_DString *cwdPtr))
int tcl_ParseVarName TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr, int append))
int tcl_ParseQuotedString TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr))
int tcl_ParseExpr TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr))
int tcl_ParseCommand TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string, int numBytes, int nested, Tcl_Parse *parsePtr))
int tcl_ParseBraces TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr))
void tcl_LogCommandInfo TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *script, CONST char *command, int length))
void tcl_FreeParse TclStubs::_ANSI_ARGS_ ((Tcl_Parse *parsePtr))
Tcl_Obj* tcl_EvalTokens TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Token *tokenPtr, int count))
Tcl_RegExp tcl_GetRegExpFromObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *patObj, int flags))
Tcl_UniChar* tcl_UtfToUniCharDString TclStubs::_ANSI_ARGS_ ((CONST char *string, int length, Tcl_DString *dsPtr))
char* tcl_UniCharToUtfDString TclStubs::_ANSI_ARGS_ ((CONST Tcl_UniChar *string, int numChars, Tcl_DString *dsPtr))
int tcl_UniCharNcmp TclStubs::_ANSI_ARGS_ ((CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct, unsigned long n))
int tcl_UniCharLen TclStubs::_ANSI_ARGS_ ((CONST Tcl_UniChar *str))
int tcl_UniCharIsWordChar TclStubs::_ANSI_ARGS_ ((int ch))
int tcl_UniCharIsUpper TclStubs::_ANSI_ARGS_ ((int ch))
int tcl_UniCharIsSpace TclStubs::_ANSI_ARGS_ ((int ch))
int tcl_UniCharIsLower TclStubs::_ANSI_ARGS_ ((int ch))
int tcl_UniCharIsDigit TclStubs::_ANSI_ARGS_ ((int ch))
int tcl_UniCharIsAlpha TclStubs::_ANSI_ARGS_ ((int ch))
int tcl_UniCharIsAlnum TclStubs::_ANSI_ARGS_ ((int ch))
void tcl_ServiceModeHook TclStubs::_ANSI_ARGS_ ((int mode))
void tcl_AlertNotifier TclStubs::_ANSI_ARGS_ ((ClientData clientData))
void tcl_SetDefaultEncodingDir TclStubs::_ANSI_ARGS_ ((CONST char *path))
CONST84_RETURN char* tcl_GetDefaultEncodingDir TclStubs::_ANSI_ARGS_ ((void))
char* tcl_GetString TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr))
int tcl_WriteObj TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan, Tcl_Obj *objPtr))
int tcl_WriteChars TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan, CONST char *src, int srcLen))
int tcl_UtfToUpper TclStubs::_ANSI_ARGS_ ((char *src))
int tcl_UtfToUniChar TclStubs::_ANSI_ARGS_ ((CONST char *src, Tcl_UniChar *chPtr))
int tcl_UtfToTitle TclStubs::_ANSI_ARGS_ ((char *src))
int tcl_UtfToLower TclStubs::_ANSI_ARGS_ ((char *src))
char* tcl_UtfToExternalDString TclStubs::_ANSI_ARGS_ ((Tcl_Encoding encoding, CONST char *src, int srcLen, Tcl_DString *dsPtr))
int tcl_UtfToExternal TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Encoding encoding, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr))
CONST84_RETURN char* tcl_UtfPrev TclStubs::_ANSI_ARGS_ ((CONST char *src, CONST char *start))
CONST84_RETURN char* tcl_UtfNext TclStubs::_ANSI_ARGS_ ((CONST char *src))
CONST84_RETURN char* tcl_UtfFindLast TclStubs::_ANSI_ARGS_ ((CONST char *src, int ch))
CONST84_RETURN char* tcl_UtfFindFirst TclStubs::_ANSI_ARGS_ ((CONST char *src, int ch))
int tcl_UtfBackslash TclStubs::_ANSI_ARGS_ ((CONST char *src, int *readPtr, char *dst))
int tcl_UtfCharComplete TclStubs::_ANSI_ARGS_ ((CONST char *src, int len))
CONST84_RETURN char* tcl_UtfAtIndex TclStubs::_ANSI_ARGS_ ((CONST char *src, int index))
int tcl_UniCharToUtf TclStubs::_ANSI_ARGS_ ((int ch, char *buf))
Tcl_UniChar tcl_UniCharToUpper TclStubs::_ANSI_ARGS_ ((int ch))
Tcl_UniChar tcl_UniCharToTitle TclStubs::_ANSI_ARGS_ ((int ch))
Tcl_UniChar tcl_UniCharToLower TclStubs::_ANSI_ARGS_ ((int ch))
Tcl_UniChar tcl_UniCharAtIndex TclStubs::_ANSI_ARGS_ ((CONST char *src, int index))
void tcl_ThreadQueueEvent TclStubs::_ANSI_ARGS_ ((Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position))
void tcl_ThreadAlert TclStubs::_ANSI_ARGS_ ((Tcl_ThreadId threadId))
Tcl_Obj* tcl_SetVar2Ex TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, Tcl_Obj *newValuePtr, int flags))
int tcl_SetSystemEncoding TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name))
void tcl_SaveResult TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_SavedResult *statePtr))
void tcl_RestoreResult TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_SavedResult *statePtr))
int tcl_ReadChars TclStubs::_ANSI_ARGS_ ((Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag))
int tcl_NumUtfChars TclStubs::_ANSI_ARGS_ ((CONST char *src, int len))
void tcl_ConditionWait TclStubs::_ANSI_ARGS_ ((Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, Tcl_Time *timePtr))
void tcl_ConditionNotify TclStubs::_ANSI_ARGS_ ((Tcl_Condition *condPtr))
void tcl_MutexUnlock TclStubs::_ANSI_ARGS_ ((Tcl_Mutex *mutexPtr))
void tcl_MutexLock TclStubs::_ANSI_ARGS_ ((Tcl_Mutex *mutexPtr))
ClientData tcl_InitNotifier TclStubs::_ANSI_ARGS_ ((void))
Tcl_Obj* tcl_GetVar2Ex TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags))
VOID* tcl_GetThreadData TclStubs::_ANSI_ARGS_ ((Tcl_ThreadDataKey *keyPtr, int size))
int tcl_GetIndexFromObjStruct TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, CONST VOID *tablePtr, int offset, CONST char *msg, int flags, int *indexPtr))
void tcl_GetEncodingNames TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
CONST84_RETURN char* tcl_GetEncodingName TclStubs::_ANSI_ARGS_ ((Tcl_Encoding encoding))
Tcl_Encoding tcl_GetEncoding TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name))
Tcl_ThreadId tcl_GetCurrentThread TclStubs::_ANSI_ARGS_ ((void))
void tcl_FreeEncoding TclStubs::_ANSI_ARGS_ ((Tcl_Encoding encoding))
void tcl_FinalizeNotifier TclStubs::_ANSI_ARGS_ ((ClientData clientData))
void tcl_FinalizeThread TclStubs::_ANSI_ARGS_ ((void))
char* tcl_ExternalToUtfDString TclStubs::_ANSI_ARGS_ ((Tcl_Encoding encoding, CONST char *src, int srcLen, Tcl_DString *dsPtr))
int tcl_ExternalToUtf TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Encoding encoding, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr))
void tcl_ExitThread TclStubs::_ANSI_ARGS_ ((int status))
int tcl_EvalObjEx TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int flags))
int tcl_EvalObjv TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags))
int tcl_EvalEx TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *script, int numBytes, int flags))
void tcl_DiscardResult TclStubs::_ANSI_ARGS_ ((Tcl_SavedResult *statePtr))
void tcl_DeleteThreadExitHandler TclStubs::_ANSI_ARGS_ ((Tcl_ExitProc *proc, ClientData clientData))
void tcl_CreateThreadExitHandler TclStubs::_ANSI_ARGS_ ((Tcl_ExitProc *proc, ClientData clientData))
Tcl_Encoding tcl_CreateEncoding TclStubs::_ANSI_ARGS_ ((Tcl_EncodingType *typePtr))
void tcl_AppendObjToObj TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr))
void tcl_SetMainLoop TclStubs::_ANSI_ARGS_ ((Tcl_MainLoopProc *proc))
Tcl_Channel tcl_GetStackedChannel TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan))
int tcl_UnstackChannel TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan))
Tcl_Channel tcl_StackChannel TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan))
void tcl_InitMemory TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
void tcl_GetVersion TclStubs::_ANSI_ARGS_ ((int *major, int *minor, int *patchLevel, int *type))
void tcl_PanicVA TclStubs::_ANSI_ARGS_ ((CONST char *format, va_list argList))
Tcl_Pid tcl_WaitPid TclStubs::_ANSI_ARGS_ ((Tcl_Pid pid, int *statPtr, int options))
int tcl_VarEvalVA TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, va_list argList))
void tcl_SetErrorCodeVA TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, va_list argList))
CONST84_RETURN char* tcl_PkgRequire TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version, int exact))
int tcl_PkgProvide TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version))
CONST84_RETURN char* tcl_PkgPresentEx TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr))
CONST84_RETURN char* tcl_PkgPresent TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version, int exact))
CONST84_RETURN char* tcl_ParseVar TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, CONST84 char **termPtr))
CONST84_RETURN char* tcl_HashStats TclStubs::_ANSI_ARGS_ ((Tcl_HashTable *tablePtr))
void tcl_AppendStringsToObjVA TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, va_list argList))
void tcl_AppendResultVA TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, va_list argList))
void tcl_ValidateAllMemory TclStubs::_ANSI_ARGS_ ((CONST char *file, int line))
int tcl_DumpActiveMemory TclStubs::_ANSI_ARGS_ ((CONST char *fileName))
void tcl_WrongNumArgs TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], CONST char *message))
int tcl_Write TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan, CONST char *s, int slen))
ClientData tcl_VarTraceInfo2 TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData))
ClientData tcl_VarTraceInfo TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData))
int tcl_VarEval TclStubs::_ANSI_ARGS_ (TCL_VARARGS(Tcl_Interp *, interp))
int tcl_UpVar2 TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *frameName, CONST char *part1, CONST char *part2, CONST char *localName, int flags))
int tcl_UpVar TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *frameName, CONST char *varName, CONST char *localName, int flags))
void tcl_UpdateLinkedVar TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName))
void tcl_UntraceVar2 TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData))
void tcl_UntraceVar TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData))
int tcl_UnsetVar2 TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags))
int tcl_UnsetVar TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags))
int tcl_UnregisterChannel TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan))
void tcl_UnlinkVar TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName))
int tcl_Ungets TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan, CONST char *str, int len, int atHead))
char* tcl_TranslateFileName TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_DString *bufferPtr))
int tcl_TraceVar2 TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData))
int tcl_TraceVar TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData))
int tcl_TellOld TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan))
int tcl_StringMatch TclStubs::_ANSI_ARGS_ ((CONST char *str, CONST char *pattern))
void tcl_StaticPackage TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc))
void tcl_SplitPath TclStubs::_ANSI_ARGS_ ((CONST char *path, int *argcPtr, CONST84 char ***argvPtr))
int tcl_SplitList TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *listStr, int *argcPtr, CONST84 char ***argvPtr))
void tcl_SourceRCFile TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
CONST84_RETURN char* tcl_SignalMsg TclStubs::_ANSI_ARGS_ ((int sig))
CONST84_RETURN char* tcl_SignalId TclStubs::_ANSI_ARGS_ ((int sig))
CONST84_RETURN char* tcl_SetVar2 TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, CONST char *newValue, int flags))
CONST84_RETURN char* tcl_SetVar TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, CONST char *newValue, int flags))
void tcl_SetStdChannel TclStubs::_ANSI_ARGS_ ((Tcl_Channel channel, int type))
void tcl_SetObjResult TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *resultObjPtr))
void tcl_SetObjErrorCode TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *errorObjPtr))
int tcl_SetServiceMode TclStubs::_ANSI_ARGS_ ((int mode))
void tcl_SetResult TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, char *str, Tcl_FreeProc *freeProc))
int tcl_SetRecursionLimit TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, int depth))
void tcl_SetPanicProc TclStubs::_ANSI_ARGS_ ((Tcl_PanicProc *panicProc))
void tcl_SetMaxBlockTime TclStubs::_ANSI_ARGS_ ((Tcl_Time *timePtr))
void tcl_SetErrorCode TclStubs::_ANSI_ARGS_ (TCL_VARARGS(Tcl_Interp *, interp))
void tcl_SetErrno TclStubs::_ANSI_ARGS_ ((int err))
int tcl_SetCommandInfo TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, CONST Tcl_CmdInfo *infoPtr))
int tcl_SetChannelOption TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, CONST char *newValue))
void tcl_SetChannelBufferSize TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan, int sz))
void tcl_SetAssocData TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_InterpDeleteProc *proc, ClientData clientData))
int tcl_ServiceEvent TclStubs::_ANSI_ARGS_ ((int flags))
int tcl_ServiceAll TclStubs::_ANSI_ARGS_ ((void))
int tcl_SeekOld TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan, int offset, int mode))
int tcl_ScanCountedElement TclStubs::_ANSI_ARGS_ ((CONST char *str, int length, int *flagPtr))
int tcl_ScanElement TclStubs::_ANSI_ARGS_ ((CONST char *str, int *flagPtr))
void tcl_ResetResult TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
void tcl_Release TclStubs::_ANSI_ARGS_ ((ClientData clientData))
void tcl_RegExpRange TclStubs::_ANSI_ARGS_ ((Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr))
int tcl_RegExpMatch TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, CONST char *pattern))
int tcl_RegExpExec TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_RegExp regexp, CONST char *str, CONST char *start))
Tcl_RegExp tcl_RegExpCompile TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string))
void tcl_RegisterObjType TclStubs::_ANSI_ARGS_ ((Tcl_ObjType *typePtr))
void tcl_RegisterChannel TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan))
int tcl_RecordAndEvalObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags))
int tcl_RecordAndEval TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmd, int flags))
void tcl_ReapDetachedProcs TclStubs::_ANSI_ARGS_ ((void))
int tcl_Read TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan, char *bufPtr, int toRead))
void tcl_QueueEvent TclStubs::_ANSI_ARGS_ ((Tcl_Event *evPtr, Tcl_QueuePosition position))
CONST84_RETURN char* tcl_PosixError TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
int tcl_PutEnv TclStubs::_ANSI_ARGS_ ((CONST char *string))
void tcl_PrintDouble TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, double value, char *dst))
void tcl_Preserve TclStubs::_ANSI_ARGS_ ((ClientData data))
Tcl_Channel tcl_OpenTcpServer TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, int port, CONST char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData))
Tcl_Channel tcl_OpenTcpClient TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, int port, CONST char *address, CONST char *myaddr, int myport, int async))
Tcl_Channel tcl_OpenFileChannel TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *fileName, CONST char *modeString, int permissions))
Tcl_Channel tcl_OpenCommandChannel TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, int argc, CONST84 char **argv, int flags))
Tcl_Obj* tcl_ObjSetVar2 TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags))
Tcl_Obj* tcl_ObjGetVar2 TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags))
void tcl_NotifyChannel TclStubs::_ANSI_ARGS_ ((Tcl_Channel channel, int mask))
Tcl_HashEntry* tcl_NextHashEntry TclStubs::_ANSI_ARGS_ ((Tcl_HashSearch *searchPtr))
char* tcl_Merge TclStubs::_ANSI_ARGS_ ((int argc, CONST84 char *CONST *argv))
Tcl_Channel tcl_MakeTcpClientChannel TclStubs::_ANSI_ARGS_ ((ClientData tcpSocket))
int tcl_MakeSafe TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
Tcl_Channel tcl_MakeFileChannel TclStubs::_ANSI_ARGS_ ((ClientData handle, int mode))
int tcl_LinkVar TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, char *addr, int type))
char* tcl_JoinPath TclStubs::_ANSI_ARGS_ ((int argc, CONST84 char *CONST *argv, Tcl_DString *resultPtr))
int tcl_IsSafe TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
int tcl_InterpDeleted TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
int tcl_InputBuffered TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan))
int tcl_InputBlocked TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan))
void tcl_InitHashTable TclStubs::_ANSI_ARGS_ ((Tcl_HashTable *tablePtr, int keyType))
int tcl_Init TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
int tcl_HideCommand TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, CONST char *hiddenCmdToken))
int tcl_GlobalEvalObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
int tcl_GlobalEval TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *command))
CONST84_RETURN char* tcl_GetVar2 TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags))
CONST84_RETURN char* tcl_GetVar TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags))
CONST84_RETURN char* tcl_GetStringResult TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
Tcl_Channel tcl_GetStdChannel TclStubs::_ANSI_ARGS_ ((int type))
Tcl_Interp* tcl_GetSlave TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *slaveName))
int tcl_GetServiceMode TclStubs::_ANSI_ARGS_ ((void))
int tcl_GetsObj TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan, Tcl_Obj *objPtr))
int tcl_Gets TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan, Tcl_DString *dsPtr))
Tcl_PathType tcl_GetPathType TclStubs::_ANSI_ARGS_ ((CONST char *path))
int tcl_GetOpenFile TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int forWriting, int checkUsage, ClientData *filePtr))
Tcl_Obj* tcl_GetObjResult TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
CONST char* tcl_GetNameOfExecutable TclStubs::_ANSI_ARGS_ ((void))
Tcl_Interp* tcl_GetMaster TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
int tcl_GetInterpPath TclStubs::_ANSI_ARGS_ ((Tcl_Interp *askInterp, Tcl_Interp *slaveInterp))
CONST84_RETURN char* tcl_GetHostName TclStubs::_ANSI_ARGS_ ((void))
int tcl_GetErrno TclStubs::_ANSI_ARGS_ ((void))
CONST84_RETURN char* tcl_GetCommandName TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Command command))
int tcl_GetCommandInfo TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, Tcl_CmdInfo *infoPtr))
Tcl_ChannelType* tcl_GetChannelType TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan))
int tcl_GetChannelOption TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, Tcl_DString *dsPtr))
CONST84_RETURN char* tcl_GetChannelName TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan))
int tcl_GetChannelMode TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan))
ClientData tcl_GetChannelInstanceData TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan))
int tcl_GetChannelHandle TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan, int direction, ClientData *handlePtr))
int tcl_GetChannelBufferSize TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan))
Tcl_Channel tcl_GetChannel TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *chanName, int *modePtr))
ClientData tcl_GetAssocData TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_InterpDeleteProc **procPtr))
int tcl_GetAliasObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv))
int tcl_GetAlias TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr))
void tcl_FreeResult TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
int tcl_Flush TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan))
Tcl_HashEntry* tcl_FirstHashEntry TclStubs::_ANSI_ARGS_ ((Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr))
void tcl_FindExecutable TclStubs::_ANSI_ARGS_ ((CONST char *argv0))
void tcl_Finalize TclStubs::_ANSI_ARGS_ ((void))
int tcl_ExprString TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string))
int tcl_ExprObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr))
int tcl_ExprLongObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr))
int tcl_ExprLong TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, long *ptr))
int tcl_ExprDoubleObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr))
int tcl_ExprDouble TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, double *ptr))
int tcl_ExprBooleanObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr))
int tcl_ExprBoolean TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int *ptr))
int tcl_ExposeCommand TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *hiddenCmdToken, CONST char *cmdName))
void tcl_Exit TclStubs::_ANSI_ARGS_ ((int status))
void tcl_EventuallyFree TclStubs::_ANSI_ARGS_ ((ClientData clientData, Tcl_FreeProc *freeProc))
int tcl_EvalObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
int tcl_EvalFile TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *fileName))
int tcl_Eval TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string))
CONST84_RETURN char* tcl_ErrnoMsg TclStubs::_ANSI_ARGS_ ((int err))
CONST84_RETURN char* tcl_ErrnoId TclStubs::_ANSI_ARGS_ ((void))
int tcl_Eof TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan))
void tcl_DStringStartSublist TclStubs::_ANSI_ARGS_ ((Tcl_DString *dsPtr))
void tcl_DStringSetLength TclStubs::_ANSI_ARGS_ ((Tcl_DString *dsPtr, int length))
void tcl_DStringResult TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_DString *dsPtr))
void tcl_DStringInit TclStubs::_ANSI_ARGS_ ((Tcl_DString *dsPtr))
void tcl_DStringGetResult TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_DString *dsPtr))
void tcl_DStringFree TclStubs::_ANSI_ARGS_ ((Tcl_DString *dsPtr))
void tcl_DStringEndSublist TclStubs::_ANSI_ARGS_ ((Tcl_DString *dsPtr))
char* tcl_DStringAppendElement TclStubs::_ANSI_ARGS_ ((Tcl_DString *dsPtr, CONST char *string))
char* tcl_DStringAppend TclStubs::_ANSI_ARGS_ ((Tcl_DString *dsPtr, CONST char *str, int length))
void tcl_DoWhenIdle TclStubs::_ANSI_ARGS_ ((Tcl_IdleProc *proc, ClientData clientData))
int tcl_DoOneEvent TclStubs::_ANSI_ARGS_ ((int flags))
void tcl_DontCallWhenDeleted TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData))
void tcl_DeleteTrace TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Trace trace))
void tcl_DeleteTimerHandler TclStubs::_ANSI_ARGS_ ((Tcl_TimerToken token))
void tcl_DetachPids TclStubs::_ANSI_ARGS_ ((int numPids, Tcl_Pid *pidPtr))
void tcl_DeleteInterp TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
void tcl_DeleteHashTable TclStubs::_ANSI_ARGS_ ((Tcl_HashTable *tablePtr))
void tcl_DeleteHashEntry TclStubs::_ANSI_ARGS_ ((Tcl_HashEntry *entryPtr))
void tcl_DeleteExitHandler TclStubs::_ANSI_ARGS_ ((Tcl_ExitProc *proc, ClientData clientData))
void tcl_DeleteEventSource TclStubs::_ANSI_ARGS_ ((Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData))
void tcl_DeleteEvents TclStubs::_ANSI_ARGS_ ((Tcl_EventDeleteProc *proc, ClientData clientData))
int tcl_DeleteCommandFromToken TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Command command))
int tcl_DeleteCommand TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName))
void tcl_DeleteCloseHandler TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData))
void tcl_DeleteChannelHandler TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData))
void tcl_DeleteAssocData TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name))
Tcl_Trace tcl_CreateTrace TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData))
Tcl_TimerToken tcl_CreateTimerHandler TclStubs::_ANSI_ARGS_ ((int milliseconds, Tcl_TimerProc *proc, ClientData clientData))
Tcl_Interp* tcl_CreateSlave TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *slaveName, int isSafe))
Tcl_Command tcl_CreateObjCommand TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc))
void tcl_CreateMathFunc TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData))
Tcl_Interp* tcl_CreateInterp TclStubs::_ANSI_ARGS_ ((void))
void tcl_CreateExitHandler TclStubs::_ANSI_ARGS_ ((Tcl_ExitProc *proc, ClientData clientData))
void tcl_CreateEventSource TclStubs::_ANSI_ARGS_ ((Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData))
Tcl_Command tcl_CreateCommand TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc))
void tcl_CreateCloseHandler TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData))
void tcl_CreateChannelHandler TclStubs::_ANSI_ARGS_ ((Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData))
Tcl_Channel tcl_CreateChannel TclStubs::_ANSI_ARGS_ ((Tcl_ChannelType *typePtr, CONST char *chanName, ClientData instanceData, int mask))
int tcl_CreateAliasObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *slave, CONST char *slaveCmd, Tcl_Interp *target, CONST char *targetCmd, int objc, Tcl_Obj *CONST objv[]))
int tcl_CreateAlias TclStubs::_ANSI_ARGS_ ((Tcl_Interp *slave, CONST char *slaveCmd, Tcl_Interp *target, CONST char *targetCmd, int argc, CONST84 char *CONST *argv))
int tcl_ConvertCountedElement TclStubs::_ANSI_ARGS_ ((CONST char *src, int length, char *dst, int flags))
int tcl_ConvertElement TclStubs::_ANSI_ARGS_ ((CONST char *src, char *dst, int flags))
char* tcl_Concat TclStubs::_ANSI_ARGS_ ((int argc, CONST84 char *CONST *argv))
int tcl_CommandComplete TclStubs::_ANSI_ARGS_ ((CONST char *cmd))
int tcl_Close TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan))
void tcl_CancelIdleCall TclStubs::_ANSI_ARGS_ ((Tcl_IdleProc *idleProc, ClientData clientData))
void tcl_CallWhenDeleted TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData))
int tcl_BadChannelOption TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *optionName, CONST char *optionList))
char tcl_Backslash TclStubs::_ANSI_ARGS_ ((CONST char *src, int *readPtr))
void tcl_BackgroundError TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
int tcl_AsyncReady TclStubs::_ANSI_ARGS_ ((void))
void tcl_AsyncMark TclStubs::_ANSI_ARGS_ ((Tcl_AsyncHandler async))
int tcl_AsyncInvoke TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, int code))
void tcl_AsyncDelete TclStubs::_ANSI_ARGS_ ((Tcl_AsyncHandler async))
Tcl_AsyncHandler tcl_AsyncCreate TclStubs::_ANSI_ARGS_ ((Tcl_AsyncProc *proc, ClientData clientData))
void tcl_AppendResult TclStubs::_ANSI_ARGS_ (TCL_VARARGS(Tcl_Interp *, interp))
void tcl_AppendElement TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string))
void tcl_AllowExceptions TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp))
void tcl_AddObjErrorInfo TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *message, int length))
void tcl_AddErrorInfo TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *message))
void tcl_SetStringObj TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST char *bytes, int length))
void tcl_SetObjLength TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, int length))
void tcl_SetLongObj TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, long longValue))
void tcl_SetListObj TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, int objc, Tcl_Obj *CONST objv[]))
void tcl_SetIntObj TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, int intValue))
void tcl_SetDoubleObj TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, double doubleValue))
void tcl_SetByteArrayObj TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST unsigned char *bytes, int length))
unsigned char* tcl_SetByteArrayLength TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, int length))
void tcl_SetBooleanObj TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, int boolValue))
Tcl_Obj* tcl_NewStringObj TclStubs::_ANSI_ARGS_ ((CONST char *bytes, int length))
Tcl_Obj* tcl_NewObj TclStubs::_ANSI_ARGS_ ((void))
Tcl_Obj* tcl_NewLongObj TclStubs::_ANSI_ARGS_ ((long longValue))
Tcl_Obj* tcl_NewListObj TclStubs::_ANSI_ARGS_ ((int objc, Tcl_Obj *CONST objv[]))
Tcl_Obj* tcl_NewIntObj TclStubs::_ANSI_ARGS_ ((int intValue))
Tcl_Obj* tcl_NewDoubleObj TclStubs::_ANSI_ARGS_ ((double doubleValue))
Tcl_Obj* tcl_NewByteArrayObj TclStubs::_ANSI_ARGS_ ((CONST unsigned char *bytes, int length))
Tcl_Obj* tcl_NewBooleanObj TclStubs::_ANSI_ARGS_ ((int boolValue))
int tcl_ListObjReplace TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *CONST objv[]))
int tcl_ListObjLength TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr))
int tcl_ListObjIndex TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr))
int tcl_ListObjGetElements TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr))
int tcl_ListObjAppendElement TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr))
int tcl_ListObjAppendList TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr))
void tcl_InvalidateStringRep TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr))
char* tcl_GetStringFromObj TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, int *lengthPtr))
Tcl_ObjType* tcl_GetObjType TclStubs::_ANSI_ARGS_ ((CONST char *typeName))
int tcl_GetLongFromObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr))
int tcl_GetIntFromObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr))
int tcl_GetInt TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int *intPtr))
int tcl_GetIndexFromObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char **tablePtr, CONST char *msg, int flags, int *indexPtr))
int tcl_GetDoubleFromObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr))
int tcl_GetDouble TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, double *doublePtr))
unsigned char* tcl_GetByteArrayFromObj TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, int *lengthPtr))
int tcl_GetBooleanFromObj TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr))
int tcl_GetBoolean TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int *boolPtr))
void tclFreeObj TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr))
Tcl_Obj* tcl_DuplicateObj TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr))
Tcl_Obj* tcl_DbNewStringObj TclStubs::_ANSI_ARGS_ ((CONST char *bytes, int length, CONST char *file, int line))
Tcl_Obj* tcl_DbNewObj TclStubs::_ANSI_ARGS_ ((CONST char *file, int line))
Tcl_Obj* tcl_DbNewLongObj TclStubs::_ANSI_ARGS_ ((long longValue, CONST char *file, int line))
Tcl_Obj* tcl_DbNewListObj TclStubs::_ANSI_ARGS_ ((int objc, Tcl_Obj *CONST *objv, CONST char *file, int line))
Tcl_Obj* tcl_DbNewDoubleObj TclStubs::_ANSI_ARGS_ ((double doubleValue, CONST char *file, int line))
Tcl_Obj* tcl_DbNewByteArrayObj TclStubs::_ANSI_ARGS_ ((CONST unsigned char *bytes, int length, CONST char *file, int line))
Tcl_Obj* tcl_DbNewBooleanObj TclStubs::_ANSI_ARGS_ ((int boolValue, CONST char *file, int line))
int tcl_DbIsShared TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST char *file, int line))
void tcl_DbIncrRefCount TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST char *file, int line))
void tcl_DbDecrRefCount TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST char *file, int line))
int tcl_ConvertToType TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_ObjType *typePtr))
Tcl_Obj* tcl_ConcatObj TclStubs::_ANSI_ARGS_ ((int objc, Tcl_Obj *CONST objv[]))
void tcl_AppendToObj TclStubs::_ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST char *bytes, int length))
void tcl_AppendStringsToObj TclStubs::_ANSI_ARGS_ (TCL_VARARGS(Tcl_Obj *, objPtr))
int tcl_AppendAllObjTypes TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
int tcl_WaitForEvent TclStubs::_ANSI_ARGS_ ((Tcl_Time *timePtr))
void tcl_Sleep TclStubs::_ANSI_ARGS_ ((int ms))
void tcl_SetTimer TclStubs::_ANSI_ARGS_ ((Tcl_Time *timePtr))
void tcl_DeleteFileHandler TclStubs::_ANSI_ARGS_ ((int fd))
void tcl_CreateFileHandler TclStubs::_ANSI_ARGS_ ((int fd, int mask, Tcl_FileProc *proc, ClientData clientData))
char* tcl_DbCkrealloc TclStubs::_ANSI_ARGS_ ((char *ptr, unsigned int size, CONST char *file, int line))
int tcl_DbCkfree TclStubs::_ANSI_ARGS_ ((char *ptr, CONST char *file, int line))
char* tcl_DbCkalloc TclStubs::_ANSI_ARGS_ ((unsigned int size, CONST char *file, int line))
char* tcl_Realloc TclStubs::_ANSI_ARGS_ ((char *ptr, unsigned int size))
void tcl_Free TclStubs::_ANSI_ARGS_ ((char *ptr))
char* tcl_Alloc TclStubs::_ANSI_ARGS_ ((unsigned int size))
void tcl_Panic TclStubs::_ANSI_ARGS_ (TCL_VARARGS(CONST char *, format))
CONST84_RETURN char* tcl_PkgRequireEx TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr))
int tcl_PkgProvideEx TclStubs::_ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version, ClientData clientData))

Member Data Documentation
struct TclStubHooks* TclStubs::hooks

Definition at line 1662 of file tclDecls.h.
Referenced by Tcl_InitStubs().int TclStubs::magic

Definition at line 1661 of file tclDecls.h.
Referenced by HasStubSupport().void* TclStubs::reserved188

Definition at line 1884 of file tclDecls.h.void* TclStubs::reserved285

Definition at line 1997 of file tclDecls.h.void* TclStubs::reserved494

Definition at line 2206 of file tclDecls.h.void* TclStubs::reserved495

Definition at line 2207 of file tclDecls.h.void* TclStubs::reserved496

Definition at line 2208 of file tclDecls.h.void* TclStubs::reserved497

Definition at line 2209 of file tclDecls.h.void* TclStubs::reserved498

Definition at line 2210 of file tclDecls.h.void* TclStubs::reserved499

Definition at line 2211 of file tclDecls.h.void* TclStubs::reserved500

Definition at line 2212 of file tclDecls.h.void* TclStubs::reserved501

Definition at line 2213 of file tclDecls.h.void* TclStubs::reserved502

Definition at line 2214 of file tclDecls.h.void* TclStubs::reserved503

Definition at line 2215 of file tclDecls.h.void* TclStubs::reserved504

Definition at line 2216 of file tclDecls.h.void* TclStubs::reserved505

Definition at line 2217 of file tclDecls.h.void* TclStubs::reserved506

Definition at line 2218 of file tclDecls.h.void* TclStubs::reserved507

Definition at line 2219 of file tclDecls.h.void* TclStubs::reserved508

Definition at line 2220 of file tclDecls.h.void* TclStubs::reserved509

Definition at line 2221 of file tclDecls.h.void* TclStubs::reserved510

Definition at line 2222 of file tclDecls.h.void* TclStubs::reserved511

Definition at line 2223 of file tclDecls.h.void* TclStubs::reserved512

Definition at line 2224 of file tclDecls.h.void* TclStubs::reserved513

Definition at line 2225 of file tclDecls.h.void* TclStubs::reserved514

Definition at line 2226 of file tclDecls.h.void* TclStubs::reserved515

Definition at line 2227 of file tclDecls.h.void* TclStubs::reserved516

Definition at line 2228 of file tclDecls.h.void* TclStubs::reserved517

Definition at line 2229 of file tclDecls.h.void* TclStubs::reserved518

Definition at line 2230 of file tclDecls.h.void* TclStubs::reserved519

Definition at line 2231 of file tclDecls.h.void* TclStubs::reserved520

Definition at line 2232 of file tclDecls.h.void* TclStubs::reserved521

Definition at line 2233 of file tclDecls.h.void* TclStubs::reserved522

Definition at line 2234 of file tclDecls.h.void* TclStubs::reserved523

Definition at line 2235 of file tclDecls.h.void* TclStubs::reserved524

Definition at line 2236 of file tclDecls.h.void* TclStubs::reserved525

Definition at line 2237 of file tclDecls.h.void* TclStubs::reserved526

Definition at line 2238 of file tclDecls.h.void* TclStubs::reserved527

Definition at line 2239 of file tclDecls.h.void* TclStubs::reserved528

Definition at line 2240 of file tclDecls.h.void* TclStubs::reserved529

Definition at line 2241 of file tclDecls.h.void* TclStubs::reserved530

Definition at line 2242 of file tclDecls.h.void* TclStubs::reserved531

Definition at line 2243 of file tclDecls.h.void* TclStubs::reserved532

Definition at line 2244 of file tclDecls.h.void* TclStubs::reserved533

Definition at line 2245 of file tclDecls.h.void* TclStubs::reserved534

Definition at line 2246 of file tclDecls.h.void* TclStubs::reserved535

Definition at line 2247 of file tclDecls.h.void* TclStubs::reserved536

Definition at line 2248 of file tclDecls.h.void* TclStubs::reserved537

Definition at line 2249 of file tclDecls.h.void* TclStubs::reserved538

Definition at line 2250 of file tclDecls.h.void* TclStubs::reserved539

Definition at line 2251 of file tclDecls.h.void* TclStubs::reserved540

Definition at line 2252 of file tclDecls.h.void* TclStubs::reserved541

Definition at line 2253 of file tclDecls.h.void* TclStubs::reserved542

Definition at line 2254 of file tclDecls.h.void* TclStubs::reserved543

Definition at line 2255 of file tclDecls.h.void* TclStubs::reserved544

Definition at line 2256 of file tclDecls.h.void* TclStubs::reserved545

Definition at line 2257 of file tclDecls.h.void* TclStubs::reserved546

Definition at line 2258 of file tclDecls.h.void* TclStubs::reserved547

Definition at line 2259 of file tclDecls.h.void* TclStubs::reserved548

Definition at line 2260 of file tclDecls.h.void* TclStubs::reserved549

Definition at line 2261 of file tclDecls.h.void* TclStubs::reserved550

Definition at line 2262 of file tclDecls.h.void* TclStubs::reserved551

Definition at line 2263 of file tclDecls.h.void* TclStubs::reserved552

Definition at line 2264 of file tclDecls.h.void* TclStubs::reserved553

Definition at line 2265 of file tclDecls.h.void* TclStubs::reserved555

Definition at line 2267 of file tclDecls.h.void* TclStubs::reserved556

Definition at line 2268 of file tclDecls.h.void* TclStubs::reserved557

Definition at line 2269 of file tclDecls.h.void* TclStubs::reserved558

Definition at line 2270 of file tclDecls.h.void* TclStubs::reserved559

Definition at line 2271 of file tclDecls.h.void* TclStubs::reserved560

Definition at line 2272 of file tclDecls.h.void* TclStubs::reserved561

Definition at line 2273 of file tclDecls.h.void* TclStubs::reserved562

Definition at line 2274 of file tclDecls.h.void* TclStubs::reserved563

Definition at line 2275 of file tclDecls.h.void* TclStubs::reserved564

Definition at line 2276 of file tclDecls.h.void* TclStubs::reserved565

Definition at line 2277 of file tclDecls.h.void* TclStubs::reserved566

Definition at line 2278 of file tclDecls.h.void* TclStubs::reserved567

Definition at line 2279 of file tclDecls.h.void* TclStubs::reserved568

Definition at line 2280 of file tclDecls.h.void* TclStubs::reserved569

Definition at line 2281 of file tclDecls.h.void* TclStubs::reserved570

Definition at line 2282 of file tclDecls.h.void* TclStubs::reserved571

Definition at line 2283 of file tclDecls.h.void* TclStubs::reserved572

Definition at line 2284 of file tclDecls.h.
The documentation for this struct was generated from the following file:
generic/tclDecls.h

TclWinProcs Struct Reference
#include <tclWinInt.h>

Detailed Description

Definition at line 61 of file tclWinInt.h.Public Member Functions
BOOL (WINAPI *buildCommDCBProc)(CONST TCHAR *
TCHAR *WINAPI * charLowerProc (TCHAR *)
BOOL (WINAPI *copyFileProc)(CONST TCHAR *
BOOL (WINAPI *createDirectoryProc)(CONST TCHAR *
HANDLE (WINAPI *createFileProc)(CONST TCHAR *
BOOL (WINAPI *createProcessProc)(CONST TCHAR *
BOOL (WINAPI *deleteFileProc)(CONST TCHAR *)
HANDLE (WINAPI *findFirstFileProc)(CONST TCHAR *
WIN32_FIND_DATAT * BOOL (WINAPI *findNextFileProc)(HANDLE
WIN32_FIND_DATAT *WIN32_FIND_DATAT * BOOL (WINAPI *getComputerNameProc)(WCHAR *
DWORD (WINAPI *getCurrentDirectoryProc)(DWORD
WCHAR * DWORD (WINAPI *getFileAttributesProc)(CONST TCHAR *)
DWORD (WINAPI *getFullPathNameProc)(CONST TCHAR *
DWORD WCHAR TCHAR ** DWORD (WINAPI *getModuleFileNameProc)(HMODULE
DWORD (WINAPI *getShortPathNameProc)(CONST TCHAR *
UINT (WINAPI *getTempFileNameProc)(CONST TCHAR *
CONST TCHAR WCHAR * DWORD (WINAPI *getTempPathProc)(DWORD
CONST TCHAR WCHAR *WCHAR * BOOL (WINAPI *getVolumeInformationProc)(CONST TCHAR *
HINSTANCE (WINAPI *loadLibraryProc)(CONST TCHAR *)
TCHAR (WINAPI *lstrcpyProc)(WCHAR *
CONST TCHAR * BOOL (WINAPI *moveFileProc)(CONST TCHAR *
CONST TCHAR *CONST TCHAR * BOOL (WINAPI *removeDirectoryProc)(CONST TCHAR *)
DWORD (WINAPI *searchPathProc)(CONST TCHAR *
CONST TCHAR CONST TCHAR WCHAR TCHAR ** BOOL (WINAPI *setCurrentDirectoryProc)(CONST TCHAR *)
BOOL (WINAPI *setFileAttributesProc)(CONST TCHAR *
BOOL (WINAPI *getFileAttributesExProc)(CONST TCHAR *
BOOL (WINAPI *createHardLinkProc)(CONST TCHAR *
INT (__cdecl *utimeProc)(CONST TCHAR *
_utimbuf * HANDLE (WINAPI *findFirstFileExProc)(CONST TCHAR *
BOOL (WINAPI *getVolumeNameForVMPProc)(CONST TCHAR *
DWORD (WINAPI *getLongPathNameProc)(CONST TCHAR *
BOOL (WINAPI *getFileSecurityProc)(LPCTSTR lpFileName
BOOL (WINAPI *impersonateSelfProc)(SECURITY_IMPERSONATION_LEVEL ImpersonationLevel)
BOOL (WINAPI *openThreadTokenProc)(HANDLE ThreadHandle
BOOL (WINAPI *revertToSelfProc)(void)
VOID (WINAPI *mapGenericMaskProc)(PDWORD AccessMask
BOOL (WINAPI *accessCheckProc)(PSECURITY_DESCRIPTOR pSecurityDescriptor
BOOL (WINAPI *readConsoleProc)(HANDLE hConsoleInput
BOOL (WINAPI *writeConsoleProc)(HANDLE hConsoleOutput
Public Attributes
int useWide
LPDCB
CONST TCHAR BOOL
LPSECURITY_ATTRIBUTES
DWORD
HANDLE
TCHAR LPSECURITY_ATTRIBUTES
TCHAR BOOL
TCHAR DWORD
TCHAR LPVOID
TCHAR CONST TCHAR LPSTARTUPINFOA
TCHAR CONST TCHAR LPPROCESS_INFORMATION
WIN32_FIND_DATAT *WIN32_FIND_DATAT * LPDWORD
DWORD nBufferLength
DWORD WCHAR TCHAR **WCHAR int
WCHAR DWORD
CONST TCHAR UINT
CONST TCHAR WCHAR *WCHAR *WCHAR DWORD
CONST TCHAR WCHAR *WCHAR *WCHAR LPDWORD
CONST TCHAR WCHAR *WCHAR *WCHAR LPDWORD
CONST TCHAR WCHAR *WCHAR *WCHAR LPDWORD
CONST TCHAR WCHAR *WCHAR *WCHAR WCHAR DWORD
CONST TCHAR CONST TCHAR DWORD
GET_FILEEX_INFO_LEVELS
LPVOID
CONST TCHAR LPSECURITY_ATTRIBUTES
_utimbuf * UINT
_utimbuf LPVOID
_utimbuf UINT
_utimbuf LPVOID
_utimbuf DWORD
SECURITY_INFORMATION RequestedInformation
SECURITY_INFORMATION PSECURITY_DESCRIPTOR pSecurityDescriptor
SECURITY_INFORMATION PSECURITY_DESCRIPTOR DWORD nLength
SECURITY_INFORMATION PSECURITY_DESCRIPTOR DWORD LPDWORD lpnLengthNeeded
DWORD DesiredAccess
DWORD BOOL OpenAsSelf
DWORD BOOL PHANDLE TokenHandle
PGENERIC_MAPPING GenericMapping
HANDLE ClientToken
HANDLE DWORD DesiredAccess
HANDLE DWORD PGENERIC_MAPPING GenericMapping
HANDLE DWORD PGENERIC_MAPPING PPRIVILEGE_SET PrivilegeSet
HANDLE DWORD PGENERIC_MAPPING PPRIVILEGE_SET LPDWORD PrivilegeSetLength
HANDLE DWORD PGENERIC_MAPPING PPRIVILEGE_SET LPDWORD LPDWORD GrantedAccess
HANDLE DWORD PGENERIC_MAPPING PPRIVILEGE_SET LPDWORD LPDWORD LPBOOL AccessStatus
LPVOID lpBuffer
LPVOID DWORD nNumberOfCharsToRead
LPVOID DWORD LPDWORD lpNumberOfCharsRead
LPVOID DWORD LPDWORD LPVOID lpReserved
const VOID * lpBuffer
const VOID DWORD nNumberOfCharsToWrite
const VOID DWORD LPDWORD lpNumberOfCharsWritten
const VOID DWORD LPDWORD LPVOID lpReserved

Member Function Documentation
TclWinProcs::BOOL (WINAPI * writeConsoleProc)
TclWinProcs::BOOL (WINAPI * readConsoleProc)
TclWinProcs::BOOL (WINAPI * accessCheckProc)
TclWinProcs::BOOL (WINAPI * revertToSelfProc)
TclWinProcs::BOOL (WINAPI * openThreadTokenProc)
TclWinProcs::BOOL (WINAPI * impersonateSelfProc)
TclWinProcs::BOOL (WINAPI * getFileSecurityProc)
TclWinProcs::BOOL (WINAPI * getVolumeNameForVMPProc)
TclWinProcs::BOOL (WINAPI * createHardLinkProc)
TclWinProcs::BOOL (WINAPI * getFileAttributesExProc)
TclWinProcs::BOOL (WINAPI * setFileAttributesProc)
CONST TCHAR CONST TCHAR WCHAR TCHAR** TclWinProcs::BOOL (WINAPI * setCurrentDirectoryProc)
CONST TCHAR* CONST TCHAR* TclWinProcs::BOOL (WINAPI * removeDirectoryProc)
CONST TCHAR* TclWinProcs::BOOL (WINAPI * moveFileProc)
CONST TCHAR WCHAR* WCHAR* TclWinProcs::BOOL (WINAPI * getVolumeInformationProc)
WIN32_FIND_DATAT* WIN32_FIND_DATAT* TclWinProcs::BOOL (WINAPI * getComputerNameProc)
WIN32_FIND_DATAT* TclWinProcs::BOOL (WINAPI * findNextFileProc)
TclWinProcs::BOOL (WINAPI * deleteFileProc)
TclWinProcs::BOOL (WINAPI * createProcessProc)
TclWinProcs::BOOL (WINAPI * createDirectoryProc)
TclWinProcs::BOOL (WINAPI * copyFileProc)
TclWinProcs::BOOL (WINAPI * buildCommDCBProc)
TCHAR* WINAPI* TclWinProcs::charLowerProc (TCHAR *)

Referenced by DoRenameFile().TclWinProcs::DWORD (WINAPI * getLongPathNameProc)
TclWinProcs::DWORD (WINAPI * searchPathProc)
CONST TCHAR WCHAR* TclWinProcs::DWORD (WINAPI * getTempPathProc)
TclWinProcs::DWORD (WINAPI * getShortPathNameProc)
DWORD WCHAR TCHAR** TclWinProcs::DWORD (WINAPI * getModuleFileNameProc)
TclWinProcs::DWORD (WINAPI * getFullPathNameProc)
WCHAR* TclWinProcs::DWORD (WINAPI * getFileAttributesProc)
TclWinProcs::DWORD (WINAPI * getCurrentDirectoryProc)
struct _utimbuf* TclWinProcs::HANDLE (WINAPI * findFirstFileExProc)
TclWinProcs::HANDLE (WINAPI * findFirstFileProc)
TclWinProcs::HANDLE (WINAPI * createFileProc)
TclWinProcs::HINSTANCE (WINAPI * loadLibraryProc)
TclWinProcs::INT (__cdecl * utimeProc)
TclWinProcs::TCHAR (WINAPI * lstrcpyProc)
TclWinProcs::UINT (WINAPI * getTempFileNameProc)
TclWinProcs::VOID (WINAPI * mapGenericMaskProc)

Member Data Documentation
HANDLE DWORD PGENERIC_MAPPING PPRIVILEGE_SET LPDWORD LPDWORD LPBOOL TclWinProcs::AccessStatus

Definition at line 135 of file tclWinInt.h.TCHAR TclWinProcs::BOOL

Definition at line 70 of file tclWinInt.h.CONST TCHAR TclWinProcs::BOOL

Definition at line 66 of file tclWinInt.h.HANDLE TclWinProcs::ClientToken

Definition at line 135 of file tclWinInt.h.HANDLE DWORD TclWinProcs::DesiredAccess

Definition at line 135 of file tclWinInt.h.DWORD TclWinProcs::DesiredAccess

Definition at line 129 of file tclWinInt.h.struct _utimbuf TclWinProcs::DWORD

Definition at line 110 of file tclWinInt.h.CONST TCHAR CONST TCHAR TclWinProcs::DWORD

Definition at line 92 of file tclWinInt.h.CONST TCHAR WCHAR* WCHAR* WCHAR WCHAR TclWinProcs::DWORD

Definition at line 86 of file tclWinInt.h.CONST TCHAR WCHAR* WCHAR* WCHAR TclWinProcs::DWORD

Definition at line 86 of file tclWinInt.h.WCHAR TclWinProcs::DWORD

Definition at line 82 of file tclWinInt.h.TCHAR TclWinProcs::DWORD

Definition at line 70 of file tclWinInt.h.TCHAR TclWinProcs::DWORD

Definition at line 68 of file tclWinInt.h.HANDLE DWORD PGENERIC_MAPPING TclWinProcs::GenericMapping

Definition at line 135 of file tclWinInt.h.PGENERIC_MAPPING TclWinProcs::GenericMapping

Definition at line 133 of file tclWinInt.h.TclWinProcs::GET_FILEEX_INFO_LEVELS

Definition at line 104 of file tclWinInt.h.HANDLE DWORD PGENERIC_MAPPING PPRIVILEGE_SET LPDWORD LPDWORD TclWinProcs::GrantedAccess

Definition at line 135 of file tclWinInt.h.TclWinProcs::HANDLE

Definition at line 68 of file tclWinInt.h.DWORD WCHAR TCHAR** WCHAR TclWinProcs::int

Definition at line 81 of file tclWinInt.h.const VOID* TclWinProcs::lpBuffer

Definition at line 150 of file tclWinInt.h.LPVOID TclWinProcs::lpBuffer

Definition at line 145 of file tclWinInt.h.TclWinProcs::LPDCB

Definition at line 64 of file tclWinInt.h.CONST TCHAR WCHAR* WCHAR* WCHAR TclWinProcs::LPDWORD

Definition at line 86 of file tclWinInt.h.CONST TCHAR WCHAR* WCHAR* WCHAR TclWinProcs::LPDWORD

Definition at line 86 of file tclWinInt.h.CONST TCHAR WCHAR* WCHAR* WCHAR TclWinProcs::LPDWORD

Definition at line 86 of file tclWinInt.h.WIN32_FIND_DATAT* WIN32_FIND_DATAT* TclWinProcs::LPDWORD

Definition at line 76 of file tclWinInt.h.SECURITY_INFORMATION PSECURITY_DESCRIPTOR DWORD LPDWORD TclWinProcs::lpnLengthNeeded

Definition at line 122 of file tclWinInt.h.LPVOID DWORD LPDWORD TclWinProcs::lpNumberOfCharsRead

Definition at line 145 of file tclWinInt.h.const VOID DWORD LPDWORD TclWinProcs::lpNumberOfCharsWritten

Definition at line 150 of file tclWinInt.h.TCHAR CONST TCHAR TclWinProcs::LPPROCESS_INFORMATION

Definition at line 70 of file tclWinInt.h.const VOID DWORD LPDWORD LPVOID TclWinProcs::lpReserved

Definition at line 150 of file tclWinInt.h.LPVOID DWORD LPDWORD LPVOID TclWinProcs::lpReserved

Definition at line 145 of file tclWinInt.h.CONST TCHAR TclWinProcs::LPSECURITY_ATTRIBUTES

Definition at line 105 of file tclWinInt.h.TCHAR TclWinProcs::LPSECURITY_ATTRIBUTES

Definition at line 70 of file tclWinInt.h.TCHAR TclWinProcs::LPSECURITY_ATTRIBUTES

Definition at line 67 of file tclWinInt.h.TCHAR CONST TCHAR TclWinProcs::LPSTARTUPINFOA

Definition at line 70 of file tclWinInt.h.struct _utimbuf TclWinProcs::LPVOID

Definition at line 110 of file tclWinInt.h.struct _utimbuf TclWinProcs::LPVOID

Definition at line 110 of file tclWinInt.h.TclWinProcs::LPVOID

Definition at line 104 of file tclWinInt.h.TCHAR TclWinProcs::LPVOID

Definition at line 70 of file tclWinInt.h.DWORD TclWinProcs::nBufferLength

Definition at line 79 of file tclWinInt.h.SECURITY_INFORMATION PSECURITY_DESCRIPTOR DWORD TclWinProcs::nLength

Definition at line 122 of file tclWinInt.h.LPVOID DWORD TclWinProcs::nNumberOfCharsToRead

Definition at line 145 of file tclWinInt.h.const VOID DWORD TclWinProcs::nNumberOfCharsToWrite

Definition at line 150 of file tclWinInt.h.DWORD BOOL TclWinProcs::OpenAsSelf

Definition at line 129 of file tclWinInt.h.HANDLE DWORD PGENERIC_MAPPING PPRIVILEGE_SET TclWinProcs::PrivilegeSet

Definition at line 135 of file tclWinInt.h.HANDLE DWORD PGENERIC_MAPPING PPRIVILEGE_SET LPDWORD TclWinProcs::PrivilegeSetLength

Definition at line 135 of file tclWinInt.h.SECURITY_INFORMATION PSECURITY_DESCRIPTOR TclWinProcs::pSecurityDescriptor

Definition at line 122 of file tclWinInt.h.SECURITY_INFORMATION TclWinProcs::RequestedInformation

Definition at line 122 of file tclWinInt.h.DWORD BOOL PHANDLE TclWinProcs::TokenHandle

Definition at line 129 of file tclWinInt.h.struct _utimbuf TclWinProcs::UINT

Definition at line 110 of file tclWinInt.h.struct _utimbuf* TclWinProcs::UINT

Definition at line 110 of file tclWinInt.h.CONST TCHAR TclWinProcs::UINT

Definition at line 83 of file tclWinInt.h.int TclWinProcs::useWide

Definition at line 62 of file tclWinInt.h.
Referenced by ConvertFileNameFormat(), DoRenameFile(), NativeCreateNativeRep(), NativeIsExec(), TclNativeDupInternalRep(), TclpGetCwd(), TclpMatchInDirectory(), TempFileName(), and TraverseWinTree().
The documentation for this struct was generated from the following file:
win/tclWinInt.h

TcpState Struct Reference

Detailed Description

Definition at line 66 of file tclMacSock.c.Public Attributes
TCPiopb pb
ProcessSerialNumber psn
StreamPtr tcpStream
int port
int flags
int checkMask
int watchMask
Tcl_TcpAcceptProc * acceptProc
ClientData acceptProcData
wdsEntry dataSegment [2]
rdsEntry rdsarray [5+1]
Tcl_Channel channel
int writeBufferSize
void * writeBuffer
TcpState * nextPtr
int fd
Tcl_TcpAcceptProc * acceptProc

Member Data Documentation
Tcl_TcpAcceptProc* TcpState::acceptProc

Definition at line 194 of file tclUnixChan.c.Tcl_TcpAcceptProc* TcpState::acceptProc

Definition at line 79 of file tclMacSock.c.
Referenced by TcpAccept().ClientData TcpState::acceptProcData

Definition at line 80 of file tclMacSock.c.
Referenced by TcpAccept().Tcl_Channel TcpState::channel

Definition at line 84 of file tclMacSock.c.
Referenced by TcpAccept().int TcpState::checkMask

Definition at line 74 of file tclMacSock.c.wdsEntry TcpState::dataSegment[2]

Definition at line 81 of file tclMacSock.c.int TcpState::fd

Definition at line 191 of file tclUnixChan.c.
Referenced by TcpAccept().int TcpState::flags

Definition at line 72 of file tclMacSock.c.
Referenced by TcpAccept().struct TcpState* TcpState::nextPtr

Definition at line 88 of file tclMacSock.c.
Referenced by FreeSocketInfo(), and SocketCheckProc().TCPiopb TcpState::pb

Definition at line 67 of file tclMacSock.c.int TcpState::port

Definition at line 71 of file tclMacSock.c.ProcessSerialNumber TcpState::psn

Definition at line 69 of file tclMacSock.c.rdsEntry TcpState::rdsarray[5+1]

Definition at line 82 of file tclMacSock.c.StreamPtr TcpState::tcpStream

Definition at line 70 of file tclMacSock.c.
Referenced by TcpAccept().int TcpState::watchMask

Definition at line 77 of file tclMacSock.c.void* TcpState::writeBuffer

Definition at line 87 of file tclMacSock.c.int TcpState::writeBufferSize

Definition at line 85 of file tclMacSock.c.
The documentation for this struct was generated from the following files:
mac/tclMacSock.c
unix/tclUnixChan.c

TestAsyncHandler Struct Reference

Detailed Description

Definition at line 56 of file tclTest.c.Public Attributes
int id
Tcl_AsyncHandler handler
char * command
TestAsyncHandler * nextPtr

Member Data Documentation
char* TestAsyncHandler::command

Definition at line 59 of file tclTest.c.
Referenced by AsyncHandlerProc(), and TestasyncCmd().Tcl_AsyncHandler TestAsyncHandler::handler

Definition at line 58 of file tclTest.c.
Referenced by TestasyncCmd().int TestAsyncHandler::id

Definition at line 57 of file tclTest.c.
Referenced by TestasyncCmd().struct TestAsyncHandler* TestAsyncHandler::nextPtr

Definition at line 61 of file tclTest.c.
Referenced by TestasyncCmd().
The documentation for this struct was generated from the following file:
generic/tclTest.c

TestEvent Struct Reference

Detailed Description

Definition at line 118 of file tclTest.c.Public Attributes
Tcl_Event header
Tcl_Interp * interp
Tcl_Obj * command
Tcl_Obj * tag

Member Data Documentation
Tcl_Obj* TestEvent::command

Definition at line 121 of file tclTest.c.
Referenced by TesteventDeleteProc(), TesteventObjCmd(), and TesteventProc().Tcl_Event TestEvent::header

Definition at line 119 of file tclTest.c.
Referenced by TesteventObjCmd().Tcl_Interp* TestEvent::interp

Definition at line 120 of file tclTest.c.
Referenced by TesteventObjCmd(), and TesteventProc().Tcl_Obj* TestEvent::tag

Definition at line 122 of file tclTest.c.
Referenced by TesteventDeleteProc(), TesteventObjCmd(), and TesteventProc().
The documentation for this struct was generated from the following file:
generic/tclTest.c

TestString Struct Reference

Detailed Description

Definition at line 62 of file tclTestObj.c.Public Attributes
int numChars
size_t allocated
size_t uallocated
Tcl_UniChar unicode [2]

Member Data Documentation
size_t TestString::allocated

Definition at line 64 of file tclTestObj.c.
Referenced by TeststringobjCmd().int TestString::numChars

Definition at line 63 of file tclTestObj.c.size_t TestString::uallocated

Definition at line 65 of file tclTestObj.c.
Referenced by TeststringobjCmd().Tcl_UniChar TestString::unicode[2]

Definition at line 66 of file tclTestObj.c.
The documentation for this struct was generated from the following file:
generic/tclTestObj.c

ThreadSpecificData Struct Reference

Detailed Description

Definition at line 49 of file tclAsync.c.Public Attributes
AsyncHandler * firstHandler
AsyncHandler * lastHandler
int asyncReady
int asyncActive
Tcl_Mutex asyncMutex
int initialized
Tcl_Obj * macRootPatternPtr
NextChannelHandler * nestedHandlerPtr
ChannelState * firstCSPtr
Tcl_Channel stdinChannel
int stdinInitialized
Tcl_Channel stdoutChannel
int stdoutInitialized
Tcl_Channel stderrChannel
int stderrInitialized
Tcl_Event * firstEventPtr
Tcl_Event * lastEventPtr
Tcl_Event * markerEventPtr
Tcl_Mutex queueMutex
int serviceMode
int blockTimeSet
Tcl_Time blockTime
int inTraversal
EventSource * firstEventSourcePtr
Tcl_ThreadId threadId
ClientData clientData
ThreadSpecificData * nextPtr
char * patterns [NUM_REGEXPS]
int patLengths [NUM_REGEXPS]
TclRegexp * regexps [NUM_REGEXPS]
TimerHandler * firstTimerHandlerPtr
int lastTimerId
int timerPending
IdleHandler * idleList
IdleHandler * lastIdlePtr
int idleGeneration
int afterId
FileState * firstFilePtr
TcpState * socketList
FileHandler * firstFileHandlerPtr
SelectMasks checkMasks
SelectMasks readyMasks
int numFdBits
tm gmtime_buf
tm localtime_buf
FileInfo * firstFilePtr
ConsoleInfo * firstConsolePtr
Conversation * currentConversations
RegisteredInterp * interpListPtr
CRITICAL_SECTION crit
DWORD thread
HANDLE event
int pending
HWND hwnd
int timeout
int timerActive
PipeInfo * firstPipePtr
SerialInfo * firstSerialPtr
HANDLE socketThread
HANDLE readyEvent
HANDLE socketListLock
SocketInfo * socketList
char tzName [64]
tm tm

Member Data Documentation
int ThreadSpecificData::afterId

Definition at line 111 of file tclTimer.c.
Referenced by Tcl_AfterObjCmd().int ThreadSpecificData::asyncActive

Definition at line 73 of file tclAsync.c.
Referenced by Tcl_AsyncInvoke(), and Tcl_AsyncMark().Tcl_Mutex ThreadSpecificData::asyncMutex

Definition at line 75 of file tclAsync.c.
Referenced by Tcl_AsyncCreate(), Tcl_AsyncDelete(), Tcl_AsyncInvoke(), Tcl_AsyncMark(), and TclFinalizeAsync().int ThreadSpecificData::asyncReady

Definition at line 65 of file tclAsync.c.
Referenced by Tcl_AsyncInvoke(), Tcl_AsyncMark(), and Tcl_AsyncReady().Tcl_Time ThreadSpecificData::blockTime

Definition at line 61 of file tclNotify.c.
Referenced by Tcl_DoOneEvent(), Tcl_ServiceAll(), and Tcl_SetMaxBlockTime().int ThreadSpecificData::blockTimeSet

Definition at line 59 of file tclNotify.c.
Referenced by Tcl_DoOneEvent(), Tcl_ServiceAll(), and Tcl_SetMaxBlockTime().SelectMasks ThreadSpecificData::checkMasks

Definition at line 81 of file tclUnixNotfy.c.
Referenced by Tcl_CreateFileHandler(), Tcl_DeleteFileHandler(), and Tcl_WaitForEvent().ClientData ThreadSpecificData::clientData

Definition at line 69 of file tclNotify.c.
Referenced by TCL_DECLARE_MUTEX(), Tcl_ThreadAlert(), and TclFinalizeNotifier().CRITICAL_SECTION ThreadSpecificData::crit

Definition at line 33 of file tclWinNotify.c.
Referenced by NotifierProc(), Tcl_AlertNotifier(), TCL_DECLARE_MUTEX(), and Tcl_FinalizeNotifier().Conversation* ThreadSpecificData::currentConversations

Definition at line 56 of file tclWinDde.c.
Referenced by DdeServerProc().HANDLE ThreadSpecificData::event

Definition at line 36 of file tclWinNotify.c.
Referenced by Tcl_AlertNotifier(), TCL_DECLARE_MUTEX(), Tcl_FinalizeNotifier(), and Tcl_WaitForEvent().ConsoleInfo* ThreadSpecificData::firstConsolePtr

Definition at line 120 of file tclWinConsole.c.
Referenced by ConsoleCheckProc(), ConsoleCloseProc(), ConsoleEventProc(), ConsoleInit(), ConsoleSetupProc(), and ConsoleWatchProc().ChannelState* ThreadSpecificData::firstCSPtr

Definition at line 47 of file tclIO.c.
Referenced by CloseChannel(), Tcl_CutChannel(), Tcl_IsChannelExisting(), Tcl_SpliceChannel(), Tcl_StackChannel(), and TclFinalizeIOSubsystem().Tcl_Event* ThreadSpecificData::firstEventPtr

Definition at line 51 of file tclNotify.c.
Referenced by Tcl_DeleteEvents(), Tcl_ServiceEvent(), and TclFinalizeNotifier().EventSource* ThreadSpecificData::firstEventSourcePtr

Definition at line 65 of file tclNotify.c.
Referenced by Tcl_CreateEventSource(), Tcl_DeleteEventSource(), Tcl_DoOneEvent(), and Tcl_ServiceAll().FileHandler* ThreadSpecificData::firstFileHandlerPtr

Definition at line 78 of file tclUnixNotfy.c.
Referenced by FileHandlerEventProc(), Tcl_CreateFileHandler(), Tcl_DeleteFileHandler(), and Tcl_WaitForEvent().FileInfo* ThreadSpecificData::firstFilePtr

Definition at line 53 of file tclWinChan.c.FileState* ThreadSpecificData::firstFilePtr

Definition at line 54 of file tclMacChan.c.
Referenced by FileCheckProc(), FileCloseProc(), FileEventProc(), FileInit(), FileSetupProc(), FileThreadActionProc(), OpenFileChannel(), Tcl_MakeFileChannel(), TclWinFlushDirtyChannels(), and TclWinOpenFileChannel().AsyncHandler* ThreadSpecificData::firstHandler

Definition at line 54 of file tclAsync.c.
Referenced by Tcl_AsyncCreate(), Tcl_AsyncDelete(), and Tcl_AsyncInvoke().PipeInfo* ThreadSpecificData::firstPipePtr

Definition at line 159 of file tclWinPipe.c.
Referenced by PipeCheckProc(), PipeClose2Proc(), PipeEventProc(), PipeInit(), PipeSetupProc(), and PipeWatchProc().SerialInfo* ThreadSpecificData::firstSerialPtr

Definition at line 134 of file tclWinSerial.c.
Referenced by SerialCheckProc(), SerialCloseProc(), SerialEventProc(), SerialExitHandler(), SerialInit(), SerialSetupProc(), and SerialWatchProc().TimerHandler* ThreadSpecificData::firstTimerHandlerPtr

Definition at line 99 of file tclTimer.c.
Referenced by Tcl_CreateTimerHandler(), Tcl_DeleteTimerHandler(), TimerCheckProc(), TimerExitProc(), TimerHandlerEventProc(), and TimerSetupProc().struct tm ThreadSpecificData::gmtime_buf

Definition at line 29 of file tclUnixTime.c.
Referenced by TclpGmtime().HWND ThreadSpecificData::hwnd

Definition at line 40 of file tclWinNotify.c.
Referenced by CreateSocket(), InitSockets(), SocketEventProc(), SocketThread(), Tcl_AlertNotifier(), TCL_DECLARE_MUTEX(), Tcl_FinalizeNotifier(), Tcl_MakeTcpClientChannel(), Tcl_ServiceModeHook(), Tcl_SetTimer(), TclpFinalizeSockets(), TcpAccept(), TcpInputProc(), TcpOutputProc(), TcpThreadActionProc(), and WaitForSocketEvent().int ThreadSpecificData::idleGeneration

Definition at line 105 of file tclTimer.c.
Referenced by Tcl_DoWhenIdle(), and TclServiceIdle().IdleHandler* ThreadSpecificData::idleList

Definition at line 103 of file tclTimer.c.
Referenced by Tcl_CancelIdleCall(), Tcl_DoWhenIdle(), TclServiceIdle(), and TimerSetupProc().int ThreadSpecificData::initialized

Definition at line 51 of file tclFileName.c.
Referenced by CompileRegexp(), FileNameCleanup(), FileNameInit(), FinalizeRegexp(), FsThrExitProc(), TCL_DECLARE_MUTEX(), TclFinalizeNotifier(), and TclFSCwdPointerEquals().RegisteredInterp* ThreadSpecificData::interpListPtr

Definition at line 59 of file tclWinDde.c.
Referenced by DdeServerProc(), DdeSetServerName(), DeleteProc(), Initialize(), and Tcl_DdeObjCmd().int ThreadSpecificData::inTraversal

Definition at line 63 of file tclNotify.c.
Referenced by Tcl_DoOneEvent(), Tcl_ServiceAll(), and Tcl_SetMaxBlockTime().Tcl_Event* ThreadSpecificData::lastEventPtr

Definition at line 52 of file tclNotify.c.
Referenced by Tcl_DeleteEvents(), Tcl_ServiceEvent(), and TclFinalizeNotifier().AsyncHandler* ThreadSpecificData::lastHandler

Definition at line 56 of file tclAsync.c.
Referenced by Tcl_AsyncCreate(), and Tcl_AsyncDelete().IdleHandler* ThreadSpecificData::lastIdlePtr

Definition at line 104 of file tclTimer.c.
Referenced by Tcl_CancelIdleCall(), Tcl_DoWhenIdle(), and TclServiceIdle().int ThreadSpecificData::lastTimerId

Definition at line 100 of file tclTimer.c.
Referenced by Tcl_CreateTimerHandler(), and TimerHandlerEventProc().struct tm ThreadSpecificData::localtime_buf

Definition at line 30 of file tclUnixTime.c.
Referenced by TclpLocaltime().Tcl_Obj* ThreadSpecificData::macRootPatternPtr

Definition at line 52 of file tclFileName.c.
Referenced by FileNameCleanup(), FileNameInit(), SplitMacPath(), and TclpGetNativePathType().Tcl_Event* ThreadSpecificData::markerEventPtr

Definition at line 53 of file tclNotify.c.
Referenced by Tcl_DeleteEvents(), and Tcl_ServiceEvent().NextChannelHandler* ThreadSpecificData::nestedHandlerPtr

Definition at line 41 of file tclIO.c.
Referenced by Tcl_ClearChannelHandlers(), Tcl_DeleteChannelHandler(), and Tcl_NotifyChannel().struct ThreadSpecificData* ThreadSpecificData::nextPtr

Definition at line 72 of file tclNotify.c.
Referenced by TCL_DECLARE_MUTEX(), Tcl_ThreadAlert(), Tcl_ThreadQueueEvent(), Tcl_WaitForEvent(), and TclFinalizeNotifier().int ThreadSpecificData::numFdBits

Definition at line 88 of file tclUnixNotfy.c.
Referenced by Tcl_CreateFileHandler(), Tcl_DeleteFileHandler(), and Tcl_WaitForEvent().int ThreadSpecificData::patLengths[NUM_REGEXPS]

Definition at line 76 of file tclRegexp.c.
Referenced by CompileRegexp().char* ThreadSpecificData::patterns[NUM_REGEXPS]

Definition at line 72 of file tclRegexp.c.
Referenced by CompileRegexp(), and FinalizeRegexp().int ThreadSpecificData::pending

Definition at line 38 of file tclWinNotify.c.
Referenced by NotifierProc(), Tcl_AlertNotifier(), and TCL_DECLARE_MUTEX().Tcl_Mutex ThreadSpecificData::queueMutex

Definition at line 55 of file tclNotify.c.
Referenced by Tcl_DeleteEvents(), Tcl_ServiceEvent(), and TclFinalizeNotifier().HANDLE ThreadSpecificData::readyEvent

Definition at line 219 of file tclWinSock.c.
Referenced by InitSockets(), SocketProc(), SocketThread(), TclpFinalizeSockets(), and WaitForSocketEvent().SelectMasks ThreadSpecificData::readyMasks

Definition at line 85 of file tclUnixNotfy.c.
Referenced by Tcl_WaitForEvent().struct TclRegexp* ThreadSpecificData::regexps[NUM_REGEXPS]

Definition at line 79 of file tclRegexp.c.
Referenced by CompileRegexp(), and FinalizeRegexp().int ThreadSpecificData::serviceMode

Definition at line 57 of file tclNotify.c.
Referenced by Tcl_DoOneEvent(), Tcl_GetServiceMode(), Tcl_ServiceAll(), and Tcl_SetServiceMode().SocketInfo* ThreadSpecificData::socketList

Definition at line 224 of file tclWinSock.c.TcpState* ThreadSpecificData::socketList

Definition at line 258 of file tclMacSock.c.
Referenced by CleanUpExitProc(), ClearZombieSockets(), FreeSocketInfo(), InitSockets(), NewSocketInfo(), SocketCheckProc(), SocketEventProc(), SocketProc(), SocketSetupProc(), and TcpThreadActionProc().HANDLE ThreadSpecificData::socketListLock

Definition at line 223 of file tclWinSock.c.
Referenced by InitSockets(), SocketCheckProc(), SocketEventProc(), SocketProc(), SocketSetupProc(), TclpFinalizeSockets(), and TcpThreadActionProc().HANDLE ThreadSpecificData::socketThread

Definition at line 217 of file tclWinSock.c.
Referenced by InitSockets(), and TclpFinalizeSockets().Tcl_Channel ThreadSpecificData::stderrChannel

Definition at line 67 of file tclIO.c.
Referenced by CheckForStdChannelsBeingClosed(), StdIOClose(), Tcl_CreateChannel(), Tcl_GetChannelNamesEx(), Tcl_GetStdChannel(), Tcl_IsChannelExisting(), Tcl_IsStandardChannel(), Tcl_SetStdChannel(), and TclFinalizeIOSubsystem().int ThreadSpecificData::stderrInitialized

Definition at line 68 of file tclIO.c.
Referenced by CheckForStdChannelsBeingClosed(), Tcl_CreateChannel(), Tcl_GetStdChannel(), and Tcl_SetStdChannel().Tcl_Channel ThreadSpecificData::stdinChannel

Definition at line 63 of file tclIO.c.
Referenced by CheckForStdChannelsBeingClosed(), StdIOClose(), Tcl_CreateChannel(), Tcl_GetChannelNamesEx(), Tcl_GetStdChannel(), Tcl_IsChannelExisting(), Tcl_IsStandardChannel(), Tcl_SetStdChannel(), and TclFinalizeIOSubsystem().int ThreadSpecificData::stdinInitialized

Definition at line 64 of file tclIO.c.
Referenced by CheckForStdChannelsBeingClosed(), Tcl_CreateChannel(), Tcl_GetStdChannel(), and Tcl_SetStdChannel().Tcl_Channel ThreadSpecificData::stdoutChannel

Definition at line 65 of file tclIO.c.
Referenced by CheckForStdChannelsBeingClosed(), StdIOClose(), Tcl_CreateChannel(), Tcl_GetChannelNamesEx(), Tcl_GetStdChannel(), Tcl_IsChannelExisting(), Tcl_IsStandardChannel(), Tcl_SetStdChannel(), and TclFinalizeIOSubsystem().int ThreadSpecificData::stdoutInitialized

Definition at line 66 of file tclIO.c.
Referenced by CheckForStdChannelsBeingClosed(), Tcl_CreateChannel(), Tcl_GetStdChannel(), and Tcl_SetStdChannel().DWORD ThreadSpecificData::thread

Definition at line 34 of file tclWinNotify.c.
Referenced by TCL_DECLARE_MUTEX().Tcl_ThreadId ThreadSpecificData::threadId

Definition at line 68 of file tclNotify.c.
Referenced by InitSockets(), SocketProc(), TCL_DECLARE_MUTEX(), Tcl_ThreadAlert(), and Tcl_ThreadQueueEvent().int ThreadSpecificData::timeout

Definition at line 41 of file tclWinNotify.c.
Referenced by Tcl_SetTimer().int ThreadSpecificData::timerActive

Definition at line 42 of file tclWinNotify.c.
Referenced by TCL_DECLARE_MUTEX(), and Tcl_SetTimer().int ThreadSpecificData::timerPending

Definition at line 102 of file tclTimer.c.
Referenced by TimerCheckProc(), TimerHandlerEventProc(), and TimerSetupProc().struct tm ThreadSpecificData::tm

Definition at line 41 of file tclWinTime.c.
Referenced by ComputeGMT().char ThreadSpecificData::tzName[64]

Definition at line 40 of file tclWinTime.c.
Referenced by TclpGetTZName().
The documentation for this struct was generated from the following files:
generic/tclAsync.c
generic/tclFileName.c
generic/tclIO.c
generic/tclNotify.c
generic/tclRegexp.c
generic/tclTimer.c
mac/tclMacChan.c
mac/tclMacSock.c
unix/tclUnixNotfy.c
unix/tclUnixTime.c
win/tclWinChan.c
win/tclWinConsole.c
win/tclWinDde.c
win/tclWinNotify.c
win/tclWinPipe.c
win/tclWinSerial.c
win/tclWinSock.c
win/tclWinTime.c

TimeInfo Struct Reference

Detailed Description

Definition at line 49 of file tclWinTime.c.Public Attributes
CRITICAL_SECTION cs
int initialized
int perfCounterAvailable
HANDLE calibrationThread
HANDLE readyEvent
HANDLE exitEvent
LARGE_INTEGER nominalFreq
ULARGE_INTEGER fileTimeLastCall
LARGE_INTEGER perfCounterLastCall
LARGE_INTEGER curCounterFreq
Tcl_WideUInt fileTimeSample [SAMPLES]
Tcl_WideInt perfCounterSample [SAMPLES]
int sampleNo

Member Data Documentation
HANDLE TimeInfo::calibrationThread

Definition at line 59 of file tclWinTime.c.
Referenced by StopCalibration(), and Tcl_GetTime().CRITICAL_SECTION TimeInfo::cs

Definition at line 51 of file tclWinTime.c.
Referenced by Tcl_GetTime(), and UpdateTimeEachSecond().LARGE_INTEGER TimeInfo::curCounterFreq

Definition at line 86 of file tclWinTime.c.
Referenced by CalibrationThread(), Tcl_GetTime(), and UpdateTimeEachSecond().HANDLE TimeInfo::exitEvent

Definition at line 67 of file tclWinTime.c.
Referenced by CalibrationThread(), StopCalibration(), and Tcl_GetTime().ULARGE_INTEGER TimeInfo::fileTimeLastCall

Definition at line 84 of file tclWinTime.c.
Referenced by CalibrationThread(), Tcl_GetTime(), and UpdateTimeEachSecond().Tcl_WideUInt TimeInfo::fileTimeSample[SAMPLES]

Definition at line 92 of file tclWinTime.c.
Referenced by AccumulateSample(), and ResetCounterSamples().int TimeInfo::initialized

Definition at line 53 of file tclWinTime.c.
Referenced by Tcl_GetTime().LARGE_INTEGER TimeInfo::nominalFreq

Definition at line 71 of file tclWinTime.c.
Referenced by AccumulateSample(), and Tcl_GetTime().int TimeInfo::perfCounterAvailable

Definition at line 56 of file tclWinTime.c.
Referenced by Tcl_GetTime().LARGE_INTEGER TimeInfo::perfCounterLastCall

Definition at line 85 of file tclWinTime.c.
Referenced by CalibrationThread(), Tcl_GetTime(), and UpdateTimeEachSecond().Tcl_WideInt TimeInfo::perfCounterSample[SAMPLES]

Definition at line 94 of file tclWinTime.c.
Referenced by AccumulateSample(), and ResetCounterSamples().HANDLE TimeInfo::readyEvent

Definition at line 62 of file tclWinTime.c.
Referenced by CalibrationThread(), and Tcl_GetTime().int TimeInfo::sampleNo

Definition at line 96 of file tclWinTime.c.
Referenced by AccumulateSample(), and ResetCounterSamples().
The documentation for this struct was generated from the following file:
win/tclWinTime.c

TimerHandler Struct Reference

Detailed Description

Definition at line 24 of file tclTimer.c.Public Attributes
Tcl_Time time
Tcl_TimerProc * proc
ClientData clientData
Tcl_TimerToken token
TimerHandler * nextPtr

Member Data Documentation
ClientData TimerHandler::clientData

Definition at line 27 of file tclTimer.c.
Referenced by Tcl_CreateTimerHandler(), and TimerHandlerEventProc().struct TimerHandler* TimerHandler::nextPtr

Definition at line 30 of file tclTimer.c.
Referenced by Tcl_CreateTimerHandler(), Tcl_DeleteTimerHandler(), TimerExitProc(), and TimerHandlerEventProc().Tcl_TimerProc* TimerHandler::proc

Definition at line 26 of file tclTimer.c.
Referenced by Tcl_CreateTimerHandler(), and TimerHandlerEventProc().Tcl_Time TimerHandler::time

Definition at line 25 of file tclTimer.c.
Referenced by Tcl_CreateTimerHandler(), TimerCheckProc(), TimerHandlerEventProc(), and TimerSetupProc().Tcl_TimerToken TimerHandler::token

Definition at line 28 of file tclTimer.c.
Referenced by Tcl_CreateTimerHandler(), Tcl_DeleteTimerHandler(), and TimerHandlerEventProc().
The documentation for this struct was generated from the following file:
generic/tclTimer.c

TMInfo Struct Reference

Detailed Description

Definition at line 25 of file tclMacInterupt.c.Public Attributes
TMTask tmTask
ProcessSerialNumber psn
Point lastPoint
Point newPoint
long currentA5
long ourA5
int installed

Member Data Documentation
long TMInfo::currentA5

Definition at line 30 of file tclMacInterupt.c.int TMInfo::installed

Definition at line 32 of file tclMacInterupt.c.
Referenced by CleanUpExitProc(), and TclMacStartTimer().Point TMInfo::lastPoint

Definition at line 28 of file tclMacInterupt.c.Point TMInfo::newPoint

Definition at line 29 of file tclMacInterupt.c.long TMInfo::ourA5

Definition at line 31 of file tclMacInterupt.c.ProcessSerialNumber TMInfo::psn

Definition at line 27 of file tclMacInterupt.c.
Referenced by SleepTimerProc(), and TclMacStartTimer().TMTask TMInfo::tmTask

Definition at line 26 of file tclMacInterupt.c.
Referenced by TclMacStartTimer(), and TclMacTimerExpired().
The documentation for this struct was generated from the following file:
mac/tclMacInterupt.c

Trace Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 702 of file tclInt.h.Public Attributes
int level
Tcl_CmdObjTraceProc * proc
ClientData clientData
Trace * nextPtr
int flags
Tcl_CmdObjTraceDeleteProc * delProc

Member Data Documentation
ClientData Trace::clientData

Definition at line 706 of file tclInt.h.
Referenced by Tcl_CreateObjTrace(), and Tcl_DeleteTrace().Tcl_CmdObjTraceDeleteProc* Trace::delProc

Definition at line 710 of file tclInt.h.
Referenced by Tcl_CreateObjTrace(), and Tcl_DeleteTrace().int Trace::flags

Definition at line 708 of file tclInt.h.
Referenced by Tcl_CreateObjTrace(), Tcl_DeleteTrace(), and TclCheckInterpTraces().int Trace::level

Definition at line 703 of file tclInt.h.
Referenced by Tcl_CreateObjTrace(), Tcl_EvalObjv(), TclCheckInterpTraces(), and TclExecuteByteCode().struct Trace* Trace::nextPtr

Definition at line 707 of file tclInt.h.
Referenced by Tcl_CreateObjTrace(), Tcl_DeleteTrace(), Tcl_EvalObjv(), TclCheckInterpTraces(), and TclExecuteByteCode().Tcl_CmdObjTraceProc* Trace::proc

Definition at line 705 of file tclInt.h.
Referenced by Tcl_CreateObjTrace().
The documentation for this struct was generated from the following file:
generic/tclInt.h

TraceCommandInfo Struct Reference

Detailed Description

Definition at line 49 of file tclCmdMZ.c.Public Attributes
int flags
size_t length
Tcl_Trace stepTrace
int startLevel
char * startCmd
int curFlags
int curCode
int refCount
char command [4]

Member Data Documentation
char TraceCommandInfo::command[4]

Definition at line 67 of file tclCmdMZ.c.
Referenced by TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TraceCommandProc(), and TraceExecutionProc().int TraceCommandInfo::curCode

Definition at line 62 of file tclCmdMZ.c.
Referenced by TclCheckExecutionTraces(), TclCheckInterpTraces(), and TraceExecutionProc().int TraceCommandInfo::curFlags

Definition at line 61 of file tclCmdMZ.c.
Referenced by TclCheckExecutionTraces(), TclCheckInterpTraces(), and TraceExecutionProc().int TraceCommandInfo::flags

Definition at line 50 of file tclCmdMZ.c.
Referenced by TclCheckExecutionTraces(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TraceCommandProc(), and TraceExecutionProc().size_t TraceCommandInfo::length

Definition at line 52 of file tclCmdMZ.c.
Referenced by TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TraceCommandProc(), and TraceExecutionProc().int TraceCommandInfo::refCount

Definition at line 63 of file tclCmdMZ.c.
Referenced by CommandObjTraceDeleted(), TclCheckExecutionTraces(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TraceCommandProc(), and TraceExecutionProc().char* TraceCommandInfo::startCmd

Definition at line 58 of file tclCmdMZ.c.
Referenced by TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TraceCommandProc(), and TraceExecutionProc().int TraceCommandInfo::startLevel

Definition at line 55 of file tclCmdMZ.c.
Referenced by TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), and TraceExecutionProc().Tcl_Trace TraceCommandInfo::stepTrace

Definition at line 53 of file tclCmdMZ.c.
Referenced by TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TraceCommandProc(), and TraceExecutionProc().
The documentation for this struct was generated from the following file:
generic/tclCmdMZ.c

TraceVarInfo Struct Reference

Detailed Description

Definition at line 29 of file tclCmdMZ.c.Public Attributes
int flags
size_t length
char command [4]

Member Data Documentation
char TraceVarInfo::command[4]

Definition at line 33 of file tclCmdMZ.c.
Referenced by Tcl_TraceObjCmd(), TclTraceVariableObjCmd(), and TraceVarProc().int TraceVarInfo::flags

Definition at line 30 of file tclCmdMZ.c.
Referenced by Tcl_TraceObjCmd(), TclTraceVariableObjCmd(), and TraceVarProc().size_t TraceVarInfo::length

Definition at line 32 of file tclCmdMZ.c.
Referenced by TclTraceVariableObjCmd(), and TraceVarProc().
The documentation for this struct was generated from the following file:
generic/tclCmdMZ.c

TransformChannelData Struct Reference

Detailed Description

Definition at line 192 of file tclIOGT.c.Public Attributes
Tcl_Channel self
int readIsFlushed
int flags
int watchMask
int mode
Tcl_TimerToken timer
int maxRead
Tcl_Interp * interp
Tcl_Obj * command
ResultBuffer result

Member Data Documentation
Tcl_Obj* TransformChannelData::command

Definition at line 219 of file tclIOGT.c.
Referenced by TclChannelTransform(), and TransformCloseProc().int TransformChannelData::flags

Definition at line 202 of file tclIOGT.c.
Referenced by TclChannelTransform(), TransformBlockModeProc(), and TransformInputProc().Tcl_Interp* TransformChannelData::interp

Definition at line 216 of file tclIOGT.c.
Referenced by TclChannelTransform().int TransformChannelData::maxRead

Definition at line 213 of file tclIOGT.c.
Referenced by TclChannelTransform(), and TransformInputProc().int TransformChannelData::mode

Definition at line 204 of file tclIOGT.c.
Referenced by TclChannelTransform(), TransformCloseProc(), TransformSeekProc(), and TransformWideSeekProc().int TransformChannelData::readIsFlushed

Definition at line 200 of file tclIOGT.c.
Referenced by TclChannelTransform(), TransformCloseProc(), and TransformInputProc().ResultBuffer TransformChannelData::result

Definition at line 220 of file tclIOGT.c.
Referenced by TclChannelTransform(), TransformChannelHandlerTimer(), TransformCloseProc(), TransformInputProc(), and TransformWatchProc().Tcl_Channel TransformChannelData::self

Definition at line 199 of file tclIOGT.c.
Referenced by TclChannelTransform(), TransformChannelHandlerTimer(), TransformGetFileHandleProc(), TransformGetOptionProc(), TransformInputProc(), TransformSeekProc(), TransformSetOptionProc(), TransformWatchProc(), and TransformWideSeekProc().Tcl_TimerToken TransformChannelData::timer

Definition at line 206 of file tclIOGT.c.
Referenced by TclChannelTransform(), TransformChannelHandlerTimer(), TransformCloseProc(), TransformNotifyProc(), and TransformWatchProc().int TransformChannelData::watchMask

Definition at line 203 of file tclIOGT.c.
Referenced by TclChannelTransform(), TransformChannelHandlerTimer(), and TransformWatchProc().
The documentation for this struct was generated from the following file:
generic/tclIOGT.c

tree Union Reference
#include <regguts.h>

Detailed Description

Definition at line 199 of file regguts.h.Public Attributes
colors colors
ptrs ptrs

Member Data Documentation
struct colors tree::colors

Definition at line 200 of file regguts.h.struct ptrs tree::ptrs

Definition at line 201 of file regguts.h.
The documentation for this union was generated from the following file:
generic/regguts.h

Var Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 414 of file tclInt.h.Public Attributes
union {
  Tcl_Obj * objPtr
  Tcl_HashTable * tablePtr
  Var * linkPtr
} value
char * name
Namespace * nsPtr
Tcl_HashEntry * hPtr
int refCount
VarTrace * tracePtr
ArraySearch * searchPtr
int flags

Member Data Documentation
int Var::flags

Definition at line 459 of file tclInt.h.
Referenced by DeleteArray(), TclDeleteCompiledLocalVars(), TclDeleteVars(), TclLookupArrayElement(), and UnsetVarStruct().Tcl_HashEntry* Var::hPtr

Definition at line 437 of file tclInt.h.
Referenced by DeleteArray(), TclDeleteCompiledLocalVars(), TclDeleteVars(), TclLookupArrayElement(), and UnsetVarStruct().struct Var* Var::linkPtr

Definition at line 422 of file tclInt.h.
Referenced by TclDeleteCompiledLocalVars(), and TclExecuteByteCode().char* Var::name

Definition at line 427 of file tclInt.h.
Referenced by TclExecuteByteCode(), and TclLookupSimpleVar().Namespace* Var::nsPtr

Definition at line 434 of file tclInt.h.
Referenced by ObjMakeUpvar(), and TclLookupArrayElement().Tcl_Obj* Var::objPtr

Definition at line 416 of file tclInt.h.
Referenced by DeleteArray(), TclExecuteByteCode(), and UnsetVarStruct().int Var::refCount

Definition at line 447 of file tclInt.h.
Referenced by DeleteArray(), FreeNsVarName(), ObjMakeUpvar(), Tcl_LappendObjCmd(), TclDeleteCompiledLocalVars(), TclDeleteVars(), TclInitCompiledLocals(), and UnsetVarStruct().ArraySearch* Var::searchPtr

Definition at line 457 of file tclInt.h.
Referenced by TclLookupArrayElement(), and UnsetVarStruct().Tcl_HashTable* Var::tablePtr

Definition at line 418 of file tclInt.h.
Referenced by TclLookupArrayElement().VarTrace* Var::tracePtr

Definition at line 455 of file tclInt.h.
Referenced by DeleteArray(), TclDeleteCompiledLocalVars(), TclDeleteVars(), TclExecuteByteCode(), TclPtrGetVar(), TclPtrSetVar(), TclVarTraceExists(), and UnsetVarStruct().union { ... }   Var::value

Referenced by DeleteArray(), TclDeleteCompiledLocalVars(), TclExecuteByteCode(), TclLookupArrayElement(), and UnsetVarStruct().
The documentation for this struct was generated from the following file:
generic/tclInt.h

vars Struct Reference

Detailed Description

Definition at line 196 of file regcomp.c.Public Attributes
regex_t * re
chr * now
chr * stop
chr * savenow
chr * savestop
int err
int cflags
int lasttype
int nexttype
chr nextvalue
int lexcon
int nsubexp
subre ** subs
size_t nsubs
subre * sub10 [10]
nfa * nfa
colormap * cm
color nlcolor
state * wordchrs
subre * tree
subre * treechain
subre * treefree
int ntree
cvec * cv
cvec * cv2
cvec * mcces
state * mccepbegin
state * mccepend
subre * lacons
int nlacons
regex_t * re
guts * g
int eflags
size_t nmatch
regmatch_t * pmatch
rm_detail_t * details
chr * start
chr * stop
regoff_t * mem
smalldfa dfa1
smalldfa dfa2

Member Data Documentation
int vars::cflags

Definition at line 203 of file regcomp.c.
Referenced by compile().struct colormap* vars::cm

Definition at line 213 of file regcomp.c.
Referenced by compile().struct cvec* vars::cv

Definition at line 220 of file regcomp.c.
Referenced by compile().struct cvec* vars::cv2

Definition at line 221 of file regcomp.c.
Referenced by compile().rm_detail_t* vars::details

Definition at line 102 of file regexec.c.
Referenced by exec().struct smalldfa vars::dfa1

Definition at line 107 of file regexec.c.struct smalldfa vars::dfa2

Definition at line 108 of file regexec.c.int vars::eflags

Definition at line 99 of file regexec.c.
Referenced by exec().int vars::err

Definition at line 202 of file regcomp.c.
Referenced by compile(), and exec().struct guts* vars::g

Definition at line 98 of file regexec.c.
Referenced by exec().struct subre* vars::lacons

Definition at line 226 of file regcomp.c.
Referenced by compile(), and newlacon().int vars::lasttype

Definition at line 204 of file regcomp.c.int vars::lexcon

Definition at line 207 of file regcomp.c.struct state* vars::mccepbegin

Definition at line 224 of file regcomp.c.struct state* vars::mccepend

Definition at line 225 of file regcomp.c.struct cvec* vars::mcces

Definition at line 222 of file regcomp.c.
Referenced by compile().regoff_t* vars::mem

Definition at line 106 of file regexec.c.
Referenced by exec().int vars::nexttype

Definition at line 205 of file regcomp.c.chr vars::nextvalue

Definition at line 206 of file regcomp.c.struct nfa* vars::nfa

Definition at line 212 of file regcomp.c.
Referenced by compile().int vars::nlacons

Definition at line 227 of file regcomp.c.
Referenced by compile().color vars::nlcolor

Definition at line 214 of file regcomp.c.
Referenced by compile().size_t vars::nmatch

Definition at line 100 of file regexec.c.
Referenced by exec().chr* vars::now

Definition at line 198 of file regcomp.c.
Referenced by compile().int vars::nsubexp

Definition at line 208 of file regcomp.c.
Referenced by compile().size_t vars::nsubs

Definition at line 210 of file regcomp.c.
Referenced by compile().int vars::ntree

Definition at line 219 of file regcomp.c.regmatch_t* vars::pmatch

Definition at line 101 of file regexec.c.
Referenced by exec().regex_t* vars::re

Definition at line 97 of file regexec.c.regex_t* vars::re

Definition at line 197 of file regcomp.c.
Referenced by compile(), and exec().chr* vars::savenow

Definition at line 200 of file regcomp.c.
Referenced by compile().chr* vars::savestop

Definition at line 201 of file regcomp.c.
Referenced by compile().chr* vars::start

Definition at line 103 of file regexec.c.
Referenced by exec().chr* vars::stop

Definition at line 104 of file regexec.c.chr* vars::stop

Definition at line 199 of file regcomp.c.
Referenced by compile(), and exec().struct subre* vars::sub10[10]

Definition at line 211 of file regcomp.c.
Referenced by compile().struct subre** vars::subs

Definition at line 209 of file regcomp.c.
Referenced by compile().struct subre* vars::tree

Definition at line 216 of file regcomp.c.
Referenced by compile().struct subre* vars::treechain

Definition at line 217 of file regcomp.c.
Referenced by compile().struct subre* vars::treefree

Definition at line 218 of file regcomp.c.
Referenced by compile().struct state* vars::wordchrs

Definition at line 215 of file regcomp.c.
Referenced by compile().
The documentation for this struct was generated from the following files:
generic/regcomp.c
generic/regexec.c

VarTrace Struct Reference
#include <tclInt.h>

Detailed Description

Definition at line 305 of file tclInt.h.Public Attributes
Tcl_VarTraceProc * traceProc
ClientData clientData
int flags
VarTrace * nextPtr

Member Data Documentation
ClientData VarTrace::clientData

Definition at line 308 of file tclInt.h.
Referenced by Tcl_TraceVar2(), Tcl_UntraceVar2(), Tcl_VarTraceInfo2(), and TclTraceVariableObjCmd().int VarTrace::flags

Definition at line 309 of file tclInt.h.
Referenced by CallVarTraces(), Tcl_TraceVar2(), Tcl_UntraceVar2(), and TclTraceVariableObjCmd().struct VarTrace* VarTrace::nextPtr

Definition at line 313 of file tclInt.h.
Referenced by CallVarTraces(), DeleteArray(), Tcl_TraceVar2(), Tcl_UntraceVar2(), Tcl_VarTraceInfo2(), TclDeleteNamespaceVars(), TclDeleteVars(), TclTraceVariableObjCmd(), and UnsetVarStruct().Tcl_VarTraceProc* VarTrace::traceProc

Definition at line 306 of file tclInt.h.
Referenced by Tcl_TraceVar2(), Tcl_UntraceVar2(), Tcl_VarTraceInfo2(), and TclTraceVariableObjCmd().
The documentation for this struct was generated from the following file:
generic/tclInt.h

WaitInfo Struct Reference

Detailed Description

Definition at line 34 of file waitpid.c.Public Attributes
pid_t pid
WAIT_STATUS_TYPE status
WaitInfo * nextPtr

Member Data Documentation
struct WaitInfo* WaitInfo::nextPtr

Definition at line 38 of file waitpid.c.
Referenced by waitpid().pid_t WaitInfo::pid

Definition at line 35 of file waitpid.c.WAIT_STATUS_TYPE WaitInfo::status

Definition at line 36 of file waitpid.c.
The documentation for this struct was generated from the following file:
compat/waitpid.c

WIN32_FIND_DATAT Union Reference
#include <tclWinInt.h>

Detailed Description

Definition at line 56 of file tclWinInt.h.Public Attributes
WIN32_FIND_DATAA a
WIN32_FIND_DATAW w

Member Data Documentation
WIN32_FIND_DATAA WIN32_FIND_DATAT::a

Definition at line 57 of file tclWinInt.h.
Referenced by ConvertFileNameFormat(), NativeStat(), TclpMatchInDirectory(), and TraverseWinTree().WIN32_FIND_DATAW WIN32_FIND_DATAT::w

Definition at line 58 of file tclWinInt.h.
Referenced by ConvertFileNameFormat(), TclpMatchInDirectory(), and TraverseWinTree().
The documentation for this union was generated from the following file:
win/tclWinInt.h

WinCondition Struct Reference

Detailed Description

Definition at line 123 of file tclWinThrd.c.Public Attributes
CRITICAL_SECTION condLock
ThreadSpecificData * firstPtr
ThreadSpecificData * lastPtr

Member Data Documentation
CRITICAL_SECTION WinCondition::condLock

Definition at line 124 of file tclWinThrd.c.struct ThreadSpecificData* WinCondition::firstPtr

Definition at line 125 of file tclWinThrd.c.struct ThreadSpecificData* WinCondition::lastPtr

Definition at line 126 of file tclWinThrd.c.
The documentation for this struct was generated from the following file:
win/tclWinThrd.c

YYSTYPE Union Reference

Detailed Description

Definition at line 120 of file tclDate.c.Public Attributes
time_t Number
enum _MERIDIAN Meridian

Member Data Documentation
enum _MERIDIAN YYSTYPE::Meridian

Definition at line 126 of file tclDate.c.
Referenced by LookupWord(), and TclDateparse().time_t YYSTYPE::Number

Definition at line 125 of file tclDate.c.
Referenced by LookupWord(), TclDatelex(), and TclDateparse().
The documentation for this union was generated from the following file:
generic/tclDate.c

Database File Documentation
compat/dirent.h File Reference
#include <sys/dir.h>
Defines
#define dirent  direct

Define Documentation
#define dirent  direct

Definition at line 21 of file dirent.h.

compat/dirent2.h File Reference
#include <tcl.h>
Classes
struct dirent
struct _dirdesc
Defines
#define MAXNAMLEN  255
#define DIRBLKSIZ  512
Typedefs
typedef _dirdesc DIR
Functions
void closedir _ANSI_ARGS_ ((DIR *dirp))
DIR *opendir _ANSI_ARGS_ ((char *name))

Define Documentation
#define DIRBLKSIZ  512

Definition at line 29 of file dirent2.h.
Referenced by readdir().#define MAXNAMLEN  255

Definition at line 28 of file dirent2.h.
Typedef Documentation
typedef struct _dirdesc  DIR

Function Documentation
DIR* opendir _ANSI_ARGS_ ((char *name))
void closedir _ANSI_ARGS_ ((DIR *dirp))

compat/dlfcn.h File Reference
#include <tcl.h>
Classes
struct dl_info
Defines
#define RTLD_LAZY  1
#define RTLD_NOW  2
#define RTLD_GLOBAL  0x100
Functions
VOID *dlopen _ANSI_ARGS_ ((const char *path, int mode))
VOID *dlsym _ANSI_ARGS_ ((void *handle, const char *symbol))
char *dlerror _ANSI_ARGS_ ((void))
int dlclose _ANSI_ARGS_ ((void *handle))

Define Documentation
#define RTLD_GLOBAL  0x100

Definition at line 45 of file dlfcn.h.
Referenced by TclpDlopen().#define RTLD_LAZY  1

Definition at line 43 of file dlfcn.h.#define RTLD_NOW  2

Definition at line 44 of file dlfcn.h.
Referenced by TclpDlopen(), and TclpInitPlatform().
Function Documentation
int dlclose _ANSI_ARGS_ ((void *handle))
char* dlerror _ANSI_ARGS_ ((void))
VOID* dlsym _ANSI_ARGS_ ((void *handle, const char *symbol))
VOID* dlopen _ANSI_ARGS_ ((const char *path, int mode))

compat/fixstrtod.c File Reference
#include <stdio.h>
Functions
double strtod ()
double fixstrtod (char *string, char **endPtr)

Function Documentation
double fixstrtod (char * string, char ** endPtr)

Definition at line 28 of file fixstrtod.c.
References NULL, and strtod().31 {
32     double d;
33     d = strtod(string, endPtr);
34     if ((endPtr != NULL) && (*endPtr != string) && ((*endPtr)[-1] == 0)) {
35   *endPtr -= 1;
36     }
37     return d;
38 }
double strtod ()

Referenced by fixstrtod(), GetLexeme(), SetBooleanFromAny(), SetDoubleFromAny(), Tcl_GetDouble(), Tcl_ScanObjCmd(), and Tcl_StringObjCmd().

compat/float.h File Reference

compat/gettod.c File Reference
#include "tcl.h"
#include "tclPort.h"
#include <sys/timeb.h>
Functions
int gettimeofday (struct timeval *tp, struct timezone *tz)

Function Documentation
int gettimeofday (struct timeval * tp, struct timezone * tz)

Definition at line 22 of file gettod.c.
Referenced by Tcl_GetTime(), and TclpGetClicks().25 {
26     struct timeb t;
27     ftime(&t);
28     tp->tv_sec = t.time;
29     tp->tv_usec = t. millitm * 1000;
30     return 0;
31 }

compat/limits.h File Reference
Defines
#define LONG_MIN  0x80000000
#define LONG_MAX  0x7fffffff
#define INT_MIN  0x80000000
#define INT_MAX  0x7fffffff
#define SHRT_MIN  0x8000
#define SHRT_MAX  0x7fff

Define Documentation
#define INT_MAX  0x7fffffff

Definition at line 22 of file limits.h.
Referenced by FileSeekProc(), GetSrcInfoForPc(), SerialSetupProc(), Tcl_GetInt(), Tcl_StringObjCmd(), and Tcl_WaitForEvent().#define INT_MIN  0x80000000

Definition at line 21 of file limits.h.
Referenced by TCL_DECLARE_MUTEX(), and Tcl_StringObjCmd().#define LONG_MAX  0x7fffffff

Definition at line 20 of file limits.h.
Referenced by ExprIntFunc(), ExprRoundFunc(), SetIntOrWideFromAny(), Tcl_GetInt(), Tcl_IncrObjCmd(), Tcl_Seek(), TclpGetDate(), TclPtrIncrVar(), TestintobjCmd(), and TransformWideSeekProc().#define LONG_MIN  0x80000000

Definition at line 19 of file limits.h.
Referenced by ExprAbsFunc(), ExprIntFunc(), ExprRoundFunc(), Tcl_IncrObjCmd(), Tcl_Seek(), TclpGetDate(), TclPtrIncrVar(), and TransformWideSeekProc().#define SHRT_MAX  0x7fff

Definition at line 24 of file limits.h.#define SHRT_MIN  0x8000

Definition at line 23 of file limits.h.

compat/memcmp.c File Reference
#include "tcl.h"
#include "tclPort.h"
Functions
int memcmp _ANSI_ARGS_ ((CONST VOID *s1, CONST VOID *s2, size_t n))
int memcmp (CONST VOID *s1, CONST VOID *s2, size_t n)

Function Documentation
int memcmp _ANSI_ARGS_ ((CONST VOID *s1, CONST VOID *s2, size_t n))
int memcmp (CONST VOID * s1, CONST VOID * s2, size_t n)

Definition at line 46 of file memcmp.c.
Referenced by cmp(), EscapeToUtfProc(), Tcl_AfterObjCmd(), Tcl_IsChannelExisting(), Tcl_LsearchObjCmd(), Tcl_StringObjCmd(), Tcl_UniCharNcmp(), TclExecuteByteCode(), TclMacUnRegisterResourceFork(), and TclRegisterLiteral().50 {
51     unsigned char u1, u2;
52 
53     for ( ; n-- ; s1++, s2++) {
54   u1 = * (unsigned char *) s1;
55   u2 = * (unsigned char *) s2;
56   if ( u1 != u2) {
57       return (u1-u2);
58   }
59     }
60     return 0;
61 }

compat/opendir.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Classes
struct olddirect
Defines
#define DIRSIZ(dp)  ((sizeof (struct dirent) - (MAXNAMLEN+1)) + (((dp)->d_namlen+1 + 3) &~ 3))
#define ODIRSIZ  14
Functions
DIR * opendir (char *name)
dirent * readdir (DIR *dirp)
void closedir (DIR *dirp)

Define Documentation
#define DIRSIZ(dp)  ((sizeof (struct dirent) - (MAXNAMLEN+1)) + (((dp)->d_namlen+1 + 3) &~ 3))

Definition at line 17 of file opendir.c.#define ODIRSIZ  14

Definition at line 47 of file opendir.c.
Function Documentation
void closedir (DIR * dirp)

Definition at line 101 of file opendir.c.
References ckfree.
Referenced by DoRenameFile(), TclpMatchInDirectory(), and TraverseUnixTree().103 {
104   close(dirp->dd_fd);
105   dirp->dd_fd = -1;
106   dirp->dd_loc = 0;
107   ckfree((char *) dirp);
108 }
DIR* opendir (char * name)

Definition at line 24 of file opendir.c.
References ckalloc, _dirdesc::dd_fd, _dirdesc::dd_loc, and NULL.
Referenced by DoRenameFile(), TclpMatchInDirectory(), and TraverseUnixTree().26 {
27   register DIR *dirp;
28   register int fd;
29   char *myname;
30 
31   myname = ((*name == '\0') ? "." : name);
32   if ((fd = open(myname, 0, 0)) == -1)
33     return NULL;
34   if ((dirp = (DIR *)ckalloc(sizeof(DIR))) == NULL) {
35     close (fd);
36     return NULL;
37   }
38   dirp->dd_fd = fd;
39   dirp->dd_loc = 0;
40   return dirp;
41 }
struct dirent* readdir (DIR * dirp)

Definition at line 67 of file opendir.c.
References DIRBLKSIZ, and NULL.69 {
70   register struct olddirect *dp;
71   static struct dirent dir;
72 
73   for (;;) {
74     if (dirp->dd_loc == 0) {
75       dirp->dd_size = read(dirp->dd_fd, dirp->dd_buf,
76           DIRBLKSIZ);
77       if (dirp->dd_size <= 0)
78         return NULL;
79     }
80     if (dirp->dd_loc >= dirp->dd_size) {
81       dirp->dd_loc = 0;
82       continue;
83     }
84     dp = (struct olddirect *)(dirp->dd_buf + dirp->dd_loc);
85     dirp->dd_loc += sizeof(struct olddirect);
86     if (dp->od_ino == 0)
87       continue;
88     dir.d_ino = dp->od_ino;
89     strncpy(dir.d_name, dp->od_name, ODIRSIZ);
90     dir.d_name[ODIRSIZ] = '\0'; /* insure null termination */
91     dir.d_namlen = strlen(dir.d_name);
92     dir.d_reclen = DIRSIZ(&dir);
93     return (&dir);
94   }
95 }

compat/stdlib.h File Reference
#include <tcl.h>
Functions
void abort _ANSI_ARGS_ ((void))
double atof _ANSI_ARGS_ ((CONST char *string))
char *calloc _ANSI_ARGS_ ((unsigned int numElements, unsigned int size))
void exit _ANSI_ARGS_ ((int status))
int free _ANSI_ARGS_ ((char *blockPtr))
char *getenv _ANSI_ARGS_ ((CONST char *name))
char *malloc _ANSI_ARGS_ ((unsigned int numBytes))
void qsort _ANSI_ARGS_ ((VOID *base, int n, int size, int(*compar)(CONST VOID *element1, CONST VOID *element2)))
char *realloc _ANSI_ARGS_ ((char *ptr, unsigned int numBytes))
double strtod _ANSI_ARGS_ ((CONST char *string, char **endPtr))
long strtol _ANSI_ARGS_ ((CONST char *string, char **endPtr, int base))

Function Documentation
long strtol _ANSI_ARGS_ ((CONST char *string, char **endPtr, int base))
double strtod _ANSI_ARGS_ ((CONST char *string, char **endPtr))
char* realloc _ANSI_ARGS_ ((char *ptr, unsigned int numBytes))
void qsort _ANSI_ARGS_ ((VOID *base, int n, int size, int(*compar)(CONST VOID *element1, CONST VOID *element2)))
char* malloc _ANSI_ARGS_ ((unsigned int numBytes))
char* getenv _ANSI_ARGS_ ((CONST char *name))
int free _ANSI_ARGS_ ((char *blockPtr))
void exit _ANSI_ARGS_ ((int status))
char* calloc _ANSI_ARGS_ ((unsigned int numElements, unsigned int size))
double atof _ANSI_ARGS_ ((CONST char *string))
void abort _ANSI_ARGS_ ((void))

compat/strftime.c File Reference
#include <time.h>
#include <string.h>
#include <locale.h>
#include "tclInt.h"
#include "tclPort.h"
Classes
struct _TimeLocale
Defines
#define TM_YEAR_BASE  1900
#define IsLeapYear(x)  ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))
#define SUN_WEEK(t)
#define MON_WEEK(t)
Functions
static int _add _ANSI_ARGS_ ((const char *str))
static int _conv _ANSI_ARGS_ ((int n, int digits, int pad))
static int _secs _ANSI_ARGS_ ((const struct tm *t))
static size_t _fmt _ANSI_ARGS_ ((const char *format, const struct tm *t))
static int ISO8601Week _ANSI_ARGS_ ((CONST struct tm *t, int *year))
size_t TclpStrftime (char *s, size_t maxsize, const char *format, const struct tm *t, int useGMT)
static size_t _fmt (char *format, const struct tm *t) const
static int _secs (struct tm *t) const
static int _conv (int n, int digits, int pad)
static int _add (char *str) const
static int ISO8601Week (CONST struct tm *t, int *year)
Variables
static const _TimeLocale _DefaultTimeLocale
static const _TimeLocale * _CurrentTimeLocale = &_DefaultTimeLocale
static int isGMT
static size_t gsize
static char * pt

Define Documentation
#define IsLeapYear(x)  ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))

Definition at line 60 of file strftime.c.
Referenced by Convert(), ISO8601Week(), TclDateparse(), and TclpStrftime().#define MON_WEEK(t)
Value:(((t)->tm_yday + 7 - \
        ((t)->tm_wday ? (t)->tm_wday - 1 : 6)) / 7)
Definition at line 155 of file strftime.c.
Referenced by _fmt().#define SUN_WEEK(t)
Value:(((t)->tm_yday + 7 - \
        ((t)->tm_wday)) / 7)
Definition at line 153 of file strftime.c.
Referenced by _fmt().#define TM_YEAR_BASE  1900

Definition at line 59 of file strftime.c.
Referenced by _fmt(), ISO8601Week(), NamedMonth(), RelativeMonth(), TclGetDate(), and TclpStrftime().
Function Documentation
static int _add (char * str) const [static]

Definition at line 457 of file strftime.c.
References gsize, and pt.
Referenced by _conv(), _fmt(), and _secs().459 {
460     for (;; ++pt, --gsize) {
461   if (!gsize)
462       return(0);
463   if (!(*pt = *str++))
464       return(1);
465     }
466 }
static int ISO8601Week _ANSI_ARGS_ ((CONST struct tm *t, int *year)) [static]
static size_t _fmt _ANSI_ARGS_ ((const char *format, const struct tm *t)) [static]
static int _secs _ANSI_ARGS_ ((const struct tm *t)) [static]
static int _conv _ANSI_ARGS_ ((int n, int digits, int pad)) [static]
static int _add _ANSI_ARGS_ ((const char *str)) [static]
static int _conv (int n, int digits, int pad) [static]

Definition at line 436 of file strftime.c.
References _add().
Referenced by _fmt().439 {
440     static char buf[10];
441     register char *p;
442 
443     p = buf + sizeof( buf ) - 1;
444     *p-- = '\0';
445     if ( n == 0 ) {
446   *p-- = '0'; --digits;
447     } else {
448   for (; n > 0 && p > buf; n /= 10, --digits)
449       *p-- = (char)(n % 10 + '0');
450     }
451     while (p > buf && digits-- > 0)
452   *p-- = (char) pad;
453     return(_add(++p));
454 }
static size_t _fmt (char * format, const struct tm * t) const [static]

Definition at line 159 of file strftime.c.
References _add(), _conv(), _CurrentTimeLocale, _secs(), _TimeLocale::abday, _TimeLocale::abmon, _TimeLocale::am_pm, _TimeLocale::d_fmt, _TimeLocale::d_t_fmt, _TimeLocale::day, gsize, isGMT, ISO8601Week(), _TimeLocale::mon, MON_WEEK, NULL, pt, SUN_WEEK, _TimeLocale::t_fmt, _TimeLocale::t_fmt_ampm, Tcl_UtfToExternal(), TclpGetTZName(), and TM_YEAR_BASE.
Referenced by TclpStrftime().162 {
163 #ifdef WIN32
164 #define BUF_SIZ 256
165     TCHAR buf[BUF_SIZ];
166     SYSTEMTIME syst = {
167   t->tm_year + 1900,
168   t->tm_mon + 1,
169   t->tm_wday,
170   t->tm_mday,
171   t->tm_hour,
172   t->tm_min,
173   t->tm_sec,
174   0,
175     };
176 #endif
177     for (; *format; ++format) {
178   if (*format == '%') {
179       ++format;
180       if (*format == 'E') {
181         /* Alternate Era */
182     ++format;
183       } else if (*format == 'O') {
184         /* Alternate numeric symbols */
185     ++format;
186       }
187       switch(*format) {
188     case '\0':
189         --format;
190         break;
191     case 'A':
192         if (t->tm_wday < 0 || t->tm_wday > 6)
193       return(0);
194         if (!_add(_CurrentTimeLocale->day[t->tm_wday]))
195       return(0);
196         continue;
197     case 'a':
198         if (t->tm_wday < 0 || t->tm_wday > 6)
199       return(0);
200         if (!_add(_CurrentTimeLocale->abday[t->tm_wday]))
201       return(0);
202         continue;
203     case 'B':
204         if (t->tm_mon < 0 || t->tm_mon > 11)
205       return(0);
206         if (!_add(_CurrentTimeLocale->mon[t->tm_mon]))
207       return(0);
208         continue;
209     case 'b':
210     case 'h':
211         if (t->tm_mon < 0 || t->tm_mon > 11)
212       return(0);
213         if (!_add(_CurrentTimeLocale->abmon[t->tm_mon]))
214       return(0);
215         continue;
216     case 'C':
217         if (!_conv((t->tm_year + TM_YEAR_BASE) / 100,
218           2, '0'))
219       return(0);
220         continue;
221     case 'D':
222         if (!_fmt("%m/%d/%y", t))
223       return(0);
224         continue;
225     case 'd':
226         if (!_conv(t->tm_mday, 2, '0'))
227       return(0);
228         continue;
229     case 'e':
230         if (!_conv(t->tm_mday, 2, ' '))
231       return(0);
232         continue;
233           case 'g':
234         {
235       int year;
236       ISO8601Week( t, &year );
237       if ( !_conv( year%100, 2, '0' ) ) {
238           return( 0 );
239       }
240       continue;
241         }
242           case 'G':
243         {
244       int year;
245       ISO8601Week( t, &year );
246       if ( !_conv( year, 4, '0' ) ) {
247           return( 0 );
248       }
249       continue;
250         }
251     case 'H':
252         if (!_conv(t->tm_hour, 2, '0'))
253       return(0);
254         continue;
255     case 'I':
256         if (!_conv(t->tm_hour % 12 ?
257           t->tm_hour % 12 : 12, 2, '0'))
258       return(0);
259         continue;
260     case 'j':
261         if (!_conv(t->tm_yday + 1, 3, '0'))
262       return(0);
263         continue;
264     case 'k':
265         if (!_conv(t->tm_hour, 2, ' '))
266       return(0);
267         continue;
268     case 'l':
269         if (!_conv(t->tm_hour % 12 ?
270           t->tm_hour % 12: 12, 2, ' '))
271       return(0);
272         continue;
273     case 'M':
274         if (!_conv(t->tm_min, 2, '0'))
275       return(0);
276         continue;
277     case 'm':
278         if (!_conv(t->tm_mon + 1, 2, '0'))
279       return(0);
280         continue;
281     case 'n':
282         if (!_add("\n"))
283       return(0);
284         continue;
285     case 'p':
286         if (!_add(_CurrentTimeLocale->am_pm[t->tm_hour >= 12]))
287       return(0);
288         continue;
289     case 'R':
290         if (!_fmt("%H:%M", t))
291       return(0);
292         continue;
293     case 'r':
294         if (!_fmt(_CurrentTimeLocale->t_fmt_ampm, t))
295       return(0);
296         continue;
297     case 'S':
298         if (!_conv(t->tm_sec, 2, '0'))
299       return(0);
300         continue;
301     case 's':
302         if (!_secs(t))
303       return(0);
304         continue;
305     case 'T':
306         if (!_fmt("%H:%M:%S", t))
307       return(0);
308         continue;
309     case 't':
310         if (!_add("\t"))
311       return(0);
312         continue;
313     case 'U':
314         if (!_conv(SUN_WEEK(t), 2, '0'))
315       return(0);
316         continue;
317     case 'u':
318         if (!_conv(t->tm_wday ? t->tm_wday : 7, 1, '0'))
319       return(0);
320         continue;
321     case 'V':
322     {
323         int week = ISO8601Week( t, NULL );
324         if (!_conv(week, 2, '0'))
325       return(0);
326         continue;
327     }
328     case 'W':
329         if (!_conv(MON_WEEK(t), 2, '0'))
330       return(0);
331         continue;
332     case 'w':
333         if (!_conv(t->tm_wday, 1, '0'))
334       return(0);
335         continue;
336 #ifdef WIN32
337     /*
338      * To properly handle the localized time routines on Windows,
339      * we must make use of the special localized calls.
340      */
341     case 'c':
342         if (!GetDateFormat(LOCALE_USER_DEFAULT,
343                DATE_LONGDATE | LOCALE_USE_CP_ACP,
344                &syst, NULL, buf, BUF_SIZ)
345       || !_add(buf)
346       || !_add(" ")) {
347       return(0);
348         }
349         /*
350          * %c is created with LONGDATE + " " + TIME on Windows,
351          * so continue to %X case here.
352          */
353     case 'X':
354         if (!GetTimeFormat(LOCALE_USER_DEFAULT,
355                LOCALE_USE_CP_ACP,
356                &syst, NULL, buf, BUF_SIZ)
357       || !_add(buf)) {
358       return(0);
359         }
360         continue;
361     case 'x':
362         if (!GetDateFormat(LOCALE_USER_DEFAULT,
363                DATE_SHORTDATE | LOCALE_USE_CP_ACP,
364                &syst, NULL, buf, BUF_SIZ)
365       || !_add(buf)) {
366       return(0);
367         }
368         continue;
369 #else
370     case 'c':
371         if (!_fmt(_CurrentTimeLocale->d_t_fmt, t))
372       return(0);
373         continue;
374     case 'x':
375         if (!_fmt(_CurrentTimeLocale->d_fmt, t))
376       return(0);
377         continue;
378     case 'X':
379         if (!_fmt(_CurrentTimeLocale->t_fmt, t))
380       return(0);
381         continue;
382 #endif
383     case 'y':
384         if (!_conv((t->tm_year + TM_YEAR_BASE) % 100,
385           2, '0'))
386       return(0);
387         continue;
388     case 'Y':
389         if (!_conv((t->tm_year + TM_YEAR_BASE), 4, '0'))
390       return(0);
391         continue;
392     case 'Z': {
393         char *name = (isGMT ? "GMT" : TclpGetTZName(t->tm_isdst));
394         int wrote;
395         Tcl_UtfToExternal(NULL, NULL, name, -1, 0, NULL,
396               pt, gsize, NULL, &wrote, NULL);
397         pt += wrote;
398         gsize -= wrote;
399         continue;
400     }
401     case '%':
402         /*
403          * X311J/88-090 (4.12.3.5): if conversion char is
404          * undefined, behavior is undefined.  Print out the
405          * character itself as printf(3) does.
406          */
407     default:
408         break;
409       }
410   }
411   if (!gsize--)
412       return(0);
413   *pt++ = *format;
414     }
415     return(gsize);
416 }
static int _secs (struct tm * t) const [static]

Definition at line 419 of file strftime.c.
References _add().
Referenced by _fmt().421 {
422     static char buf[15];
423     register time_t s;
424     register char *p;
425     struct tm tmp;
426 
427     /* Make a copy, mktime(3) modifies the tm struct. */
428     tmp = *t;
429     s = mktime(&tmp);
430     for (p = buf + sizeof(buf) - 2; s > 0 && p > buf; s /= 10)
431   *p-- = (char)(s % 10 + '0');
432     return(_add(++p));
433 }
static int ISO8601Week (CONST struct tm* t, int* year) [static]

Definition at line 469 of file strftime.c.
References IsLeapYear, NULL, and TM_YEAR_BASE.
Referenced by _fmt().472 {
473     /* Find the day-of-year of the Thursday in
474      * the week in question. */
475     
476     int ydayThursday;
477     int week;
478     if ( t->tm_wday == 0 ) {
479   ydayThursday = t->tm_yday - 3;
480     } else {
481   ydayThursday = t->tm_yday - t->tm_wday + 4;
482     }
483     
484     if ( ydayThursday < 0 ) {
485   
486   /* This is the last week of the previous year. */
487   if ( IsLeapYear(( t->tm_year + TM_YEAR_BASE - 1 )) ) {
488       ydayThursday += 366;
489   } else {
490       ydayThursday += 365;
491   }
492   week = ydayThursday / 7 + 1;
493   if ( year != NULL ) {
494       *year = t->tm_year + 1899;
495   }
496   
497     } else if ( ( IsLeapYear(( t -> tm_year + TM_YEAR_BASE ))
498       && ydayThursday >= 366 )
499     || ( !IsLeapYear(( t -> tm_year
500            + TM_YEAR_BASE ))
501          && ydayThursday >= 365 ) ) {
502   
503   /* This is week 1 of the following year */
504   
505   week = 1;
506   if ( year != NULL ) {
507       *year = t->tm_year + 1901;
508   }
509   
510     } else {
511   
512   week = ydayThursday / 7 + 1;
513   if ( year != NULL ) {
514       *year = t->tm_year + 1900;
515   }
516   
517     }
518 
519     return week;
520     
521 }
size_t TclpStrftime (char * s, size_t maxsize, const char * format, const struct tm * t, int useGMT)

Definition at line 119 of file strftime.c.
References _fmt(), gsize, isGMT, IsLeapYear, pt, TM_YEAR_BASE, and tzset.
Referenced by FormatClock().125 {
126     if (format[0] == '%' && format[1] == 'Q') {
127   /* Format as a stardate */
128   sprintf(s, "Stardate %2d%03d.%01d",
129     (((t->tm_year + TM_YEAR_BASE) + 377) - 2323),
130     (((t->tm_yday + 1) * 1000) /
131       (365 + IsLeapYear((t->tm_year + TM_YEAR_BASE)))),
132     (((t->tm_hour * 60) + t->tm_min)/144));
133   return(strlen(s));
134     }
135 
136     isGMT = useGMT;
137     /*
138      * We may be able to skip this for useGMT, but it should be harmless.
139      * -- hobbs
140      */
141     tzset();
142 
143     pt = s;
144     if ((gsize = maxsize) < 1)
145   return(0);
146     if (_fmt(format, t)) {
147   *pt = '\0';
148   return(maxsize - gsize);
149     }
150     return(0);
151 }

Variable Documentation
const _TimeLocale* _CurrentTimeLocale = &_DefaultTimeLocale [static]

Definition at line 106 of file strftime.c.
Referenced by _fmt().const _TimeLocale _DefaultTimeLocale [static]
Initial value: 
{
    {
  "Sun","Mon","Tue","Wed","Thu","Fri","Sat",
    },
    {
  "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday",
  "Friday", "Saturday"
    },
    {
  "Jan", "Feb", "Mar", "Apr", "May", "Jun",
  "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
    },
    {
  "January", "February", "March", "April", "May", "June", "July",
  "August", "September", "October", "November", "December"
    },
    {
  "AM", "PM"
    },
    "%a %b %d %H:%M:%S %Y",
    "%m/%d/%y",
    "%H:%M:%S",
    "%I:%M:%S %p"
}
Definition at line 80 of file strftime.c.size_t gsize [static]

Definition at line 109 of file strftime.c.
Referenced by _add(), _fmt(), and TclpStrftime().int isGMT [static]

Definition at line 108 of file strftime.c.
Referenced by _fmt(), and TclpStrftime().char* pt [static]

Definition at line 110 of file strftime.c.
Referenced by _add(), _fmt(), and TclpStrftime().

compat/string.h File Reference
#include <tcl.h>
#include <sys/types.h>
Functions
char *memchr _ANSI_ARGS_ ((CONST VOID *s, int c, size_t n))
int memcmp _ANSI_ARGS_ ((CONST VOID *s1, CONST VOID *s2, size_t n))
char *memcpy _ANSI_ARGS_ ((VOID *t, CONST VOID *f, size_t n))
char *memset _ANSI_ARGS_ ((VOID *s, int c, size_t n))
int strcasecmp _ANSI_ARGS_ ((CONST char *s1, CONST char *s2))
char *strcat _ANSI_ARGS_ ((char *dst, CONST char *src))
char *strchr _ANSI_ARGS_ ((CONST char *string, int c))
size_t strcspn _ANSI_ARGS_ ((CONST char *string, CONST char *chars))
char *strdup _ANSI_ARGS_ ((CONST char *string))
char *strerror _ANSI_ARGS_ ((int error))
int strncasecmp _ANSI_ARGS_ ((CONST char *s1, CONST char *s2, size_t n))
char *strncat _ANSI_ARGS_ ((char *dst, CONST char *src, size_t numChars))
int strncmp _ANSI_ARGS_ ((CONST char *s1, CONST char *s2, size_t nChars))
char *strstr _ANSI_ARGS_ ((CONST char *string, CONST char *substring))
char *strtok _ANSI_ARGS_ ((char *s, CONST char *delim))

Function Documentation
char* strtok _ANSI_ARGS_ ((char *s, CONST char *delim))
char* strstr _ANSI_ARGS_ ((CONST char *string, CONST char *substring))
int strncmp _ANSI_ARGS_ ((CONST char *s1, CONST char *s2, size_t nChars))
char* strncat _ANSI_ARGS_ ((char *dst, CONST char *src, size_t numChars))
int strncasecmp _ANSI_ARGS_ ((CONST char *s1, CONST char *s2, size_t n))
char* strerror _ANSI_ARGS_ ((int error))
char* strdup _ANSI_ARGS_ ((CONST char *string))
size_t strcspn _ANSI_ARGS_ ((CONST char *string, CONST char *chars))
char* strchr _ANSI_ARGS_ ((CONST char *string, int c))
char* strcat _ANSI_ARGS_ ((char *dst, CONST char *src))
int strcasecmp _ANSI_ARGS_ ((CONST char *s1, CONST char *s2))
char* memset _ANSI_ARGS_ ((VOID *s, int c, size_t n))
char* memcpy _ANSI_ARGS_ ((VOID *t, CONST VOID *f, size_t n))
int memcmp _ANSI_ARGS_ ((CONST VOID *s1, CONST VOID *s2, size_t n))
char* memchr _ANSI_ARGS_ ((CONST VOID *s, int c, size_t n))

compat/strncasecmp.c File Reference
#include "tclPort.h"
Functions
int strncasecmp _ANSI_ARGS_ ((CONST char *s1, CONST char *s2, size_t n))
int strcasecmp _ANSI_ARGS_ ((CONST char *s1, CONST char *s2))
int strcasecmp (CONST char *s1, CONST char *s2)
int strncasecmp (CONST char *s1, CONST char *s2, size_t length)
Variables
static unsigned char charmap []

Function Documentation
int strcasecmp _ANSI_ARGS_ ((CONST char *s1, CONST char *s2))
int strncasecmp _ANSI_ARGS_ ((CONST char *s1, CONST char *s2, size_t n))
int strcasecmp (CONST char * s1, CONST char * s2)

Definition at line 87 of file strncasecmp.c.
References charmap.
Referenced by TclpInitLibraryPath().90 {
91     unsigned char u1, u2;
92 
93     for ( ; ; s1++, s2++) {
94   u1 = (unsigned char) *s1;
95   u2 = (unsigned char) *s2;
96   if ((u1 == '\0') || (charmap[u1] != charmap[u2])) {
97       break;
98   }
99     }
100     return charmap[u1] - charmap[u2];
101 }
int strncasecmp (CONST char * s1, CONST char * s2, size_t length)

Definition at line 122 of file strncasecmp.c.
References charmap.
Referenced by TryToLoad().128 {
129     unsigned char u1, u2;
130 
131     for (; length != 0; length--, s1++, s2++) {
132   u1 = (unsigned char) *s1;
133   u2 = (unsigned char) *s2;
134   if (charmap[u1] != charmap[u2]) {
135       return charmap[u1] - charmap[u2];
136   }
137   if (u1 == '\0') {
138       return 0;
139   }
140     }
141     return 0;
142 }

Variable Documentation
unsigned char charmap[] [static]

Definition at line 23 of file strncasecmp.c.
Referenced by strcasecmp(), and strncasecmp().

compat/strstr.c File Reference
#include <tcl.h>
Defines
#define NULL  0
Functions
char * strstr (char *string, char *substring)

Define Documentation
#define NULL  0

Definition at line 17 of file strstr.c.
Referenced by _fmt(), AcceptCallbackProc(), AddLocalLiteralEntry(), addmcce(), AfterCleanupProc(), AliasCreate(), AliasDelete(), AliasDescribe(), AliasList(), allocarc(), AllocChannelBuffer(), altdissect(), analyze(), AppendDllPath(), AppendEnvironment(), AppendLocals(), AppendSystemError(), AppendUnicodeToUnicodeRep(), AppInitExitHandler(), ApplicationType(), AsyncHandlerProc(), BgErrorDeleteProc(), BroadcastValue(), BuildCharSet(), BuildResourceForkList(), BumpCmdRefEpochs(), caltdissect(), CannotSetAttribute(), cbracket(), cbrdissect(), cclass(), ccondissect(), cdissect(), cfind(), cfindloop(), ChannelTimerProc(), CheckChannelErrors(), CheckFlush(), CheckForCompilerFeature(), CheckForDeadChannel(), CheckForLinkerFeature(), CheckForStdChannelsBeingClosed(), cleanst(), cleanup(), CleanupChannelHandlers(), CleanUpExitProc(), clearcvec(), cleartraverse(), ClearZombieSockets(), cloneouts(), CloseChannel(), CloseCompletionRoutine(), CloseLibraryResource(), CmdProc1(), CmdProc2(), cmtreefree(), colorcomplement(), CommandComplete(), CommonGetsCleanup(), compact(), compile(), CompileMathFuncCall(), CompileRegexp(), CompileSubExpr(), condissect(), ConsoleCheckProc(), ConsoleCloseProc(), ConsoleEventProc(), ConsoleExitHandler(), ConsoleInit(), ConsoleInputProc(), ConsoleOutputProc(), ConsoleReaderThread(), ConsoleSetupProc(), ConsoleThreadActionProc(), ConsoleWatchProc(), ConsoleWriterThread(), ConvertFileNameFormat(), CopyAndTranslateBuffer(), CopyBuffer(), CopyData(), CopyFileAtts(), copyins(), copyouts(), CopyRenameOneFile(), CreatedCommandProc(), CreatedCommandProc2(), CreateFileHandler(), CreateScriptRecord(), CreateSocket(), CreateSocketAddress(), CreateTempFile(), crevdissect(), DdeCreateClient(), DdeExitProc(), DdeGetServicesList(), DdeServerProc(), DdeServicesOnAck(), DdeSetServerName(), DelCmdProc(), DeleteArray(), DeleteChannelTable(), DeleteFileHandler(), DeleteImportedCmd(), DeleteInterpProc(), DeleteKey(), DeleteProc(), DeleteScanNumberCache(), DeleteScriptRecord(), DeleteValue(), delsub(), deltraverse(), destroystate(), DetachChannel(), DiscardInputQueued(), DiscardOutputQueued(), dissect(), dlerror(), dlopen(), dlsym(), DoCopyDirectory(), DoCopyFile(), DoCreateDirectory(), DoReadChars(), DoRemoveDirectory(), DoRemoveJustDirectory(), DoRenameFile(), DoTildeSubst(), dovec(), DoWrite(), DoWriteChars(), dropstate(), dump(), dumpnfa(), dumpst(), DupEncodingIntRep(), DupListInternalRep(), dupnfa(), DupNsNameInternalRep(), DupStringInternalRep(), duptraverse(), DyldOFIErrorMsg(), eclass(), element(), EscapeFreeProc(), EscapeToUtfProc(), exec(), ExecuteCallback(), ExecuteRemoteObject(), ExpandLocalLiteralArray(), ExprAbsFunc(), ExprCallMathFunc(), ExprIntFunc(), ExprRoundFunc(), ExprSrandFunc(), ExprWideFunc(), FileBasename(), FileChannelExitHandler(), FileCheckProc(), FileClose(), FileCloseProc(), FileCopyRename(), FileEventProc(), FileForceOption(), FileHandlerEventProc(), FileInit(), FileInputProc(), FileNameInit(), FileOutputProc(), FileRCVariables(), FileSeek(), FileSetupProc(), FileThreadActionProc(), FilterInputBytes(), FinalizeRegexp(), find(), findarc(), FindLibraries(), findMain(), fixempties(), fixstrtod(), FlushChannel(), ForgetSyncObject(), FormatClock(), FreeAllMemory(), freearc(), FreeByteCodeInternalRep(), freecm(), freecolor(), freedfa(), FreeEncoding(), FreeListInternalRep(), freenfa(), FreeNsNameInternalRep(), FreeSocketInfo(), freesrnode(), freestate(), freesubre(), freev(), FSpGetDefaultDir(), FSpLocationFromPathAlias(), FSpPathFromLocation(), FSpSetDefaultDir(), GetAfterEvent(), GetChannelTable(), getcvec(), GetExceptRangeForPc(), GetFileFinderAttributes(), GetFileReadOnly(), GetFinderFont(), GetGroupAttribute(), GetHostFromString(), GetInput(), GetInterp(), GetInterp2(), GetKeyNames(), GetLexeme(), GetNamespaceFromObj(), GetOwnerAttribute(), GetPermissionsAttribute(), GetRsrcRefFromObj(), getSortedHashKeys(), GetSrcInfoForPc(), GetStatBuf(), GetTableEncoding(), GetTimesCmd(), GetType(), GetUserName(), getvacant(), GetValue(), GetValueNames(), GrepForDefine(), HandleBgErrors(), HandleMacEvents(), HasConsole(), HasStubSupport(), IllegalExprOperandType(), InfoArgsCmd(), InfoBodyCmd(), InfoCmdCountCmd(), InfoCommandsCmd(), InfoDefaultCmd(), InfoExistsCmd(), InfoFunctionsCmd(), InfoGlobalsCmd(), InfoHostnameCmd(), InfoLevelCmd(), InfoLibraryCmd(), InfoLoadedCmd(), InfoLocalsCmd(), InfoNameOfExecutableCmd(), InfoPatchLevelCmd(), InfoProcsCmd(), InfoScriptCmd(), InfoSharedlibCmd(), InfoTclVersionCmd(), InfoVarsCmd(), InitByteCodeExecution(), initcm(), Initialize(), initialize(), InitNotifier(), InitSockets(), InitTimer(), int(), InterpInfoDeleteProc(), IsIn(), ISO8601Week(), lacon(), lastcold(), leaders(), lexnest(), LinkTraceProc(), LoadEncodingFile(), LoadEscapeEncoding(), LoadTableEncoding(), LogSyntaxError(), longest(), main(), MakeDdeConnection(), MakeFolderEnvVar(), makesearch(), MakeTcpClientChannelMode(), markcanreach(), markreachable(), markst(), MergeLists(), MergeSort(), miss(), moresubs(), moveins(), moveouts(), MoveRename(), NamespaceChildrenCmd(), NamespaceCodeCmd(), NamespaceCurrentCmd(), NamespaceDeleteCmd(), NamespaceEvalCmd(), NamespaceExistsCmd(), NamespaceExportCmd(), NamespaceForgetCmd(), NamespaceImportCmd(), NamespaceInscopeCmd(), NamespaceOriginCmd(), NamespaceParentCmd(), NamespaceWhichCmd(), NativeAccess(), NativeIsExec(), NativeMatchType(), NativeReadReparse(), NativeStat(), NativeWriteReparse(), newarc(), newcolor(), newcvec(), newdfa(), newfstate(), newlacon(), newnfa(), NewSocketInfo(), newstate(), next(), nextleader(), nfanode(), nfatree(), NotifierExitHandler(), numst(), ObjValue(), okcolors(), opendir(), OpenEncodingFile(), OpenFileChannel(), OpenLibraryResource(), OpenSubKey(), optimize(), optst(), parse(), ParseComment(), ParseKeyName(), ParsePrimaryExpr(), parseqatom(), ParseTokens(), PathVariables(), PeekAhead(), pickss(), PipeBlockModeProc(), PipeCheckProc(), PipeClose2Proc(), PipeCloseProc(), PipeEventProc(), PipeInit(), PipeInputProc(), PipeOutputProc(), PipeReaderThread(), PipeSetupProc(), PipeThreadActionProc(), PipeWatchProc(), PipeWriterThread(), Pkga_Init(), Pkgb_Init(), Pkgb_SafeInit(), Pkgc_Init(), Pkgc_SafeInit(), Pkgd_Init(), Pkgd_SafeInit(), Pkge_Init(), Pkgf_Init(), prepareScriptData(), PretendTclpOpenFileChannel(), PrintParse(), ProcBodyTestProcObjCmd(), ProcCompileProc(), Prompt(), pull(), pullback(), push(), pushfwd(), QueueEvent(), range(), ReadChars(), readdir(), readExports(), RebuildLiteralTable(), RecursiveDeleteKey(), RecycleBuffer(), RegExpExecUniChar(), regfree(), RegisterTcpServerInterpCleanup(), Registry_Init(), RegistryObjCmd(), RememberSyncObject(), ResetObjResult(), ResolveAddress(), ResultClear(), ResultInit(), RezRCVariables(), rfree(), ScanNumber(), SerialCheckProc(), SerialCloseProc(), SerialEventProc(), SerialExitHandler(), SerialGetOptionProc(), SerialInit(), SerialSetOptionProc(), SerialSetupProc(), SerialThreadActionProc(), SerialWatchProc(), SerialWriterThread(), setargv(), SetBlockMode(), SetByteArrayFromAny(), SetByteCodeFromAny(), SetCmdNameFromAny(), setcolor(), SetEndOffsetFromAny(), SetFileFinderAttributes(), SetFileReadOnly(), SetGroupAttribute(), SetListFromAny(), SetNsNameFromAny(), SetOSTypeFromAny(), SetOwnerAttribute(), SetPermissionsAttribute(), SetRegexpFromAny(), SetStringFromAny(), SetTimer(), SetTZIfNecessary(), SetupAppendBuffer(), SetValue(), shortest(), SimpleCopy(), SimpleOpenFileChannel(), SimpleStat(), SlaveCreate(), SlaveExpose(), SlaveHidden(), SlaveHide(), SlaveMarkTrusted(), SlaveObjCmd(), SlaveObjCmdDeleteProc(), SlaveRecursionLimit(), SocketCheckProc(), SocketEventProc(), SocketExitHandler(), SocketProc(), SocketsEnabled(), SocketSetupProc(), SocketThread(), SortCompare(), specialcolors(), SplitMacPath(), SplitUnixPath(), SplitWinPath(), StackSetBlockMode(), StatError(), StdinProc(), StdIOClose(), stdump(), StopCopy(), strstr(), strtod(), subblock(), subre(), SystemVariables(), Tcl_AddInterpResolvers(), Tcl_AfterObjCmd(), Tcl_AppendExportList(), Tcl_AppendObjToObj(), Tcl_AppendResultVA(), Tcl_AppendStringsToObjVA(), Tcl_AppendToObj(), Tcl_AppendUnicodeToObj(), Tcl_AppInit(), Tcl_AsyncCreate(), Tcl_AsyncDelete(), Tcl_AsyncInvoke(), Tcl_AttemptSetObjLength(), Tcl_BackgroundError(), Tcl_BadChannelOption(), Tcl_BeepObjCmd(), Tcl_BinaryObjCmd(), Tcl_BreakObjCmd(), Tcl_CancelIdleCall(), Tcl_CatchObjCmd(), Tcl_CdObjCmd(), Tcl_ChannelBuffered(), Tcl_ChannelFlushProc(), Tcl_ChannelHandlerProc(), Tcl_ChannelThreadActionProc(), Tcl_ChannelWideSeekProc(), Tcl_ClearChannelHandlers(), Tcl_Close(), Tcl_CloseObjCmd(), Tcl_CommandTraceInfo(), Tcl_ConcatObj(), Tcl_ContinueObjCmd(), Tcl_ConvertCountedElement(), Tcl_CreateChannel(), Tcl_CreateChannelHandler(), Tcl_CreateCommand(), Tcl_CreateEncoding(), Tcl_CreateFileHandler(), Tcl_CreateInterp(), Tcl_CreateNamespace(), Tcl_CreateObjCommand(), Tcl_CreateThread(), Tcl_CreateTimerHandler(), Tcl_CutChannel(), Tcl_DdeObjCmd(), TCL_DECLARE_MUTEX(), Tcl_DeleteAssocData(), Tcl_DeleteChannelHandler(), Tcl_DeleteCloseHandler(), Tcl_DeleteCommand(), Tcl_DeleteEvents(), Tcl_DeleteEventSource(), Tcl_DeleteExitHandler(), Tcl_DeleteFileHandler(), Tcl_DeleteNamespace(), Tcl_DeleteThreadExitHandler(), Tcl_DeleteTimerHandler(), Tcl_DontCallWhenDeleted(), Tcl_DoOneEvent(), Tcl_DoWhenIdle(), Tcl_DStringAppendElement(), Tcl_DStringGetResult(), Tcl_EchoCmd(), Tcl_EncodingObjCmd(), Tcl_EofObjCmd(), Tcl_ErrorObjCmd(), Tcl_ExecObjCmd(), Tcl_Export(), Tcl_ExposeCommand(), Tcl_ExprObj(), Tcl_ExternalToUtf(), Tcl_ExternalToUtfDString(), Tcl_FblockedObjCmd(), Tcl_FconfigureObjCmd(), Tcl_FcopyObjCmd(), Tcl_FileEventObjCmd(), Tcl_FileObjCmd(), Tcl_Finalize(), Tcl_FinalizeNotifier(), Tcl_FinalizeThread(), Tcl_FindCommand(), Tcl_FindExecutable(), Tcl_FindNamespace(), Tcl_FindNamespaceVar(), Tcl_Flush(), Tcl_FlushObjCmd(), Tcl_ForeachObjCmd(), Tcl_ForgetImport(), Tcl_FormatObjCmd(), Tcl_FreeResult(), Tcl_FSJoinToPath(), Tcl_FSOpenFileChannel(), Tcl_GetAlias(), Tcl_GetAliasObj(), Tcl_GetAllocMutex(), Tcl_GetAssocData(), Tcl_GetBoolean(), Tcl_GetByteArrayFromObj(), Tcl_GetChannel(), Tcl_GetChannelNames(), Tcl_GetChannelNamesEx(), Tcl_GetChannelOption(), Tcl_GetCharLength(), Tcl_GetCurrentNamespace(), Tcl_GetCwd(), Tcl_GetDouble(), Tcl_GetEncoding(), Tcl_GetEncodingName(), Tcl_GetEncodingNames(), Tcl_GetHostName(), Tcl_GetIndexFromObjStruct(), Tcl_GetInt(), Tcl_GetInterpPath(), Tcl_GetInterpResolvers(), Tcl_GetMaster(), Tcl_GetNamespaceResolvers(), Tcl_GetObjResult(), Tcl_GetOpenFile(), Tcl_GetRange(), Tcl_GetRegExpFromObj(), Tcl_GetsObj(), Tcl_GetsObjCmd(), Tcl_GetStdChannel(), Tcl_GetThreadData(), Tcl_GetTime(), Tcl_GetUniChar(), Tcl_GetUnicode(), Tcl_GetUnicodeFromObj(), Tcl_GlobalObjCmd(), Tcl_GlobObjCmd(), Tcl_HideCommand(), Tcl_IfObjCmd(), Tcl_Import(), Tcl_IncrObjCmd(), Tcl_InfoObjCmd(), Tcl_Init(), Tcl_InitNotifier(), Tcl_InitStubs(), Tcl_InputBuffered(), Tcl_InterpObjCmd(), Tcl_IsChannelExisting(), Tcl_IsChannelRegistered(), Tcl_IsSafe(), Tcl_JoinPath(), Tcl_LappendObjCmd(), Tcl_LindexObjCmd(), Tcl_LinkVar(), Tcl_ListObjIndex(), Tcl_LoadObjCmd(), Tcl_LreplaceObjCmd(), Tcl_LsearchObjCmd(), Tcl_LsetObjCmd(), Tcl_LsObjCmd(), Tcl_LsortObjCmd(), Tcl_MacConvertTextResource(), Tcl_MacEvalResource(), Tcl_MacFindResource(), Tcl_MacOSXOpenBundleResources(), Tcl_MacOSXOpenVersionedBundleResources(), Tcl_MacSourceObjCmd(), Tcl_Main(), Tcl_MakeFileChannel(), Tcl_MakeSafe(), Tcl_MakeTcpClientChannel(), Tcl_NamespaceObjCmd(), Tcl_NewListObj(), Tcl_NewOSTypeObj(), Tcl_NotifyChannel(), Tcl_OpenCommandChannel(), Tcl_OpenObjCmd(), Tcl_OpenTcpClient(), Tcl_OpenTcpServer(), Tcl_OSACmd(), Tcl_OSAComponentCmd(), Tcl_OutputBuffered(), Tcl_PanicVA(), Tcl_ParseBraces(), Tcl_ParseCommand(), Tcl_ParseExpr(), Tcl_ParseQuotedString(), Tcl_ParseVar(), Tcl_ParseVarName(), Tcl_PidObjCmd(), Tcl_PkgProvide(), Tcl_PkgProvideEx(), Tcl_PopCallFrame(), Tcl_ProcObjCmd(), Tcl_PushCallFrame(), Tcl_PutsObjCmd(), Tcl_PwdObjCmd(), Tcl_ReadObjCmd(), Tcl_ReapDetachedProcs(), Tcl_RegExpExec(), Tcl_RegExpExecObj(), Tcl_RegExpMatch(), Tcl_RegExpMatchObj(), Tcl_RegexpObjCmd(), Tcl_RegExpRange(), Tcl_RegisterChannel(), Tcl_RegsubObjCmd(), Tcl_RemoveInterpResolvers(), Tcl_ResetResult(), Tcl_ResourceObjCmd(), Tcl_RestoreResult(), Tcl_ReturnObjCmd(), Tcl_SaveResult(), Tcl_ScanCountedElement(), Tcl_ScanObjCmd(), Tcl_Seek(), Tcl_SeekObjCmd(), Tcl_ServiceAll(), Tcl_ServiceEvent(), Tcl_ServiceModeHook(), Tcl_SetByteArrayLength(), Tcl_SetByteArrayObj(), Tcl_SetChannelBufferSize(), Tcl_SetChannelOption(), Tcl_SetErrorCodeVA(), Tcl_SetListObj(), Tcl_SetMaxBlockTime(), Tcl_SetObjErrorCode(), Tcl_SetObjLength(), Tcl_SetObjResult(), Tcl_SetOSTypeObj(), Tcl_SetResult(), Tcl_SetStringObj(), Tcl_SetSystemEncoding(), Tcl_SetTimer(), Tcl_SetUnicodeObj(), Tcl_Sleep(), Tcl_SocketObjCmd(), Tcl_SourceRCFile(), Tcl_SpliceChannel(), Tcl_SplitList(), Tcl_SplitObjCmd(), Tcl_SplitPath(), Tcl_StackChannel(), Tcl_StringObjCmd(), Tcl_SubstObj(), Tcl_SubstObjCmd(), Tcl_SwitchObjCmd(), Tcl_Tell(), Tcl_TellObjCmd(), Tcl_TraceCommand(), Tcl_TraceObjCmd(), Tcl_TranslateFileName(), Tcl_Ungets(), Tcl_UnlinkVar(), Tcl_UnregisterChannel(), Tcl_UnstackChannel(), Tcl_UntraceCommand(), Tcl_UpdateLinkedVar(), Tcl_UpdateObjCmd(), Tcl_UtfBackslash(), Tcl_UtfFindFirst(), Tcl_UtfFindLast(), Tcl_UtfToExternal(), Tcl_UtfToExternalDString(), TCL_VARARGS_DEF(), Tcl_VariableObjCmd(), Tcl_VwaitObjCmd(), Tcl_WaitForEvent(), Tcl_WaitPid(), Tcl_WriteObj(), Tcl_WrongNumArgs(), TclAddLiteralObj(), Tclapplescript_Init(), TclChannelEventScriptInvoker(), TclChannelTransform(), TclCheckBadOctal(), TclCheckExecutionTraces(), TclCheckInterpTraces(), TclCleanupByteCode(), TclCleanupChildren(), TclCompEvalObj(), TclCompileCatchCmd(), TclCompileExpr(), TclCompileForeachCmd(), TclCompileIncrCmd(), TclCompileLappendCmd(), TclCompileListCmd(), TclCompileReturnCmd(), TclCompileScript(), TclCompileStringCmd(), TclCompileTokens(), TclCompileVariableCmd(), TclCompileWhileCmd(), TclCopyChannel(), TclCreatePipeline(), TclCreateProc(), TclDeleteLiteralTable(), TclDeleteVars(), TclDoGlob(), TclExecuteByteCode(), TclExprFloatError(), TclFileAttrsCmd(), TclFileDeleteCmd(), TclFileDirname(), TclFileMakeDirsCmd(), TclFinalizeAsync(), TclFinalizeEncodingSubsystem(), TclFinalizeIOSubsystem(), TclFinalizeNotifier(), TclFinalizePreserve(), TclFinalizeSynchronization(), TclFinalizeThreadData(), TclFindCompiledLocal(), TclFindElement(), TclFindEncodings(), TclFindProc(), TclGetAuxDataType(), TclGetDate(), TclGetEncodingFromObj(), TclGetExtension(), TclGetFrame(), TclGetIntForIndex(), TclGetLibraryPath(), TclGetLong(), TclGetNamespaceForQualName(), TclGetOpenMode(), TclGetOriginalCommand(), TclGetStartupScriptFileName(), TclGlob(), TclHandleFree(), TclHandlePreserve(), TclHandleRelease(), TclHideLiteral(), TclHideUnsafeCommands(), TclInitByteCodeObj(), TclInitCompiledLocals(), TclInitEncodingSubsystem(), TclInitSubsystems(), TclInterpInit(), TclInThreadExit(), TclIsProc(), TclLindexFlat(), TclLindexList(), TclListObjSetElement(), TclLooksLikeInt(), TclLookupLiteralEntry(), TclLsetFlat(), TclLsetList(), TclMacCreateEnv(), TclMacDoNotification(), TclMacExitHandler(), TclMacFOpenHack(), TclMacGetFontEncoding(), TclMacInitExitToShell(), TclMacInstallExitToShellPatch(), TclMacRegisterResourceFork(), TclMacRemoveTimer(), TclMacStartTimer(), TclMacTimerExpired(), TclMacUnRegisterResourceFork(), TclNewProcBodyObj(), TclObjInterpProc(), TclObjInvoke(), TclObjTest_Init(), tclOSAAddContext(), tclOSAAddScript(), tclOSAASError(), tclOSAClose(), TclOSACompileCmd(), tclOSADecompileCmd(), tclOSADeleteCmd(), tclOSADeleteContext(), tclOSADeleteScript(), tclOSAExecuteCmd(), tclOSAGetContextID(), tclOSAGetScript(), tclOSAGetScriptID(), tclOSAInfoCmd(), tclOSALoad(), tclOSALoadCmd(), tclOSAMakeContext(), tclOSAMakeNewComponent(), tclOSARunCmd(), tclOSAStore(), tclOSAStoreCmd(), TclParseBackslash(), TclpCloseFile(), TclpCreateCommandChannel(), TclpCreatePipe(), TclpCreateProcess(), TclpCreateTempFile(), TclpDeleteFile(), TclpDlopen(), TclpFilesystemPathType(), TclpFinalizePipes(), TclpFinalizeSockets(), TclpFindExecutable(), TclpFindSymbol(), TclpFindVariable(), TclpGetCwd(), TclpGetDefaultStdChannel(), TclpGetGrGid(), TclpGetGrNam(), TclpGetHostByAddr(), TclpGetHostByName(), TclpGetNativePathType(), TclpGetPid(), TclpGetPwNam(), TclpGetPwUid(), TclpGetTZName(), TclpGetUserHome(), TclpHasSockets(), TclpInitLibraryPath(), TclpInitPlatform(), TclplatformtestInit(), TclpMakeFile(), TclpMatchInDirectory(), TclpNativeJoinPath(), TclpNativeSplitPath(), TclpObjAccess(), TclpObjChdir(), TclpObjCopyDirectory(), TclpObjGetCwd(), TclpObjListVolumes(), TclpObjNormalizePath(), TclpObjRemoveDirectory(), TclpObjStat(), TclpObjStatAlias(), TclpOpenFile(), TclpOpenFileChannel(), TclpReadlink(), TclPrecTraceProc(), TclPreventAliasLoop(), TclPrintSource(), TclProcCleanupProc(), TclProcCompileProc(), TclpSetInitialEncodings(), TclpSetVariables(), TclpSysAlloc(), TclpSysFree(), TclpSysRealloc(), TclpTempFileName(), TclpThreadCreate(), TclpThreadExit(), TclpUnloadFile(), TclPushVarName(), TclpUtime(), TclRegError(), TclRegisterAuxDataType(), TclRegisterLiteral(), TclReleaseLiteral(), TclRenameCommand(), TclResetShadowedCmdRefs(), TclServiceIdle(), TclSetAppContext(), TclSetByteCodeFromAny(), TclSetLibraryPath(), TclSetStartupScriptPath(), TclSockGetPort(), TclTeardownNamespace(), Tcltest_Init(), TclThreadDataKeySet(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), TclTransferResult(), TclUnixWaitForFile(), TclUpdateReturnInfo(), TclWinDriveLetterForVolMountPoint(), TclWinEncodingsCleanup(), TclWinFlushDirtyChannels(), TclWinGetServByName(), TclWinOpenConsoleChannel(), TclWinOpenFileChannel(), TclWinOpenSerialChannel(), TclWinResetInterfaceEncodings(), TclWinSetInterfaces(), TclWinSymLinkDelete(), Tclxttest_Init(), TcpAccept(), TcpAcceptCallbacksDeleteProc(), TcpClose(), TcpGetOptionProc(), TcpOutput(), TcpServerCloseProc(), TcpSetOptionProc(), TcpThreadActionProc(), TestAccessProc1(), TestAccessProc2(), TestAccessProc3(), TestaccessprocCmd(), TestalarmCmd(), TestasyncCmd(), TestbooleanobjCmd(), TestChannelCmd(), TestChannelEventCmd(), TestchmodCmd(), TestcmdinfoCmd(), TestcmdtokenCmd(), TestcmdtraceCmd(), TestconvertobjCmd(), TestcreatecommandCmd(), TestdelassocdataCmd(), TestdelCmd(), TestdoubleobjCmd(), TestdstringCmd(), TestencodingObjCmd(), TestevalexObjCmd(), TesteventDeleteProc(), TesteventloopCmd(), TesteventObjCmd(), TestExceptionCmd(), TestexithandlerCmd(), TestexprlongCmd(), TestexprstringCmd(), TestfeventCmd(), TestfileCmd(), TestfilehandlerCmd(), TestfilelinkCmd(), TestfilewaitCmd(), TestfindexecutableCmd(), TestgetassocdataCmd(), TestgetdefencdirCmd(), TestGetIndexFromObjStructObjCmd(), TestgetopenfileCmd(), TestgetplatformCmd(), TestgetvarfullnameCmd(), TestgotsigCmd(), TestindexobjCmd(), TestinterpdeleteCmd(), TestlinkCmd(), TestlocaleCmd(), TestOpenFileChannelProc1(), TestOpenFileChannelProc2(), TestOpenFileChannelProc3(), TestopenfilechannelprocCmd(), TestparsevarObjCmd(), TestplatformChmod(), TestregexpObjCmd(), TestReport(), TestReportAccess(), TestReportChdir(), TestReportCreateDirectory(), TestReportDeleteFile(), TestReportFileAttrsGet(), TestReportFileAttrStrings(), TestReportFreeInternalRep(), TestReportInFilesystem(), TestReportLoadFile(), TestReportLstat(), TestReportMatchInDirectory(), TestReportNormalizePath(), TestReportOpenFileChannel(), TestReportRemoveDirectory(), TestReportStat(), TestReportUtime(), TestsaveresultCmd(), TestsetassocdataCmd(), TestsetCmd(), TestsetdefencdirCmd(), TestseterrorcodeCmd(), TestsetplatformCmd(), TestSimpleFilesystemObjCmd(), TeststaticpkgCmd(), TestStatProc1(), TestStatProc2(), TestStatProc3(), TeststatprocCmd(), TesttranslatefilenameCmd(), TestupvarCmd(), TestvolumetypeCmd(), TestWrongNumArgsObjCmd(), TimerExitProc(), TimerHandlerEventProc(), TraceCommandProc(), TraceExecutionProc(), TraceVarProc(), TransformChannelHandlerTimer(), TransformCloseProc(), TransformGetOptionProc(), TransformInputProc(), TransformNotifyProc(), TransformSeekProc(), TransformSetOptionProc(), TransformWatchProc(), TransformWideSeekProc(), TranslateInputEOL(), TraversalCopy(), TraversalDelete(), TraverseUnixTree(), TraverseWinTree(), TryToLoad(), uncolorchain(), UnlinkSymbolTable(), UnregisterTcpServerInterpCleanupProc(), UpdateInterest(), UpdateStringOfNsName(), UpdateStringOfString(), ValidateFormat(), VerifyExprObjType(), VwaitVarProc(), WaitForEvent(), WaitForRead(), WaitForSocketEvent(), waitpid(), WinLink(), WinReadLink(), WinReadLinkDirectory(), wordchrs(), WriteBytes(), WriteChars(), WriteTextResource(), and zapmem().
Function Documentation
char* strstr (char * string, char * substring)

Definition at line 42 of file strstr.c.
References NULL.
Referenced by CheckForCompilerFeature(), CheckForLinkerFeature(), IsIn(), ObjMakeUpvar(), Tcl_CreateCommand(), Tcl_CreateObjCommand(), Tcl_ExposeCommand(), Tcl_HideCommand(), Tcl_OSACmd(), TclLookupSimpleVar(), TclpDlopen(), TestAccessProc1(), TestAccessProc2(), TestAccessProc3(), TestStatProc1(), TestStatProc2(), and TestStatProc3().45 {
46     register char *a, *b;
47 
48     /* First scan quickly through the two strings looking for a
49      * single-character match.  When it's found, then compare the
50      * rest of the substring.
51      */
52 
53     b = substring;
54     if (*b == 0) {
55   return string;
56     }
57     for ( ; *string != 0; string += 1) {
58   if (*string != *b) {
59       continue;
60   }
61   a = string;
62   while (1) {
63       if (*b == 0) {
64     return string;
65       }
66       if (*a++ != *b++) {
67     break;
68       }
69   }
70   b = substring;
71     }
72     return NULL;
73 }

compat/strtod.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include <ctype.h>
Defines
#define TRUE  1
#define FALSE  0
#define NULL  0
Functions
double strtod (CONST char *string, char **endPtr)
Variables
static int maxExponent = 511
static double powersOf10 []

Define Documentation
#define FALSE  0

Definition at line 21 of file strtod.c.
Referenced by blockingRead(), blockingWrite(), CalibrationThread(), CheckForCompilerFeature(), ConsoleCloseProc(), ConsoleOutputProc(), ConsoleReaderThread(), ConsoleWriterThread(), DdeServerProc(), DoCopyFile(), DoRemoveJustDirectory(), DoRenameFile(), FileCloseProc(), FileInputProc(), FileOutputProc(), FSpLLocationFromPath(), FSpLocationFromPathAlias(), HasConsole(), InitSockets(), main(), NativeAccess(), PipeOutputProc(), PipeReaderThread(), PipeWriterThread(), SerialCloseProc(), SerialInputProc(), SerialSetOptionProc(), SerialWriterThread(), sigHandler(), strtod(), TCL_DECLARE_MUTEX(), Tcl_GetTime(), Tcl_MacOSXOpenVersionedBundleResources(), Tcl_MakeFileChannel(), Tcl_WaitForEvent(), TclpCloseFile(), TclpCreateCommandChannel(), TclpCreateProcess(), TclpDeleteFile(), TclpObjLstat(), TclpObjNormalizePath(), TclWinOpenConsoleChannel(), TclWinOpenSerialChannel(), TclWinSerialReopen(), TestplatformChmod(), TraversalCopy(), and WaitForRead().#define NULL  0

Definition at line 24 of file strtod.c.#define TRUE  1

Definition at line 20 of file strtod.c.
Referenced by blockingRead(), blockingWrite(), CheckForCompilerFeature(), CheckForLinkerFeature(), ConsoleInputProc(), CreateTempFile(), DdeEnumWindowsCallback(), DdeServerProc(), FSpLocationFromPath(), HasConsole(), InitSockets(), main(), NativeStat(), PipeInputProc(), SerialSetOptionProc(), SerialWriterThread(), sigHandler(), strtod(), Tcl_AppInit(), TCL_DECLARE_MUTEX(), Tcl_GetTime(), Tcl_MacOSXOpenVersionedBundleResources(), TclpCreateCommandChannel(), TclpCreateProcess(), TclpMatchInDirectory(), TclpObjNormalizePath(), TclpObjStat(), TclpSetVariables(), TclWinOpenConsoleChannel(), TclWinOpenSerialChannel(), TestplatformChmod(), and WaitForRead().
Function Documentation
double strtod (CONST char * string, char ** endPtr)

Definition at line 66 of file strtod.c.
References CONST, ERANGE, errno, FALSE, maxExponent, NULL, powersOf10, TRUE, and UCHAR.81 {
82     int sign, expSign = FALSE;
83     double fraction, dblExp, *d;
84     register CONST char *p;
85     register int c;
86     int exp = 0;    /* Exponent read from "EX" field. */
87     int fracExp = 0;    /* Exponent that derives from the fractional
88          * part.  Under normal circumstatnces, it is
89          * the negative of the number of digits in F.
90          * However, if I is very long, the last digits
91          * of I get dropped (otherwise a long I with a
92          * large negative exponent could cause an
93          * unnecessary overflow on I alone).  In this
94          * case, fracExp is incremented one for each
95          * dropped digit. */
96     int mantSize;   /* Number of digits in mantissa. */
97     int decPt;      /* Number of mantissa digits BEFORE decimal
98          * point. */
99     CONST char *pExp;   /* Temporarily holds location of exponent
100          * in string. */
101 
102     /*
103      * Strip off leading blanks and check for a sign.
104      */
105 
106     p = string;
107     while (isspace(UCHAR(*p))) {
108   p += 1;
109     }
110     if (*p == '-') {
111   sign = TRUE;
112   p += 1;
113     } else {
114   if (*p == '+') {
115       p += 1;
116   }
117   sign = FALSE;
118     }
119 
120     /*
121      * Count the number of digits in the mantissa (including the decimal
122      * point), and also locate the decimal point.
123      */
124 
125     decPt = -1;
126     for (mantSize = 0; ; mantSize += 1)
127     {
128   c = *p;
129   if (!isdigit(c)) {
130       if ((c != '.') || (decPt >= 0)) {
131     break;
132       }
133       decPt = mantSize;
134   }
135   p += 1;
136     }
137 
138     /*
139      * Now suck up the digits in the mantissa.  Use two integers to
140      * collect 9 digits each (this is faster than using floating-point).
141      * If the mantissa has more than 18 digits, ignore the extras, since
142      * they can't affect the value anyway.
143      */
144     
145     pExp  = p;
146     p -= mantSize;
147     if (decPt < 0) {
148   decPt = mantSize;
149     } else {
150   mantSize -= 1;      /* One of the digits was the point. */
151     }
152     if (mantSize > 18) {
153   fracExp = decPt - 18;
154   mantSize = 18;
155     } else {
156   fracExp = decPt - mantSize;
157     }
158     if (mantSize == 0) {
159   fraction = 0.0;
160   p = string;
161   goto done;
162     } else {
163   int frac1, frac2;
164   frac1 = 0;
165   for ( ; mantSize > 9; mantSize -= 1)
166   {
167       c = *p;
168       p += 1;
169       if (c == '.') {
170     c = *p;
171     p += 1;
172       }
173       frac1 = 10*frac1 + (c - '0');
174   }
175   frac2 = 0;
176   for (; mantSize > 0; mantSize -= 1)
177   {
178       c = *p;
179       p += 1;
180       if (c == '.') {
181     c = *p;
182     p += 1;
183       }
184       frac2 = 10*frac2 + (c - '0');
185   }
186   fraction = (1.0e9 * frac1) + frac2;
187     }
188 
189     /*
190      * Skim off the exponent.
191      */
192 
193     p = pExp;
194     if ((*p == 'E') || (*p == 'e')) {
195   p += 1;
196   if (*p == '-') {
197       expSign = TRUE;
198       p += 1;
199   } else {
200       if (*p == '+') {
201     p += 1;
202       }
203       expSign = FALSE;
204   }
205   if (!isdigit(UCHAR(*p))) {
206       p = pExp;
207       goto done;
208   }
209   while (isdigit(UCHAR(*p))) {
210       exp = exp * 10 + (*p - '0');
211       p += 1;
212   }
213     }
214     if (expSign) {
215   exp = fracExp - exp;
216     } else {
217   exp = fracExp + exp;
218     }
219 
220     /*
221      * Generate a floating-point number that represents the exponent.
222      * Do this by processing the exponent one bit at a time to combine
223      * many powers of 2 of 10. Then combine the exponent with the
224      * fraction.
225      */
226     
227     if (exp < 0) {
228   expSign = TRUE;
229   exp = -exp;
230     } else {
231   expSign = FALSE;
232     }
233     if (exp > maxExponent) {
234   exp = maxExponent;
235   errno = ERANGE;
236     }
237     dblExp = 1.0;
238     for (d = powersOf10; exp != 0; exp >>= 1, d += 1) {
239   if (exp & 01) {
240       dblExp *= *d;
241   }
242     }
243     if (expSign) {
244   fraction /= dblExp;
245     } else {
246   fraction *= dblExp;
247     }
248 
249 done:
250     if (endPtr != NULL) {
251   *endPtr = (char *) p;
252     }
253 
254     if (sign) {
255   return -fraction;
256     }
257     return fraction;
258 }

Variable Documentation
int maxExponent = 511 [static]

Definition at line 27 of file strtod.c.
Referenced by strtod().double powersOf10[] [static]
Initial value: {  
    10.,      
    100.,     
    1.0e4,
    1.0e8,
    1.0e16,
    1.0e32,
    1.0e64,
    1.0e128,
    1.0e256
}
Definition at line 32 of file strtod.c.
Referenced by strtod().

compat/strtol.c File Reference
#include <ctype.h>
#include "tclInt.h"
#include "tclPort.h"
Functions
long int strtol (CONST char *string, char **endPtr, int base)

Function Documentation
long int strtol (CONST char * string, char ** endPtr, int base)

Definition at line 41 of file strtol.c.
References CONST, strtoul(), and UCHAR.
Referenced by LoadTableEncoding(), SetBooleanFromAny(), Tcl_ScanObjCmd(), Tcl_StringObjCmd(), TclpCreateProcess(), TclpInitPlatform(), and TestchmodCmd().51                                                 :
52          * "0x" means hex, "0" means octal, anything
53          * else means decimal.
54          */
55 {
56     register CONST char *p;
57     long result;
58 
59     /*
60      * Skip any leading blanks.
61      */
62 
63     p = string;
64     while (isspace(UCHAR(*p))) {
65   p += 1;
66     }
67 
68     /*
69      * Check for a sign.
70      */
71 
72     if (*p == '-') {
73   p += 1;
74   result = -(strtoul(p, endPtr, base));
75     } else {
76   if (*p == '+') {
77       p += 1;
78   }
79   result = strtoul(p, endPtr, base);
80     }
81     if ((result == 0) && (endPtr != 0) && (*endPtr == p)) {
82   *endPtr = (char *) string;
83     }
84     return result;
85 }
}

compat/strtoll.c File Reference
#include "tcl.h"
#include "tclPort.h"
#include <ctype.h>
Defines
#define TCL_WIDEINT_MAX  (((Tcl_WideUInt)Tcl_LongAsWide(-1))>>1)
Functions
Tcl_WideInt strtoll (CONST char *string, char **endPtr, int base)

Define Documentation
#define TCL_WIDEINT_MAX  (((Tcl_WideUInt)Tcl_LongAsWide(-1))>>1)

Definition at line 19 of file strtoll.c.
Referenced by strtoll().
Function Documentation
Tcl_WideInt strtoll (CONST char * string, char ** endPtr, int base)

Definition at line 47 of file strtoll.c.
References CONST, ERANGE, errno, strtoull(), Tcl_LongAsWide, TCL_WIDEINT_MAX, and UCHAR.
Referenced by SetBooleanFromAny(), and Tcl_ScanObjCmd().57                                                 :
58          * "0x" means hex, "0" means octal, anything
59          * else means decimal.
60          */
61 {
62     register CONST char *p;
63     Tcl_WideInt result = Tcl_LongAsWide(0);
64     Tcl_WideUInt uwResult;
65 
66     /*
67      * Skip any leading blanks.
68      */
69 
70     p = string;
71     while (isspace(UCHAR(*p))) {
72   p += 1;
73     }
74 
75     /*
76      * Check for a sign.
77      */
78 
79     errno = 0;
80     if (*p == '-') {
81   p += 1;
82   uwResult = strtoull(p, endPtr, base);
83   if (errno != ERANGE) {
84       if (uwResult > TCL_WIDEINT_MAX+1) {
85     errno = ERANGE;
86     return Tcl_LongAsWide(-1);
87       } else if (uwResult > TCL_WIDEINT_MAX) {
88     return ~((Tcl_WideInt)TCL_WIDEINT_MAX);
89       } else {
90     result = -((Tcl_WideInt) uwResult);
91       }
92   }
93     } else {
94   if (*p == '+') {
95       p += 1;
96   }
97   uwResult = strtoull(p, endPtr, base);
98   if (errno != ERANGE) {
99       if (uwResult > TCL_WIDEINT_MAX) {
100     errno = ERANGE;
101     return Tcl_LongAsWide(-1);
102       } else {
103     result = uwResult;
104       }
105   }
106     }
107     if ((result == 0) && (endPtr != 0) && (*endPtr == p)) {
108   *endPtr = (char *) string;
109     }
110     return result;
111 }
}

compat/strtoul.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Functions
unsigned long int strtoul (CONST char *string, char **endPtr, int base)
Variables
static char cvtIn []

Function Documentation
unsigned long int strtoul (CONST char * string, char ** endPtr, int base)

Definition at line 56 of file strtoul.c.
References CONST, cvtIn, ERANGE, errno, and UCHAR.
Referenced by GetAfterEvent(), GetFormatSpec(), SetArraySearchObj(), SetIntOrWideFromAny(), strtol(), Tcl_FormatObjCmd(), Tcl_GetInt(), Tcl_ScanObjCmd(), Tcl_StringObjCmd(), TclGetLong(), TclPrecTraceProc(), and ValidateFormat().66                                                 :
67          * "0x" means hex, "0" means octal, anything
68          * else means decimal.
69          */
70 {
71     register CONST char *p;
72     register unsigned long int result = 0;
73     register unsigned digit;
74     int anyDigits = 0;
75     int negative=0;
76     int overflow=0;
77 
78     /*
79      * Skip any leading blanks.
80      */
81 
82     p = string;
83     while (isspace(UCHAR(*p))) {
84   p += 1;
85     }
86     if (*p == '-') {
87         negative = 1;
88         p += 1;
89     } else {
90         if (*p == '+') {
91             p += 1;
92         }
93     }
94 
95     /*
96      * If no base was provided, pick one from the leading characters
97      * of the string.
98      */
99     
100     if (base == 0)
101     {
102   if (*p == '0') {
103       p += 1;
104       if ((*p == 'x') || (*p == 'X')) {
105     p += 1;
106     base = 16;
107       } else {
108 
109     /*
110      * Must set anyDigits here, otherwise "0" produces a
111      * "no digits" error.
112      */
113 
114     anyDigits = 1;
115     base = 8;
116       }
117   }
118   else base = 10;
119     } else if (base == 16) {
120 
121   /*
122    * Skip a leading "0x" from hex numbers.
123    */
124 
125   if ((p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) {
126       p += 2;
127   }
128     }
129 
130     /*
131      * Sorry this code is so messy, but speed seems important.  Do
132      * different things for base 8, 10, 16, and other.
133      */
134 
135     if (base == 8) {
136   unsigned long maxres = ULONG_MAX >> 3;
137   for ( ; ; p += 1) {
138       digit = *p - '0';
139       if (digit > 7) {
140     break;
141       }
142       if (result > maxres) { overflow = 1; }
143       result = (result << 3);
144       if (digit > (ULONG_MAX - result)) { overflow = 1; }
145       result += digit;
146       anyDigits = 1;
147   }
148     } else if (base == 10) {
149   unsigned long maxres = ULONG_MAX / 10;
150   for ( ; ; p += 1) {
151       digit = *p - '0';
152       if (digit > 9) {
153     break;
154       }
155       if (result > maxres) { overflow = 1; }
156       result *= 10;
157       if (digit > (ULONG_MAX - result)) { overflow = 1; }
158       result += digit;
159       anyDigits = 1;
160   }
161     } else if (base == 16) {
162   unsigned long maxres = ULONG_MAX >> 4;
163   for ( ; ; p += 1) {
164       digit = *p - '0';
165       if (digit > ('z' - '0')) {
166     break;
167       }
168       digit = cvtIn[digit];
169       if (digit > 15) {
170     break;
171       }
172       if (result > maxres) { overflow = 1; }
173       result = (result << 4);
174       if (digit > (ULONG_MAX - result)) { overflow = 1; }
175       result += digit;
176       anyDigits = 1;
177   }
178     } else if ( base >= 2 && base <= 36 ) {
179   unsigned long maxres = ULONG_MAX / base;
180   for ( ; ; p += 1) {
181       digit = *p - '0';
182       if (digit > ('z' - '0')) {
183     break;
184       }
185       digit = cvtIn[digit];
186       if (digit >= ( (unsigned) base )) {
187     break;
188       }
189       if (result > maxres) { overflow = 1; }
190       result *= base;
191       if (digit > (ULONG_MAX - result)) { overflow = 1; }
192       result += digit;
193       anyDigits = 1;
194   }
195     }
196 
197     /*
198      * See if there were any digits at all.
199      */
200 
201     if (!anyDigits) {
202   p = string;
203     }
204 
205     if (endPtr != 0) {
206   /* unsafe, but required by the strtoul prototype */
207   *endPtr = (char *) p;
208     }
209 
210     if (overflow) {
211   errno = ERANGE;
212   return ULONG_MAX;
213     } 
214     if (negative) {
215   return -result;
216     }
217     return result;
218 }
}

Variable Documentation
char cvtIn[] [static]
Initial value: {
    0, 1, 2, 3, 4, 5, 6, 7, 8, 9,   
    100, 100, 100, 100, 100, 100, 100,    
    10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 
    20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
    30, 31, 32, 33, 34, 35,
    100, 100, 100, 100, 100, 100,   
    10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 
    20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
    30, 31, 32, 33, 34, 35}
Definition at line 24 of file strtoul.c.
Referenced by strtoul(), and strtoull().

compat/strtoull.c File Reference
#include "tcl.h"
#include "tclPort.h"
#include <ctype.h>
Functions
Tcl_WideUInt strtoull (CONST char *string, char **endPtr, int base)
Variables
static char cvtIn []

Function Documentation
Tcl_WideUInt strtoull (CONST char * string, char ** endPtr, int base)

Definition at line 62 of file strtoull.c.
References CONST, cvtIn, ERANGE, errno, Tcl_LongAsWide, and UCHAR.
Referenced by SetWideIntFromAny(), strtoll(), Tcl_ScanObjCmd(), and Tcl_StringObjCmd().72                                                 :
73          * "0x" means hex, "0" means octal, anything
74          * else means decimal.
75          */
76 {
77     register CONST char *p;
78     register Tcl_WideUInt result = 0;
79     register unsigned digit;
80     register Tcl_WideUInt shifted;
81     int anyDigits = 0, negative = 0;
82 
83     /*
84      * Skip any leading blanks.
85      */
86 
87     p = string;
88     while (isspace(UCHAR(*p))) {  /* INTL: locale-dependent */
89   p += 1;
90     }
91 
92     /*
93      * Check for a sign.
94      */
95 
96     if (*p == '-') {
97   p += 1;
98   negative = 1;
99     } else {
100   if (*p == '+') {
101       p += 1;
102   }
103     }
104 
105     /*
106      * If no base was provided, pick one from the leading characters
107      * of the string.
108      */
109     
110     if (base == 0) {
111   if (*p == '0') {
112       p += 1;
113       if (*p == 'x' || *p == 'X') {
114     p += 1;
115     base = 16;
116       } else {
117 
118     /*
119      * Must set anyDigits here, otherwise "0" produces a
120      * "no digits" error.
121      */
122 
123     anyDigits = 1;
124     base = 8;
125       }
126   } else {
127       base = 10;
128   }
129     } else if (base == 16) {
130 
131   /*
132    * Skip a leading "0x" from hex numbers.
133    */
134 
135   if ((p[0] == '0') && (p[1] == 'x' || *p == 'X')) {
136       p += 2;
137   }
138     }
139 
140     /*
141      * Sorry this code is so messy, but speed seems important.  Do
142      * different things for base 8, 10, 16, and other.
143      */
144 
145     if (base == 8) {
146   for ( ; ; p += 1) {
147       digit = *p - '0';
148       if (digit > 7) {
149     break;
150       }
151       shifted = result << 3;
152       if ((shifted >> 3) != result) {
153     goto overflow;
154       }
155       result = shifted + digit;
156       if ( result < shifted ) {
157     goto overflow;
158       }
159       anyDigits = 1;
160   }
161     } else if (base == 10) {
162   for ( ; ; p += 1) {
163       digit = *p - '0';
164       if (digit > 9) {
165     break;
166       }
167       shifted = 10 * result;
168       if ((shifted / 10) != result) {
169     goto overflow;
170       }
171       result = shifted + digit;
172       if ( result < shifted ) {
173     goto overflow;
174       }
175       anyDigits = 1;
176   }
177     } else if (base == 16) {
178   for ( ; ; p += 1) {
179       digit = *p - '0';
180       if (digit > ('z' - '0')) {
181     break;
182       }
183       digit = cvtIn[digit];
184       if (digit > 15) {
185     break;
186       }
187       shifted = result << 4;
188       if ((shifted >> 4) != result) {
189     goto overflow;
190       }
191       result = shifted + digit;
192       if ( result < shifted ) {
193     goto overflow;
194       }
195       anyDigits = 1;
196   }
197     } else if ( base >= 2 && base <= 36 ) {
198   for ( ; ; p += 1) {
199       digit = *p - '0';
200       if (digit > ('z' - '0')) {
201     break;
202       }
203       digit = cvtIn[digit];
204       if (digit >= (unsigned) base) {
205     break;
206       }
207       shifted = result * base;
208       if ((shifted/base) != result) {
209     goto overflow;
210       }
211       result = shifted + digit;
212       if ( result < shifted ) {
213     goto overflow;
214       }
215       anyDigits = 1;
216   }
217     }
218 
219     /*
220      * Negate if we found a '-' earlier.
221      */
222 
223     if (negative) {
224   result = (Tcl_WideUInt)(-((Tcl_WideInt)result));
225     }
226 
227     /*
228      * See if there were any digits at all.
229      */
230 
231     if (!anyDigits) {
232   p = string;
233     }
234 
235     if (endPtr != 0) {
236   *endPtr = (char *) p;
237     }
238 
239     return result;
240 
241     /*
242      * On overflow generate the right output
243      */
244 
245  overflow:
246     errno = ERANGE;
247     if (endPtr != 0) {
248   for ( ; ; p += 1) {
249       digit = *p - '0';
250       if (digit > ('z' - '0')) {
251     break;
252       }
253       digit = cvtIn[digit];
254       if (digit >= (unsigned) base) {
255     break;
256       }
257   }
258   *endPtr = (char *) p;
259     }
260     return (Tcl_WideUInt)Tcl_LongAsWide(-1);
261 }
}

Variable Documentation
char cvtIn[] [static]
Initial value: {
    0, 1, 2, 3, 4, 5, 6, 7, 8, 9,   
    100, 100, 100, 100, 100, 100, 100,    
    10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 
    20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
    30, 31, 32, 33, 34, 35,
    100, 100, 100, 100, 100, 100,   
    10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 
    20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
    30, 31, 32, 33, 34, 35}
Definition at line 25 of file strtoull.c.

compat/tclErrno.h File Reference
Defines
#define EPERM  1
#define ENOENT  2
#define ESRCH  3
#define EINTR  4
#define EIO  5
#define ENXIO  6
#define E2BIG  7
#define ENOEXEC  8
#define EBADF  9
#define ECHILD  10
#define EDEADLK  11
#define ENOMEM  12
#define EACCES  13
#define EFAULT  14
#define ENOTBLK  15
#define EBUSY  16
#define EEXIST  17
#define EXDEV  18
#define ENODEV  19
#define ENOTDIR  20
#define EISDIR  21
#define EINVAL  22
#define ENFILE  23
#define EMFILE  24
#define ENOTTY  25
#define ETXTBSY  26
#define EFBIG  27
#define ENOSPC  28
#define ESPIPE  29
#define EROFS  30
#define EMLINK  31
#define EPIPE  32
#define EDOM  33
#define ERANGE  34
#define EAGAIN  35
#define EWOULDBLOCK  EAGAIN
#define EINPROGRESS  36
#define EALREADY  37
#define ENOTSOCK  38
#define EDESTADDRREQ  39
#define EMSGSIZE  40
#define EPROTOTYPE  41
#define ENOPROTOOPT  42
#define EPROTONOSUPPORT  43
#define ESOCKTNOSUPPORT  44
#define EOPNOTSUPP  45
#define EPFNOSUPPORT  46
#define EAFNOSUPPORT  47
#define EADDRINUSE  48
#define EADDRNOTAVAIL  49
#define ENETDOWN  50
#define ENETUNREACH  51
#define ENETRESET  52
#define ECONNABORTED  53
#define ECONNRESET  54
#define ENOBUFS  55
#define EISCONN  56
#define ENOTCONN  57
#define ESHUTDOWN  58
#define ETOOMANYREFS  59
#define ETIMEDOUT  60
#define ECONNREFUSED  61
#define ELOOP  62
#define ENAMETOOLONG  63
#define EHOSTDOWN  64
#define EHOSTUNREACH  65
#define ENOTEMPTY  66
#define EPROCLIM  67
#define EUSERS  68
#define EDQUOT  69
#define ESTALE  70
#define EREMOTE  71
#define EBADRPC  72
#define ERPCMISMATCH  73
#define EPROGUNAVAIL  74
#define EPROGMISMATCH  75
#define EPROCUNAVAIL  76
#define ENOLCK  77
#define ENOSYS  78
#define EOVERFLOW  79
Variables
int errno

Define Documentation
#define E2BIG  7

Definition at line 25 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EACCES  13

Definition at line 32 of file tclErrno.h.
Referenced by CheckChannelErrors(), DoCopyFile(), DoRemoveJustDirectory(), DoRenameFile(), FileInput(), NativeAccess(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), TclMacOSErrorToPosixError(), TclpDeleteFile(), TclpObjAccess(), and TclpObjChdir().#define EADDRINUSE  48

Definition at line 68 of file tclErrno.h.
Referenced by CreateSocket(), Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EADDRNOTAVAIL  49

Definition at line 69 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EAFNOSUPPORT  47

Definition at line 67 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EAGAIN  35

Definition at line 54 of file tclErrno.h.
Referenced by ConsoleOutputProc(), DoReadChars(), FlushChannel(), GetInput(), PipeOutputProc(), SerialInputProc(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), TransformInputProc(), and WaitForRead().#define EALREADY  37

Definition at line 57 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EBADF  9

Definition at line 27 of file tclErrno.h.
Referenced by DoCopyFile(), DoRenameFile(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), TclpGetDefaultStdChannel(), and TclpInitPlatform().#define EBADRPC  72

Definition at line 92 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EBUSY  16

Definition at line 35 of file tclErrno.h.
Referenced by CheckChannelErrors(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), and TclMacOSErrorToPosixError().#define ECHILD  10

Definition at line 28 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), Tcl_ErrnoMsg(), Tcl_ReapDetachedProcs(), and TclCleanupChildren().#define ECONNABORTED  53

Definition at line 73 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ECONNREFUSED  61

Definition at line 81 of file tclErrno.h.
Referenced by CreateSocket(), Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ECONNRESET  54

Definition at line 74 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), Tcl_ErrnoMsg(), and TcpInputProc().#define EDEADLK  11

Definition at line 29 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EDESTADDRREQ  39

Definition at line 59 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EDOM  33

Definition at line 52 of file tclErrno.h.
Referenced by _matherr(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), and TclExprFloatError().#define EDQUOT  69

Definition at line 89 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EEXIST  17

Definition at line 36 of file tclErrno.h.
Referenced by CopyRenameOneFile(), DoRemoveDirectory(), DoRemoveJustDirectory(), DoRenameFile(), OpenFileChannel(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), Tcl_FileObjCmd(), TclFileDeleteCmd(), TclFileMakeDirsCmd(), TclMacOSErrorToPosixError(), and WinLink().#define EFAULT  14

Definition at line 33 of file tclErrno.h.
Referenced by CreateSocketAddress(), OpenFileChannel(), StdIOBlockMode(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), Tcl_Seek(), Tcl_Tell(), TcpInputProc(), and TcpOutputProc().#define EFBIG  27

Definition at line 46 of file tclErrno.h.
Referenced by PretendTclpStat(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), and Tcl_Stat().#define EHOSTDOWN  64

Definition at line 84 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EHOSTUNREACH  65

Definition at line 85 of file tclErrno.h.
Referenced by CreateSocket(), CreateSocketAddress(), Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EINPROGRESS  36

Definition at line 56 of file tclErrno.h.
Referenced by CreateSocket(), Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EINTR  4

Definition at line 22 of file tclErrno.h.
Referenced by FlushChannel(), PipeInputProc(), PipeOutputProc(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), and Tcl_WaitPid().#define EINVAL  22

Definition at line 41 of file tclErrno.h.
Referenced by CheckForDeadChannel(), CopyRenameOneFile(), DoRenameFile(), FileInput(), GetInput(), NativeReadReparse(), Tcl_BadChannelOption(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), Tcl_FSLink(), Tcl_Seek(), Tcl_Tell(), TclMacOSErrorToPosixError(), TclpDeleteFile(), TclpReadlink(), TclWinConvertError(), TclWinConvertWSAError(), TcpInput(), TransformInputProc(), TransformOutputProc(), waitpid(), WinReadLinkDirectory(), and WriteChars().#define EIO  5

Definition at line 23 of file tclErrno.h.
Referenced by DoRenameFile(), FileInput(), SerialInputProc(), SerialOutputProc(), Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EISCONN  56

Definition at line 76 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EISDIR  21

Definition at line 40 of file tclErrno.h.
Referenced by CopyRenameOneFile(), DoCopyFile(), DoRenameFile(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), TclpDeleteFile(), and WinLink().#define ELOOP  62

Definition at line 82 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EMFILE  24

Definition at line 43 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EMLINK  31

Definition at line 50 of file tclErrno.h.
Referenced by CopyRenameOneFile(), Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EMSGSIZE  40

Definition at line 60 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ENAMETOOLONG  63

Definition at line 83 of file tclErrno.h.
Referenced by DoRenameFile(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), TclMacOSErrorToPosixError(), and TclpReadlink().#define ENETDOWN  50

Definition at line 70 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ENETRESET  52

Definition at line 72 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ENETUNREACH  51

Definition at line 71 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ENFILE  23

Definition at line 42 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), Tcl_ErrnoMsg(), and TclMacOSErrorToPosixError().#define ENOBUFS  55

Definition at line 75 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ENODEV  19

Definition at line 38 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), Tcl_ErrnoMsg(), and WinLink().#define ENOENT  2

Definition at line 20 of file tclErrno.h.
Referenced by CopyRenameOneFile(), DoCopyFile(), DoRemoveJustDirectory(), DoRenameFile(), NativeStat(), readExports(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), Tcl_FileObjCmd(), Tcl_FSAccess(), Tcl_FSChdir(), Tcl_FSCreateDirectory(), Tcl_FSDeleteFile(), Tcl_FSFileAttrsGet(), Tcl_FSFileAttrsSet(), Tcl_FSFileAttrStrings(), Tcl_FSLink(), Tcl_FSLoadFile(), Tcl_FSLstat(), Tcl_FSMatchInDirectory(), Tcl_FSOpenFileChannel(), Tcl_FSRemoveDirectory(), Tcl_FSStat(), TclFileDeleteCmd(), TclFileMakeDirsCmd(), TclMacOSErrorToPosixError(), TclpDeleteFile(), TclpObjChdir(), and TclpObjStat().#define ENOEXEC  8

Definition at line 26 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ENOLCK  77

Definition at line 97 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ENOMEM  12

Definition at line 31 of file tclErrno.h.
Referenced by findMain(), readExports(), Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ENOPROTOOPT  42

Definition at line 62 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ENOSPC  28

Definition at line 47 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), Tcl_ErrnoMsg(), and TclMacOSErrorToPosixError().#define ENOSYS  78

Definition at line 98 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ENOTBLK  15

Definition at line 34 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ENOTCONN  57

Definition at line 77 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), Tcl_ErrnoMsg(), TcpInput(), and TcpOutput().#define ENOTDIR  20

Definition at line 39 of file tclErrno.h.
Referenced by DoRemoveDirectory(), DoRemoveJustDirectory(), DoRenameFile(), FileCopyRename(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), TclMacOSErrorToPosixError(), TclpObjChdir(), WinLink(), and WinReadLink().#define ENOTEMPTY  66

Definition at line 86 of file tclErrno.h.
Referenced by DoRemoveDirectory(), DoRemoveJustDirectory(), DoRenameFile(), Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ENOTSOCK  38

Definition at line 58 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ENOTTY  25

Definition at line 44 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ENXIO  6

Definition at line 24 of file tclErrno.h.
Referenced by CreateSocketAddress(), Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EOPNOTSUPP  45

Definition at line 65 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EOVERFLOW  79

Definition at line 99 of file tclErrno.h.
Referenced by FileSeekProc(), PretendTclpStat(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), Tcl_Seek(), Tcl_Stat(), and TransformWideSeekProc().#define EPERM  1

Definition at line 19 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EPFNOSUPPORT  46

Definition at line 66 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EPIPE  32

Definition at line 51 of file tclErrno.h.
Referenced by FileInputProc(), PipeInputProc(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), TcpOutput(), and WaitForRead().#define EPROCLIM  67

Definition at line 87 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EPROCUNAVAIL  76

Definition at line 96 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EPROGMISMATCH  75

Definition at line 95 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EPROGUNAVAIL  74

Definition at line 94 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EPROTONOSUPPORT  43

Definition at line 63 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EPROTOTYPE  41

Definition at line 61 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ERANGE  34

Definition at line 53 of file tclErrno.h.
Referenced by _matherr(), SetIntOrWideFromAny(), SetWideIntFromAny(), strtod(), strtoll(), strtoul(), strtoull(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), Tcl_GetInt(), Tcl_StringObjCmd(), TclExprFloatError(), and TclGetLong().#define EREMOTE  71

Definition at line 91 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EROFS  30

Definition at line 49 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), Tcl_ErrnoMsg(), TclMacOSErrorToPosixError(), and TclpObjAccess().#define ERPCMISMATCH  73

Definition at line 93 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ESHUTDOWN  58

Definition at line 78 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), Tcl_ErrnoMsg(), TcpInput(), and TcpOutput().#define ESOCKTNOSUPPORT  44

Definition at line 64 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ESPIPE  29

Definition at line 48 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ESRCH  3

Definition at line 21 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ESTALE  70

Definition at line 90 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ETIMEDOUT  60

Definition at line 80 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ETOOMANYREFS  59

Definition at line 79 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define ETXTBSY  26

Definition at line 45 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EUSERS  68

Definition at line 88 of file tclErrno.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EWOULDBLOCK  EAGAIN

Definition at line 55 of file tclErrno.h.
Referenced by CreateSocket(), FlushChannel(), GetInput(), SerialOutputProc(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), TcpInput(), TcpOutput(), TcpOutputProc(), TransformInputProc(), WaitForConnect(), and WaitForSocketEvent().#define EXDEV  18

Definition at line 37 of file tclErrno.h.
Referenced by CopyRenameOneFile(), DoRenameFile(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), Tcl_FSCopyDirectory(), Tcl_FSCopyFile(), Tcl_FSRenameFile(), and TclMacOSErrorToPosixError().
Variable Documentation
int errno

Referenced by _matherr(), ConsoleCloseProc(), ConsoleInputProc(), ConsoleOutputProc(), CopyRenameOneFile(), CreateSocket(), CreateSocketAddress(), dlclose(), DoCopyDirectory(), DoCopyFile(), DoCreateDirectory(), DoRemoveDirectory(), DoRenameFile(), ExprBinaryFunc(), ExprUnaryFunc(), FileBlockModeProc(), FileClose(), FileCloseProc(), FileCopyRename(), FileInput(), FileInputProc(), FileOutput(), FileOutputProc(), FileSeek(), FileSeekProc(), FileWideSeekProc(), findMain(), GetFileFinderAttributes(), GetFileReadOnly(), GetLexeme(), main(), OpenFileChannel(), PipeBlockModeProc(), PipeClose2Proc(), PipeCloseProc(), PipeInputProc(), PipeOutputProc(), PretendTclpStat(), readExports(), SerialCloseProc(), SerialInputProc(), SerialOutputProc(), SetDoubleFromAny(), SetFileFinderAttributes(), SetFileReadOnly(), SetIntOrWideFromAny(), SetWideIntFromAny(), StdIOClose(), StdIOInput(), StdIOOutput(), StdIOSeek(), strtod(), strtoll(), strtoul(), strtoull(), Tcl_ErrnoId(), Tcl_ErrnoMsg(), Tcl_FileObjCmd(), Tcl_FSEvalFile(), Tcl_FSLink(), Tcl_GetDouble(), Tcl_GetErrno(), Tcl_GetInt(), Tcl_PosixError(), Tcl_ReapDetachedProcs(), Tcl_SetErrno(), Tcl_Stat(), Tcl_StringObjCmd(), Tcl_WaitPid(), TclCleanupChildren(), TclExprFloatError(), TclFileDeleteCmd(), TclFileMakeDirsCmd(), TclGetLong(), TclMacChmod(), TclpCreateProcess(), TclpDeleteFile(), TclpGetDefaultStdChannel(), TclpInitPlatform(), TclpObjAccess(), TclpObjChdir(), TclpObjStatAlias(), TclpReadlink(), TcpBlockModeProc(), TcpCloseProc(), TcpGetOptionProc(), TcpInput(), TcpInputProc(), TcpOutput(), TcpOutputProc(), WaitForConnect(), WaitForRead(), and waitpid().

compat/tmpnam.c File Reference
#include <sys/param.h>
#include <sys/stat.h>
#include <sys/file.h>
#include <stdio.h>
Defines
#define P_tmpdir  "/tmp"
Functions
char * tmpnam (char *s)

Define Documentation
#define P_tmpdir  "/tmp"

Definition at line 29 of file tmpnam.c.
Referenced by TclpCreateTempFile(), TclpTempFileName(), and tmpnam().
Function Documentation
char* tmpnam (char * s)

Definition at line 32 of file tmpnam.c.
References P_tmpdir, and void().
Referenced by TclpDlopen(), and TclpTempFileName().34 {
35   static char name[50];
36   char *mktemp();
37 
38   if (!s)
39     s = name;
40   (void)sprintf(s, "%s/XXXXXX", P_tmpdir);
41   return(mktemp(s));
42 }

compat/unistd.h File Reference
#include <sys/types.h>
#include "tcl.h"
Defines
#define NULL  0
Functions
void _exit _ANSI_ARGS_ ((int status))
int access _ANSI_ARGS_ ((CONST char *path, int mode))
int chdir _ANSI_ARGS_ ((CONST char *path))
int chown _ANSI_ARGS_ ((CONST char *path, uid_t owner, gid_t group))
int close _ANSI_ARGS_ ((int fd))
int dup _ANSI_ARGS_ ((int oldfd))
int dup2 _ANSI_ARGS_ ((int oldfd, int newfd))
int execl _ANSI_ARGS_ ((CONST char *path,...))
int execlp _ANSI_ARGS_ ((CONST char *file,...))
int execv _ANSI_ARGS_ ((CONST char *path, char **argv))
int execve _ANSI_ARGS_ ((CONST char *path, char **argv, char **envp))
int execvp _ANSI_ARGS_ ((CONST char *file, char **argv))
pid_t fork _ANSI_ARGS_ ((void))
char *getcwd _ANSI_ARGS_ ((char *buf, size_t size))
int getgroups _ANSI_ARGS_ ((int bufSize, int *buffer))
long lseek _ANSI_ARGS_ ((int fd, long offset, int whence))
int pipe _ANSI_ARGS_ ((int *fildes))
int read _ANSI_ARGS_ ((int fd, char *buf, size_t size))
int setgid _ANSI_ARGS_ ((gid_t group))
int setuid _ANSI_ARGS_ ((uid_t user))
unsigned sleep _ANSI_ARGS_ ((unsigned seconds))
int write _ANSI_ARGS_ ((int fd, CONST char *buf, size_t size))
char *crypt _ANSI_ARGS_ ((CONST char *, CONST char *))
int fchown _ANSI_ARGS_ ((int fd, uid_t owner, gid_t group))
int flock _ANSI_ARGS_ ((int fd, int operation))
int ftruncate _ANSI_ARGS_ ((int fd, unsigned long length))
int ioctl _ANSI_ARGS_ ((int fd, int request,...))
int readlink _ANSI_ARGS_ ((CONST char *path, char *buf, int bufsize))
int setreuid _ANSI_ARGS_ ((int ruid, int euid))
int truncate _ANSI_ARGS_ ((CONST char *path, unsigned long length))

Define Documentation
#define NULL  0

Definition at line 27 of file unistd.h.
Function Documentation
int truncate _ANSI_ARGS_ ((CONST char *path, unsigned long length))
int setreuid _ANSI_ARGS_ ((int ruid, int euid))
int readlink _ANSI_ARGS_ ((CONST char *path, char *buf, int bufsize))
int ioctl _ANSI_ARGS_ ((int fd, int request,...))
int ftruncate _ANSI_ARGS_ ((int fd, unsigned long length))
int flock _ANSI_ARGS_ ((int fd, int operation))
int fchown _ANSI_ARGS_ ((int fd, uid_t owner, gid_t group))
char* crypt _ANSI_ARGS_ ((CONST char *, CONST char *))
int write _ANSI_ARGS_ ((int fd, CONST char *buf, size_t size))
unsigned sleep _ANSI_ARGS_ ((unsigned seconds))
int setuid _ANSI_ARGS_ ((uid_t user))
int setgid _ANSI_ARGS_ ((gid_t group))
int read _ANSI_ARGS_ ((int fd, char *buf, size_t size))
int pipe _ANSI_ARGS_ ((int *fildes))
long lseek _ANSI_ARGS_ ((int fd, long offset, int whence))
int getgroups _ANSI_ARGS_ ((int bufSize, int *buffer))
char* getcwd _ANSI_ARGS_ ((char *buf, size_t size))
pid_t fork _ANSI_ARGS_ ((void))
int execvp _ANSI_ARGS_ ((CONST char *file, char **argv))
int execve _ANSI_ARGS_ ((CONST char *path, char **argv, char **envp))
int execv _ANSI_ARGS_ ((CONST char *path, char **argv))
int execlp _ANSI_ARGS_ ((CONST char *file,...))
int execl _ANSI_ARGS_ ((CONST char *path,...))
int dup2 _ANSI_ARGS_ ((int oldfd, int newfd))
int dup _ANSI_ARGS_ ((int oldfd))
int close _ANSI_ARGS_ ((int fd))
int chown _ANSI_ARGS_ ((CONST char *path, uid_t owner, gid_t group))
int chdir _ANSI_ARGS_ ((CONST char *path))
int access _ANSI_ARGS_ ((CONST char *path, int mode))
void _exit _ANSI_ARGS_ ((int status))

compat/waitpid.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Classes
struct WaitInfo
Defines
#define pid_t  int
Functions
pid_t waitpid (pid_t pid, int *statusPtr, int options)
Variables
static WaitInfo * deadList = NULL

Define Documentation
#define pid_t  int

Definition at line 22 of file waitpid.c.
Referenced by Tcl_WaitPid(), and waitpid().
Function Documentation
pid_t waitpid (pid_t pid, int * statusPtr, int options)

Definition at line 72 of file waitpid.c.
References deadList, EINVAL, errno, WaitInfo::nextPtr, NULL, pid_t, status, WAIT_STATUS_TYPE, WIFSTOPPED, and WUNTRACED.
Referenced by Tcl_WaitPid().79 {
80     register WaitInfo *waitPtr, *prevPtr;
81     pid_t result;
82     WAIT_STATUS_TYPE status;
83 
84     if ((pid < -1) || (pid == 0)) {
85   errno = EINVAL;
86   return -1;
87     }
88 
89     /*
90      * See if there's a suitable process that has already stopped or
91      * exited. If so, remove it from the list of exited processes and
92      * return its information.
93      */
94 
95     for (waitPtr = deadList, prevPtr = NULL; waitPtr != NULL;
96       prevPtr = waitPtr, waitPtr = waitPtr->nextPtr) {
97   if ((pid != waitPtr->pid) && (pid != -1)) {
98       continue;
99   }
100   if (!(options & WUNTRACED) && (WIFSTOPPED(waitPtr->status))) {
101       continue;
102   }
103   result = waitPtr->pid;
104   *statusPtr = *((int *) &waitPtr->status);
105   if (prevPtr == NULL) {
106       deadList = waitPtr->nextPtr;
107   } else {
108       prevPtr->nextPtr = waitPtr->nextPtr;
109   }
110   ckfree((char *) waitPtr);
111   return result;
112     }
113 
114     /*
115      * Wait for any process to stop or exit.  If it's an acceptable one
116      * then return it to the caller;  otherwise store information about it
117      * in the list of exited processes and try again.  On systems that
118      * have only wait but not wait3, there are several situations we can't
119      * handle, but we do the best we can (e.g. can still handle some
120      * combinations of options by invoking wait instead of wait3).
121      */
122 
123     while (1) {
124 #if NO_WAIT3
125   if (options & WNOHANG) {
126       return 0;
127   }
128   if (options != 0) {
129       errno = EINVAL;
130       return -1;
131   }
132   result = wait(&status);
133 #else
134   result = wait3(&status, options, 0);
135 #endif
136   if ((result == -1) && (errno == EINTR)) {
137       continue;
138   }
139   if (result <= 0) {
140       return result;
141   }
142 
143   if ((pid != result) && (pid != -1)) {
144       goto saveInfo;
145   }
146   if (!(options & WUNTRACED) && (WIFSTOPPED(status))) {
147       goto saveInfo;
148   }
149   *statusPtr = *((int *) &status);
150   return result;
151 
152   /*
153    * Can't return this info to caller.  Save it in the list of
154    * stopped or exited processes.  Tricky point: first check for
155    * an existing entry for the process and overwrite it if it
156    * exists (e.g. a previously stopped process might now be dead).
157    */
158 
159   saveInfo:
160   for (waitPtr = deadList; waitPtr != NULL; waitPtr = waitPtr->nextPtr) {
161       if (waitPtr->pid == result) {
162     waitPtr->status = status;
163     goto waitAgain;
164       }
165   }
166   waitPtr = (WaitInfo *) ckalloc(sizeof(WaitInfo));
167   waitPtr->pid = result;
168   waitPtr->status = status;
169   waitPtr->nextPtr = deadList;
170   deadList = waitPtr;
171 
172   waitAgain: continue;
173     }
174 }

Variable Documentation
WaitInfo* deadList = NULL [static]

Definition at line 41 of file waitpid.c.
Referenced by waitpid().

generic/regc_color.c File Reference
Defines
#define CISERR()  VISERR(cm->v)
#define CERR(e)  VERR(cm->v, (e))
Functions
static VOID initcm (struct vars *v, struct colormap *cm)
static VOID freecm (struct colormap *cm)
static VOID cmtreefree (struct colormap *cm, union tree *tree, int level)
static color setcolor (struct colormap *cm, pchr c, pcolor co)
static color maxcolor (struct colormap *cm)
static color newcolor (struct colormap *cm)
static VOID freecolor (struct colormap *cm, pcolor co)
static color pseudocolor (struct colormap *cm)
static color subcolor (struct colormap *cm, pchr c)
static color newsub (struct colormap *cm, pcolor co)
static VOID subrange (struct vars *v, pchr from, pchr to, struct state *lp, struct state *rp)
static VOID subblock (struct vars *v, pchr start, struct state *lp, struct state *rp)
static VOID okcolors (struct nfa *nfa, struct colormap *cm)
static VOID colorchain (struct colormap *cm, struct arc *a)
static VOID uncolorchain (struct colormap *cm, struct arc *a)
static int singleton (struct colormap *cm, pchr c)
static VOID rainbow (struct nfa *nfa, struct colormap *cm, int type, pcolor but, struct state *from, struct state *to)
static VOID colorcomplement (struct nfa *nfa, struct colormap *cm, int type, struct state *of, struct state *from, struct state *to)

Define Documentation
#define CERR(e)  VERR(cm->v, (e))

Definition at line 40 of file regc_color.c.
Referenced by newcolor(), setcolor(), and subblock().#define CISERR()  VISERR(cm->v)

Definition at line 39 of file regc_color.c.
Referenced by colorcomplement(), maxcolor(), newcolor(), newsub(), pseudocolor(), rainbow(), setcolor(), and subcolor().
Function Documentation
static VOID cmtreefree (struct colormap * cm, union tree * tree, int level) [static]

Definition at line 115 of file regc_color.c.
References BYTTAB, FREE, NBYTS, and NULL.
Referenced by freecm().119 {
120   int i;
121   union tree *t;
122   union tree *fillt = &cm->tree[level+1];
123   union tree *cb;
124 
125   assert(level < NBYTS-1);  /* this level has pointers */
126   for (i = BYTTAB-1; i >= 0; i--) {
127     t = tree->tptr[i];
128     assert(t != NULL);
129     if (t != fillt) {
130       if (level < NBYTS-2) {  /* more pointer blocks below */
131         cmtreefree(cm, t, level+1);
132         FREE(t);
133       } else {    /* color block below */
134         cb = cm->cd[t->tcolor[0]].block;
135         if (t != cb)  /* not a solid block */
136           FREE(t);
137       }
138     }
139   }
140 }
static VOID colorchain (struct colormap * cm, struct arc * a) [static]

Definition at line 583 of file regc_color.c.
References colordesc::arcs, arc::co, and arc::colorchain.
Referenced by newarc().586 {
587   struct colordesc *cd = &cm->cd[a->co];
588 
589   a->colorchain = cd->arcs;
590   cd->arcs = a;
591 }
static VOID colorcomplement (struct nfa * nfa, struct colormap * cm, int type, struct state * of, struct state * from, struct state * to) [static]

Definition at line 665 of file regc_color.c.
References colormap::cd, CDEND, CISERR, findarc(), colordesc::flags, newarc(), NULL, PLAIN, PSEUDO, and UNUSEDCOLOR.
Referenced by cbracket(), dovec(), and nonword().672 {
673   struct colordesc *cd;
674   struct colordesc *end = CDEND(cm);
675   color co;
676 
677   assert(of != from);
678   for (cd = cm->cd, co = 0; cd < end && !CISERR(); cd++, co++)
679     if (!UNUSEDCOLOR(cd) && !(cd->flags&PSEUDO))
680       if (findarc(of, PLAIN, co) == NULL)
681         newarc(nfa, type, co, from, to);
682 }
static VOID freecm (struct colormap * cm) [static]

Definition at line 91 of file regc_color.c.
References cmtreefree(), FREE, NBYTS, NULL, size_t(), and UNUSEDCOLOR.
Referenced by rfree().93 {
94   size_t i;
95   union tree *cb;
96 
97   cm->magic = 0;
98   if (NBYTS > 1)
99     cmtreefree(cm, cm->tree, 0);
100   for (i = 1; i <= cm->max; i++)    /* skip WHITE */
101     if (!UNUSEDCOLOR(&cm->cd[i])) {
102       cb = cm->cd[i].block;
103       if (cb != NULL)
104         FREE(cb);
105     }
106   if (cm->cd != cm->cdspace)
107     FREE(cm->cd);
108 }
static VOID freecolor (struct colormap * cm, pcolor co) [static]

Definition at line 279 of file regc_color.c.
References colordesc::arcs, colordesc::block, colordesc::flags, FREE, FREECOL, colordesc::nchrs, NOSUB, NULL, size_t(), colordesc::sub, UNUSEDCOLOR, and WHITE.
Referenced by okcolors().282 {
283   struct colordesc *cd = &cm->cd[co];
284   color pco, nco;     /* for freelist scan */
285 
286   assert(co >= 0);
287   if (co == WHITE)
288     return;
289 
290   assert(cd->arcs == NULL);
291   assert(cd->sub == NOSUB);
292   assert(cd->nchrs == 0);
293   cd->flags = FREECOL;
294   if (cd->block != NULL) {
295     FREE(cd->block);
296     cd->block = NULL; /* just paranoia */
297   }
298 
299   if ((size_t)co == cm->max) {
300     while (cm->max > WHITE && UNUSEDCOLOR(&cm->cd[cm->max]))
301       cm->max--;
302     assert(cm->free >= 0);
303     while ((size_t)cm->free > cm->max)
304       cm->free = cm->cd[cm->free].sub;
305     if (cm->free > 0) {
306       assert(cm->free < cm->max);
307       pco = cm->free;
308       nco = cm->cd[pco].sub;
309       while (nco > 0)
310         if ((size_t)nco > cm->max) {
311           /* take this one out of freelist */
312           nco = cm->cd[nco].sub;
313           cm->cd[pco].sub = nco;
314         } else {
315           assert(nco < cm->max);
316           pco = nco;
317           nco = cm->cd[pco].sub;
318         }
319     }
320   } else {
321     cd->sub = cm->free;
322     cm->free = (color)(cd - cm->cd);
323   }
324 }
static VOID initcm (struct vars * v, struct colormap * cm) [static]

Definition at line 49 of file regc_color.c.
References colordesc::arcs, colordesc::block, BYTTAB, colormap::cd, colormap::cdspace, CHR_MAX, CHR_MIN, CMMAGIC, colordesc::flags, colormap::free, colormap::magic, colormap::max, NBYTS, colormap::ncds, colordesc::nchrs, NINLINECDS, NOSUB, NULL, colordesc::sub, colormap::tree, colormap::v, and WHITE.
Referenced by compile().52 {
53   int i;
54   int j;
55   union tree *t;
56   union tree *nextt;
57   struct colordesc *cd;
58 
59   cm->magic = CMMAGIC;
60   cm->v = v;
61 
62   cm->ncds = NINLINECDS;
63   cm->cd = cm->cdspace;
64   cm->max = 0;
65   cm->free = 0;
66 
67   cd = cm->cd;      /* cm->cd[WHITE] */
68   cd->sub = NOSUB;
69   cd->arcs = NULL;
70   cd->flags = 0;
71   cd->nchrs = CHR_MAX - CHR_MIN + 1;
72 
73   /* upper levels of tree */
74   for (t = &cm->tree[0], j = NBYTS-1; j > 0; t = nextt, j--) {
75     nextt = t + 1;
76     for (i = BYTTAB-1; i >= 0; i--)
77       t->tptr[i] = nextt;
78   }
79   /* bottom level is solid white */
80   t = &cm->tree[NBYTS-1];
81   for (i = BYTTAB-1; i >= 0; i--)
82     t->tcolor[i] = WHITE;
83   cd->block = t;
84 }
static color maxcolor (struct colormap * cm) [static]

Definition at line 207 of file regc_color.c.
References CISERR, and COLORLESS.
Referenced by compact().209 {
210   if (CISERR())
211     return COLORLESS;
212 
213   return (color)cm->max;
214 }
static color newcolor (struct colormap * cm) [static]

Definition at line 222 of file regc_color.c.
References colordesc::arcs, colordesc::block, CERR, CISERR, COLORLESS, colordesc::flags, MALLOC, colordesc::nchrs, NOSUB, NULL, REALLOC, REG_ESPACE, size_t(), colordesc::sub, UNUSEDCOLOR, and VS.
Referenced by newsub(), and pseudocolor().224 {
225   struct colordesc *cd;
226   struct colordesc *new;
227   size_t n;
228 
229   if (CISERR())
230     return COLORLESS;
231 
232   if (cm->free != 0) {
233     assert(cm->free > 0);
234     assert((size_t)cm->free < cm->ncds);
235     cd = &cm->cd[cm->free];
236     assert(UNUSEDCOLOR(cd));
237     assert(cd->arcs == NULL);
238     cm->free = cd->sub;
239   } else if (cm->max < cm->ncds - 1) {
240     cm->max++;
241     cd = &cm->cd[cm->max];
242   } else {
243     /* oops, must allocate more */
244     n = cm->ncds * 2;
245     if (cm->cd == cm->cdspace) {
246       new = (struct colordesc *)MALLOC(n *
247             sizeof(struct colordesc));
248       if (new != NULL)
249         memcpy(VS(new), VS(cm->cdspace), cm->ncds *
250             sizeof(struct colordesc));
251     } else
252       new = (struct colordesc *)REALLOC(cm->cd,
253             n * sizeof(struct colordesc));
254     if (new == NULL) {
255       CERR(REG_ESPACE);
256       return COLORLESS;
257     }
258     cm->cd = new;
259     cm->ncds = n;
260     assert(cm->max < cm->ncds - 1);
261     cm->max++;
262     cd = &cm->cd[cm->max];
263   }
264 
265   cd->nchrs = 0;
266   cd->sub = NOSUB;
267   cd->arcs = NULL;
268   cd->flags = 0;
269   cd->block = NULL;
270 
271   return (color)(cd - cm->cd);
272 }
static color newsub (struct colormap * cm, pcolor co) [static]

Definition at line 375 of file regc_color.c.
References CISERR, COLORLESS, newcolor(), and NOSUB.
Referenced by subblock(), and subcolor().378 {
379   color sco;      /* new subcolor */
380 
381   sco = cm->cd[co].sub;
382   if (sco == NOSUB) {   /* color has no open subcolor */
383     if (cm->cd[co].nchrs == 1)  /* optimization */
384       return co;
385     sco = newcolor(cm); /* must create subcolor */
386     if (sco == COLORLESS) {
387       assert(CISERR());
388       return COLORLESS;
389     }
390     cm->cd[co].sub = sco;
391     cm->cd[sco].sub = sco;  /* open subcolor points to self */
392   }
393   assert(sco != NOSUB);
394 
395   return sco;
396 }
static VOID okcolors (struct nfa * nfa, struct colormap * cm) [static]

Definition at line 529 of file regc_color.c.
References colordesc::arcs, colormap::cd, CDEND, arc::co, arc::colorchain, freecolor(), arc::from, colordesc::nchrs, newarc(), NOSUB, NULL, colordesc::sub, arc::to, arc::type, and UNUSEDCOLOR.
Referenced by bracket(), compile(), leaders(), and parseqatom().532 {
533   struct colordesc *cd;
534   struct colordesc *end = CDEND(cm);
535   struct colordesc *scd;
536   struct arc *a;
537   color co;
538   color sco;
539 
540   for (cd = cm->cd, co = 0; cd < end; cd++, co++) {
541     sco = cd->sub;
542     if (UNUSEDCOLOR(cd) || sco == NOSUB) {
543       /* has no subcolor, no further action */
544     } else if (sco == co) {
545       /* is subcolor, let parent deal with it */
546     } else if (cd->nchrs == 0) {
547       /* parent empty, its arcs change color to subcolor */
548       cd->sub = NOSUB;
549       scd = &cm->cd[sco];
550       assert(scd->nchrs > 0);
551       assert(scd->sub == sco);
552       scd->sub = NOSUB;
553       while ((a = cd->arcs) != NULL) {
554         assert(a->co == co);
555         /* uncolorchain(cm, a); */
556         cd->arcs = a->colorchain;
557         a->co = sco;
558         /* colorchain(cm, a); */
559         a->colorchain = scd->arcs;
560         scd->arcs = a;
561       }
562       freecolor(cm, co);
563     } else {
564       /* parent's arcs must gain parallel subcolor arcs */
565       cd->sub = NOSUB;
566       scd = &cm->cd[sco];
567       assert(scd->nchrs > 0);
568       assert(scd->sub == sco);
569       scd->sub = NOSUB;
570       for (a = cd->arcs; a != NULL; a = a->colorchain) {
571         assert(a->co == co);
572         newarc(nfa, a->type, sco, a->from, a->to);
573       }
574     }
575   }
576 }
static color pseudocolor (struct colormap * cm) [static]

Definition at line 331 of file regc_color.c.
References CISERR, COLORLESS, newcolor(), and PSEUDO.
Referenced by specialcolors().333 {
334   color co;
335 
336   co = newcolor(cm);
337   if (CISERR())
338     return COLORLESS;
339   cm->cd[co].nchrs = 1;
340   cm->cd[co].flags = PSEUDO;
341   return co;
342 }
static VOID rainbow (struct nfa * nfa, struct colormap * cm, int type, pcolor but, struct state * from, struct state * to) [static]

Definition at line 640 of file regc_color.c.
References colormap::cd, CDEND, CISERR, colordesc::flags, newarc(), PSEUDO, colordesc::sub, and UNUSEDCOLOR.
Referenced by makesearch(), newnfa(), and parseqatom().647 {
648   struct colordesc *cd;
649   struct colordesc *end = CDEND(cm);
650   color co;
651 
652   for (cd = cm->cd, co = 0; cd < end && !CISERR(); cd++, co++)
653     if (!UNUSEDCOLOR(cd) && cd->sub != co && co != but &&
654               !(cd->flags&PSEUDO))
655       newarc(nfa, type, co, from, to);
656 }
static color setcolor (struct colormap * cm, pchr c, pcolor co) [static]

Definition at line 147 of file regc_color.c.
References BYTBITS, BYTMASK, BYTTAB, CERR, CISERR, CMMAGIC, COLORLESS, MALLOC, NBYTS, NULL, REG_ESPACE, and VS.
Referenced by subcolor().151 {
152   uchr uc = c;
153   int shift;
154   int level;
155   int b;
156   int bottom;
157   union tree *t;
158   union tree *newt;
159   union tree *fillt;
160   union tree *lastt;
161   union tree *cb;
162   color prev;
163 
164   assert(cm->magic == CMMAGIC);
165   if (CISERR() || co == COLORLESS)
166     return COLORLESS;
167 
168   t = cm->tree;
169   for (level = 0, shift = BYTBITS * (NBYTS - 1); shift > 0;
170             level++, shift -= BYTBITS) {
171     b = (uc >> shift) & BYTMASK;
172     lastt = t;
173     t = lastt->tptr[b];
174     assert(t != NULL);
175     fillt = &cm->tree[level+1];
176     bottom = (shift <= BYTBITS) ? 1 : 0;
177     cb = (bottom) ? cm->cd[t->tcolor[0]].block : fillt;
178     if (t == fillt || t == cb) {  /* must allocate a new block */
179       newt = (union tree *)MALLOC((bottom) ?
180         sizeof(struct colors) : sizeof(struct ptrs));
181       if (newt == NULL) {
182         CERR(REG_ESPACE);
183         return COLORLESS;
184       }
185       if (bottom)
186         memcpy(VS(newt->tcolor), VS(t->tcolor),
187               BYTTAB*sizeof(color));
188       else
189         memcpy(VS(newt->tptr), VS(t->tptr),
190             BYTTAB*sizeof(union tree *));
191       t = newt;
192       lastt->tptr[b] = t;
193     }
194   }
195 
196   b = uc & BYTMASK;
197   prev = t->tcolor[b];
198   t->tcolor[b] = (color)co;
199   return prev;
200 }
static int singleton (struct colormap * cm, pchr c) [static]

Definition at line 622 of file regc_color.c.
References arc::co, and NOSUB.
Referenced by dovec().625 {
626   color co;     /* color of c */
627 
628   co = GETCOLOR(cm, c);
629   if (cm->cd[co].nchrs == 1 && cm->cd[co].sub == NOSUB)
630     return 1;
631   return 0;
632 }
static VOID subblock (struct vars * v, pchr start, struct state * lp, struct state * rp) [static]

Definition at line 438 of file regc_color.c.
References colordesc::block, BYTBITS, BYTMASK, BYTTAB, colormap::cd, CERR, MALLOC, NBYTS, colordesc::nchrs, newarc(), newsub(), NULL, PLAIN, REG_ESPACE, tcolor, colormap::tree, and VS.
Referenced by subrange().443 {
444   uchr uc = start;
445   struct colormap *cm = v->cm;
446   int shift;
447   int level;
448   int i;
449   int b;
450   union tree *t;
451   union tree *cb;
452   union tree *fillt;
453   union tree *lastt;
454   int previ;
455   int ndone;
456   color co;
457   color sco;
458 
459   assert((uc % BYTTAB) == 0);
460 
461   /* find its color block, making new pointer blocks as needed */
462   t = cm->tree;
463   fillt = NULL;
464   for (level = 0, shift = BYTBITS * (NBYTS - 1); shift > 0;
465             level++, shift -= BYTBITS) {
466     b = (uc >> shift) & BYTMASK;
467     lastt = t;
468     t = lastt->tptr[b];
469     assert(t != NULL);
470     fillt = &cm->tree[level+1];
471     if (t == fillt && shift > BYTBITS) {  /* need new ptr block */
472       t = (union tree *)MALLOC(sizeof(struct ptrs));
473       if (t == NULL) {
474         CERR(REG_ESPACE);
475         return;
476       }
477       memcpy(VS(t->tptr), VS(fillt->tptr),
478             BYTTAB*sizeof(union tree *));
479       lastt->tptr[b] = t;
480     }
481   }
482 
483   /* special cases:  fill block or solid block */
484   co = t->tcolor[0];
485   cb = cm->cd[co].block;
486   if (t == fillt || t == cb) {
487     /* either way, we want a subcolor solid block */
488     sco = newsub(cm, co);
489     t = cm->cd[sco].block;
490     if (t == NULL) {  /* must set it up */
491       t = (union tree *)MALLOC(sizeof(struct colors));
492       if (t == NULL) {
493         CERR(REG_ESPACE);
494         return;
495       }
496       for (i = 0; i < BYTTAB; i++)
497         t->tcolor[i] = sco;
498       cm->cd[sco].block = t;
499     }
500     /* find loop must have run at least once */
501     lastt->tptr[b] = t;
502     newarc(v->nfa, PLAIN, sco, lp, rp);
503     cm->cd[co].nchrs -= BYTTAB;
504     cm->cd[sco].nchrs += BYTTAB;
505     return;
506   }
507 
508   /* general case, a mixed block to be altered */
509   i = 0;
510   while (i < BYTTAB) {
511     co = t->tcolor[i];
512     sco = newsub(cm, co);
513     newarc(v->nfa, PLAIN, sco, lp, rp);
514     previ = i;
515     do {
516       t->tcolor[i++] = sco;
517     } while (i < BYTTAB && t->tcolor[i] == co);
518     ndone = i - previ;
519     cm->cd[co].nchrs -= ndone;
520     cm->cd[sco].nchrs += ndone;
521   }
522 }
static color subcolor (struct colormap * cm, pchr c) [static]

Definition at line 349 of file regc_color.c.
References CISERR, COLORLESS, newsub(), and setcolor().
Referenced by compile(), dovec(), leaders(), onechr(), and subrange().352 {
353   color co;     /* current color of c */
354   color sco;      /* new subcolor */
355 
356   co = GETCOLOR(cm, c);
357   sco = newsub(cm, co);
358   if (CISERR())
359     return COLORLESS;
360   assert(sco != COLORLESS);
361 
362   if (co == sco)    /* already in an open subcolor */
363     return co;  /* rest is redundant */
364   cm->cd[co].nchrs--;
365   cm->cd[sco].nchrs++;
366   setcolor(cm, c, sco);
367   return sco;
368 }
static VOID subrange (struct vars * v, pchr from, pchr to, struct state * lp, struct state * rp) [static]

Definition at line 404 of file regc_color.c.
References BYTMASK, BYTTAB, newarc(), PLAIN, subblock(), and subcolor().
Referenced by dovec().410 {
411   uchr uf;
412   int i;
413 
414   assert(from <= to);
415 
416   /* first, align "from" on a tree-block boundary */
417   uf = (uchr)from;
418   i = (int)( ((uf + BYTTAB-1) & (uchr)~BYTMASK) - uf );
419   for (; from <= to && i > 0; i--, from++)
420     newarc(v->nfa, PLAIN, subcolor(v->cm, from), lp, rp);
421   if (from > to)      /* didn't reach a boundary */
422     return;
423 
424   /* deal with whole blocks */
425   for (; to - from >= BYTTAB; from += BYTTAB)
426     subblock(v, from, lp, rp);
427 
428   /* clean up any remaining partial table */
429   for (; from <= to; from++)
430     newarc(v->nfa, PLAIN, subcolor(v->cm, from), lp, rp);
431 }
static VOID uncolorchain (struct colormap * cm, struct arc * a) [static]

Definition at line 598 of file regc_color.c.
References colordesc::arcs, arc::co, arc::colorchain, and NULL.
Referenced by freearc().601 {
602   struct colordesc *cd = &cm->cd[a->co];
603   struct arc *aa;
604 
605   aa = cd->arcs;
606   if (aa == a)    /* easy case */
607     cd->arcs = a->colorchain;
608   else {
609     for (; aa != NULL && aa->colorchain != a; aa = aa->colorchain)
610       continue;
611     assert(aa != NULL);
612     aa->colorchain = a->colorchain;
613   }
614   a->colorchain = NULL; /* paranoia */
615 }

generic/regc_cvec.c File Reference
Functions
static struct cvec * newcvec (int nchrs, int nranges, int nmcces)
static struct cvec * clearcvec (struct cvec *cv)
static VOID addchr (struct cvec *cv, pchr c)
static VOID addrange (struct cvec *cv, pchr from, pchr to)
static VOID addmcce (struct cvec *cv, chr *startp, chr *endp)
static int haschr (struct cvec *cv, pchr c)
static struct cvec * getcvec (struct vars *v, int nchrs, int nranges, int nmcces)
static VOID freecvec (struct cvec *cv)

Function Documentation
static VOID addchr (struct cvec * cv, pchr c) [static]

Definition at line 91 of file regc_cvec.c.
Referenced by allcases(), cclass(), dovec(), eclass(), leaders(), and range().94 {
95     assert(cv->nchrs < cv->chrspace - cv->nmccechrs);
96     cv->chrs[cv->nchrs++] = (chr)c;
97 }
static VOID addmcce (struct cvec * cv, chr * startp, chr * endp) [static]

Definition at line 120 of file regc_cvec.c.
References cvec::chrspace, and NULL.
Referenced by compile().124 {
125     int len;
126     int i;
127     chr *s;
128     chr *d;
129 
130     if (startp == NULL && endp == NULL) {
131   return;
132     }
133     len = endp - startp;
134     assert(len > 0);
135     assert(cv->nchrs + len < cv->chrspace - cv->nmccechrs);
136     assert(cv->nmcces < cv->mccespace);
137     d = &cv->chrs[cv->chrspace - cv->nmccechrs - len - 1];
138     cv->mcces[cv->nmcces++] = d;
139     for (s = startp, i = len; i > 0; s++, i--) {
140   *d++ = *s;
141     }
142     *d++ = 0;       /* endmarker */
143     assert(d == &cv->chrs[cv->chrspace - cv->nmccechrs]);
144     cv->nmccechrs += len + 1;
145 }
static VOID addrange (struct cvec * cv, pchr from, pchr to) [static]

Definition at line 104 of file regc_cvec.c.
Referenced by cclass(), and range().108 {
109     assert(cv->nranges < cv->rangespace);
110     cv->ranges[cv->nranges*2] = (chr)from;
111     cv->ranges[cv->nranges*2 + 1] = (chr)to;
112     cv->nranges++;
113 }
static struct cvec* clearcvec (struct cvec * cv) [static]

Definition at line 68 of file regc_cvec.c.
References NULL.
Referenced by allmcces(), dovec(), getcvec(), and newcvec().70 {
71     int i;
72 
73     assert(cv != NULL);
74     cv->nchrs = 0;
75     assert(cv->chrs == (chr *)&cv->mcces[cv->mccespace]);
76     cv->nmcces = 0;
77     cv->nmccechrs = 0;
78     cv->nranges = 0;
79     for (i = 0; i < cv->mccespace; i++) {
80   cv->mcces[i] = NULL;
81     }
82 
83     return cv;
84 }
static VOID freecvec (struct cvec * cv) [static]

Definition at line 204 of file regc_cvec.c.
References FREE.
Referenced by freev(), and getcvec().206 {
207     FREE(cv);
208 }
static struct cvec* getcvec (struct vars * v, int nchrs, int nranges, int nmcces) [static]

Definition at line 177 of file regc_cvec.c.
References clearcvec(), ERR, freecvec(), newcvec(), NULL, and REG_ESPACE.
Referenced by allcases(), cclass(), eclass(), and range().182 {
183     if (v->cv != NULL && nchrs <= v->cv->chrspace &&
184       nranges <= v->cv->rangespace && nmcces <= v->cv->mccespace) {
185   return clearcvec(v->cv);
186     }
187 
188     if (v->cv != NULL) {
189   freecvec(v->cv);
190     }
191     v->cv = newcvec(nchrs, nranges, nmcces);
192     if (v->cv == NULL) {
193   ERR(REG_ESPACE);
194     }
195 
196     return v->cv;
197 }
static int haschr (struct cvec * cv, pchr c) [static]

Definition at line 152 of file regc_cvec.c.
Referenced by dovec(), and leaders().155 {
156     int i;
157     chr *p;
158 
159     for (p = cv->chrs, i = cv->nchrs; i > 0; p++, i--) {
160   if (*p == c) {
161       return 1;
162   }
163     }
164     for (p = cv->ranges, i = cv->nranges; i > 0; p += 2, i--) {
165   if ((*p <= c) && (c <= *(p+1))) {
166       return 1;
167   }
168     }
169     return 0;
170 }
static struct cvec* newcvec (int nchrs, int nranges, int nmcces) [static]

Definition at line 38 of file regc_cvec.c.
References cvec::chrs, cvec::chrspace, clearcvec(), MALLOC, MAXMCCE, cvec::mcces, cvec::mccespace, nmcces(), NULL, cvec::ranges, cvec::rangespace, and size_t().
Referenced by compile(), dovec(), and getcvec().42 {
43     size_t n;
44     size_t nc;
45     struct cvec *cv;
46 
47     nc = (size_t)nchrs + (size_t)nmcces*(MAXMCCE+1) + (size_t)nranges*2;
48     n = sizeof(struct cvec) + (size_t)(nmcces-1)*sizeof(chr *)
49       + nc*sizeof(chr);
50     cv = (struct cvec *)MALLOC(n);
51     if (cv == NULL) {
52   return NULL;
53     }
54     cv->chrspace = nchrs;
55     cv->chrs = (chr *)&cv->mcces[nmcces]; /* chrs just after MCCE ptrs */
56     cv->mccespace = nmcces;
57     cv->ranges = cv->chrs + nchrs + nmcces*(MAXMCCE+1);
58     cv->rangespace = nranges;
59     return clearcvec(cv);
60 }

generic/regc_lex.c File Reference
Defines
#define ATEOS()  (v->now >= v->stop)
#define HAVE(n)  (v->stop - v->now >= (n))
#define NEXT1(c)  (!ATEOS() && *v->now == CHR(c))
#define NEXT2(a, b)  (HAVE(2) && *v->now == CHR(a) && *(v->now+1) == CHR(b))
#define NEXT3(a, b, c)
#define SET(c)  (v->nexttype = (c))
#define SETV(c, n)  (v->nexttype = (c), v->nextvalue = (n))
#define RET(c)  return (SET(c), 1)
#define RETV(c, n)  return (SETV(c, n), 1)
#define FAILW(e)  return (ERR(e), 0)
#define LASTTYPE(t)  (v->lasttype == (t))
#define L_ERE  1
#define L_BRE  2
#define L_Q  3
#define L_EBND  4
#define L_BBND  5
#define L_BRACK  6
#define L_CEL  7
#define L_ECL  8
#define L_CCL  9
#define INTOCON(c)  (v->lexcon = (c))
#define INCON(con)  (v->lexcon == (con))
#define ENDOF(array)  ((array) + sizeof(array)/sizeof(chr))
Functions
static VOID lexstart (struct vars *v)
static VOID prefixes (struct vars *v)
static VOID lexnest (struct vars *v, chr *beginp, chr *endp)
static VOID lexword (struct vars *v)
static int next (struct vars *v)
static int lexescape (struct vars *v)
static chr lexdigits (struct vars *v, int base, int minlen, int maxlen)
static int brenext (struct vars *v, pchr pc)
static VOID skip (struct vars *v)
static chr newline ()
static chr chrnamed (struct vars *v, chr *startp, chr *endp, pchr lastresort)
Variables
static chr backd []
static chr backD []
static chr brbackd []
static chr backs []
static chr backS []
static chr brbacks []
static chr backw []
static chr backW []
static chr brbackw []

Define Documentation
#define ATEOS()  (v->now >= v->stop)

Definition at line 34 of file regc_lex.c.
Referenced by brenext(), lexdigits(), lexescape(), next(), prefixes(), and skip().#define ENDOF(array)  ((array) + sizeof(array)/sizeof(chr))

Definition at line 62 of file regc_lex.c.
Referenced by lexescape(), lexword(), and next().#define FAILW(e)  return (ERR(e), 0)

Definition at line 45 of file regc_lex.c.
Referenced by brenext(), lexescape(), and next().#define HAVE(n)  (v->stop - v->now >= (n))

Definition at line 35 of file regc_lex.c.
Referenced by brenext(), next(), and prefixes().#define INCON(con)  (v->lexcon == (con))

Definition at line 59 of file regc_lex.c.
Referenced by next().#define INTOCON(c)  (v->lexcon = (c))

Definition at line 58 of file regc_lex.c.
Referenced by brenext(), lexstart(), and next().#define L_BBND  5

Definition at line 53 of file regc_lex.c.
Referenced by brenext(), and next().#define L_BRACK  6

Definition at line 54 of file regc_lex.c.
Referenced by brenext(), and next().#define L_BRE  2

Definition at line 50 of file regc_lex.c.
Referenced by lexstart(), and next().#define L_CCL  9

Definition at line 57 of file regc_lex.c.
Referenced by next().#define L_CEL  7

Definition at line 55 of file regc_lex.c.
Referenced by next().#define L_EBND  4

Definition at line 52 of file regc_lex.c.
Referenced by next().#define L_ECL  8

Definition at line 56 of file regc_lex.c.
Referenced by next().#define L_ERE  1

Definition at line 49 of file regc_lex.c.
Referenced by lexstart(), and next().#define L_Q  3

Definition at line 51 of file regc_lex.c.
Referenced by lexstart(), and next().#define LASTTYPE(t)  (v->lasttype == (t))

Definition at line 46 of file regc_lex.c.
Referenced by brenext(), and next().#define NEXT1(c)  (!ATEOS() && *v->now == CHR(c))

Definition at line 36 of file regc_lex.c.
Referenced by brenext(), next(), prefixes(), and skip().#define NEXT2(a, b)  (HAVE(2) && *v->now == CHR(a) && *(v->now+1) == CHR(b))

Definition at line 37 of file regc_lex.c.
Referenced by brenext(), and prefixes().#define NEXT3(a, b, c)
Value:(HAVE(3) && *v->now == CHR(a) && \
            *(v->now+1) == CHR(b) && \
            *(v->now+2) == CHR(c))
Definition at line 38 of file regc_lex.c.
Referenced by prefixes().#define RET(c)  return (SET(c), 1)

Definition at line 43 of file regc_lex.c.
Referenced by brenext(), lexescape(), and next().#define RETV(c, n)  return (SETV(c, n), 1)

Definition at line 44 of file regc_lex.c.
Referenced by brenext(), lexescape(), and next().#define SET(c)  (v->nexttype = (c))

Definition at line 41 of file regc_lex.c.#define SETV(c, n)  (v->nexttype = (c), v->nextvalue = (n))

Definition at line 42 of file regc_lex.c.
Function Documentation
static int brenext (struct vars * v, pchr pc) [static]

Definition at line 868 of file regc_lex.c.
References ATEOS, BACKREF, CHR, DIGITVAL, EMPTY, FAILW, HAVE, INTOCON, iscalnum, L_BBND, L_BRACK, LASTTYPE, NEXT1, NEXT2, NOTE, NOTREACHED, PLAIN, REG_EESCAPE, REG_EXPANDED, REG_UBACKREF, REG_UBOUNDS, REG_UBSALNUM, REG_UNONPOSIX, REG_UUNSPEC, RET, RETV, and skip().
Referenced by next().871 {
872   chr c = (chr)pc;
873 
874   switch (c) {
875   case CHR('*'):
876     if (LASTTYPE(EMPTY) || LASTTYPE('(') || LASTTYPE('^'))
877       RETV(PLAIN, c);
878     RET('*');
879     break;
880   case CHR('['):
881     if (HAVE(6) &&  *(v->now+0) == CHR('[') &&
882         *(v->now+1) == CHR(':') &&
883         (*(v->now+2) == CHR('<') ||
884             *(v->now+2) == CHR('>')) &&
885         *(v->now+3) == CHR(':') &&
886         *(v->now+4) == CHR(']') &&
887         *(v->now+5) == CHR(']')) {
888       c = *(v->now+2);
889       v->now += 6;
890       NOTE(REG_UNONPOSIX);
891       RET((c == CHR('<')) ? '<' : '>');
892     }
893     INTOCON(L_BRACK);
894     if (NEXT1('^')) {
895       v->now++;
896       RETV('[', 0);
897     }
898     RETV('[', 1);
899     break;
900   case CHR('.'):
901     RET('.');
902     break;
903   case CHR('^'):
904     if (LASTTYPE(EMPTY))
905       RET('^');
906     if (LASTTYPE('(')) {
907       NOTE(REG_UUNSPEC);
908       RET('^');
909     }
910     RETV(PLAIN, c);
911     break;
912   case CHR('$'):
913     if (v->cflags&REG_EXPANDED)
914       skip(v);
915     if (ATEOS())
916       RET('$');
917     if (NEXT2('\\', ')')) {
918       NOTE(REG_UUNSPEC);
919       RET('$');
920     }
921     RETV(PLAIN, c);
922     break;
923   case CHR('\\'):
924     break;    /* see below */
925   default:
926     RETV(PLAIN, c);
927     break;
928   }
929 
930   assert(c == CHR('\\'));
931 
932   if (ATEOS())
933     FAILW(REG_EESCAPE);
934 
935   c = *v->now++;
936   switch (c) {
937   case CHR('{'):
938     INTOCON(L_BBND);
939     NOTE(REG_UBOUNDS);
940     RET('{');
941     break;
942   case CHR('('):
943     RETV('(', 1);
944     break;
945   case CHR(')'):
946     RETV(')', c);
947     break;
948   case CHR('<'):
949     NOTE(REG_UNONPOSIX);
950     RET('<');
951     break;
952   case CHR('>'):
953     NOTE(REG_UNONPOSIX);
954     RET('>');
955     break;
956   case CHR('1'): case CHR('2'): case CHR('3'): case CHR('4'):
957   case CHR('5'): case CHR('6'): case CHR('7'): case CHR('8'):
958   case CHR('9'):
959     NOTE(REG_UBACKREF);
960     RETV(BACKREF, (chr)DIGITVAL(c));
961     break;
962   default:
963     if (iscalnum(c)) {
964       NOTE(REG_UBSALNUM);
965       NOTE(REG_UUNSPEC);
966     }
967     RETV(PLAIN, c);
968     break;
969   }
970 
971   assert(NOTREACHED);
972 }
static chr chrnamed (struct vars * v, chr * startp, chr * endp, pchr lastresort) [static]

Definition at line 1037 of file regc_lex.c.
References cvec::chrs, element(), cvec::nchrs, and range().
Referenced by lexescape().1042 {
1043   celt c;
1044   int errsave;
1045   int e;
1046   struct cvec *cv;
1047 
1048   errsave = v->err;
1049   v->err = 0;
1050   c = element(v, startp, endp);
1051   e = v->err;
1052   v->err = errsave;
1053 
1054   if (e != 0)
1055     return (chr)lastresort;
1056 
1057   cv = range(v, c, c, 0);
1058   if (cv->nchrs == 0)
1059     return (chr)lastresort;
1060   return cv->chrs[0];
1061 }
static chr lexdigits (struct vars * v, int base, int minlen, int maxlen) [static]

Definition at line 814 of file regc_lex.c.
References ATEOS, CHR, CONST, DIGITVAL, ERR, and REG_EESCAPE.
Referenced by lexescape().819 {
820   uchr n;     /* unsigned to avoid overflow misbehavior */
821   int len;
822   chr c;
823   int d;
824   CONST uchr ub = (uchr) base;
825 
826   n = 0;
827   for (len = 0; len < maxlen && !ATEOS(); len++) {
828     c = *v->now++;
829     switch (c) {
830     case CHR('0'): case CHR('1'): case CHR('2'): case CHR('3'):
831     case CHR('4'): case CHR('5'): case CHR('6'): case CHR('7'):
832     case CHR('8'): case CHR('9'):
833       d = DIGITVAL(c);
834       break;
835     case CHR('a'): case CHR('A'): d = 10; break;
836     case CHR('b'): case CHR('B'): d = 11; break;
837     case CHR('c'): case CHR('C'): d = 12; break;
838     case CHR('d'): case CHR('D'): d = 13; break;
839     case CHR('e'): case CHR('E'): d = 14; break;
840     case CHR('f'): case CHR('F'): d = 15; break;
841     default:
842       v->now--; /* oops, not a digit at all */
843       d = -1;
844       break;
845     }
846 
847     if (d >= base) {  /* not a plausible digit */
848       v->now--;
849       d = -1;
850     }
851     if (d < 0)
852       break;    /* NOTE BREAK OUT */
853     n = n*ub + (uchr)d;
854   }
855   if (len < minlen)
856     ERR(REG_EESCAPE);
857 
858   return (chr)n;
859 }
static int lexescape (struct vars * v) [static]

Definition at line 659 of file regc_lex.c.
References ATEOS, BACKREF, CCLASS, CHR, chrnamed(), ENDOF, FAILW, iscalnum, iscalpha, ISERR, lexdigits(), NOTE, NOTREACHED, NWBDRY, PLAIN, REG_ADVF, REG_EESCAPE, REG_UBACKREF, REG_ULOCALE, REG_UNONPOSIX, REG_UUNPORT, RET, RETV, SBEGIN, SEND, and WBDRY.
Referenced by next().661 {
662   chr c;
663   static chr alert[] = {
664     CHR('a'), CHR('l'), CHR('e'), CHR('r'), CHR('t')
665   };
666   static chr esc[] = {
667     CHR('E'), CHR('S'), CHR('C')
668   };
669   chr *save;
670 
671   assert(v->cflags&REG_ADVF);
672 
673   assert(!ATEOS());
674   c = *v->now++;
675   if (!iscalnum(c))
676     RETV(PLAIN, c);
677 
678   NOTE(REG_UNONPOSIX);
679   switch (c) {
680   case CHR('a'):
681     RETV(PLAIN, chrnamed(v, alert, ENDOF(alert), CHR('\007')));
682     break;
683   case CHR('A'):
684     RETV(SBEGIN, 0);
685     break;
686   case CHR('b'):
687     RETV(PLAIN, CHR('\b'));
688     break;
689   case CHR('B'):
690     RETV(PLAIN, CHR('\\'));
691     break;
692   case CHR('c'):
693     NOTE(REG_UUNPORT);
694     if (ATEOS())
695       FAILW(REG_EESCAPE);
696     RETV(PLAIN, (chr)(*v->now++ & 037));
697     break;
698   case CHR('d'):
699     NOTE(REG_ULOCALE);
700     RETV(CCLASS, 'd');
701     break;
702   case CHR('D'):
703     NOTE(REG_ULOCALE);
704     RETV(CCLASS, 'D');
705     break;
706   case CHR('e'):
707     NOTE(REG_UUNPORT);
708     RETV(PLAIN, chrnamed(v, esc, ENDOF(esc), CHR('\033')));
709     break;
710   case CHR('f'):
711     RETV(PLAIN, CHR('\f'));
712     break;
713   case CHR('m'):
714     RET('<');
715     break;
716   case CHR('M'):
717     RET('>');
718     break;
719   case CHR('n'):
720     RETV(PLAIN, CHR('\n'));
721     break;
722   case CHR('r'):
723     RETV(PLAIN, CHR('\r'));
724     break;
725   case CHR('s'):
726     NOTE(REG_ULOCALE);
727     RETV(CCLASS, 's');
728     break;
729   case CHR('S'):
730     NOTE(REG_ULOCALE);
731     RETV(CCLASS, 'S');
732     break;
733   case CHR('t'):
734     RETV(PLAIN, CHR('\t'));
735     break;
736   case CHR('u'):
737     c = lexdigits(v, 16, 4, 4);
738     if (ISERR())
739       FAILW(REG_EESCAPE);
740     RETV(PLAIN, c);
741     break;
742   case CHR('U'):
743     c = lexdigits(v, 16, 8, 8);
744     if (ISERR())
745       FAILW(REG_EESCAPE);
746     RETV(PLAIN, c);
747     break;
748   case CHR('v'):
749     RETV(PLAIN, CHR('\v'));
750     break;
751   case CHR('w'):
752     NOTE(REG_ULOCALE);
753     RETV(CCLASS, 'w');
754     break;
755   case CHR('W'):
756     NOTE(REG_ULOCALE);
757     RETV(CCLASS, 'W');
758     break;
759   case CHR('x'):
760     NOTE(REG_UUNPORT);
761     c = lexdigits(v, 16, 1, 255); /* REs >255 long outside spec */
762     if (ISERR())
763       FAILW(REG_EESCAPE);
764     RETV(PLAIN, c);
765     break;
766   case CHR('y'):
767     NOTE(REG_ULOCALE);
768     RETV(WBDRY, 0);
769     break;
770   case CHR('Y'):
771     NOTE(REG_ULOCALE);
772     RETV(NWBDRY, 0);
773     break;
774   case CHR('Z'):
775     RETV(SEND, 0);
776     break;
777   case CHR('1'): case CHR('2'): case CHR('3'): case CHR('4'):
778   case CHR('5'): case CHR('6'): case CHR('7'): case CHR('8'):
779   case CHR('9'):
780     save = v->now;
781     v->now--; /* put first digit back */
782     c = lexdigits(v, 10, 1, 255); /* REs >255 long outside spec */
783     if (ISERR())
784       FAILW(REG_EESCAPE);
785     /* ugly heuristic (first test is "exactly 1 digit?") */
786     if (v->now - save == 0 || (int)c <= v->nsubexp) {
787       NOTE(REG_UBACKREF);
788       RETV(BACKREF, (chr)c);
789     }
790     /* oops, doesn't look like it's a backref after all... */
791     v->now = save;
792     /* and fall through into octal number */
793   case CHR('0'):
794     NOTE(REG_UUNPORT);
795     v->now--; /* put first digit back */
796     c = lexdigits(v, 8, 1, 3);
797     if (ISERR())
798       FAILW(REG_EESCAPE);
799     RETV(PLAIN, c);
800     break;
801   default:
802     assert(iscalpha(c));
803     FAILW(REG_EESCAPE); /* unknown alphabetic escape */
804     break;
805   }
806   assert(NOTREACHED);
807 }
static VOID lexnest (struct vars * v, chr * beginp, chr * endp) [static]

Definition at line 196 of file regc_lex.c.
References NULL.
Referenced by lexword(), and next().200 {
201   assert(v->savenow == NULL); /* only one level of nesting */
202   v->savenow = v->now;
203   v->savestop = v->stop;
204   v->now = beginp;
205   v->stop = endp;
206 }
static VOID lexstart (struct vars * v) [static]

Definition at line 69 of file regc_lex.c.
References EMPTY, INTOCON, L_BRE, L_ERE, L_Q, next(), NOERR, prefixes(), REG_ADVANCED, REG_ADVF, REG_EXPANDED, REG_EXTENDED, REG_NEWLINE, and REG_QUOTE.
Referenced by compile().71 {
72   prefixes(v);      /* may turn on new type bits etc. */
73   NOERR();
74 
75   if (v->cflags&REG_QUOTE) {
76     assert(!(v->cflags&(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE)));
77     INTOCON(L_Q);
78   } else if (v->cflags&REG_EXTENDED) {
79     assert(!(v->cflags&REG_QUOTE));
80     INTOCON(L_ERE);
81   } else {
82     assert(!(v->cflags&(REG_QUOTE|REG_ADVF)));
83     INTOCON(L_BRE);
84   }
85 
86   v->nexttype = EMPTY;    /* remember we were at the start */
87   next(v);      /* set up the first token */
88 }
static VOID lexword (struct vars * v) [static]

Definition at line 263 of file regc_lex.c.
References backw, ENDOF, and lexnest().
Referenced by wordchrs().265 {
266   lexnest(v, backw, ENDOF(backw));
267 }
static chr newline () [static]

Definition at line 1007 of file regc_lex.c.
References CHR.
Referenced by compile(), Tcl_PutsObjCmd(), and Tcl_ReadObjCmd().1008 {
1009   return CHR('\n');
1010 }
static int next (struct vars * v) [static]

Definition at line 274 of file regc_lex.c.
References ATEOS, backD, backd, backS, backs, backW, backw, brbackd, brbacks, brbackw, brenext(), CCLASS, CHR, COLLEL, DIGIT, DIGITVAL, DISCARD, ECLASS, EMPTY, END, ENDOF, EOS, FAILW, HAVE, INCON, INTOCON, iscalnum, iscdigit, ISERR, L_BBND, L_BRACK, L_BRE, L_CCL, L_CEL, L_EBND, L_ECL, L_ERE, L_Q, LACON, LASTTYPE, lexescape(), lexnest(), NEXT1, NOTE, NOTREACHED, NULL, PLAIN, RANGE, REG_ADVF, REG_ASSERT, REG_BADBR, REG_BADRPT, REG_BOSONLY, REG_EBRACE, REG_EBRACK, REG_EESCAPE, REG_EXPANDED, REG_EXTENDED, REG_NOSUB, REG_UBBS, REG_UBOUNDS, REG_UBRACES, REG_UBSALNUM, REG_ULOCALE, REG_ULOOKAHEAD, REG_UNONPOSIX, REG_UUNSPEC, RET, RETV, SBEGIN, and skip().
Referenced by cleanst(), lexstart(), Tcl_EvalEx(), Tcl_SplitList(), and TclCompileScript().276 {
277   chr c;
278 
279   /* errors yield an infinite sequence of failures */
280   if (ISERR())
281     return 0; /* the error has set nexttype to EOS */
282 
283   /* remember flavor of last token */
284   v->lasttype = v->nexttype;
285 
286   /* REG_BOSONLY */
287   if (v->nexttype == EMPTY && (v->cflags&REG_BOSONLY)) {
288     /* at start of a REG_BOSONLY RE */
289     RETV(SBEGIN, 0);    /* same as \A */
290   }
291 
292   /* if we're nested and we've hit end, return to outer level */
293   if (v->savenow != NULL && ATEOS()) {
294     v->now = v->savenow;
295     v->stop = v->savestop;
296     v->savenow = v->savestop = NULL;
297   }
298 
299   /* skip white space etc. if appropriate (not in literal or []) */
300   if (v->cflags&REG_EXPANDED)
301     switch (v->lexcon) {
302     case L_ERE:
303     case L_BRE:
304     case L_EBND:
305     case L_BBND:
306       skip(v);
307       break;
308     }
309 
310   /* handle EOS, depending on context */
311   if (ATEOS()) {
312     switch (v->lexcon) {
313     case L_ERE:
314     case L_BRE:
315     case L_Q:
316       RET(EOS);
317       break;
318     case L_EBND:
319     case L_BBND:
320       FAILW(REG_EBRACE);
321       break;
322     case L_BRACK:
323     case L_CEL:
324     case L_ECL:
325     case L_CCL:
326       FAILW(REG_EBRACK);
327       break;
328     }
329     assert(NOTREACHED);
330   }
331 
332   /* okay, time to actually get a character */
333   c = *v->now++;
334 
335   /* deal with the easy contexts, punt EREs to code below */
336   switch (v->lexcon) {
337   case L_BRE:     /* punt BREs to separate function */
338     return brenext(v, c);
339     break;
340   case L_ERE:     /* see below */
341     break;
342   case L_Q:     /* literal strings are easy */
343     RETV(PLAIN, c);
344     break;
345   case L_BBND:      /* bounds are fairly simple */
346   case L_EBND:
347     switch (c) {
348     case CHR('0'): case CHR('1'): case CHR('2'): case CHR('3'):
349     case CHR('4'): case CHR('5'): case CHR('6'): case CHR('7'):
350     case CHR('8'): case CHR('9'):
351       RETV(DIGIT, (chr)DIGITVAL(c));
352       break;
353     case CHR(','):
354       RET(',');
355       break;
356     case CHR('}'):    /* ERE bound ends with } */
357       if (INCON(L_EBND)) {
358         INTOCON(L_ERE);
359         if ((v->cflags&REG_ADVF) && NEXT1('?')) {
360           v->now++;
361           NOTE(REG_UNONPOSIX);
362           RETV('}', 0);
363         }
364         RETV('}', 1);
365       } else
366         FAILW(REG_BADBR);
367       break;
368     case CHR('\\'):   /* BRE bound ends with \} */
369       if (INCON(L_BBND) && NEXT1('}')) {
370         v->now++;
371         INTOCON(L_BRE);
372         RET('}');
373       } else
374         FAILW(REG_BADBR);
375       break;
376     default:
377       FAILW(REG_BADBR);
378       break;
379     }
380     assert(NOTREACHED);
381     break;
382   case L_BRACK:     /* brackets are not too hard */
383     switch (c) {
384     case CHR(']'):
385       if (LASTTYPE('['))
386         RETV(PLAIN, c);
387       else {
388         INTOCON((v->cflags&REG_EXTENDED) ?
389               L_ERE : L_BRE);
390         RET(']');
391       }
392       break;
393     case CHR('\\'):
394       NOTE(REG_UBBS);
395       if (!(v->cflags&REG_ADVF))
396         RETV(PLAIN, c);
397       NOTE(REG_UNONPOSIX);
398       if (ATEOS())
399         FAILW(REG_EESCAPE);
400       (DISCARD)lexescape(v);
401       switch (v->nexttype) {  /* not all escapes okay here */
402       case PLAIN:
403         return 1;
404         break;
405       case CCLASS:
406         switch (v->nextvalue) {
407         case 'd':
408           lexnest(v, brbackd, ENDOF(brbackd));
409           break;
410         case 's':
411           lexnest(v, brbacks, ENDOF(brbacks));
412           break;
413         case 'w':
414           lexnest(v, brbackw, ENDOF(brbackw));
415           break;
416         default:
417           FAILW(REG_EESCAPE);
418           break;
419         }
420         /* lexnest done, back up and try again */
421         v->nexttype = v->lasttype;
422         return next(v);
423         break;
424       }
425       /* not one of the acceptable escapes */
426       FAILW(REG_EESCAPE);
427       break;
428     case CHR('-'):
429       if (LASTTYPE('[') || NEXT1(']'))
430         RETV(PLAIN, c);
431       else
432         RETV(RANGE, c);
433       break;
434     case CHR('['):
435       if (ATEOS())
436         FAILW(REG_EBRACK);
437       switch (*v->now++) {
438       case CHR('.'):
439         INTOCON(L_CEL);
440         /* might or might not be locale-specific */
441         RET(COLLEL);
442         break;
443       case CHR('='):
444         INTOCON(L_ECL);
445         NOTE(REG_ULOCALE);
446         RET(ECLASS);
447         break;
448       case CHR(':'):
449         INTOCON(L_CCL);
450         NOTE(REG_ULOCALE);
451         RET(CCLASS);
452         break;
453       default:      /* oops */
454         v->now--;
455         RETV(PLAIN, c);
456         break;
457       }
458       assert(NOTREACHED);
459       break;
460     default:
461       RETV(PLAIN, c);
462       break;
463     }
464     assert(NOTREACHED);
465     break;
466   case L_CEL:     /* collating elements are easy */
467     if (c == CHR('.') && NEXT1(']')) {
468       v->now++;
469       INTOCON(L_BRACK);
470       RETV(END, '.');
471     } else
472       RETV(PLAIN, c);
473     break;
474   case L_ECL:     /* ditto equivalence classes */
475     if (c == CHR('=') && NEXT1(']')) {
476       v->now++;
477       INTOCON(L_BRACK);
478       RETV(END, '=');
479     } else
480       RETV(PLAIN, c);
481     break;
482   case L_CCL:     /* ditto character classes */
483     if (c == CHR(':') && NEXT1(']')) {
484       v->now++;
485       INTOCON(L_BRACK);
486       RETV(END, ':');
487     } else
488       RETV(PLAIN, c);
489     break;
490   default:
491     assert(NOTREACHED);
492     break;
493   }
494 
495   /* that got rid of everything except EREs and AREs */
496   assert(INCON(L_ERE));
497 
498   /* deal with EREs and AREs, except for backslashes */
499   switch (c) {
500   case CHR('|'):
501     RET('|');
502     break;
503   case CHR('*'):
504     if ((v->cflags&REG_ADVF) && NEXT1('?')) {
505       v->now++;
506       NOTE(REG_UNONPOSIX);
507       RETV('*', 0);
508     }
509     RETV('*', 1);
510     break;
511   case CHR('+'):
512     if ((v->cflags&REG_ADVF) && NEXT1('?')) {
513       v->now++;
514       NOTE(REG_UNONPOSIX);
515       RETV('+', 0);
516     }
517     RETV('+', 1);
518     break;
519   case CHR('?'):
520     if ((v->cflags&REG_ADVF) && NEXT1('?')) {
521       v->now++;
522       NOTE(REG_UNONPOSIX);
523       RETV('?', 0);
524     }
525     RETV('?', 1);
526     break;
527   case CHR('{'):    /* bounds start or plain character */
528     if (v->cflags&REG_EXPANDED)
529       skip(v);
530     if (ATEOS() || !iscdigit(*v->now)) {
531       NOTE(REG_UBRACES);
532       NOTE(REG_UUNSPEC);
533       RETV(PLAIN, c);
534     } else {
535       NOTE(REG_UBOUNDS);
536       INTOCON(L_EBND);
537       RET('{');
538     }
539     assert(NOTREACHED);
540     break;
541   case CHR('('):    /* parenthesis, or advanced extension */
542     if ((v->cflags&REG_ADVF) && NEXT1('?')) {
543       NOTE(REG_UNONPOSIX);
544       v->now++;
545       switch (*v->now++) {
546       case CHR(':'):    /* non-capturing paren */
547         RETV('(', 0);
548         break;
549       case CHR('#'):    /* comment */
550         while (!ATEOS() && *v->now != CHR(')'))
551           v->now++;
552         if (!ATEOS())
553           v->now++;
554         assert(v->nexttype == v->lasttype);
555         return next(v);
556         break;
557       case CHR('='):    /* positive lookahead */
558         NOTE(REG_ULOOKAHEAD);
559         RETV(LACON, 1);
560         break;
561       case CHR('!'):    /* negative lookahead */
562         NOTE(REG_ULOOKAHEAD);
563         RETV(LACON, 0);
564         break;
565       default:
566         FAILW(REG_BADRPT);
567         break;
568       }
569       assert(NOTREACHED);
570     }
571     if (v->cflags&REG_NOSUB)
572       RETV('(', 0);   /* all parens non-capturing */
573     else
574       RETV('(', 1);
575     break;
576   case CHR(')'):
577     if (LASTTYPE('(')) {
578       NOTE(REG_UUNSPEC);
579     }
580     RETV(')', c);
581     break;
582   case CHR('['):    /* easy except for [[:<:]] and [[:>:]] */
583     if (HAVE(6) &&  *(v->now+0) == CHR('[') &&
584         *(v->now+1) == CHR(':') &&
585         (*(v->now+2) == CHR('<') ||
586             *(v->now+2) == CHR('>')) &&
587         *(v->now+3) == CHR(':') &&
588         *(v->now+4) == CHR(']') &&
589         *(v->now+5) == CHR(']')) {
590       c = *(v->now+2);
591       v->now += 6;
592       NOTE(REG_UNONPOSIX);
593       RET((c == CHR('<')) ? '<' : '>');
594     }
595     INTOCON(L_BRACK);
596     if (NEXT1('^')) {
597       v->now++;
598       RETV('[', 0);
599     }
600     RETV('[', 1);
601     break;
602   case CHR('.'):
603     RET('.');
604     break;
605   case CHR('^'):
606     RET('^');
607     break;
608   case CHR('$'):
609     RET('$');
610     break;
611   case CHR('\\'):   /* mostly punt backslashes to code below */
612     if (ATEOS())
613       FAILW(REG_EESCAPE);
614     break;
615   default:    /* ordinary character */
616     RETV(PLAIN, c);
617     break;
618   }
619 
620   /* ERE/ARE backslash handling; backslash already eaten */
621   assert(!ATEOS());
622   if (!(v->cflags&REG_ADVF)) {  /* only AREs have non-trivial escapes */
623     if (iscalnum(*v->now)) {
624       NOTE(REG_UBSALNUM);
625       NOTE(REG_UUNSPEC);
626     }
627     RETV(PLAIN, *v->now++);
628   }
629   (DISCARD)lexescape(v);
630   if (ISERR())
631     FAILW(REG_EESCAPE);
632   if (v->nexttype == CCLASS) {  /* fudge at lexical level */
633     switch (v->nextvalue) {
634     case 'd': lexnest(v, backd, ENDOF(backd)); break;
635     case 'D': lexnest(v, backD, ENDOF(backD)); break;
636     case 's': lexnest(v, backs, ENDOF(backs)); break;
637     case 'S': lexnest(v, backS, ENDOF(backS)); break;
638     case 'w': lexnest(v, backw, ENDOF(backw)); break;
639     case 'W': lexnest(v, backW, ENDOF(backW)); break;
640     default:
641       assert(NOTREACHED);
642       FAILW(REG_ASSERT);
643       break;
644     }
645     /* lexnest done, back up and try again */
646     v->nexttype = v->lasttype;
647     return next(v);
648   }
649   /* otherwise, lexescape has already done the work */
650   return !ISERR();
651 }
static VOID prefixes (struct vars * v) [static]

Definition at line 95 of file regc_lex.c.
References ATEOS, CHR, ERR, HAVE, iscalpha, NEXT1, NEXT2, NEXT3, NOTE, REG_ADVANCED, REG_ADVF, REG_BADOPT, REG_BADPAT, REG_BADRPT, REG_EXPANDED, REG_EXTENDED, REG_ICASE, REG_NEWLINE, REG_NLANCH, REG_NLSTOP, REG_QUOTE, and REG_UNONPOSIX.
Referenced by lexstart().97 {
98   /* literal string doesn't get any of this stuff */
99   if (v->cflags&REG_QUOTE)
100     return;
101 
102   /* initial "***" gets special things */ 
103   if (HAVE(4) && NEXT3('*', '*', '*'))
104     switch (*(v->now + 3)) {
105     case CHR('?'):    /* "***?" error, msg shows version */
106       ERR(REG_BADPAT);
107       return;   /* proceed no further */
108       break;
109     case CHR('='):    /* "***=" shifts to literal string */
110       NOTE(REG_UNONPOSIX);
111       v->cflags |= REG_QUOTE;
112       v->cflags &= ~(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE);
113       v->now += 4;
114       return;   /* and there can be no more prefixes */
115       break;
116     case CHR(':'):    /* "***:" shifts to AREs */
117       NOTE(REG_UNONPOSIX);
118       v->cflags |= REG_ADVANCED;
119       v->now += 4;
120       break;
121     default:    /* otherwise *** is just an error */
122       ERR(REG_BADRPT);
123       return;
124       break;
125     }
126 
127   /* BREs and EREs don't get embedded options */
128   if ((v->cflags&REG_ADVANCED) != REG_ADVANCED)
129     return;
130 
131   /* embedded options (AREs only) */
132   if (HAVE(3) && NEXT2('(', '?') && iscalpha(*(v->now + 2))) {
133     NOTE(REG_UNONPOSIX);
134     v->now += 2;
135     for (; !ATEOS() && iscalpha(*v->now); v->now++)
136       switch (*v->now) {
137       case CHR('b'):    /* BREs (but why???) */
138         v->cflags &= ~(REG_ADVANCED|REG_QUOTE);
139         break;
140       case CHR('c'):    /* case sensitive */
141         v->cflags &= ~REG_ICASE;
142         break;
143       case CHR('e'):    /* plain EREs */
144         v->cflags |= REG_EXTENDED;
145         v->cflags &= ~(REG_ADVF|REG_QUOTE);
146         break;
147       case CHR('i'):    /* case insensitive */
148         v->cflags |= REG_ICASE;
149         break;
150       case CHR('m'):    /* Perloid synonym for n */
151       case CHR('n'):    /* \n affects ^ $ . [^ */
152         v->cflags |= REG_NEWLINE;
153         break;
154       case CHR('p'):    /* ~Perl, \n affects . [^ */
155         v->cflags |= REG_NLSTOP;
156         v->cflags &= ~REG_NLANCH;
157         break;
158       case CHR('q'):    /* literal string */
159         v->cflags |= REG_QUOTE;
160         v->cflags &= ~REG_ADVANCED;
161         break;
162       case CHR('s'):    /* single line, \n ordinary */
163         v->cflags &= ~REG_NEWLINE;
164         break;
165       case CHR('t'):    /* tight syntax */
166         v->cflags &= ~REG_EXPANDED;
167         break;
168       case CHR('w'):    /* weird, \n affects ^ $ only */
169         v->cflags &= ~REG_NLSTOP;
170         v->cflags |= REG_NLANCH;
171         break;
172       case CHR('x'):    /* expanded syntax */
173         v->cflags |= REG_EXPANDED;
174         break;
175       default:
176         ERR(REG_BADOPT);
177         return;
178       }
179     if (!NEXT1(')')) {
180       ERR(REG_BADOPT);
181       return;
182     }
183     v->now++;
184     if (v->cflags&REG_QUOTE)
185       v->cflags &= ~(REG_EXPANDED|REG_NEWLINE);
186   }
187 }
static VOID skip (struct vars * v) [static]

Definition at line 979 of file regc_lex.c.
References ATEOS, CHR, iscspace, NEXT1, NOTE, REG_EXPANDED, and REG_UNONPOSIX.
Referenced by brenext(), next(), Tcl_ExecObjCmd(), Tcl_GetsObj(), and TclCreatePipeline().981 {
982   chr *start = v->now;
983 
984   assert(v->cflags&REG_EXPANDED);
985 
986   for (;;) {
987     while (!ATEOS() && iscspace(*v->now))
988       v->now++;
989     if (ATEOS() || *v->now != CHR('#'))
990       break;        /* NOTE BREAK OUT */
991     assert(NEXT1('#'));
992     while (!ATEOS() && *v->now != CHR('\n'))
993       v->now++;
994     /* leave the newline to be picked up by the iscspace loop */
995   }
996 
997   if (v->now != start)
998     NOTE(REG_UNONPOSIX);
999 }

Variable Documentation
chr backD[] [static]
Initial value: {    
  CHR('['), CHR('^'), CHR('['), CHR(':'),
  CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'),
  CHR(':'), CHR(']'), CHR(']')
}
Definition at line 216 of file regc_lex.c.
Referenced by next().chr backd[] [static]
Initial value: {    
  CHR('['), CHR('['), CHR(':'),
  CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'),
  CHR(':'), CHR(']'), CHR(']')
}
Definition at line 211 of file regc_lex.c.
Referenced by next().chr backS[] [static]
Initial value: {    
  CHR('['), CHR('^'), CHR('['), CHR(':'),
  CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
  CHR(':'), CHR(']'), CHR(']')
}
Definition at line 231 of file regc_lex.c.
Referenced by next().chr backs[] [static]
Initial value: {    
  CHR('['), CHR('['), CHR(':'),
  CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
  CHR(':'), CHR(']'), CHR(']')
}
Definition at line 226 of file regc_lex.c.
Referenced by next().chr backW[] [static]
Initial value: {    
  CHR('['), CHR('^'), CHR('['), CHR(':'),
  CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
  CHR(':'), CHR(']'), CHR('_'), CHR(']')
}
Definition at line 246 of file regc_lex.c.
Referenced by next().chr backw[] [static]
Initial value: {    
  CHR('['), CHR('['), CHR(':'),
  CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
  CHR(':'), CHR(']'), CHR('_'), CHR(']')
}
Definition at line 241 of file regc_lex.c.
Referenced by lexword(), and next().chr brbackd[] [static]
Initial value: {  
  CHR('['), CHR(':'),
  CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'),
  CHR(':'), CHR(']')
}
Definition at line 221 of file regc_lex.c.
Referenced by next().chr brbacks[] [static]
Initial value: {  
  CHR('['), CHR(':'),
  CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
  CHR(':'), CHR(']')
}
Definition at line 236 of file regc_lex.c.
Referenced by next().chr brbackw[] [static]
Initial value: {  
  CHR('['), CHR(':'),
  CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
  CHR(':'), CHR(']'), CHR('_')
}
Definition at line 251 of file regc_lex.c.
Referenced by next().

generic/regc_locale.c File Reference
Classes
struct cname
struct crange
Defines
#define NUM_ALPHA_RANGE  (sizeof(alphaRangeTable)/sizeof(crange))
#define NUM_ALPHA_CHAR  (sizeof(alphaCharTable)/sizeof(chr))
#define NUM_DIGIT_RANGE  (sizeof(digitRangeTable)/sizeof(crange))
#define NUM_PUNCT_RANGE  (sizeof(punctRangeTable)/sizeof(crange))
#define NUM_PUNCT_CHAR  (sizeof(punctCharTable)/sizeof(chr))
#define NUM_SPACE_RANGE  (sizeof(spaceRangeTable)/sizeof(crange))
#define NUM_SPACE_CHAR  (sizeof(spaceCharTable)/sizeof(chr))
#define NUM_LOWER_RANGE  (sizeof(lowerRangeTable)/sizeof(crange))
#define NUM_LOWER_CHAR  (sizeof(lowerCharTable)/sizeof(chr))
#define NUM_UPPER_RANGE  (sizeof(upperRangeTable)/sizeof(crange))
#define NUM_UPPER_CHAR  (sizeof(upperCharTable)/sizeof(chr))
#define NUM_GRAPH_RANGE  (sizeof(graphRangeTable)/sizeof(crange))
#define NUM_GRAPH_CHAR  (sizeof(graphCharTable)/sizeof(chr))
#define CH  NOCELT
Functions
static int nmcces (struct vars *v)
static int nleaders (struct vars *v)
static struct cvec * allmcces (struct vars *v, struct cvec *cv)
static celt element (struct vars *v, chr *startp, chr *endp)
static struct cvec * range (struct vars *v, celt a, celt b, int cases)
static int before (celt x, celt y)
static struct cvec * eclass (struct vars *v, celt c, int cases)
static struct cvec * cclass (struct vars *v, chr *startp, chr *endp, int cases)
static struct cvec * allcases (struct vars *v, pchr pc)
static int cmp (CONST chr *x, CONST chr *y, size_t len)
static int casecmp (CONST chr *x, CONST chr *y, size_t len)
Variables
static struct cname cnames []
static crange alphaRangeTable []
static chr alphaCharTable []
static crange digitRangeTable []
static crange punctRangeTable []
static chr punctCharTable []
static crange spaceRangeTable []
static chr spaceCharTable []
static crange lowerRangeTable []
static chr lowerCharTable []
static crange upperRangeTable []
static chr upperCharTable []
static crange graphRangeTable []
static chr graphCharTable []

Define Documentation
#define CH  NOCELT

Definition at line 521 of file regc_locale.c.#define NUM_ALPHA_CHAR  (sizeof(alphaCharTable)/sizeof(chr))

Definition at line 198 of file regc_locale.c.
Referenced by cclass().#define NUM_ALPHA_RANGE  (sizeof(alphaRangeTable)/sizeof(crange))

Definition at line 180 of file regc_locale.c.
Referenced by cclass().#define NUM_DIGIT_RANGE  (sizeof(digitRangeTable)/sizeof(crange))

Definition at line 210 of file regc_locale.c.
Referenced by cclass().#define NUM_GRAPH_CHAR  (sizeof(graphCharTable)/sizeof(chr))

Definition at line 515 of file regc_locale.c.
Referenced by cclass().#define NUM_GRAPH_RANGE  (sizeof(graphRangeTable)/sizeof(crange))

Definition at line 496 of file regc_locale.c.
Referenced by cclass().#define NUM_LOWER_CHAR  (sizeof(lowerCharTable)/sizeof(chr))

Definition at line 312 of file regc_locale.c.
Referenced by cclass().#define NUM_LOWER_RANGE  (sizeof(lowerRangeTable)/sizeof(crange))

Definition at line 267 of file regc_locale.c.
Referenced by cclass().#define NUM_PUNCT_CHAR  (sizeof(punctCharTable)/sizeof(chr))

Definition at line 238 of file regc_locale.c.
Referenced by cclass().#define NUM_PUNCT_RANGE  (sizeof(punctRangeTable)/sizeof(crange))

Definition at line 226 of file regc_locale.c.
Referenced by cclass().#define NUM_SPACE_CHAR  (sizeof(spaceCharTable)/sizeof(chr))

Definition at line 252 of file regc_locale.c.
Referenced by cclass().#define NUM_SPACE_RANGE  (sizeof(spaceRangeTable)/sizeof(crange))

Definition at line 246 of file regc_locale.c.
Referenced by cclass().#define NUM_UPPER_CHAR  (sizeof(upperCharTable)/sizeof(chr))

Definition at line 372 of file regc_locale.c.
Referenced by cclass().#define NUM_UPPER_RANGE  (sizeof(upperRangeTable)/sizeof(crange))

Definition at line 327 of file regc_locale.c.
Referenced by cclass().
Function Documentation
static struct cvec* allcases (struct vars * v, pchr pc) [static]

Definition at line 929 of file regc_locale.c.
References addchr(), getcvec(), Tcl_UniCharToLower(), Tcl_UniCharToTitle(), and Tcl_UniCharToUpper().
Referenced by eclass(), and onechr().932 {
933     struct cvec *cv;
934     chr c = (chr)pc;
935     chr lc, uc, tc;
936 
937     lc = Tcl_UniCharToLower((chr)c);
938     uc = Tcl_UniCharToUpper((chr)c);
939     tc = Tcl_UniCharToTitle((chr)c);
940 
941     if (tc != uc) {
942   cv = getcvec(v, 3, 0, 0);
943   addchr(cv, tc);
944     } else {
945   cv = getcvec(v, 2, 0, 0);
946     }
947     addchr(cv, lc);
948     if (lc != uc) {
949   addchr(cv, uc);
950     }
951     return cv;
952 }
static struct cvec* allmcces (struct vars * v, struct cvec * cv) [static]

Definition at line 553 of file regc_locale.c.
References clearcvec().
Referenced by compile().556 {
557     return clearcvec(cv);
558 }
static int before (celt x, celt y) [static]

Definition at line 665 of file regc_locale.c.
Referenced by range(), and Tcl_Sleep().667 {
668     /* trivial because no MCCEs */
669     if (x < y) {
670   return 1;
671     }
672     return 0;
673 }
static int casecmp (CONST chr * x, CONST chr * y, size_t len) [static]

Definition at line 979 of file regc_locale.c.
References Tcl_UniCharToLower().
Referenced by compile().982 {
983     for (; len > 0; len--, x++, y++) {
984   if ((*x!=*y) && (Tcl_UniCharToLower(*x) != Tcl_UniCharToLower(*y))) {
985       return 1;
986   }
987     }
988     return 0;
989 }
static struct cvec* cclass (struct vars * v, chr * startp, chr * endp, int cases) [static]

Definition at line 717 of file regc_locale.c.
References addchr(), addrange(), alphaCharTable, alphaRangeTable, CONST, digitRangeTable, ERR, getcvec(), graphCharTable, graphRangeTable, lowerCharTable, lowerRangeTable, NULL, NUM_ALPHA_CHAR, NUM_ALPHA_RANGE, NUM_DIGIT_RANGE, NUM_GRAPH_CHAR, NUM_GRAPH_RANGE, NUM_LOWER_CHAR, NUM_LOWER_RANGE, NUM_PUNCT_CHAR, NUM_PUNCT_RANGE, NUM_SPACE_CHAR, NUM_SPACE_RANGE, NUM_UPPER_CHAR, NUM_UPPER_RANGE, punctCharTable, punctRangeTable, REG_ECTYPE, REG_ESPACE, size_t(), spaceCharTable, spaceRangeTable, Tcl_DStringInit(), Tcl_UniCharToUtfDString(), upperCharTable, and upperRangeTable.
Referenced by brackpart().722 {
723     size_t len;
724     struct cvec *cv = NULL;
725     Tcl_DString ds;
726     CONST char *np;
727     char **namePtr;
728     int i, index;
729 
730     /*
731      * The following arrays define the valid character class names.
732      */
733 
734     static char *classNames[] = {
735   "alnum", "alpha", "ascii", "blank", "cntrl", "digit", "graph",
736   "lower", "print", "punct", "space", "upper", "xdigit", NULL
737     };
738 
739     enum classes {
740   CC_ALNUM, CC_ALPHA, CC_ASCII, CC_BLANK, CC_CNTRL, CC_DIGIT, CC_GRAPH,
741   CC_LOWER, CC_PRINT, CC_PUNCT, CC_SPACE, CC_UPPER, CC_XDIGIT
742     };
743     
744 
745     /*
746      * Extract the class name
747      */
748 
749     len = endp - startp;
750     Tcl_DStringInit(&ds);
751     np = Tcl_UniCharToUtfDString(startp, (int)len, &ds);
752 
753     /*
754      * Remap lower and upper to alpha if the match is case insensitive.
755      */
756 
757     if (cases && len == 5 && (strncmp("lower", np, 5) == 0
758       || strncmp("upper", np, 5) == 0)) {
759   np = "alpha";
760     }
761 
762     /*
763      * Map the name to the corresponding enumerated value.
764      */
765 
766     index = -1;
767     for (namePtr=classNames,i=0 ; *namePtr!=NULL ; namePtr++,i++) {
768   if ((strlen(*namePtr) == len) && (strncmp(*namePtr, np, len) == 0)) {
769       index = i;
770       break;
771   }
772     }
773     Tcl_DStringInit(&ds);
774     if (index == -1) {
775   ERR(REG_ECTYPE);
776   return NULL;
777     }
778     
779     /*
780      * Now compute the character class contents.
781      */
782 
783     switch((enum classes) index) {
784     case CC_PRINT:
785     case CC_ALNUM:
786   cv = getcvec(v, NUM_ALPHA_CHAR, NUM_DIGIT_RANGE + NUM_ALPHA_RANGE, 0);
787   if (cv) {
788       for (i=0 ; i<NUM_ALPHA_CHAR ; i++) {
789     addchr(cv, alphaCharTable[i]);
790       }
791       for (i=0 ; i<NUM_ALPHA_RANGE ; i++) {
792     addrange(cv, alphaRangeTable[i].start,
793       alphaRangeTable[i].end);
794       }
795       for (i=0 ; i<NUM_DIGIT_RANGE ; i++) {
796     addrange(cv, digitRangeTable[i].start,
797       digitRangeTable[i].end);
798       }
799   }
800   break;
801     case CC_ALPHA:
802   cv = getcvec(v, NUM_ALPHA_CHAR, NUM_ALPHA_RANGE, 0);
803   if (cv) {
804       for (i=0 ; i<NUM_ALPHA_RANGE ; i++) {
805     addrange(cv, alphaRangeTable[i].start,
806       alphaRangeTable[i].end);
807       }
808       for (i=0 ; i<NUM_ALPHA_CHAR ; i++) {
809     addchr(cv, alphaCharTable[i]);
810       }
811   }
812   break;
813     case CC_ASCII:
814   cv = getcvec(v, 0, 1, 0);
815   if (cv) {
816       addrange(cv, 0, 0x7f);
817   }
818   break;
819     case CC_BLANK:
820   cv = getcvec(v, 2, 0, 0);
821   addchr(cv, '\t');
822   addchr(cv, ' ');
823   break;
824     case CC_CNTRL:
825   cv = getcvec(v, 0, 2, 0);
826   addrange(cv, 0x0, 0x1f);
827   addrange(cv, 0x7f, 0x9f);
828   break;
829     case CC_DIGIT:
830   cv = getcvec(v, 0, NUM_DIGIT_RANGE, 0);
831   if (cv) { 
832       for (i=0 ; i<NUM_DIGIT_RANGE ; i++) {
833     addrange(cv, digitRangeTable[i].start,
834       digitRangeTable[i].end);
835       }
836   }
837   break;
838     case CC_PUNCT:
839   cv = getcvec(v, NUM_PUNCT_CHAR, NUM_PUNCT_RANGE, 0);
840   if (cv) {
841       for (i=0 ; i<NUM_PUNCT_RANGE ; i++) {
842     addrange(cv, punctRangeTable[i].start,
843       punctRangeTable[i].end);
844       }
845       for (i=0 ; i<NUM_PUNCT_CHAR ; i++) {
846     addchr(cv, punctCharTable[i]);
847       }
848   }
849   break;
850     case CC_XDIGIT:
851   /*
852    * This is a 3 instead of (NUM_DIGIT_RANGE+2) because I've no
853    * idea how to define the digits 'a' through 'f' in
854    * non-western locales.  The concept is quite possibly non
855    * portable, or only used in contextx where the characters
856    * used would be the western ones anyway!  Whatever is
857    * actually the case, the number of ranges is fixed (until
858    * someone comes up with a better arrangement!)
859    */
860   cv = getcvec(v, 0, 3, 0);
861   if (cv) { 
862       addrange(cv, '0', '9');
863       addrange(cv, 'a', 'f');
864       addrange(cv, 'A', 'F');
865   }
866   break;
867     case CC_SPACE:
868   cv = getcvec(v, NUM_SPACE_CHAR, NUM_SPACE_RANGE, 0);
869   if (cv) {
870       for (i=0 ; i<NUM_SPACE_RANGE ; i++) {
871     addrange(cv, spaceRangeTable[i].start,
872       spaceRangeTable[i].end);
873       }
874       for (i=0 ; i<NUM_SPACE_CHAR ; i++) {
875     addchr(cv, spaceCharTable[i]);
876       }
877   }
878   break;
879     case CC_LOWER:
880   cv  = getcvec(v, NUM_LOWER_CHAR, NUM_LOWER_RANGE, 0);
881   if (cv) {
882       for (i=0 ; i<NUM_LOWER_RANGE ; i++) {
883     addrange(cv, lowerRangeTable[i].start,
884       lowerRangeTable[i].end);
885       }
886       for (i=0 ; i<NUM_LOWER_CHAR ; i++) {
887     addchr(cv, lowerCharTable[i]);
888       }
889   }
890   break;
891     case CC_UPPER:
892   cv  = getcvec(v, NUM_UPPER_CHAR, NUM_UPPER_RANGE, 0);
893   if (cv) {
894       for (i=0 ; i<NUM_UPPER_RANGE ; i++) {
895     addrange(cv, upperRangeTable[i].start,
896       upperRangeTable[i].end);
897       }
898       for (i=0 ; i<NUM_UPPER_CHAR ; i++) {
899     addchr(cv, upperCharTable[i]);
900       }
901   }
902   break;
903     case CC_GRAPH:
904   cv  = getcvec(v, NUM_GRAPH_CHAR, NUM_GRAPH_RANGE, 0);
905   if (cv) {
906       for (i=0 ; i<NUM_GRAPH_RANGE ; i++) {
907     addrange(cv, graphRangeTable[i].start,
908       graphRangeTable[i].end);
909       }
910       for (i=0 ; i<NUM_GRAPH_CHAR ; i++) {
911     addchr(cv, graphCharTable[i]);
912       }
913   }
914   break;
915     }
916     if (cv == NULL) {
917   ERR(REG_ESPACE);
918     }
919     return cv;
920 }
static int cmp (CONST chr * x, CONST chr * y, size_t len) [static]

Definition at line 963 of file regc_locale.c.
References memcmp(), and VS.
Referenced by compile(), and MergeLists().966 {
967     return memcmp(VS(x), VS(y), len*sizeof(chr));
968 }
static struct cvec* eclass (struct vars * v, celt c, int cases) [static]

Definition at line 681 of file regc_locale.c.
References addchr(), allcases(), getcvec(), NULL, and REG_FAKE.
Referenced by brackpart().686 {
687     struct cvec *cv;
688 
689     /* crude fake equivalence class for testing */
690     if ((v->cflags&REG_FAKE) && c == 'x') {
691   cv = getcvec(v, 4, 0, 0);
692   addchr(cv, (chr)'x');
693   addchr(cv, (chr)'y');
694   if (cases) {
695       addchr(cv, (chr)'X');
696       addchr(cv, (chr)'Y');
697   }
698   return cv;
699     }
700 
701     /* otherwise, none */
702     if (cases) {
703   return allcases(v, c);
704     }
705     cv = getcvec(v, 1, 0, 0);
706     assert(cv != NULL);
707     addchr(cv, (chr)c);
708     return cv;
709 }
static celt element (struct vars * v, chr * startp, chr * endp) [static]

Definition at line 565 of file regc_locale.c.
References cnames, CONST, cname::name, NOTE, NULL, REG_ULOCALE, size_t(), Tcl_DStringInit(), and Tcl_UniCharToUtfDString().
Referenced by brackpart(), chrnamed(), Tcl_Concat(), Tcl_ConcatObj(), Tcl_SplitList(), Tcl_SplitObjCmd(), and TclDoGlob().569 {
570     struct cname *cn;
571     size_t len;
572     Tcl_DString ds;
573     CONST char *np;
574 
575     /* generic:  one-chr names stand for themselves */
576     assert(startp < endp);
577     len = endp - startp;
578     if (len == 1) {
579   return *startp;
580     }
581 
582     NOTE(REG_ULOCALE);
583 
584     /* search table */
585     Tcl_DStringInit(&ds);
586     np = Tcl_UniCharToUtfDString(startp, (int)len, &ds);
587     for (cn=cnames; cn->name!=NULL; cn++) {
588   if (strlen(cn->name)==len && strncmp(cn->name, np, len)==0) {
589       break;      /* NOTE BREAK OUT */
590   }
591     }
592     Tcl_DStringFree(&ds);
593     if (cn->name != NULL) {
594   return CHR(cn->code);
595     }
596 
597     /* couldn't find it */
598     ERR(REG_ECOLLATE);
599     return 0;
600 }
static int nleaders (struct vars * v) [static]

Definition at line 542 of file regc_locale.c.
Referenced by compile().544 {
545     return 0;
546 }
static int nmcces (struct vars * v) [static]

Definition at line 528 of file regc_locale.c.
Referenced by compile(), dovec(), and newcvec().530 {
531     /*
532      * No multi-character collating elements defined at the moment.
533      */
534     return 0;
535 }
static struct cvec* range (struct vars * v, celt a, celt b, int cases) [static]

Definition at line 607 of file regc_locale.c.
References addchr(), addrange(), before(), ERR, getcvec(), cvec::nchrs, NOERRN, NULL, REG_ERANGE, Tcl_UniCharToLower(), Tcl_UniCharToTitle(), and Tcl_UniCharToUpper().
Referenced by brackpart(), chrnamed(), TclCompileCatchCmd(), TclCompileForeachCmd(), TclCompileReturnCmd(), and TclCompileWhileCmd().612 {
613     int nchrs;
614     struct cvec *cv;
615     celt c, lc, uc, tc;
616 
617     if (a != b && !before(a, b)) {
618   ERR(REG_ERANGE);
619   return NULL;
620     }
621 
622     if (!cases) {     /* easy version */
623   cv = getcvec(v, 0, 1, 0);
624   NOERRN();
625   addrange(cv, a, b);
626   return cv;
627     }
628 
629     /*
630      * When case-independent, it's hard to decide when cvec ranges are
631      * usable, so for now at least, we won't try.  We allocate enough
632      * space for two case variants plus a little extra for the two
633      * title case variants.
634      */
635 
636     nchrs = (b - a + 1)*2 + 4;
637 
638     cv = getcvec(v, nchrs, 0, 0);
639     NOERRN();
640 
641     for (c=a; c<=b; c++) {
642   addchr(cv, c);
643   lc = Tcl_UniCharToLower((chr)c);
644   uc = Tcl_UniCharToUpper((chr)c);
645   tc = Tcl_UniCharToTitle((chr)c);
646   if (c != lc) {
647       addchr(cv, lc);
648   }
649   if (c != uc) {
650       addchr(cv, uc);
651   }
652   if (c != tc && tc != uc) {
653       addchr(cv, tc);
654   }
655     }
656 
657     return cv;
658 }

Variable Documentation
chr alphaCharTable[] [static]
Initial value: {
    0x00aa, 0x00b5, 0x00ba, 0x02d0, 0x02d1, 0x02ee, 0x037a, 0x0386, 0x038c, 
    0x04c7, 0x04c8, 0x04cb, 0x04cc, 0x04f8, 0x04f9, 0x0559, 0x06d5, 0x06e5, 
    0x06e6, 0x0710, 0x093d, 0x0950, 0x098f, 0x0990, 0x09b2, 0x09dc, 0x09dd, 
    0x09f0, 0x09f1, 0x0a0f, 0x0a10, 0x0a32, 0x0a33, 0x0a35, 0x0a36, 0x0a38, 
    0x0a39, 0x0a5e, 0x0a8d, 0x0ab2, 0x0ab3, 0x0abd, 0x0ad0, 0x0ae0, 0x0b0f, 
    0x0b10, 0x0b32, 0x0b33, 0x0b3d, 0x0b5c, 0x0b5d, 0x0b99, 0x0b9a, 0x0b9c, 
    0x0b9e, 0x0b9f, 0x0ba3, 0x0ba4, 0x0c60, 0x0c61, 0x0cde, 0x0ce0, 0x0ce1, 
    0x0d60, 0x0d61, 0x0dbd, 0x0e32, 0x0e33, 0x0e81, 0x0e82, 0x0e84, 0x0e87, 
    0x0e88, 0x0e8a, 0x0e8d, 0x0ea5, 0x0ea7, 0x0eaa, 0x0eab, 0x0eb2, 0x0eb3, 
    0x0ebd, 0x0ec6, 0x0edc, 0x0edd, 0x0f00, 0x1029, 0x102a, 0x1248, 0x1258, 
    0x1288, 0x12b0, 0x12c0, 0x1310, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x207f, 
    0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x3005, 0x3006, 0x309d, 
    0x309e, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfe74, 0xfffe
}
Definition at line 182 of file regc_locale.c.
Referenced by cclass().crange alphaRangeTable[] [static]

Definition at line 134 of file regc_locale.c.
Referenced by cclass().struct cname  cnames[] [static]

Referenced by element().crange digitRangeTable[] [static]
Initial value: {
    {0x0030, 0x0039}, {0x0660, 0x0669}, {0x06f0, 0x06f9}, {0x0966, 0x096f}, 
    {0x09e6, 0x09ef}, {0x0a66, 0x0a6f}, {0x0ae6, 0x0aef}, {0x0b66, 0x0b6f}, 
    {0x0be7, 0x0bef}, {0x0c66, 0x0c6f}, {0x0ce6, 0x0cef}, {0x0d66, 0x0d6f}, 
    {0x0e50, 0x0e59}, {0x0ed0, 0x0ed9}, {0x0f20, 0x0f29}, {0x1040, 0x1049}, 
    {0x1369, 0x1371}, {0x17e0, 0x17e9}, {0x1810, 0x1819}, {0xff10, 0xff19}
}
Definition at line 202 of file regc_locale.c.
Referenced by cclass().chr graphCharTable[] [static]
Initial value: {
    0x0374, 0x0375, 0x037a, 0x037e, 0x038c, 0x0488, 0x0489, 0x04c7, 0x04c8, 
    0x04cb, 0x04cc, 0x04f8, 0x04f9, 0x0589, 0x058a, 0x060c, 0x061b, 0x061f, 
    0x098f, 0x0990, 0x09b2, 0x09bc, 0x09c7, 0x09c8, 0x09d7, 0x09dc, 0x09dd, 
    0x0a02, 0x0a0f, 0x0a10, 0x0a32, 0x0a33, 0x0a35, 0x0a36, 0x0a38, 0x0a39, 
    0x0a3c, 0x0a47, 0x0a48, 0x0a5e, 0x0a8d, 0x0ab2, 0x0ab3, 0x0ad0, 0x0ae0, 
    0x0b0f, 0x0b10, 0x0b32, 0x0b33, 0x0b47, 0x0b48, 0x0b56, 0x0b57, 0x0b5c, 
    0x0b5d, 0x0b82, 0x0b83, 0x0b99, 0x0b9a, 0x0b9c, 0x0b9e, 0x0b9f, 0x0ba3, 
    0x0ba4, 0x0bd7, 0x0c55, 0x0c56, 0x0c60, 0x0c61, 0x0c82, 0x0c83, 0x0cd5, 
    0x0cd6, 0x0cde, 0x0ce0, 0x0ce1, 0x0d02, 0x0d03, 0x0d57, 0x0d60, 0x0d61, 
    0x0d82, 0x0d83, 0x0dbd, 0x0dca, 0x0dd6, 0x0e81, 0x0e82, 0x0e84, 0x0e87, 
    0x0e88, 0x0e8a, 0x0e8d, 0x0ea5, 0x0ea7, 0x0eaa, 0x0eab, 0x0ec6, 0x0edc, 
    0x0edd, 0x0fcf, 0x1021, 0x1029, 0x102a, 0x10fb, 0x1248, 0x1258, 0x1288, 
    0x12b0, 0x12c0, 0x1310, 0x1f59, 0x1f5b, 0x1f5d, 0x2070, 0x274d, 0x2756, 
    0x303e, 0x303f, 0xa4c6, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfe74
}
Definition at line 498 of file regc_locale.c.
Referenced by cclass().crange graphRangeTable[] [static]

Definition at line 376 of file regc_locale.c.
Referenced by cclass().chr lowerCharTable[] [static]

Definition at line 269 of file regc_locale.c.
Referenced by cclass().crange lowerRangeTable[] [static]
Initial value: {
    {0x0061, 0x007a}, {0x00df, 0x00f6}, {0x00f8, 0x00ff}, {0x017e, 0x0180}, 
    {0x0199, 0x019b}, {0x01bd, 0x01bf}, {0x0250, 0x02ad}, {0x03ac, 0x03ce}, 
    {0x03d5, 0x03d7}, {0x03ef, 0x03f3}, {0x0430, 0x045f}, {0x0561, 0x0587}, 
    {0x1e95, 0x1e9b}, {0x1f00, 0x1f07}, {0x1f10, 0x1f15}, {0x1f20, 0x1f27}, 
    {0x1f30, 0x1f37}, {0x1f40, 0x1f45}, {0x1f50, 0x1f57}, {0x1f60, 0x1f67}, 
    {0x1f70, 0x1f7d}, {0x1f80, 0x1f87}, {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, 
    {0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4}, {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, 
    {0x1ff2, 0x1ff4}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xff41, 0xff5a}
}
Definition at line 256 of file regc_locale.c.
Referenced by cclass().chr punctCharTable[] [static]
Initial value: {
    0x003a, 0x003b, 0x003f, 0x0040, 0x005f, 0x007b, 0x007d, 0x00a1, 0x00ab, 
    0x00ad, 0x00b7, 0x00bb, 0x00bf, 0x037e, 0x0387, 0x0589, 0x058a, 0x05be, 
    0x05c0, 0x05c3, 0x05f3, 0x05f4, 0x060c, 0x061b, 0x061f, 0x06d4, 0x0964, 
    0x0965, 0x0970, 0x0df4, 0x0e4f, 0x0e5a, 0x0e5b, 0x0f85, 0x10fb, 0x166d, 
    0x166e, 0x169b, 0x169c, 0x17dc, 0x2045, 0x2046, 0x207d, 0x207e, 0x208d, 
    0x208e, 0x2329, 0x232a, 0x3030, 0x30fb, 0xfd3e, 0xfd3f, 0xfe63, 0xfe68, 
    0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d
}
Definition at line 228 of file regc_locale.c.
Referenced by cclass().crange punctRangeTable[] [static]
Initial value: {
    {0x0021, 0x0023}, {0x0025, 0x002a}, {0x002c, 0x002f}, {0x005b, 0x005d}, 
    {0x055a, 0x055f}, {0x066a, 0x066d}, {0x0700, 0x070d}, {0x0f04, 0x0f12}, 
    {0x0f3a, 0x0f3d}, {0x104a, 0x104f}, {0x1361, 0x1368}, {0x16eb, 0x16ed}, 
    {0x17d4, 0x17da}, {0x1800, 0x180a}, {0x2010, 0x2027}, {0x2030, 0x2043}, 
    {0x2048, 0x204d}, {0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, 
    {0xfe30, 0xfe44}, {0xfe49, 0xfe52}, {0xfe54, 0xfe61}, {0xff01, 0xff03}, 
    {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d}, {0xff61, 0xff65}
}
Definition at line 216 of file regc_locale.c.
Referenced by cclass().chr spaceCharTable[] [static]
Initial value: {
    0x0020, 0x00a0, 0x1680, 0x2028, 0x2029, 0x202f, 0x3000
}
Definition at line 248 of file regc_locale.c.
Referenced by cclass().crange spaceRangeTable[] [static]
Initial value: {
    {0x0009, 0x000d}, {0x2000, 0x200b}
}
Definition at line 242 of file regc_locale.c.
Referenced by cclass().chr upperCharTable[] [static]

Definition at line 329 of file regc_locale.c.
Referenced by cclass().crange upperRangeTable[] [static]
Initial value: {
    {0x0041, 0x005a}, {0x00c0, 0x00d6}, {0x00d8, 0x00de}, {0x0189, 0x018b}, 
    {0x018e, 0x0191}, {0x0196, 0x0198}, {0x01b1, 0x01b3}, {0x01f6, 0x01f8}, 
    {0x0388, 0x038a}, {0x0391, 0x03a1}, {0x03a3, 0x03ab}, {0x03d2, 0x03d4}, 
    {0x0400, 0x042f}, {0x0531, 0x0556}, {0x10a0, 0x10c5}, {0x1f08, 0x1f0f}, 
    {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f}, {0x1f38, 0x1f3f}, {0x1f48, 0x1f4d}, 
    {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb}, {0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb}, 
    {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d}, {0x2110, 0x2112}, 
    {0x2119, 0x211d}, {0x212a, 0x212d}, {0xff21, 0xff3a}
}
Definition at line 316 of file regc_locale.c.
Referenced by cclass().

generic/regc_nfa.c File Reference
Defines
#define NISERR()  VISERR(nfa->v)
#define NERR(e)  VERR(nfa->v, (e))
#define CA(ct, at)  (((ct)<<CHAR_BIT) | (at))
Functions
static struct nfa * newnfa (struct vars *v, struct colormap *cm, struct nfa *parent)
static VOID freenfa (struct nfa *nfa)
static struct state * newstate (struct nfa *nfa)
static struct state * newfstate (struct nfa *nfa, int flag)
static VOID dropstate (struct nfa *nfa, struct state *s)
static VOID freestate (struct nfa *nfa, struct state *s)
static VOID destroystate (struct nfa *nfa, struct state *s)
static VOID newarc (struct nfa *nfa, int t, pcolor co, struct state *from, struct state *to)
static struct arc * allocarc (struct nfa *nfa, struct state *s)
static VOID freearc (struct nfa *nfa, struct arc *victim)
static struct arc * findarc (struct state *s, int type, pcolor co)
static VOID cparc (struct nfa *nfa, struct arc *oa, struct state *from, struct state *to)
static VOID moveins (struct nfa *nfa, struct state *old, struct state *new)
static VOID copyins (struct nfa *nfa, struct state *old, struct state *new)
static VOID moveouts (struct nfa *nfa, struct state *old, struct state *new)
static VOID copyouts (struct nfa *nfa, struct state *old, struct state *new)
static VOID cloneouts (struct nfa *nfa, struct state *old, struct state *from, struct state *to, int type)
static VOID delsub (struct nfa *nfa, struct state *lp, struct state *rp)
static VOID deltraverse (struct nfa *nfa, struct state *leftend, struct state *s)
static VOID dupnfa (struct nfa *nfa, struct state *start, struct state *stop, struct state *from, struct state *to)
static VOID duptraverse (struct nfa *nfa, struct state *s, struct state *stmp)
static VOID cleartraverse (struct nfa *nfa, struct state *s)
static VOID specialcolors (struct nfa *nfa)
static long optimize (struct nfa *nfa, FILE *f)
static VOID pullback (struct nfa *nfa, FILE *f)
static int pull (struct nfa *nfa, struct arc *con)
static VOID pushfwd (struct nfa *nfa, FILE *f)
static int push (struct nfa *nfa, struct arc *con)
static int combine (struct arc *con, struct arc *a)
static VOID fixempties (struct nfa *nfa, FILE *f)
static int unempty (struct nfa *nfa, struct arc *a)
static VOID cleanup (struct nfa *nfa)
static VOID markreachable (struct nfa *nfa, struct state *s, struct state *okay, struct state *mark)
static VOID markcanreach (struct nfa *nfa, struct state *s, struct state *okay, struct state *mark)
static long analyze (struct nfa *nfa)
static VOID compact (struct nfa *nfa, struct cnfa *cnfa)
static VOID carcsort (struct carc *first, struct carc *last)
static VOID freecnfa (struct cnfa *cnfa)
static VOID dumpnfa (struct nfa *nfa, FILE *f)
static VOID dumpcnfa (struct cnfa *cnfa, FILE *f)

Define Documentation
#define CA(ct, at)  (((ct)<<CHAR_BIT) | (at))

Referenced by combine().#define NERR(e)  VERR(nfa->v, (e))

Definition at line 39 of file regc_nfa.c.
Referenced by allocarc(), compact(), and newstate().#define NISERR()  VISERR(nfa->v)

Definition at line 38 of file regc_nfa.c.
Referenced by compact(), duptraverse(), fixempties(), newarc(), pull(), pullback(), push(), and pushfwd().
Function Documentation
static struct arc* allocarc (struct nfa * nfa, struct state * s) [static]

Definition at line 306 of file regc_nfa.c.
References arcbatch::a, ABSIZE, state::free, MALLOC, NERR, arcbatch::next, state::noas, NULL, state::oas, REG_ESPACE, and arc::type.
Referenced by newarc().309 {
310   struct arc *a;
311   struct arcbatch *new;
312   int i;
313 
314   /* shortcut */
315   if (s->free == NULL && s->noas < ABSIZE) {
316     a = &s->oas.a[s->noas];
317     s->noas++;
318     return a;
319   }
320 
321   /* if none at hand, get more */
322   if (s->free == NULL) {
323     new = (struct arcbatch *)MALLOC(sizeof(struct arcbatch));
324     if (new == NULL) {
325       NERR(REG_ESPACE);
326       return NULL;
327     }
328     new->next = s->oas.next;
329     s->oas.next = new;
330 
331     for (i = 0; i < ABSIZE; i++) {
332       new->a[i].type = 0;
333       new->a[i].freechain = &new->a[i+1];
334     }
335     new->a[ABSIZE-1].freechain = NULL;
336     s->free = &new->a[0];
337   }
338   assert(s->free != NULL);
339 
340   a = s->free;
341   s->free = a->freechain;
342   return a;
343 }
static long analyze (struct nfa * nfa) [static]

Definition at line 1193 of file regc_nfa.c.
References NULL, arc::outchain, state::outs, REG_UEMPTYMATCH, REG_UIMPOSSIBLE, and arc::to.
Referenced by optimize().1195 {
1196   struct arc *a;
1197   struct arc *aa;
1198 
1199   if (nfa->pre->outs == NULL)
1200     return REG_UIMPOSSIBLE;
1201   for (a = nfa->pre->outs; a != NULL; a = a->outchain)
1202     for (aa = a->to->outs; aa != NULL; aa = aa->outchain)
1203       if (aa->to == nfa->post)
1204         return REG_UEMPTYMATCH;
1205   return 0;
1206 }
static VOID carcsort (struct carc * first, struct carc * last) [static]

Definition at line 1300 of file regc_nfa.c.
References carc::co, and carc::to.
Referenced by compact().1303 {
1304   struct carc *p;
1305   struct carc *q;
1306   struct carc tmp;
1307 
1308   if (last - first <= 1)
1309     return;
1310 
1311   for (p = first; p <= last; p++)
1312     for (q = p; q <= last; q++)
1313       if (p->co > q->co ||
1314           (p->co == q->co && p->to > q->to)) {
1315         assert(p != q);
1316         tmp = *p;
1317         *p = *q;
1318         *q = tmp;
1319       }
1320 }
static VOID cleanup (struct nfa * nfa) [static]

Definition at line 1116 of file regc_nfa.c.
References cleartraverse(), dropstate(), state::flag, markcanreach(), markreachable(), state::next, state::no, NULL, and state::tmp.
Referenced by ConvertFileNameFormat(), ExecuteCallback(), main(), optimize(), PeekAhead(), TclCreatePipeline(), TclExecuteByteCode(), and TclPtrSetVar().1118 {
1119   struct state *s;
1120   struct state *nexts;
1121   int n;
1122 
1123   /* clear out unreachable or dead-end states */
1124   /* use pre to mark reachable, then post to mark can-reach-post */
1125   markreachable(nfa, nfa->pre, (struct state *)NULL, nfa->pre);
1126   markcanreach(nfa, nfa->post, nfa->pre, nfa->post);
1127   for (s = nfa->states; s != NULL; s = nexts) {
1128     nexts = s->next;
1129     if (s->tmp != nfa->post && !s->flag)
1130       dropstate(nfa, s);
1131   }
1132   assert(nfa->post->nins == 0 || nfa->post->tmp == nfa->post);
1133   cleartraverse(nfa, nfa->pre);
1134   assert(nfa->post->nins == 0 || nfa->post->tmp == NULL);
1135   /* the nins==0 (final unreachable) case will be caught later */
1136 
1137   /* renumber surviving states */
1138   n = 0;
1139   for (s = nfa->states; s != NULL; s = s->next)
1140     s->no = n++;
1141   nfa->nstates = n;
1142 }
static VOID cleartraverse (struct nfa * nfa, struct state * s) [static]

Definition at line 664 of file regc_nfa.c.
References NULL, arc::outchain, state::outs, state::tmp, and arc::to.
Referenced by cleanup(), and dupnfa().667 {
668   struct arc *a;
669 
670   if (s->tmp == NULL)
671     return;
672   s->tmp = NULL;
673 
674   for (a = s->outs; a != NULL; a = a->outchain)
675     cleartraverse(nfa, a->to);
676 }
static VOID cloneouts (struct nfa * nfa, struct state * old, struct state * from, struct state * to, int type) [static]

Definition at line 524 of file regc_nfa.c.
References arc::co, arc::from, newarc(), NULL, arc::outchain, state::outs, and arc::to.
Referenced by cbracket(), and word().530 {
531   struct arc *a;
532 
533   assert(old != from);
534 
535   for (a = old->outs; a != NULL; a = a->outchain)
536     newarc(nfa, type, a->co, from, to);
537 }
static int combine (struct arc * con, struct arc * a) [static]

Definition at line 976 of file regc_nfa.c.
References AHEAD, BEHIND, CA, arc::co, COMPATIBLE, INCOMPATIBLE, LACON, NOTREACHED, PLAIN, SATISFIED, and arc::type.
Referenced by pull(), and push().979 {
980 # define  CA(ct,at) (((ct)<<CHAR_BIT) | (at))
981 
982   switch (CA(con->type, a->type)) {
983   case CA('^', PLAIN):    /* newlines are handled separately */
984   case CA('$', PLAIN):
985     return INCOMPATIBLE;
986     break;
987   case CA(AHEAD, PLAIN):    /* color constraints meet colors */
988   case CA(BEHIND, PLAIN):
989     if (con->co == a->co)
990       return SATISFIED;
991     return INCOMPATIBLE;
992     break;
993   case CA('^', '^'):    /* collision, similar constraints */
994   case CA('$', '$'):
995   case CA(AHEAD, AHEAD):
996   case CA(BEHIND, BEHIND):
997     if (con->co == a->co)   /* true duplication */
998       return SATISFIED;
999     return INCOMPATIBLE;
1000     break;
1001   case CA('^', BEHIND):   /* collision, dissimilar constraints */
1002   case CA(BEHIND, '^'):
1003   case CA('$', AHEAD):
1004   case CA(AHEAD, '$'):
1005     return INCOMPATIBLE;
1006     break;
1007   case CA('^', '$'):    /* constraints passing each other */
1008   case CA('^', AHEAD):
1009   case CA(BEHIND, '$'):
1010   case CA(BEHIND, AHEAD):
1011   case CA('$', '^'):
1012   case CA('$', BEHIND):
1013   case CA(AHEAD, '^'):
1014   case CA(AHEAD, BEHIND):
1015   case CA('^', LACON):
1016   case CA(BEHIND, LACON):
1017   case CA('$', LACON):
1018   case CA(AHEAD, LACON):
1019     return COMPATIBLE;
1020     break;
1021   }
1022   assert(NOTREACHED);
1023   return INCOMPATIBLE;    /* for benefit of blind compilers */
1024 }
static VOID compact (struct nfa * nfa, struct cnfa * cnfa) [static]

Definition at line 1213 of file regc_nfa.c.
References cnfa::arcs, cnfa::bos, carcsort(), arc::co, carc::co, COLORLESS, cnfa::eos, cnfa::flags, FREE, HASLACONS, LACON, MALLOC, maxcolor(), cnfa::ncolors, NERR, state::next, NISERR, state::no, NOTREACHED, state::nouts, cnfa::nstates, NULL, arc::outchain, state::outs, PLAIN, cnfa::post, cnfa::pre, REG_ESPACE, size_t(), cnfa::states, arc::to, carc::to, and arc::type.
Referenced by compile(), and nfanode().1216 {
1217   struct state *s;
1218   struct arc *a;
1219   size_t nstates;
1220   size_t narcs;
1221   struct carc *ca;
1222   struct carc *first;
1223 
1224   assert (!NISERR());
1225 
1226   nstates = 0;
1227   narcs = 0;
1228   for (s = nfa->states; s != NULL; s = s->next) {
1229     nstates++;
1230     narcs += 1 + s->nouts + 1;
1231     /* 1 as a fake for flags, nouts for arcs, 1 as endmarker */
1232   }
1233 
1234   cnfa->states = (struct carc **)MALLOC(nstates * sizeof(struct carc *));
1235   cnfa->arcs = (struct carc *)MALLOC(narcs * sizeof(struct carc));
1236   if (cnfa->states == NULL || cnfa->arcs == NULL) {
1237     if (cnfa->states != NULL)
1238       FREE(cnfa->states);
1239     if (cnfa->arcs != NULL)
1240       FREE(cnfa->arcs);
1241     NERR(REG_ESPACE);
1242     return;
1243   }
1244   cnfa->nstates = nstates;
1245   cnfa->pre = nfa->pre->no;
1246   cnfa->post = nfa->post->no;
1247   cnfa->bos[0] = nfa->bos[0];
1248   cnfa->bos[1] = nfa->bos[1];
1249   cnfa->eos[0] = nfa->eos[0];
1250   cnfa->eos[1] = nfa->eos[1];
1251   cnfa->ncolors = maxcolor(nfa->cm) + 1;
1252   cnfa->flags = 0;
1253 
1254   ca = cnfa->arcs;
1255   for (s = nfa->states; s != NULL; s = s->next) {
1256     assert((size_t)s->no < nstates);
1257     cnfa->states[s->no] = ca;
1258     ca->co = 0;   /* clear and skip flags "arc" */
1259     ca++;
1260     first = ca;
1261     for (a = s->outs; a != NULL; a = a->outchain)
1262       switch (a->type) {
1263       case PLAIN:
1264         ca->co = a->co;
1265         ca->to = a->to->no;
1266         ca++;
1267         break;
1268       case LACON:
1269         assert(s->no != cnfa->pre);
1270         ca->co = (color)(cnfa->ncolors + a->co);
1271         ca->to = a->to->no;
1272         ca++;
1273         cnfa->flags |= HASLACONS;
1274         break;
1275       default:
1276         assert(NOTREACHED);
1277         break;
1278       }
1279     carcsort(first, ca-1);
1280     ca->co = COLORLESS;
1281     ca->to = 0;
1282     ca++;
1283   }
1284   assert(ca == &cnfa->arcs[narcs]);
1285   assert(cnfa->nstates != 0);
1286 
1287   /* mark no-progress states */
1288   for (a = nfa->pre->outs; a != NULL; a = a->outchain)
1289     cnfa->states[a->to->no]->co = 1;
1290   cnfa->states[nfa->pre->no]->co = 1;
1291 }
static VOID copyins (struct nfa * nfa, struct state * old, struct state * new) [static]

Definition at line 467 of file regc_nfa.c.
References cparc(), arc::from, arc::inchain, state::ins, and NULL.
Referenced by pull(), and unempty().471 {
472   struct arc *a;
473 
474   assert(old != new);
475 
476   for (a = old->ins; a != NULL; a = a->inchain)
477     cparc(nfa, a, a->from, new);
478 }
static VOID copyouts (struct nfa * nfa, struct state * old, struct state * new) [static]

Definition at line 505 of file regc_nfa.c.
References cparc(), NULL, arc::outchain, state::outs, and arc::to.
Referenced by makesearch(), push(), and unempty().509 {
510   struct arc *a;
511 
512   assert(old != new);
513 
514   for (a = old->outs; a != NULL; a = a->outchain)
515     cparc(nfa, a, new, a->to);
516 }
static VOID cparc (struct nfa * nfa, struct arc * oa, struct state * from, struct state * to) [static]

Definition at line 427 of file regc_nfa.c.
References arc::co, arc::from, newarc(), arc::to, and arc::type.
Referenced by copyins(), copyouts(), duptraverse(), makesearch(), moveins(), moveouts(), pull(), and push().432 {
433   newarc(nfa, oa->type, oa->co, from, to);
434 }
static VOID delsub (struct nfa * nfa, struct state * lp, struct state * rp) [static]

Definition at line 546 of file regc_nfa.c.
References deltraverse(), FREESTATE, state::nins, state::no, state::nouts, NULL, and state::tmp.
Referenced by cbracket(), parseqatom(), and repeat().550 {
551   assert(lp != rp);
552 
553   rp->tmp = rp;     /* mark end */
554 
555   deltraverse(nfa, lp, lp);
556   assert(lp->nouts == 0 && rp->nins == 0);  /* did the job */
557   assert(lp->no != FREESTATE && rp->no != FREESTATE); /* no more */
558 
559   rp->tmp = NULL;     /* unmark end */
560   lp->tmp = NULL;     /* and begin, marked by deltraverse */
561 }
static VOID deltraverse (struct nfa * nfa, struct state * leftend, struct state * s) [static]

Definition at line 569 of file regc_nfa.c.
References freearc(), FREESTATE, freestate(), state::nins, state::no, state::nouts, NULL, state::outs, state::tmp, and arc::to.
Referenced by delsub().573 {
574   struct arc *a;
575   struct state *to;
576 
577   if (s->nouts == 0)
578     return;     /* nothing to do */
579   if (s->tmp != NULL)
580     return;     /* already in progress */
581 
582   s->tmp = s;     /* mark as in progress */
583 
584   while ((a = s->outs) != NULL) {
585     to = a->to;
586     deltraverse(nfa, leftend, to);
587     assert(to->nouts == 0 || to->tmp != NULL);
588     freearc(nfa, a);
589     if (to->nins == 0 && to->tmp == NULL) {
590       assert(to->nouts == 0);
591       freestate(nfa, to);
592     }
593   }
594 
595   assert(s->no != FREESTATE); /* we're still here */
596   assert(s == leftend || s->nins != 0); /* and still reachable */
597   assert(s->nouts == 0);    /* but have no outarcs */
598 
599   s->tmp = NULL;      /* we're done here */
600 }
static VOID destroystate (struct nfa * nfa, struct state * s) [static]

Definition at line 231 of file regc_nfa.c.
References FREE, FREESTATE, state::ins, state::next, arcbatch::next, state::no, NULL, state::oas, and state::outs.
Referenced by freenfa().234 {
235   struct arcbatch *ab;
236   struct arcbatch *abnext;
237 
238   assert(s->no == FREESTATE);
239   for (ab = s->oas.next; ab != NULL; ab = abnext) {
240     abnext = ab->next;
241     FREE(ab);
242   }
243   s->ins = NULL;
244   s->outs = NULL;
245   s->next = NULL;
246   FREE(s);
247 }
static VOID dropstate (struct nfa * nfa, struct state * s) [static]

Definition at line 182 of file regc_nfa.c.
References freearc(), freestate(), state::ins, NULL, and state::outs.
Referenced by cbracket(), cleanup(), pull(), and push().185 {
186   struct arc *a;
187 
188   while ((a = s->ins) != NULL)
189     freearc(nfa, a);
190   while ((a = s->outs) != NULL)
191     freearc(nfa, a);
192   freestate(nfa, s);
193 }
static VOID dumpcnfa (struct cnfa * cnfa, FILE * f) [static]

Definition at line 1509 of file regc_nfa.c.
References COLORLESS, and HASLACONS.
Referenced by dump(), and stdump().1512 {
1513 #ifdef REG_DEBUG
1514   int st;
1515 
1516   fprintf(f, "pre %d, post %d", cnfa->pre, cnfa->post);
1517   if (cnfa->bos[0] != COLORLESS)
1518     fprintf(f, ", bos [%ld]", (long)cnfa->bos[0]);
1519   if (cnfa->bos[1] != COLORLESS)
1520     fprintf(f, ", bol [%ld]", (long)cnfa->bos[1]);
1521   if (cnfa->eos[0] != COLORLESS)
1522     fprintf(f, ", eos [%ld]", (long)cnfa->eos[0]);
1523   if (cnfa->eos[1] != COLORLESS)
1524     fprintf(f, ", eol [%ld]", (long)cnfa->eos[1]);
1525   if (cnfa->flags&HASLACONS)
1526     fprintf(f, ", haslacons");
1527   fprintf(f, "\n");
1528   for (st = 0; st < cnfa->nstates; st++)
1529     dumpcstate(st, cnfa->states[st], cnfa, f);
1530   fflush(f);
1531 #endif
1532 }
static VOID dumpnfa (struct nfa * nfa, FILE * f) [static]

Definition at line 1341 of file regc_nfa.c.
References COLORLESS, state::next, and NULL.
Referenced by compile(), fixempties(), optimize(), pullback(), and pushfwd().1344 {
1345 #ifdef REG_DEBUG
1346   struct state *s;
1347 
1348   fprintf(f, "pre %d, post %d", nfa->pre->no, nfa->post->no);
1349   if (nfa->bos[0] != COLORLESS)
1350     fprintf(f, ", bos [%ld]", (long)nfa->bos[0]);
1351   if (nfa->bos[1] != COLORLESS)
1352     fprintf(f, ", bol [%ld]", (long)nfa->bos[1]);
1353   if (nfa->eos[0] != COLORLESS)
1354     fprintf(f, ", eos [%ld]", (long)nfa->eos[0]);
1355   if (nfa->eos[1] != COLORLESS)
1356     fprintf(f, ", eol [%ld]", (long)nfa->eos[1]);
1357   fprintf(f, "\n");
1358   for (s = nfa->states; s != NULL; s = s->next)
1359     dumpstate(s, f);
1360   if (nfa->parent == NULL)
1361     dumpcolors(nfa->cm, f);
1362   fflush(f);
1363 #endif
1364 }
static VOID dupnfa (struct nfa * nfa, struct state * start, struct state * stop, struct state * from, struct state * to) [static]

Definition at line 611 of file regc_nfa.c.
References cleartraverse(), duptraverse(), EMPTY, newarc(), NULL, and state::tmp.
Referenced by nfanode(), parseqatom(), and repeat().617 {
618   if (start == stop) {
619     newarc(nfa, EMPTY, 0, from, to);
620     return;
621   }
622 
623   stop->tmp = to;
624   duptraverse(nfa, start, from);
625   /* done, except for clearing out the tmp pointers */
626 
627   stop->tmp = NULL;
628   cleartraverse(nfa, start);
629 }
static VOID duptraverse (struct nfa * nfa, struct state * s, struct state * stmp) [static]

Definition at line 636 of file regc_nfa.c.
References cparc(), newstate(), NISERR, NULL, arc::outchain, state::outs, state::tmp, and arc::to.
Referenced by dupnfa().640 {
641   struct arc *a;
642 
643   if (s->tmp != NULL)
644     return;   /* already done */
645 
646   s->tmp = (stmp == NULL) ? newstate(nfa) : stmp;
647   if (s->tmp == NULL) {
648     assert(NISERR());
649     return;
650   }
651 
652   for (a = s->outs; a != NULL && !NISERR(); a = a->outchain) {
653     duptraverse(nfa, a->to, (struct state *)NULL);
654     assert(a->to->tmp != NULL);
655     cparc(nfa, a, s->tmp, a->to->tmp);
656   }
657 }
static struct arc* findarc (struct state * s, int type, pcolor co) [static]

Definition at line 408 of file regc_nfa.c.
References arc::co, NULL, arc::outchain, and arc::type.
Referenced by cbracket(), colorcomplement(), dovec(), and leaders().412 {
413   struct arc *a;
414 
415   for (a = s->outs; a != NULL; a = a->outchain)
416     if (a->type == type && a->co == co)
417       return a;
418   return NULL;
419 }
static VOID fixempties (struct nfa * nfa, FILE * f) [static]

Definition at line 1031 of file regc_nfa.c.
References dumpnfa(), EMPTY, FREESTATE, state::next, NISERR, state::no, NULL, arc::outchain, state::outs, arc::type, and unempty().
Referenced by optimize().1034 {
1035   struct state *s;
1036   struct state *nexts;
1037   struct arc *a;
1038   struct arc *nexta;
1039   int progress;
1040 
1041   /* find and eliminate empties until there are no more */
1042   do {
1043     progress = 0;
1044     for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
1045       nexts = s->next;
1046       for (a = s->outs; a != NULL && !NISERR(); a = nexta) {
1047         nexta = a->outchain;
1048         if (a->type == EMPTY && unempty(nfa, a))
1049           progress = 1;
1050         assert(nexta == NULL || s->no != FREESTATE);
1051       }
1052     }
1053     if (progress && f != NULL)
1054       dumpnfa(nfa, f);
1055   } while (progress && !NISERR());
1056 }
static VOID freearc (struct nfa * nfa, struct arc * victim) [static]

Definition at line 350 of file regc_nfa.c.
References COLORED, state::free, arc::from, arc::inchain, state::ins, state::nins, state::nouts, NULL, arc::outchain, state::outs, arc::to, arc::type, and uncolorchain().
Referenced by cbracket(), deltraverse(), dropstate(), makesearch(), moveins(), moveouts(), pull(), pullback(), push(), pushfwd(), and unempty().353 {
354   struct state *from = victim->from;
355   struct state *to = victim->to;
356   struct arc *a;
357 
358   assert(victim->type != 0);
359 
360   /* take it off color chain if necessary */
361   if (COLORED(victim) && nfa->parent == NULL)
362     uncolorchain(nfa->cm, victim);
363 
364   /* take it off source's out-chain */
365   assert(from != NULL);
366   assert(from->outs != NULL);
367   a = from->outs;
368   if (a == victim)    /* simple case:  first in chain */
369     from->outs = victim->outchain;
370   else {
371     for (; a != NULL && a->outchain != victim; a = a->outchain)
372       continue;
373     assert(a != NULL);
374     a->outchain = victim->outchain;
375   }
376   from->nouts--;
377 
378   /* take it off target's in-chain */
379   assert(to != NULL);
380   assert(to->ins != NULL);
381   a = to->ins;
382   if (a == victim)    /* simple case:  first in chain */
383     to->ins = victim->inchain;
384   else {
385     for (; a != NULL && a->inchain != victim; a = a->inchain)
386       continue;
387     assert(a != NULL);
388     a->inchain = victim->inchain;
389   }
390   to->nins--;
391 
392   /* clean up and place on free list */
393   victim->type = 0;
394   victim->from = NULL;    /* precautions... */
395   victim->to = NULL;
396   victim->inchain = NULL;
397   victim->outchain = NULL;
398   victim->freechain = from->free;
399   from->free = victim;
400 }
static VOID freecnfa (struct cnfa * cnfa) [static]

Definition at line 1327 of file regc_nfa.c.
References FREE.
Referenced by freelacons(), freesrnode(), and rfree().1329 {
1330   assert(cnfa->nstates != 0); /* not empty already */
1331   cnfa->nstates = 0;
1332   FREE(cnfa->states);
1333   FREE(cnfa->arcs);
1334 }
static VOID freenfa (struct nfa * nfa) [static]

Definition at line 95 of file regc_nfa.c.
References destroystate(), FREE, state::free, freestate(), state::next, state::nins, state::nouts, and NULL.
Referenced by freev(), newnfa(), and nfanode().97 {
98   struct state *s;
99 
100   while ((s = nfa->states) != NULL) {
101     s->nins = s->nouts = 0;   /* don't worry about arcs */
102     freestate(nfa, s);
103   }
104   while ((s = nfa->free) != NULL) {
105     nfa->free = s->next;
106     destroystate(nfa, s);
107   }
108 
109   nfa->slast = NULL;
110   nfa->nstates = -1;
111   nfa->pre = NULL;
112   nfa->post = NULL;
113   FREE(nfa);
114 }
static VOID freestate (struct nfa * nfa, struct state * s) [static]

Definition at line 200 of file regc_nfa.c.
References state::flag, state::free, FREESTATE, state::next, state::nins, state::no, state::nouts, NULL, and state::prev.
Referenced by cbracket(), deltraverse(), dropstate(), freenfa(), and unempty().203 {
204   assert(s != NULL);
205   assert(s->nins == 0 && s->nouts == 0);
206 
207   s->no = FREESTATE;
208   s->flag = 0;
209   if (s->next != NULL)
210     s->next->prev = s->prev;
211   else {
212     assert(s == nfa->slast);
213     nfa->slast = s->prev;
214   }
215   if (s->prev != NULL)
216     s->prev->next = s->next;
217   else {
218     assert(s == nfa->states);
219     nfa->states = s->next;
220   }
221   s->prev = NULL;
222   s->next = nfa->free;  /* don't delete it, put it on the free list */
223   nfa->free = s;
224 }
static VOID markcanreach (struct nfa * nfa, struct state * s, struct state * okay, struct state * mark) [static]

Definition at line 1172 of file regc_nfa.c.
References arc::from, arc::inchain, state::ins, NULL, and state::tmp.
Referenced by cleanup().1177 {
1178   struct arc *a;
1179 
1180   if (s->tmp != okay)
1181     return;
1182   s->tmp = mark;
1183 
1184   for (a = s->ins; a != NULL; a = a->inchain)
1185     markcanreach(nfa, a->from, okay, mark);
1186 }
static VOID markreachable (struct nfa * nfa, struct state * s, struct state * okay, struct state * mark) [static]

Definition at line 1150 of file regc_nfa.c.
References NULL, arc::outchain, state::outs, state::tmp, and arc::to.
Referenced by cleanup().1155 {
1156   struct arc *a;
1157 
1158   if (s->tmp != okay)
1159     return;
1160   s->tmp = mark;
1161 
1162   for (a = s->outs; a != NULL; a = a->outchain)
1163     markreachable(nfa, a->to, okay, mark);
1164 }
static VOID moveins (struct nfa * nfa, struct state * old, struct state * new) [static]

Definition at line 445 of file regc_nfa.c.
References cparc(), freearc(), arc::from, state::ins, state::nins, and NULL.
Referenced by parsebranch(), parseqatom(), pull(), repeat(), and unempty().449 {
450   struct arc *a;
451 
452   assert(old != new);
453 
454   while ((a = old->ins) != NULL) {
455     cparc(nfa, a, a->from, new);
456     freearc(nfa, a);
457   }
458   assert(old->nins == 0);
459   assert(old->ins == NULL);
460 }
static VOID moveouts (struct nfa * nfa, struct state * old, struct state * new) [static]

Definition at line 485 of file regc_nfa.c.
References cparc(), freearc(), NULL, state::outs, and arc::to.
Referenced by parseqatom(), push(), repeat(), and unempty().489 {
490   struct arc *a;
491 
492   assert(old != new);
493 
494   while ((a = old->outs) != NULL) {
495     cparc(nfa, a, new, a->to);
496     freearc(nfa, a);
497   }
498 }
static VOID newarc (struct nfa * nfa, int t, pcolor co, struct state * from, struct state * to) [static]

Definition at line 255 of file regc_nfa.c.
References allocarc(), arc::co, colorchain(), COLORED, arc::from, arc::inchain, state::ins, state::nins, NISERR, state::nouts, NULL, arc::outchain, state::outs, arc::to, and arc::type.
Referenced by cbracket(), cloneouts(), colorcomplement(), cparc(), dovec(), dupnfa(), leaders(), makesearch(), newnfa(), nonword(), okcolors(), onechr(), pullback(), pushfwd(), rainbow(), subblock(), and subrange().261 {
262   struct arc *a;
263 
264   assert(from != NULL && to != NULL);
265 
266   /* check for duplicates */
267   for (a = from->outs; a != NULL; a = a->outchain)
268     if (a->to == to && a->co == co && a->type == t)
269       return;
270 
271   a = allocarc(nfa, from);
272   if (NISERR())
273     return;
274   assert(a != NULL);
275 
276   a->type = t;
277   a->co = (color)co;
278   a->to = to;
279   a->from = from;
280 
281   /*
282    * Put the new arc on the beginning, not the end, of the chains.
283    * Not only is this easier, it has the very useful side effect that 
284    * deleting the most-recently-added arc is the cheapest case rather
285    * than the most expensive one.
286    */
287   a->inchain = to->ins;
288   to->ins = a;
289   a->outchain = from->outs;
290   from->outs = a;
291 
292   from->nouts++;
293   to->nins++;
294 
295   if (COLORED(a) && nfa->parent == NULL)
296     colorchain(nfa->cm, a);
297 
298   return;
299 }
static struct state* newfstate (struct nfa * nfa, int flag) [static]

Definition at line 165 of file regc_nfa.c.
References state::flag, newstate(), and NULL.
Referenced by newnfa().168 {
169   struct state *s;
170 
171   s = newstate(nfa);
172   if (s != NULL)
173     s->flag = (char)flag;
174   return s;
175 }
static struct nfa* newnfa (struct vars * v, struct colormap * cm, struct nfa * parent) [static]

Definition at line 47 of file regc_nfa.c.
References nfa::cm, COLORLESS, freenfa(), nfa::init, ISERR, MALLOC, newarc(), newfstate(), newstate(), NULL, nfa::parent, PLAIN, rainbow(), and colormap::v.
Referenced by compile(), and nfanode().51 {
52   struct nfa *nfa;
53 
54   nfa = (struct nfa *)MALLOC(sizeof(struct nfa));
55   if (nfa == NULL)
56     return NULL;
57 
58   nfa->states = NULL;
59   nfa->slast = NULL;
60   nfa->free = NULL;
61   nfa->nstates = 0;
62   nfa->cm = cm;
63   nfa->v = v;
64   nfa->bos[0] = nfa->bos[1] = COLORLESS;
65   nfa->eos[0] = nfa->eos[1] = COLORLESS;
66   nfa->post = newfstate(nfa, '@');  /* number 0 */
67   nfa->pre = newfstate(nfa, '>');   /* number 1 */
68   nfa->parent = parent;
69 
70   nfa->init = newstate(nfa);    /* may become invalid later */
71   nfa->final = newstate(nfa);
72   if (ISERR()) {
73     freenfa(nfa);
74     return NULL;
75   }
76   rainbow(nfa, nfa->cm, PLAIN, COLORLESS, nfa->pre, nfa->init);
77   newarc(nfa, '^', 1, nfa->pre, nfa->init);
78   newarc(nfa, '^', 0, nfa->pre, nfa->init);
79   rainbow(nfa, nfa->cm, PLAIN, COLORLESS, nfa->final, nfa->post);
80   newarc(nfa, '$', 1, nfa->final, nfa->post);
81   newarc(nfa, '$', 0, nfa->final, nfa->post);
82 
83   if (ISERR()) {
84     freenfa(nfa);
85     return NULL;
86   }
87   return nfa;
88 }
static struct state* newstate (struct nfa * nfa) [static]

Definition at line 121 of file regc_nfa.c.
References state::flag, state::free, state::ins, MALLOC, NERR, arcbatch::next, state::next, state::nins, state::no, state::noas, state::nouts, NULL, state::oas, state::outs, state::prev, REG_ESPACE, and state::tmp.
Referenced by cbracket(), dovec(), duptraverse(), leaders(), makesearch(), newfstate(), newnfa(), parse(), parsebranch(), parseqatom(), pull(), push(), repeat(), and wordchrs().123 {
124   struct state *s;
125 
126   if (nfa->free != NULL) {
127     s = nfa->free;
128     nfa->free = s->next;
129   } else {
130     s = (struct state *)MALLOC(sizeof(struct state));
131     if (s == NULL) {
132       NERR(REG_ESPACE);
133       return NULL;
134     }
135     s->oas.next = NULL;
136     s->free = NULL;
137     s->noas = 0;
138   }
139 
140   assert(nfa->nstates >= 0);
141   s->no = nfa->nstates++;
142   s->flag = 0;
143   if (nfa->states == NULL)
144     nfa->states = s;
145   s->nins = 0;
146   s->ins = NULL;
147   s->nouts = 0;
148   s->outs = NULL;
149   s->tmp = NULL;
150   s->next = NULL;
151   if (nfa->slast != NULL) {
152     assert(nfa->slast->next == NULL);
153     nfa->slast->next = s;
154   }
155   s->prev = nfa->slast;
156   nfa->slast = s;
157   return s;
158 }
static long optimize (struct nfa * nfa, FILE * f) [static]

Definition at line 709 of file regc_nfa.c.
References analyze(), cleanup(), dumpnfa(), fixempties(), NULL, pullback(), and pushfwd().
Referenced by compile(), and nfanode().712 {
713   int verbose = (f != NULL) ? 1 : 0;
714 
715   if (verbose)
716     fprintf(f, "\ninitial cleanup:\n");
717   cleanup(nfa);   /* may simplify situation */
718   if (verbose)
719     dumpnfa(nfa, f);
720   if (verbose)
721     fprintf(f, "\nempties:\n");
722   fixempties(nfa, f); /* get rid of EMPTY arcs */
723   if (verbose)
724     fprintf(f, "\nconstraints:\n");
725   pullback(nfa, f); /* pull back constraints backward */
726   pushfwd(nfa, f);  /* push fwd constraints forward */
727   if (verbose)
728     fprintf(f, "\nfinal cleanup:\n");
729   cleanup(nfa);   /* final tidying */
730   return analyze(nfa);  /* and analysis */
731 }
static int pull (struct nfa * nfa, struct arc * con) [static]

Definition at line 785 of file regc_nfa.c.
References combine(), COMPATIBLE, copyins(), cparc(), dropstate(), state::flag, freearc(), arc::from, arc::inchain, INCOMPATIBLE, state::ins, moveins(), newstate(), state::nins, NISERR, NOTREACHED, state::nouts, NULL, state::outs, SATISFIED, and arc::to.
Referenced by pullback().788 {
789   struct state *from = con->from;
790   struct state *to = con->to;
791   struct arc *a;
792   struct arc *nexta;
793   struct state *s;
794 
795   if (from == to) { /* circular constraint is pointless */
796     freearc(nfa, con);
797     return 1;
798   }
799   if (from->flag)   /* can't pull back beyond start */
800     return 0;
801   if (from->nins == 0) {  /* unreachable */
802     freearc(nfa, con);
803     return 1;
804   }
805 
806   /* first, clone from state if necessary to avoid other outarcs */
807   if (from->nouts > 1) {
808     s = newstate(nfa);
809     if (NISERR())
810       return 0;
811     assert(to != from);   /* con is not an inarc */
812     copyins(nfa, from, s);    /* duplicate inarcs */
813     cparc(nfa, con, s, to);   /* move constraint arc */
814     freearc(nfa, con);
815     from = s;
816     con = from->outs;
817   }
818   assert(from->nouts == 1);
819 
820   /* propagate the constraint into the from state's inarcs */
821   for (a = from->ins; a != NULL; a = nexta) {
822     nexta = a->inchain;
823     switch (combine(con, a)) {
824     case INCOMPATIBLE:  /* destroy the arc */
825       freearc(nfa, a);
826       break;
827     case SATISFIED:   /* no action needed */
828       break;
829     case COMPATIBLE:  /* swap the two arcs, more or less */
830       s = newstate(nfa);
831       if (NISERR())
832         return 0;
833       cparc(nfa, a, s, to);   /* anticipate move */
834       cparc(nfa, con, a->from, s);
835       if (NISERR())
836         return 0;
837       freearc(nfa, a);
838       break;
839     default:
840       assert(NOTREACHED);
841       break;
842     }
843   }
844 
845   /* remaining inarcs, if any, incorporate the constraint */
846   moveins(nfa, from, to);
847   dropstate(nfa, from);   /* will free the constraint */
848   return 1;
849 }
static VOID pullback (struct nfa * nfa, FILE * f) [static]

Definition at line 738 of file regc_nfa.c.
References BEHIND, arc::co, dumpnfa(), freearc(), FREESTATE, arc::from, newarc(), state::next, NISERR, state::no, NULL, arc::outchain, state::outs, PLAIN, pull(), arc::to, and arc::type.
Referenced by optimize().741 {
742   struct state *s;
743   struct state *nexts;
744   struct arc *a;
745   struct arc *nexta;
746   int progress;
747 
748   /* find and pull until there are no more */
749   do {
750     progress = 0;
751     for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
752       nexts = s->next;
753       for (a = s->outs; a != NULL && !NISERR(); a = nexta) {
754         nexta = a->outchain;
755         if (a->type == '^' || a->type == BEHIND)
756           if (pull(nfa, a))
757             progress = 1;
758         assert(nexta == NULL || s->no != FREESTATE);
759       }
760     }
761     if (progress && f != NULL)
762       dumpnfa(nfa, f);
763   } while (progress && !NISERR());
764   if (NISERR())
765     return;
766 
767   for (a = nfa->pre->outs; a != NULL; a = nexta) {
768     nexta = a->outchain;
769     if (a->type == '^') {
770       assert(a->co == 0 || a->co == 1);
771       newarc(nfa, PLAIN, nfa->bos[a->co], a->from, a->to);
772       freearc(nfa, a);
773     }
774   }
775 }
static int push (struct nfa * nfa, struct arc * con) [static]

Definition at line 903 of file regc_nfa.c.
References combine(), COMPATIBLE, copyouts(), cparc(), dropstate(), state::flag, freearc(), arc::from, INCOMPATIBLE, state::ins, moveouts(), newstate(), state::nins, NISERR, NOTREACHED, state::nouts, NULL, arc::outchain, state::outs, SATISFIED, and arc::to.
Referenced by pushfwd(), and TclWinCPUID().906 {
907   struct state *from = con->from;
908   struct state *to = con->to;
909   struct arc *a;
910   struct arc *nexta;
911   struct state *s;
912 
913   if (to == from) { /* circular constraint is pointless */
914     freearc(nfa, con);
915     return 1;
916   }
917   if (to->flag)   /* can't push forward beyond end */
918     return 0;
919   if (to->nouts == 0) { /* dead end */
920     freearc(nfa, con);
921     return 1;
922   }
923 
924   /* first, clone to state if necessary to avoid other inarcs */
925   if (to->nins > 1) {
926     s = newstate(nfa);
927     if (NISERR())
928       return 0;
929     copyouts(nfa, to, s);   /* duplicate outarcs */
930     cparc(nfa, con, from, s); /* move constraint */
931     freearc(nfa, con);
932     to = s;
933     con = to->ins;
934   }
935   assert(to->nins == 1);
936 
937   /* propagate the constraint into the to state's outarcs */
938   for (a = to->outs; a != NULL; a = nexta) {
939     nexta = a->outchain;
940     switch (combine(con, a)) {
941     case INCOMPATIBLE:  /* destroy the arc */
942       freearc(nfa, a);
943       break;
944     case SATISFIED:   /* no action needed */
945       break;
946     case COMPATIBLE:  /* swap the two arcs, more or less */
947       s = newstate(nfa);
948       if (NISERR())
949         return 0;
950       cparc(nfa, con, s, a->to);  /* anticipate move */
951       cparc(nfa, a, from, s);
952       if (NISERR())
953         return 0;
954       freearc(nfa, a);
955       break;
956     default:
957       assert(NOTREACHED);
958       break;
959     }
960   }
961 
962   /* remaining outarcs, if any, incorporate the constraint */
963   moveouts(nfa, to, from);
964   dropstate(nfa, to);   /* will free the constraint */
965   return 1;
966 }
static VOID pushfwd (struct nfa * nfa, FILE * f) [static]

Definition at line 856 of file regc_nfa.c.
References AHEAD, arc::co, dumpnfa(), freearc(), FREESTATE, arc::from, arc::inchain, state::ins, newarc(), state::next, NISERR, state::no, NULL, PLAIN, push(), arc::to, and arc::type.
Referenced by optimize().859 {
860   struct state *s;
861   struct state *nexts;
862   struct arc *a;
863   struct arc *nexta;
864   int progress;
865 
866   /* find and push until there are no more */
867   do {
868     progress = 0;
869     for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
870       nexts = s->next;
871       for (a = s->ins; a != NULL && !NISERR(); a = nexta) {
872         nexta = a->inchain;
873         if (a->type == '$' || a->type == AHEAD)
874           if (push(nfa, a))
875             progress = 1;
876         assert(nexta == NULL || s->no != FREESTATE);
877       }
878     }
879     if (progress && f != NULL)
880       dumpnfa(nfa, f);
881   } while (progress && !NISERR());
882   if (NISERR())
883     return;
884 
885   for (a = nfa->post->ins; a != NULL; a = nexta) {
886     nexta = a->inchain;
887     if (a->type == '$') {
888       assert(a->co == 0 || a->co == 1);
889       newarc(nfa, PLAIN, nfa->eos[a->co], a->from, a->to);
890       freearc(nfa, a);
891     }
892   }
893 }
static VOID specialcolors (struct nfa * nfa) [static]

Definition at line 683 of file regc_nfa.c.
References COLORLESS, NULL, and pseudocolor().
Referenced by compile(), and nfanode().685 {
686   /* false colors for BOS, BOL, EOS, EOL */
687   if (nfa->parent == NULL) {
688     nfa->bos[0] = pseudocolor(nfa->cm);
689     nfa->bos[1] = pseudocolor(nfa->cm);
690     nfa->eos[0] = pseudocolor(nfa->cm);
691     nfa->eos[1] = pseudocolor(nfa->cm);
692   } else {
693     assert(nfa->parent->bos[0] != COLORLESS);
694     nfa->bos[0] = nfa->parent->bos[0];
695     assert(nfa->parent->bos[1] != COLORLESS);
696     nfa->bos[1] = nfa->parent->bos[1];
697     assert(nfa->parent->eos[0] != COLORLESS);
698     nfa->eos[0] = nfa->parent->eos[0];
699     assert(nfa->parent->eos[1] != COLORLESS);
700     nfa->eos[1] = nfa->parent->eos[1];
701   }
702 }
static int unempty (struct nfa * nfa, struct arc * a) [static]

Definition at line 1065 of file regc_nfa.c.
References copyins(), copyouts(), EMPTY, freearc(), freestate(), arc::from, moveins(), moveouts(), state::nins, state::nouts, arc::to, and arc::type.
Referenced by fixempties().1068 {
1069   struct state *from = a->from;
1070   struct state *to = a->to;
1071   int usefrom;    /* work on from, as opposed to to? */
1072 
1073   assert(a->type == EMPTY);
1074   assert(from != nfa->pre && to != nfa->post);
1075 
1076   if (from == to) {   /* vacuous loop */
1077     freearc(nfa, a);
1078     return 1;
1079   }
1080 
1081   /* decide which end to work on */
1082   usefrom = 1;      /* default:  attack from */
1083   if (from->nouts > to->nins)
1084     usefrom = 0;
1085   else if (from->nouts == to->nins) {
1086     /* decide on secondary issue:  move/copy fewest arcs */
1087     if (from->nins > to->nouts)
1088       usefrom = 0;
1089   }
1090     
1091   freearc(nfa, a);
1092   if (usefrom) {
1093     if (from->nouts == 0) {
1094       /* was the state's only outarc */
1095       moveins(nfa, from, to);
1096       freestate(nfa, from);
1097     } else
1098       copyins(nfa, from, to);
1099   } else {
1100     if (to->nins == 0) {
1101       /* was the state's only inarc */
1102       moveouts(nfa, to, from);
1103       freestate(nfa, to);
1104     } else
1105       copyouts(nfa, to, from);
1106   }
1107 
1108   return 1;
1109 }

generic/regcomp.c File Reference
#include "regguts.h"
#include "regc_lex.c"
#include "regc_color.c"
#include "regc_nfa.c"
#include "regc_cvec.c"
#include "regc_locale.c"
Classes
struct vars
Defines
#define INCOMPATIBLE  1
#define SATISFIED  2
#define COMPATIBLE  3
#define ISCELEADER(v, c)  (v->mcces != NULL && haschr(v->mcces, (c)))
#define NEXT()  (next(v))
#define SEE(t)  (v->nexttype == (t))
#define EAT(t)  (SEE(t) && next(v))
#define VISERR(vv)  ((vv)->err != 0)
#define ISERR()  VISERR(v)
#define VERR(vv, e)
#define ERR(e)  VERR(v, e)
#define NOERR()  {if (ISERR()) return;}
#define NOERRN()  {if (ISERR()) return NULL;}
#define NOERRZ()  {if (ISERR()) return 0;}
#define INSIST(c, e)  ((c) ? 0 : ERR(e))
#define NOTE(b)  (v->re->re_info |= (b))
#define EMPTYARC(x, y)  newarc(v->nfa, EMPTY, 0, x, y)
#define EMPTY  'n'
#define EOS  'e'
#define PLAIN  'p'
#define DIGIT  'd'
#define BACKREF  'b'
#define COLLEL  'I'
#define ECLASS  'E'
#define CCLASS  'C'
#define END  'X'
#define RANGE  'R'
#define LACON  'L'
#define AHEAD  'a'
#define BEHIND  'r'
#define WBDRY  'w'
#define NWBDRY  'W'
#define SBEGIN  'A'
#define SEND  'Z'
#define PREFER  'P'
#define COLORED(a)
#define CNOERR()  { if (ISERR()) return freev(v, v->err); }
#define ARCV(t, val)  newarc(v->nfa, t, val, lp, rp)
#define SOME  2
#define INF  3
#define PAIR(x, y)  ((x)*4 + (y))
#define REDUCE(x)  ( ((x) == INFINITY) ? INF : (((x) > 1) ? SOME : (x)) )
Functions
int compile _ANSI_ARGS_ ((regex_t *, CONST chr *, size_t, int))
static VOID moresubs _ANSI_ARGS_ ((struct vars *, int))
static VOID makesearch _ANSI_ARGS_ ((struct vars *, struct nfa *))
static struct subre *parse _ANSI_ARGS_ ((struct vars *, int, int, struct state *, struct state *))
static struct subre *parsebranch _ANSI_ARGS_ ((struct vars *, int, int, struct state *, struct state *, int))
static VOID parseqatom _ANSI_ARGS_ ((struct vars *, int, int, struct state *, struct state *, struct subre *))
static VOID nonword _ANSI_ARGS_ ((struct vars *, int, struct state *, struct state *))
static int scannum _ANSI_ARGS_ ((struct vars *))
static VOID repeat _ANSI_ARGS_ ((struct vars *, struct state *, struct state *, int, int))
static VOID bracket _ANSI_ARGS_ ((struct vars *, struct state *, struct state *))
static VOID leaders _ANSI_ARGS_ ((struct vars *, struct cvec *))
static VOID onechr _ANSI_ARGS_ ((struct vars *, pchr, struct state *, struct state *))
static VOID dovec _ANSI_ARGS_ ((struct vars *, struct cvec *, struct state *, struct state *))
static celt nextleader _ANSI_ARGS_ ((struct vars *, pchr, pchr))
static VOID freesubre _ANSI_ARGS_ ((struct vars *, struct subre *))
static int numst _ANSI_ARGS_ ((struct subre *, int))
static VOID markst _ANSI_ARGS_ ((struct subre *))
static long nfatree _ANSI_ARGS_ ((struct vars *, struct subre *, FILE *))
static int newlacon _ANSI_ARGS_ ((struct vars *, struct state *, struct state *, int))
static VOID rfree _ANSI_ARGS_ ((regex_t *))
static VOID dump _ANSI_ARGS_ ((regex_t *, FILE *))
static VOID dumpst _ANSI_ARGS_ ((struct subre *, FILE *, int))
static char *stid _ANSI_ARGS_ ((struct subre *, char *, size_t))
static VOID lexnest _ANSI_ARGS_ ((struct vars *, chr *, chr *))
static chr lexdigits _ANSI_ARGS_ ((struct vars *, int, int, int))
static int brenext _ANSI_ARGS_ ((struct vars *, pchr))
static chr newline _ANSI_ARGS_ ((NOPARMS))
static chr chrnamed _ANSI_ARGS_ ((struct vars *, chr *, chr *, pchr))
static VOID initcm _ANSI_ARGS_ ((struct vars *, struct colormap *))
static VOID freecm _ANSI_ARGS_ ((struct colormap *))
static VOID cmtreefree _ANSI_ARGS_ ((struct colormap *, union tree *, int))
static color setcolor _ANSI_ARGS_ ((struct colormap *, pchr, pcolor))
static VOID freecolor _ANSI_ARGS_ ((struct colormap *, pcolor))
static color subcolor _ANSI_ARGS_ ((struct colormap *, pchr c))
static VOID subrange _ANSI_ARGS_ ((struct vars *, pchr, pchr, struct state *, struct state *))
static VOID okcolors _ANSI_ARGS_ ((struct nfa *, struct colormap *))
static VOID colorchain _ANSI_ARGS_ ((struct colormap *, struct arc *))
static VOID rainbow _ANSI_ARGS_ ((struct nfa *, struct colormap *, int, pcolor, struct state *, struct state *))
static VOID colorcomplement _ANSI_ARGS_ ((struct nfa *, struct colormap *, int, struct state *, struct state *, struct state *))
static struct nfa *newnfa _ANSI_ARGS_ ((struct vars *, struct colormap *, struct nfa *))
static VOID freenfa _ANSI_ARGS_ ((struct nfa *))
static struct state *newfstate _ANSI_ARGS_ ((struct nfa *, int flag))
static VOID dropstate _ANSI_ARGS_ ((struct nfa *, struct state *))
static VOID newarc _ANSI_ARGS_ ((struct nfa *, int, pcolor, struct state *, struct state *))
static VOID freearc _ANSI_ARGS_ ((struct nfa *, struct arc *))
static struct arc *findarc _ANSI_ARGS_ ((struct state *, int, pcolor))
static VOID cparc _ANSI_ARGS_ ((struct nfa *, struct arc *, struct state *, struct state *))
static VOID moveins _ANSI_ARGS_ ((struct nfa *, struct state *, struct state *))
static VOID cloneouts _ANSI_ARGS_ ((struct nfa *, struct state *, struct state *, struct state *, int))
static VOID dupnfa _ANSI_ARGS_ ((struct nfa *, struct state *, struct state *, struct state *, struct state *))
static long optimize _ANSI_ARGS_ ((struct nfa *, FILE *))
static int combine _ANSI_ARGS_ ((struct arc *, struct arc *))
static VOID markreachable _ANSI_ARGS_ ((struct nfa *, struct state *, struct state *, struct state *))
static VOID compact _ANSI_ARGS_ ((struct nfa *, struct cnfa *))
static VOID carcsort _ANSI_ARGS_ ((struct carc *, struct carc *))
static VOID freecnfa _ANSI_ARGS_ ((struct cnfa *))
static VOID dumpcnfa _ANSI_ARGS_ ((struct cnfa *, FILE *))
static struct cvec *newcvec _ANSI_ARGS_ ((int, int, int))
static struct cvec *clearcvec _ANSI_ARGS_ ((struct cvec *))
static VOID addchr _ANSI_ARGS_ ((struct cvec *, pchr))
static VOID addrange _ANSI_ARGS_ ((struct cvec *, pchr, pchr))
static VOID addmcce _ANSI_ARGS_ ((struct cvec *, chr *, chr *))
static struct cvec *range _ANSI_ARGS_ ((struct vars *, celt, celt, int))
static int before _ANSI_ARGS_ ((celt, celt))
static struct cvec *eclass _ANSI_ARGS_ ((struct vars *, celt, int))
static struct cvec *cclass _ANSI_ARGS_ ((struct vars *, chr *, chr *, int))
static int cmp _ANSI_ARGS_ ((CONST chr *, CONST chr *, size_t))
int compile (regex_t *re, CONST chr *string, size_t len, int flags)
static VOID moresubs (struct vars *v, int wanted)
static int freev (struct vars *v, int err)
static VOID makesearch (struct vars *v, struct nfa *nfa)
static struct subre * parse (struct vars *v, int stopper, int type, struct state *init, struct state *final)
static struct subre * parsebranch (struct vars *v, int stopper, int type, struct state *left, struct state *right, int partial)
static VOID parseqatom (struct vars *v, int stopper, int type, struct state *lp, struct state *rp, struct subre *top)
static VOID nonword (struct vars *v, int dir, struct state *lp, struct state *rp)
static VOID word (struct vars *v, int dir, struct state *lp, struct state *rp)
static int scannum (struct vars *v)
static VOID repeat (struct vars *v, struct state *lp, struct state *rp, int m, int n)
static VOID bracket (struct vars *v, struct state *lp, struct state *rp)
static VOID cbracket (struct vars *v, struct state *lp, struct state *rp)
static VOID brackpart (struct vars *v, struct state *lp, struct state *rp)
static chr * scanplain (struct vars *v)
static VOID leaders (struct vars *v, struct cvec *cv)
static VOID onechr (struct vars *v, pchr c, struct state *lp, struct state *rp)
static VOID dovec (struct vars *v, struct cvec *cv, struct state *lp, struct state *rp)
static celt nextleader (struct vars *v, pchr from, pchr to)
static VOID wordchrs (struct vars *v)
static struct subre * subre (struct vars *v, int op, int flags, struct state *begin, struct state *end)
static VOID freesubre (struct vars *v, struct subre *sr)
static VOID freesrnode (struct vars *v, struct subre *sr)
static VOID optst (struct vars *v, struct subre *t)
static int numst (struct subre *t, int start)
static VOID markst (struct subre *t)
static VOID cleanst (struct vars *v)
static long nfatree (struct vars *v, struct subre *t, FILE *f)
static long nfanode (struct vars *v, struct subre *t, FILE *f)
static int newlacon (struct vars *v, struct state *begin, struct state *end, int pos)
static VOID freelacons (struct subre *subs, int n)
static VOID rfree (regex_t *re)
static VOID dump (regex_t *re, FILE *f)
static VOID dumpst (struct subre *t, FILE *f, int nfapresent)
static VOID stdump (struct subre *t, FILE *f, int nfapresent)
static char * stid (struct subre *t, char *buf, size_t bufsize)
Variables
static struct fns functions

Define Documentation
#define AHEAD  'a'

Definition at line 258 of file regcomp.c.
Referenced by cbracket(), combine(), dovec(), nonword(), parseqatom(), pushfwd(), and word().#define ARCV(t, val)  newarc(v->nfa, t, val, lp, rp)

Referenced by parseqatom().#define BACKREF  'b'

Definition at line 251 of file regcomp.c.
Referenced by brenext(), lexescape(), and parseqatom().#define BEHIND  'r'

Definition at line 259 of file regcomp.c.
Referenced by combine(), nonword(), parseqatom(), pullback(), and word().#define CCLASS  'C'

Definition at line 254 of file regcomp.c.
Referenced by brackpart(), lexescape(), next(), and scanplain().#define CNOERR()  { if (ISERR()) return freev(v, v->err); }

Referenced by compile().#define COLLEL  'I'

Definition at line 252 of file regcomp.c.
Referenced by brackpart(), next(), and scanplain().#define COLORED(a)
Value:((a)->type == PLAIN || (a)->type == AHEAD || \
              (a)->type == BEHIND)
Definition at line 267 of file regcomp.c.
Referenced by freearc(), and newarc().#define COMPATIBLE  3

Definition at line 147 of file regcomp.c.
Referenced by combine(), pull(), and push().#define DIGIT  'd'

Definition at line 250 of file regcomp.c.
Referenced by next(), parseqatom(), and scannum().#define EAT(t)  (SEE(t) && next(v))

Definition at line 233 of file regcomp.c.
Referenced by parse(), and parseqatom().#define ECLASS  'E'

Definition at line 253 of file regcomp.c.
Referenced by brackpart(), next(), and scanplain().#define EMPTY  'n'

Definition at line 247 of file regcomp.c.
Referenced by brenext(), dupnfa(), fixempties(), lexstart(), next(), and unempty().#define EMPTYARC(x, y)  newarc(v->nfa, EMPTY, 0, x, y)

Definition at line 244 of file regcomp.c.
Referenced by parse(), parsebranch(), parseqatom(), and repeat().#define END  'X'

Definition at line 255 of file regcomp.c.
Referenced by GetLexeme(), next(), ParsePrimaryExpr(), scanplain(), and Tcl_ParseExpr().#define EOS  'e'

Definition at line 248 of file regcomp.c.
Referenced by bracket(), compile(), next(), parse(), parsebranch(), and parseqatom().#define ERR(e)  VERR(v, e)

Definition at line 238 of file regcomp.c.
Referenced by brackpart(), cclass(), cfindloop(), dovec(), freev(), getcvec(), lacon(), lexdigits(), moresubs(), newdfa(), newlacon(), parse(), parseqatom(), prefixes(), range(), repeat(), scannum(), and subre().#define INCOMPATIBLE  1

Definition at line 145 of file regcomp.c.
Referenced by combine(), pull(), and push().#define INF  3

Referenced by repeat().#define INSIST(c, e)  ((c) ? 0 : ERR(e))

Definition at line 242 of file regcomp.c.
Referenced by brackpart(), and parseqatom().#define ISCELEADER(v, c)  (v->mcces != NULL && haschr(v->mcces, (c)))

Definition at line 223 of file regcomp.c.
Referenced by brackpart(), and dovec().#define ISERR()  VISERR(v)

Definition at line 235 of file regcomp.c.
Referenced by altdissect(), bracket(), caltdissect(), ccondissect(), cfind(), condissect(), crevdissect(), find(), lexescape(), newnfa(), next(), nfanode(), parseqatom(), scanplain(), and wordchrs().#define LACON  'L'

Definition at line 257 of file regcomp.c.
Referenced by combine(), compact(), next(), and parseqatom().#define NEXT()  (next(v))

Definition at line 231 of file regcomp.c.
Referenced by bracket(), brackpart(), parseqatom(), scannum(), scanplain(), and wordchrs().#define NOERR()  {if (ISERR()) return;}

Definition at line 239 of file regcomp.c.
Referenced by brackpart(), cbracket(), cfind(), condissect(), dovec(), find(), leaders(), lexstart(), parseqatom(), repeat(), and wordchrs().#define NOERRN()  {if (ISERR()) return NULL;}

Definition at line 240 of file regcomp.c.
Referenced by parse(), parsebranch(), and range().#define NOERRZ()  {if (ISERR()) return 0;}

Definition at line 241 of file regcomp.c.
Referenced by nfanode().#define NOTE(b)  (v->re->re_info |= (b))

Definition at line 243 of file regcomp.c.
Referenced by brackpart(), brenext(), cbracket(), compile(), dovec(), element(), lexescape(), next(), parsebranch(), parseqatom(), prefixes(), and skip().#define NWBDRY  'W'

Definition at line 261 of file regcomp.c.
Referenced by lexescape(), and parseqatom().#define PAIR(x, y)  ((x)*4 + (y))

Referenced by repeat().#define PLAIN  'p'

Definition at line 249 of file regcomp.c.
Referenced by brackpart(), brenext(), cbracket(), colorcomplement(), combine(), compact(), compile(), dovec(), leaders(), lexescape(), makesearch(), newnfa(), next(), onechr(), parseqatom(), pullback(), pushfwd(), scanplain(), subblock(), and subrange().#define PREFER  'P'

Definition at line 264 of file regcomp.c.#define RANGE  'R'

Definition at line 256 of file regcomp.c.
Referenced by brackpart(), and next().#define REDUCE(x)  ( ((x) == INFINITY) ? INF : (((x) > 1) ? SOME : (x)) )

Referenced by repeat().#define SATISFIED  2

Definition at line 146 of file regcomp.c.
Referenced by combine(), pull(), and push().#define SBEGIN  'A'

Definition at line 262 of file regcomp.c.
Referenced by lexescape(), next(), and parseqatom().#define SEE(t)  (v->nexttype == (t))

Definition at line 232 of file regcomp.c.
Referenced by bracket(), brackpart(), compile(), parse(), parsebranch(), parseqatom(), scannum(), scanplain(), and wordchrs().#define SEND  'Z'

Definition at line 263 of file regcomp.c.
Referenced by lexescape(), and parseqatom().#define SOME  2

Referenced by repeat().#define VERR(vv, e)
Value:((vv)->nexttype = EOS, ((vv)->err) ? (vv)->err :\
              ((vv)->err = (e)))
Definition at line 236 of file regcomp.c.#define VISERR(vv)  ((vv)->err != 0)

Definition at line 234 of file regcomp.c.#define WBDRY  'w'

Definition at line 260 of file regcomp.c.
Referenced by lexescape(), and parseqatom().
Function Documentation
static int cmp _ANSI_ARGS_ ((CONST chr *, CONST chr *, size_t)) [static]
static struct cvec* cclass _ANSI_ARGS_ ((struct vars *, chr *, chr *, int)) [static]
static struct cvec* eclass _ANSI_ARGS_ ((struct vars *, celt, int)) [static]
static int before _ANSI_ARGS_ ((celt, celt)) [static]
static struct cvec* range _ANSI_ARGS_ ((struct vars *, celt, celt, int)) [static]
static VOID addmcce _ANSI_ARGS_ ((struct cvec *, chr *, chr *)) [static]
static VOID addrange _ANSI_ARGS_ ((struct cvec *, pchr, pchr)) [static]
static VOID addchr _ANSI_ARGS_ ((struct cvec *, pchr)) [static]
static struct cvec* clearcvec _ANSI_ARGS_ ((struct cvec *)) [static]
static struct cvec* newcvec _ANSI_ARGS_ ((int, int, int)) [static]
static VOID dumpcnfa _ANSI_ARGS_ ((struct cnfa *, FILE *)) [static]
static VOID freecnfa _ANSI_ARGS_ ((struct cnfa *)) [static]
static VOID carcsort _ANSI_ARGS_ ((struct carc *, struct carc *)) [static]
static VOID compact _ANSI_ARGS_ ((struct nfa *, struct cnfa *)) [static]
static VOID markreachable _ANSI_ARGS_ ((struct nfa *, struct state *, struct state *, struct state *)) [static]
static int combine _ANSI_ARGS_ ((struct arc *, struct arc *)) [static]
static long optimize _ANSI_ARGS_ ((struct nfa *, FILE *)) [static]
static VOID dupnfa _ANSI_ARGS_ ((struct nfa *, struct state *, struct state *, struct state *, struct state *)) [static]
static VOID cloneouts _ANSI_ARGS_ ((struct nfa *, struct state *, struct state *, struct state *, int)) [static]
static VOID moveins _ANSI_ARGS_ ((struct nfa *, struct state *, struct state *)) [static]
static VOID cparc _ANSI_ARGS_ ((struct nfa *, struct arc *, struct state *, struct state *)) [static]
static struct arc* findarc _ANSI_ARGS_ ((struct state *, int, pcolor)) [static]
static VOID freearc _ANSI_ARGS_ ((struct nfa *, struct arc *)) [static]
static VOID newarc _ANSI_ARGS_ ((struct nfa *, int, pcolor, struct state *, struct state *)) [static]
static VOID dropstate _ANSI_ARGS_ ((struct nfa *, struct state *)) [static]
static struct state* newfstate _ANSI_ARGS_ ((struct nfa *, int flag)) [static]
static VOID freenfa _ANSI_ARGS_ ((struct nfa *)) [static]
static struct nfa* newnfa _ANSI_ARGS_ ((struct vars *, struct colormap *, struct nfa *)) [static]
static VOID colorcomplement _ANSI_ARGS_ ((struct nfa *, struct colormap *, int, struct state *, struct state *, struct state *)) [static]
static VOID rainbow _ANSI_ARGS_ ((struct nfa *, struct colormap *, int, pcolor, struct state *, struct state *)) [static]
static VOID colorchain _ANSI_ARGS_ ((struct colormap *, struct arc *)) [static]
static VOID okcolors _ANSI_ARGS_ ((struct nfa *, struct colormap *)) [static]
static VOID subrange _ANSI_ARGS_ ((struct vars *, pchr, pchr, struct state *, struct state *)) [static]
static color subcolor _ANSI_ARGS_ ((struct colormap *, pchr c)) [static]
static VOID freecolor _ANSI_ARGS_ ((struct colormap *, pcolor)) [static]
static color setcolor _ANSI_ARGS_ ((struct colormap *, pchr, pcolor)) [static]
static VOID cmtreefree _ANSI_ARGS_ ((struct colormap *, union tree *, int)) [static]
static VOID freecm _ANSI_ARGS_ ((struct colormap *)) [static]
static VOID initcm _ANSI_ARGS_ ((struct vars *, struct colormap *)) [static]
static chr chrnamed _ANSI_ARGS_ ((struct vars *, chr *, chr *, pchr)) [static]
static chr newline _ANSI_ARGS_ ((NOPARMS)) [static]
static int brenext _ANSI_ARGS_ ((struct vars *, pchr)) [static]
static chr lexdigits _ANSI_ARGS_ ((struct vars *, int, int, int)) [static]
static VOID lexnest _ANSI_ARGS_ ((struct vars *, chr *, chr *)) [static]
static char* stid _ANSI_ARGS_ ((struct subre *, char *, size_t)) [static]
static VOID dumpst _ANSI_ARGS_ ((struct subre *, FILE *, int)) [static]
static VOID dump _ANSI_ARGS_ ((regex_t *, FILE *)) [static]
static VOID rfree _ANSI_ARGS_ ((regex_t *)) [static]
static int newlacon _ANSI_ARGS_ ((struct vars *, struct state *, struct state *, int)) [static]
static long nfatree _ANSI_ARGS_ ((struct vars *, struct subre *, FILE *)) [static]
static VOID markst _ANSI_ARGS_ ((struct subre *)) [static]
static int numst _ANSI_ARGS_ ((struct subre *, int)) [static]
static VOID freesubre _ANSI_ARGS_ ((struct vars *, struct subre *)) [static]
static celt nextleader _ANSI_ARGS_ ((struct vars *, pchr, pchr)) [static]
static VOID dovec _ANSI_ARGS_ ((struct vars *, struct cvec *, struct state *, struct state *)) [static]
static VOID onechr _ANSI_ARGS_ ((struct vars *, pchr, struct state *, struct state *)) [static]
static VOID leaders _ANSI_ARGS_ ((struct vars *, struct cvec *)) [static]
static VOID bracket _ANSI_ARGS_ ((struct vars *, struct state *, struct state *)) [static]
static VOID repeat _ANSI_ARGS_ ((struct vars *, struct state *, struct state *, int, int)) [static]
static int scannum _ANSI_ARGS_ ((struct vars *)) [static]
static VOID nonword _ANSI_ARGS_ ((struct vars *, int, struct state *, struct state *)) [static]
static VOID parseqatom _ANSI_ARGS_ ((struct vars *, int, int, struct state *, struct state *, struct subre *)) [static]
static struct subre* parsebranch _ANSI_ARGS_ ((struct vars *, int, int, struct state *, struct state *, int)) [static]
static struct subre* parse _ANSI_ARGS_ ((struct vars *, int, int, struct state *, struct state *)) [static]
static VOID makesearch _ANSI_ARGS_ ((struct vars *, struct nfa *)) [static]
static VOID moresubs _ANSI_ARGS_ ((struct vars *, int)) [static]
int compile _ANSI_ARGS_ ((regex_t *, CONST chr *, size_t, int))
static VOID bracket (struct vars * v, struct state * lp, struct state * rp) [static]

Definition at line 1260 of file regcomp.c.
References brackpart(), EOS, ISERR, NEXT, okcolors(), and SEE.
Referenced by cbracket(), parseqatom(), and wordchrs().1264 {
1265   assert(SEE('['));
1266   NEXT();
1267   while (!SEE(']') && !SEE(EOS))
1268     brackpart(v, lp, rp);
1269   assert(SEE(']') || ISERR());
1270   okcolors(v->nfa, v->cm);
1271 }
static VOID brackpart (struct vars * v, struct state * lp, struct state * rp) [static]

Definition at line 1365 of file regcomp.c.
References cclass(), CCLASS, COLLEL, dovec(), eclass(), ECLASS, element(), ERR, INSIST, ISCELEADER, NEXT, NOERR, NOTE, onechr(), PLAIN, range(), RANGE, REG_ASSERT, REG_ECOLLATE, REG_ECTYPE, REG_ERANGE, REG_ICASE, REG_UUNPORT, scanplain(), and SEE.
Referenced by bracket().1369 {
1370   celt startc;
1371   celt endc;
1372   struct cvec *cv;
1373   chr *startp;
1374   chr *endp;
1375   chr c[1];
1376 
1377   /* parse something, get rid of special cases, take shortcuts */
1378   switch (v->nexttype) {
1379   case RANGE:     /* a-b-c or other botch */
1380     ERR(REG_ERANGE);
1381     return;
1382     break;
1383   case PLAIN:
1384     c[0] = v->nextvalue;
1385     NEXT();
1386     /* shortcut for ordinary chr (not range, not MCCE leader) */
1387     if (!SEE(RANGE) && !ISCELEADER(v, c[0])) {
1388       onechr(v, c[0], lp, rp);
1389       return;
1390     }
1391     startc = element(v, c, c+1);
1392     NOERR();
1393     break;
1394   case COLLEL:
1395     startp = v->now;
1396     endp = scanplain(v);
1397     INSIST(startp < endp, REG_ECOLLATE);
1398     NOERR();
1399     startc = element(v, startp, endp);
1400     NOERR();
1401     break;
1402   case ECLASS:
1403     startp = v->now;
1404     endp = scanplain(v);
1405     INSIST(startp < endp, REG_ECOLLATE);
1406     NOERR();
1407     startc = element(v, startp, endp);
1408     NOERR();
1409     cv = eclass(v, startc, (v->cflags&REG_ICASE));
1410     NOERR();
1411     dovec(v, cv, lp, rp);
1412     return;
1413     break;
1414   case CCLASS:
1415     startp = v->now;
1416     endp = scanplain(v);
1417     INSIST(startp < endp, REG_ECTYPE);
1418     NOERR();
1419     cv = cclass(v, startp, endp, (v->cflags&REG_ICASE));
1420     NOERR();
1421     dovec(v, cv, lp, rp);
1422     return;
1423     break;
1424   default:
1425     ERR(REG_ASSERT);
1426     return;
1427     break;
1428   }
1429 
1430   if (SEE(RANGE)) {
1431     NEXT();
1432     switch (v->nexttype) {
1433     case PLAIN:
1434     case RANGE:
1435       c[0] = v->nextvalue;
1436       NEXT();
1437       endc = element(v, c, c+1);
1438       NOERR();
1439       break;
1440     case COLLEL:
1441       startp = v->now;
1442       endp = scanplain(v);
1443       INSIST(startp < endp, REG_ECOLLATE);
1444       NOERR();
1445       endc = element(v, startp, endp);
1446       NOERR();
1447       break;
1448     default:
1449       ERR(REG_ERANGE);
1450       return;
1451       break;
1452     }
1453   } else
1454     endc = startc;
1455 
1456   /*
1457    * Ranges are unportable.  Actually, standard C does
1458    * guarantee that digits are contiguous, but making
1459    * that an exception is just too complicated.
1460    */
1461   if (startc != endc)
1462     NOTE(REG_UUNPORT);
1463   cv = range(v, startc, endc, (v->cflags&REG_ICASE));
1464   NOERR();
1465   dovec(v, cv, lp, rp);
1466 }
static VOID cbracket (struct vars * v, struct state * lp, struct state * rp) [static]

Definition at line 1281 of file regcomp.c.
References AHEAD, bracket(), cloneouts(), arc::co, colorcomplement(), delsub(), dropstate(), findarc(), freearc(), freestate(), newarc(), newstate(), state::nins, NOERR, NOTE, state::nouts, NULL, arc::outchain, state::outs, PLAIN, REG_NLSTOP, REG_ULOCALE, and arc::to.
Referenced by parseqatom().1285 {
1286   struct state *left = newstate(v->nfa);
1287   struct state *right = newstate(v->nfa);
1288   struct state *s;
1289   struct arc *a;      /* arc from lp */
1290   struct arc *ba;     /* arc from left, from bracket() */
1291   struct arc *pa;     /* MCCE-prototype arc */
1292   color co;
1293   chr *p;
1294   int i;
1295 
1296   NOERR();
1297   bracket(v, left, right);
1298   if (v->cflags&REG_NLSTOP)
1299     newarc(v->nfa, PLAIN, v->nlcolor, left, right);
1300   NOERR();
1301 
1302   assert(lp->nouts == 0);   /* all outarcs will be ours */
1303 
1304   /* easy part of complementing */
1305   colorcomplement(v->nfa, v->cm, PLAIN, left, lp, rp);
1306   NOERR();
1307   if (v->mcces == NULL) {   /* no MCCEs -- we're done */
1308     dropstate(v->nfa, left);
1309     assert(right->nins == 0);
1310     freestate(v->nfa, right);
1311     return;
1312   }
1313 
1314   /* but complementing gets messy in the presence of MCCEs... */
1315   NOTE(REG_ULOCALE);
1316   for (p = v->mcces->chrs, i = v->mcces->nchrs; i > 0; p++, i--) {
1317     co = GETCOLOR(v->cm, *p);
1318     a = findarc(lp, PLAIN, co);
1319     ba = findarc(left, PLAIN, co);
1320     if (ba == NULL) {
1321       assert(a != NULL);
1322       freearc(v->nfa, a);
1323     } else {
1324       assert(a == NULL);
1325     }
1326     s = newstate(v->nfa);
1327     NOERR();
1328     newarc(v->nfa, PLAIN, co, lp, s);
1329     NOERR();
1330     pa = findarc(v->mccepbegin, PLAIN, co);
1331     assert(pa != NULL);
1332     if (ba == NULL) { /* easy case, need all of them */
1333       cloneouts(v->nfa, pa->to, s, rp, PLAIN);
1334       newarc(v->nfa, '$', 1, s, rp);
1335       newarc(v->nfa, '$', 0, s, rp);
1336       colorcomplement(v->nfa, v->cm, AHEAD, pa->to, s, rp);
1337     } else {    /* must be selective */
1338       if (findarc(ba->to, '$', 1) == NULL) {
1339         newarc(v->nfa, '$', 1, s, rp);
1340         newarc(v->nfa, '$', 0, s, rp);
1341         colorcomplement(v->nfa, v->cm, AHEAD, pa->to,
1342                    s, rp);
1343       }
1344       for (pa = pa->to->outs; pa != NULL; pa = pa->outchain)
1345         if (findarc(ba->to, PLAIN, pa->co) == NULL)
1346           newarc(v->nfa, PLAIN, pa->co, s, rp);
1347       if (s->nouts == 0)  /* limit of selectivity: none */
1348         dropstate(v->nfa, s); /* frees arc too */
1349     }
1350     NOERR();
1351   }
1352 
1353   delsub(v->nfa, left, right);
1354   assert(left->nouts == 0);
1355   freestate(v->nfa, left);
1356   assert(right->nins == 0);
1357   freestate(v->nfa, right);
1358 }
static VOID cleanst (struct vars * v) [static]

Definition at line 1894 of file regcomp.c.
References subre::chain, subre::flags, FREE, INUSE, next(), and NULL.
Referenced by compile(), and freev().1896 {
1897   struct subre *t;
1898   struct subre *next;
1899 
1900   for (t = v->treechain; t != NULL; t = next) {
1901     next = t->chain;
1902     if (!(t->flags&INUSE))
1903       FREE(t);
1904   }
1905   v->treechain = NULL;
1906   v->treefree = NULL;   /* just on general principles */
1907 }
int compile (regex_t * re, CONST chr * string, size_t len, int flags)

Definition at line 284 of file regcomp.c.
References addmcce(), allmcces(), casecmp(), guts::cflags, vars::cflags, cleanst(), vars::cm, guts::cmap, cmp(), CNOERR, COLORLESS, compact(), vars::cv, vars::cv2, DISCARD, dump(), dumpnfa(), dumpst(), EOS, vars::err, freev(), functions, GUTSMAGIC, guts::info, initcm(), guts::lacons, vars::lacons, leaders(), lexstart(), guts::magic, makesearch(), MALLOC, markst(), vars::mcces, newcvec(), newline(), newnfa(), vars::nfa, nfanode(), nfatree(), guts::nlacons, vars::nlacons, vars::nlcolor, nleaders(), nmcces(), NOTE, vars::now, guts::nsub, vars::nsubexp, vars::nsubs, guts::ntree, NULL, numst(), okcolors(), optimize(), optst(), parse(), PLAIN, vars::re, REG_ADVANCED, REG_ADVF, REG_DUMP, REG_ESPACE, REG_EXPANDED, REG_EXTENDED, REG_ICASE, REG_INVARG, REG_NEWLINE, REG_NLANCH, REG_NLSTOP, REG_PROGRESS, REG_QUOTE, REG_USHORTEST, REMAGIC, vars::savenow, vars::savestop, guts::search, SEE, SHORTER, size_t(), specialcolors(), vars::stop, vars::sub10, subcolor(), vars::subs, guts::tree, vars::tree, vars::treechain, vars::treefree, VS, vars::wordchrs, and ZAPCNFA.289 {
290   struct vars var;
291   struct vars *v = &var;
292   struct guts *g;
293   int i;
294   size_t j;
295   FILE *debug = (flags&REG_PROGRESS) ? stdout : (FILE *)NULL;
296 # define  CNOERR()  { if (ISERR()) return freev(v, v->err); }
297 
298   /* sanity checks */
299 
300   if (re == NULL || string == NULL)
301     return REG_INVARG;
302   if ((flags&REG_QUOTE) &&
303       (flags&(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE)))
304     return REG_INVARG;
305   if (!(flags&REG_EXTENDED) && (flags&REG_ADVF))
306     return REG_INVARG;
307 
308   /* initial setup (after which freev() is callable) */
309   v->re = re;
310   v->now = (chr *)string;
311   v->stop = v->now + len;
312   v->savenow = v->savestop = NULL;
313   v->err = 0;
314   v->cflags = flags;
315   v->nsubexp = 0;
316   v->subs = v->sub10;
317   v->nsubs = 10;
318   for (j = 0; j < v->nsubs; j++)
319     v->subs[j] = NULL;
320   v->nfa = NULL;
321   v->cm = NULL;
322   v->nlcolor = COLORLESS;
323   v->wordchrs = NULL;
324   v->tree = NULL;
325   v->treechain = NULL;
326   v->treefree = NULL;
327   v->cv = NULL;
328   v->cv2 = NULL;
329   v->mcces = NULL;
330   v->lacons = NULL;
331   v->nlacons = 0;
332   re->re_magic = REMAGIC;
333   re->re_info = 0;    /* bits get set during parse */
334   re->re_csize = sizeof(chr);
335   re->re_guts = NULL;
336   re->re_fns = VS(&functions);
337 
338   /* more complex setup, malloced things */
339   re->re_guts = VS(MALLOC(sizeof(struct guts)));
340   if (re->re_guts == NULL)
341     return freev(v, REG_ESPACE);
342   g = (struct guts *)re->re_guts;
343   g->tree = NULL;
344   initcm(v, &g->cmap);
345   v->cm = &g->cmap;
346   g->lacons = NULL;
347   g->nlacons = 0;
348   ZAPCNFA(g->search);
349   v->nfa = newnfa(v, v->cm, (struct nfa *)NULL);
350   CNOERR();
351   v->cv = newcvec(100, 20, 10);
352   if (v->cv == NULL)
353     return freev(v, REG_ESPACE);
354   i = nmcces(v);
355   if (i > 0) {
356     v->mcces = newcvec(nleaders(v), 0, i);
357     CNOERR();
358     v->mcces = allmcces(v, v->mcces);
359     leaders(v, v->mcces);
360     addmcce(v->mcces, (chr *)NULL, (chr *)NULL);  /* dummy */
361   }
362   CNOERR();
363 
364   /* parsing */
365   lexstart(v);      /* also handles prefixes */
366   if ((v->cflags&REG_NLSTOP) || (v->cflags&REG_NLANCH)) {
367     /* assign newline a unique color */
368     v->nlcolor = subcolor(v->cm, newline());
369     okcolors(v->nfa, v->cm);
370   }
371   CNOERR();
372   v->tree = parse(v, EOS, PLAIN, v->nfa->init, v->nfa->final);
373   assert(SEE(EOS));   /* even if error; ISERR() => SEE(EOS) */
374   CNOERR();
375   assert(v->tree != NULL);
376 
377   /* finish setup of nfa and its subre tree */
378   specialcolors(v->nfa);
379   CNOERR();
380   if (debug != NULL) {
381     fprintf(debug, "\n\n\n========= RAW ==========\n");
382     dumpnfa(v->nfa, debug);
383     dumpst(v->tree, debug, 1);
384   }
385   optst(v, v->tree);
386   v->ntree = numst(v->tree, 1);
387   markst(v->tree);
388   cleanst(v);
389   if (debug != NULL) {
390     fprintf(debug, "\n\n\n========= TREE FIXED ==========\n");
391     dumpst(v->tree, debug, 1);
392   }
393 
394   /* build compacted NFAs for tree and lacons */
395   re->re_info |= nfatree(v, v->tree, debug);
396   CNOERR();
397   assert(v->nlacons == 0 || v->lacons != NULL);
398   for (i = 1; i < v->nlacons; i++) {
399     if (debug != NULL)
400       fprintf(debug, "\n\n\n========= LA%d ==========\n", i);
401     nfanode(v, &v->lacons[i], debug);
402   }
403   CNOERR();
404   if (v->tree->flags&SHORTER)
405     NOTE(REG_USHORTEST);
406 
407   /* build compacted NFAs for tree, lacons, fast search */
408   if (debug != NULL)
409     fprintf(debug, "\n\n\n========= SEARCH ==========\n");
410   /* can sacrifice main NFA now, so use it as work area */
411   (DISCARD)optimize(v->nfa, debug);
412   CNOERR();
413   makesearch(v, v->nfa);
414   CNOERR();
415   compact(v->nfa, &g->search);
416   CNOERR();
417 
418   /* looks okay, package it up */
419   re->re_nsub = v->nsubexp;
420   v->re = NULL;     /* freev no longer frees re */
421   g->magic = GUTSMAGIC;
422   g->cflags = v->cflags;
423   g->info = re->re_info;
424   g->nsub = re->re_nsub;
425   g->tree = v->tree;
426   v->tree = NULL;
427   g->ntree = v->ntree;
428   g->compare = (v->cflags&REG_ICASE) ? casecmp : cmp;
429   g->lacons = v->lacons;
430   v->lacons = NULL;
431   g->nlacons = v->nlacons;
432 
433   if (flags&REG_DUMP)
434     dump(re, stdout);
435 
436   assert(v->err == 0);
437   return freev(v, 0);
438 }
static VOID dovec (struct vars * v, struct cvec * cv, struct state * lp, struct state * rp) [static]

Definition at line 1567 of file regcomp.c.
References addchr(), AHEAD, cvec::chrs, clearcvec(), arc::co, colorcomplement(), ERR, findarc(), state::free, arc::from, haschr(), ISCELEADER, cvec::mcces, cvec::nchrs, newarc(), newcvec(), newstate(), nextleader(), cvec::nmcces, nmcces(), NOCELT, NOERR, NOTE, cvec::nranges, NULL, PLAIN, cvec::ranges, REG_ASSERT, REG_ULOCALE, singleton(), subcolor(), subrange(), and arc::to.
Referenced by brackpart(), and onechr().1572 {
1573   chr ch, from, to;
1574   celt ce;
1575   chr *p;
1576   int i;
1577   color co;
1578   struct cvec *leads;
1579   struct arc *a;
1580   struct arc *pa;   /* arc in prototype */
1581   struct state *s;
1582   struct state *ps; /* state in prototype */
1583 
1584   /* need a place to store leaders, if any */
1585   if (nmcces(v) > 0) {
1586     assert(v->mcces != NULL);
1587     if (v->cv2 == NULL || v->cv2->nchrs < v->mcces->nchrs) {
1588       if (v->cv2 != NULL)
1589         free(v->cv2);
1590       v->cv2 = newcvec(v->mcces->nchrs, 0, v->mcces->nmcces);
1591       NOERR();
1592       leads = v->cv2;
1593     } else
1594       leads = clearcvec(v->cv2);
1595   } else
1596     leads = NULL;
1597 
1598   /* first, get the ordinary characters out of the way */
1599   for (p = cv->chrs, i = cv->nchrs; i > 0; p++, i--) {
1600     ch = *p;
1601     if (!ISCELEADER(v, ch))
1602       newarc(v->nfa, PLAIN, subcolor(v->cm, ch), lp, rp);
1603     else {
1604       assert(singleton(v->cm, ch));
1605       assert(leads != NULL);
1606       if (!haschr(leads, ch))
1607         addchr(leads, ch);
1608     }
1609   }
1610 
1611   /* and the ranges */
1612   for (p = cv->ranges, i = cv->nranges; i > 0; p += 2, i--) {
1613     from = *p;
1614     to = *(p+1);
1615     while (from <= to && (ce = nextleader(v, from, to)) != NOCELT) {
1616       if (from < ce)
1617         subrange(v, from, ce - 1, lp, rp);
1618       assert(singleton(v->cm, ce));
1619       assert(leads != NULL);
1620       if (!haschr(leads, ce))
1621         addchr(leads, ce);
1622       from = ce + 1;
1623     }
1624     if (from <= to)
1625       subrange(v, from, to, lp, rp);
1626   }
1627 
1628   if ((leads == NULL || leads->nchrs == 0) && cv->nmcces == 0)
1629     return;
1630 
1631   /* deal with the MCCE leaders */
1632   NOTE(REG_ULOCALE);
1633   for (p = leads->chrs, i = leads->nchrs; i > 0; p++, i--) {
1634     co = GETCOLOR(v->cm, *p);
1635     a = findarc(lp, PLAIN, co);
1636     if (a != NULL)
1637       s = a->to;
1638     else {
1639       s = newstate(v->nfa);
1640       NOERR();
1641       newarc(v->nfa, PLAIN, co, lp, s);
1642       NOERR();
1643     }
1644     pa = findarc(v->mccepbegin, PLAIN, co);
1645     assert(pa != NULL);
1646     ps = pa->to;
1647     newarc(v->nfa, '$', 1, s, rp);
1648     newarc(v->nfa, '$', 0, s, rp);
1649     colorcomplement(v->nfa, v->cm, AHEAD, ps, s, rp);
1650     NOERR();
1651   }
1652 
1653   /* and the MCCEs */
1654   for (i = 0; i < cv->nmcces; i++) {
1655     p = cv->mcces[i];
1656     assert(singleton(v->cm, *p));
1657     if (!singleton(v->cm, *p)) {
1658       ERR(REG_ASSERT);
1659       return;
1660     }
1661     ch = *p++;
1662     co = GETCOLOR(v->cm, ch);
1663     a = findarc(lp, PLAIN, co);
1664     if (a != NULL)
1665       s = a->to;
1666     else {
1667       s = newstate(v->nfa);
1668       NOERR();
1669       newarc(v->nfa, PLAIN, co, lp, s);
1670       NOERR();
1671     }
1672     assert(*p != 0);  /* at least two chars */
1673     assert(singleton(v->cm, *p));
1674     ch = *p++;
1675     co = GETCOLOR(v->cm, ch);
1676     assert(*p == 0);  /* and only two, for now */
1677     newarc(v->nfa, PLAIN, co, s, rp);
1678     NOERR();
1679   }
1680 }
static VOID dump (regex_t * re, FILE * f) [static]

Definition at line 2049 of file regcomp.c.
References guts::cmap, subre::cnfa, dumpcnfa(), dumpst(), GUTSMAGIC, guts::lacons, guts::magic, guts::nlacons, guts::ntree, NULL, NULLCNFA, REMAGIC, guts::search, subre::subno, and guts::tree.
Referenced by compile().2052 {
2053 #ifdef REG_DEBUG
2054   struct guts *g;
2055   int i;
2056 
2057   if (re->re_magic != REMAGIC)
2058     fprintf(f, "bad magic number (0x%x not 0x%x)\n", re->re_magic,
2059                 REMAGIC);
2060   if (re->re_guts == NULL) {
2061     fprintf(f, "NULL guts!!!\n");
2062     return;
2063   }
2064   g = (struct guts *)re->re_guts;
2065   if (g->magic != GUTSMAGIC)
2066     fprintf(f, "bad guts magic number (0x%x not 0x%x)\n", g->magic,
2067                 GUTSMAGIC);
2068 
2069   fprintf(f, "\n\n\n========= DUMP ==========\n");
2070   fprintf(f, "nsub %d, info 0%lo, csize %d, ntree %d\n", 
2071     re->re_nsub, re->re_info, re->re_csize, g->ntree);
2072 
2073   dumpcolors(&g->cmap, f);
2074   if (!NULLCNFA(g->search)) {
2075     printf("\nsearch:\n");
2076     dumpcnfa(&g->search, f);
2077   }
2078   for (i = 1; i < g->nlacons; i++) {
2079     fprintf(f, "\nla%d (%s):\n", i,
2080         (g->lacons[i].subno) ? "positive" : "negative");
2081     dumpcnfa(&g->lacons[i].cnfa, f);
2082   }
2083   fprintf(f, "\n");
2084   dumpst(g->tree, f, 0);
2085 #endif
2086 }
static VOID dumpst (struct subre * t, FILE * f, int nfapresent) [static]

Definition at line 2093 of file regcomp.c.
References NULL, and stdump().
Referenced by compile(), and dump().2097 {
2098   if (t == NULL)
2099     fprintf(f, "null tree\n");
2100   else
2101     stdump(t, f, nfapresent);
2102   fflush(f);
2103 }
static VOID freelacons (struct subre * subs, int n) [static]

Definition at line 2002 of file regcomp.c.
References subre::cnfa, FREE, freecnfa(), and NULLCNFA.
Referenced by freev(), and rfree().2005 {
2006   struct subre *sub;
2007   int i;
2008 
2009   assert(n > 0);
2010   for (sub = subs + 1, i = n - 1; i > 0; sub++, i--)  /* no 0th */
2011     if (!NULLCNFA(sub->cnfa))
2012       freecnfa(&sub->cnfa);
2013   FREE(subs);
2014 }
static VOID freesrnode (struct vars * v, struct subre * sr) [static]

Definition at line 1813 of file regcomp.c.
References subre::cnfa, subre::flags, FREE, freecnfa(), subre::left, NULL, and NULLCNFA.
Referenced by freesubre().1816 {
1817   if (sr == NULL)
1818     return;
1819 
1820   if (!NULLCNFA(sr->cnfa))
1821     freecnfa(&sr->cnfa);
1822   sr->flags = 0;
1823 
1824   if (v != NULL) {
1825     sr->left = v->treefree;
1826     v->treefree = sr;
1827   } else
1828     FREE(sr);
1829 }
static VOID freesubre (struct vars * v, struct subre * sr) [static]

Definition at line 1793 of file regcomp.c.
References freesrnode(), subre::left, NULL, and subre::right.
Referenced by freev(), parse(), parseqatom(), and rfree().1796 {
1797   if (sr == NULL)
1798     return;
1799 
1800   if (sr->left != NULL)
1801     freesubre(v, sr->left);
1802   if (sr->right != NULL)
1803     freesubre(v, sr->right);
1804 
1805   freesrnode(v, sr);
1806 }
static int freev (struct vars * v, int err) [static]

Definition at line 479 of file regcomp.c.
References cleanst(), ERR, FREE, freecvec(), freelacons(), freenfa(), freesubre(), NULL, and rfree().
Referenced by compile().482 {
483   if (v->re != NULL)
484     rfree(v->re);
485   if (v->subs != v->sub10)
486     FREE(v->subs);
487   if (v->nfa != NULL)
488     freenfa(v->nfa);
489   if (v->tree != NULL)
490     freesubre(v, v->tree);
491   if (v->treechain != NULL)
492     cleanst(v);
493   if (v->cv != NULL)
494     freecvec(v->cv);
495   if (v->cv2 != NULL)
496     freecvec(v->cv2);
497   if (v->mcces != NULL)
498     freecvec(v->mcces);
499   if (v->lacons != NULL)
500     freelacons(v->lacons, v->nlacons);
501   ERR(err);     /* nop if err==0 */
502 
503   return v->err;
504 }
static VOID leaders (struct vars * v, struct cvec * cv) [static]

Definition at line 1502 of file regcomp.c.
References addchr(), findarc(), haschr(), cvec::mcces, newarc(), newstate(), cvec::nmcces, NOERR, NULL, okcolors(), PLAIN, subcolor(), and arc::to.
Referenced by compile().1505 {
1506   int mcce;
1507   chr *p;
1508   chr leader;
1509   struct state *s;
1510   struct arc *a;
1511 
1512   v->mccepbegin = newstate(v->nfa);
1513   v->mccepend = newstate(v->nfa);
1514   NOERR();
1515 
1516   for (mcce = 0; mcce < cv->nmcces; mcce++) {
1517     p = cv->mcces[mcce];
1518     leader = *p;
1519     if (!haschr(cv, leader)) {
1520       addchr(cv, leader);
1521       s = newstate(v->nfa);
1522       newarc(v->nfa, PLAIN, subcolor(v->cm, leader),
1523               v->mccepbegin, s);
1524       okcolors(v->nfa, v->cm);
1525     } else {
1526       a = findarc(v->mccepbegin, PLAIN,
1527             GETCOLOR(v->cm, leader));
1528       assert(a != NULL);
1529       s = a->to;
1530       assert(s != v->mccepend);
1531     }
1532     p++;
1533     assert(*p != 0 && *(p+1) == 0); /* only 2-char MCCEs for now */
1534     newarc(v->nfa, PLAIN, subcolor(v->cm, *p), s, v->mccepend);
1535     okcolors(v->nfa, v->cm);
1536   }
1537 }
static VOID makesearch (struct vars * v, struct nfa * nfa) [static]

Definition at line 512 of file regcomp.c.
References nfa::bos, nfa::cm, arc::co, COLORLESS, copyouts(), cparc(), freearc(), arc::from, arc::inchain, state::ins, newarc(), newstate(), NULL, arc::outchain, state::outs, PLAIN, nfa::pre, rainbow(), state::tmp, arc::to, and arc::type.
Referenced by compile().515 {
516   struct arc *a;
517   struct arc *b;
518   struct state *pre = nfa->pre;
519   struct state *s;
520   struct state *s2;
521   struct state *slist;
522 
523   /* no loops are needed if it's anchored */
524   for (a = pre->outs; a != NULL; a = a->outchain) {
525     assert(a->type == PLAIN);
526     if (a->co != nfa->bos[0] && a->co != nfa->bos[1])
527       break;
528   }
529   if (a != NULL) {
530     /* add implicit .* in front */
531     rainbow(nfa, v->cm, PLAIN, COLORLESS, pre, pre);
532 
533     /* and ^* and \A* too -- not always necessary, but harmless */
534     newarc(nfa, PLAIN, nfa->bos[0], pre, pre);
535     newarc(nfa, PLAIN, nfa->bos[1], pre, pre);
536   }
537 
538   /*
539    * Now here's the subtle part.  Because many REs have no lookback
540    * constraints, often knowing when you were in the pre state tells
541    * you little; it's the next state(s) that are informative.  But
542    * some of them may have other inarcs, i.e. it may be possible to
543    * make actual progress and then return to one of them.  We must
544    * de-optimize such cases, splitting each such state into progress
545    * and no-progress states.
546    */
547 
548   /* first, make a list of the states */
549   slist = NULL;
550   for (a = pre->outs; a != NULL; a = a->outchain) {
551     s = a->to;
552     for (b = s->ins; b != NULL; b = b->inchain)
553       if (b->from != pre)
554         break;
555     if (b != NULL) {    /* must be split */
556       if (s->tmp == NULL) {  /* if not already in the list */
557                              /* (fixes bugs 505048, 230589, */
558                              /* 840258, 504785) */
559         s->tmp = slist;
560         slist = s;
561       }
562     }
563   }
564 
565   /* do the splits */
566   for (s = slist; s != NULL; s = s2) {
567     s2 = newstate(nfa);
568     copyouts(nfa, s, s2);
569     for (a = s->ins; a != NULL; a = b) {
570       b = a->inchain;
571       if (a->from != pre) {
572         cparc(nfa, a, a->from, s2);
573         freearc(nfa, a);
574       }
575     }
576     s2 = s->tmp;
577     s->tmp = NULL;    /* clean up while we're at it */
578   }
579 }
static VOID markst (struct subre * t) [static]

Definition at line 1877 of file regcomp.c.
References INUSE, and NULL.
Referenced by compile().1879 {
1880   assert(t != NULL);
1881 
1882   t->flags |= INUSE;
1883   if (t->left != NULL)
1884     markst(t->left);
1885   if (t->right != NULL)
1886     markst(t->right);
1887 }
static VOID moresubs (struct vars * v, int wanted) [static]

Definition at line 445 of file regcomp.c.
References ERR, MALLOC, NULL, REALLOC, REG_ESPACE, size_t(), and VS.
Referenced by parseqatom().448 {
449   struct subre **p;
450   size_t n;
451 
452   assert(wanted > 0 && (size_t)wanted >= v->nsubs);
453   n = (size_t)wanted * 3 / 2 + 1;
454   if (v->subs == v->sub10) {
455     p = (struct subre **)MALLOC(n * sizeof(struct subre *));
456     if (p != NULL)
457       memcpy(VS(p), VS(v->subs),
458           v->nsubs * sizeof(struct subre *));
459   } else
460     p = (struct subre **)REALLOC(v->subs, n*sizeof(struct subre *));
461   if (p == NULL) {
462     ERR(REG_ESPACE);
463     return;
464   }
465   v->subs = p;
466   for (p = &v->subs[v->nsubs]; v->nsubs < n; p++, v->nsubs++)
467     *p = NULL;
468   assert(v->nsubs == n);
469   assert((size_t)wanted < v->nsubs);
470 }
static int newlacon (struct vars * v, struct state * begin, struct state * end, int pos) [static]

Definition at line 1967 of file regcomp.c.
References subre::begin, subre::cnfa, subre::end, ERR, vars::lacons, MALLOC, NULL, REALLOC, REG_ESPACE, subre::subno, and ZAPCNFA.
Referenced by parseqatom().1972 {
1973   int n;
1974   struct subre *sub;
1975 
1976   if (v->nlacons == 0) {
1977     v->lacons = (struct subre *)MALLOC(2 * sizeof(struct subre));
1978     n = 1;    /* skip 0th */
1979     v->nlacons = 2;
1980   } else {
1981     v->lacons = (struct subre *)REALLOC(v->lacons,
1982           (v->nlacons+1)*sizeof(struct subre));
1983     n = v->nlacons++;
1984   }
1985   if (v->lacons == NULL) {
1986     ERR(REG_ESPACE);
1987     return 0;
1988   }
1989   sub = &v->lacons[n];
1990   sub->begin = begin;
1991   sub->end = end;
1992   sub->subno = pos;
1993   ZAPCNFA(sub->cnfa);
1994   return n;
1995 }
static celt nextleader (struct vars * v, pchr from, pchr to) [static]

Definition at line 1687 of file regcomp.c.
References NOCELT, and NULL.
Referenced by dovec().1691 {
1692   int i;
1693   chr *p;
1694   chr ch;
1695   celt it = NOCELT;
1696 
1697   if (v->mcces == NULL)
1698     return it;
1699 
1700   for (i = v->mcces->nchrs, p = v->mcces->chrs; i > 0; i--, p++) {
1701     ch = *p;
1702     if (from <= ch && ch <= to)
1703       if (it == NOCELT || ch < it)
1704         it = ch;
1705   }
1706   return it;
1707 }
static long nfanode (struct vars * v, struct subre * t, FILE * f) [static]

Definition at line 1934 of file regcomp.c.
References subre::begin, subre::cnfa, compact(), dupnfa(), subre::end, nfa::final, freenfa(), nfa::init, ISERR, newnfa(), NOERRZ, NULL, optimize(), specialcolors(), and stid().
Referenced by compile(), and nfatree().1938 {
1939   struct nfa *nfa;
1940   long ret = 0;
1941   char idbuf[50];
1942 
1943   assert(t->begin != NULL);
1944 
1945   if (f != NULL)
1946     fprintf(f, "\n\n\n========= TREE NODE %s ==========\n",
1947             stid(t, idbuf, sizeof(idbuf)));
1948   nfa = newnfa(v, v->cm, v->nfa);
1949   NOERRZ();
1950   dupnfa(nfa, t->begin, t->end, nfa->init, nfa->final);
1951   if (!ISERR()) {
1952     specialcolors(nfa);
1953     ret = optimize(nfa, f);
1954   }
1955   if (!ISERR())
1956     compact(nfa, &t->cnfa);
1957 
1958   freenfa(nfa);
1959   return ret;
1960 }
static long nfatree (struct vars * v, struct subre * t, FILE * f) [static]

Definition at line 1914 of file regcomp.c.
References subre::begin, DISCARD, subre::left, nfanode(), NULL, and subre::right.
Referenced by compile().1918 {
1919   assert(t != NULL && t->begin != NULL);
1920 
1921   if (t->left != NULL)
1922     (DISCARD)nfatree(v, t->left, f);
1923   if (t->right != NULL)
1924     (DISCARD)nfatree(v, t->right, f);
1925 
1926   return nfanode(v, t, f);
1927 }
static VOID nonword (struct vars * v, int dir, struct state * lp, struct state * rp) [static]

Definition at line 1110 of file regcomp.c.
References AHEAD, BEHIND, colorcomplement(), and newarc().
Referenced by parseqatom().1115 {
1116   int anchor = (dir == AHEAD) ? '$' : '^';
1117 
1118   assert(dir == AHEAD || dir == BEHIND);
1119   newarc(v->nfa, anchor, 1, lp, rp);
1120   newarc(v->nfa, anchor, 0, lp, rp);
1121   colorcomplement(v->nfa, v->cm, dir, v->wordchrs, lp, rp);
1122   /* (no need for special attention to \n) */
1123 }
static int numst (struct subre * t, int start) [static]

Definition at line 1855 of file regcomp.c.
References NULL.
Referenced by compile().1858 {
1859   int i;
1860 
1861   assert(t != NULL);
1862 
1863   i = start;
1864   t->retry = (short)i++;
1865   if (t->left != NULL)
1866     i = numst(t->left, i);
1867   if (t->right != NULL)
1868     i = numst(t->right, i);
1869   return i;
1870 }
static VOID onechr (struct vars * v, pchr c, struct state * lp, struct state * rp) [static]

Definition at line 1545 of file regcomp.c.
References allcases(), dovec(), newarc(), PLAIN, REG_ICASE, and subcolor().
Referenced by brackpart(), and parseqatom().1550 {
1551   if (!(v->cflags&REG_ICASE)) {
1552     newarc(v->nfa, PLAIN, subcolor(v->cm, c), lp, rp);
1553     return;
1554   }
1555 
1556   /* rats, need general case anyway... */
1557   dovec(v, allcases(v, c), lp, rp);
1558 }
static VOID optst (struct vars * v, struct subre * t) [static]

Definition at line 1836 of file regcomp.c.
References subre::left, NULL, and subre::right.
Referenced by compile().1839 {
1840   if (t == NULL)
1841     return;
1842 
1843   /* recurse through children */
1844   if (t->left != NULL)
1845     optst(v, t->left);
1846   if (t->right != NULL)
1847     optst(v, t->right);
1848 }
static struct subre* parse (struct vars * v, int stopper, int type, struct state * init, struct state * final) [static]

Definition at line 590 of file regcomp.c.
References EAT, EMPTYARC, EOS, ERR, subre::flags, freesubre(), init, subre::left, LONGER, MESSY, newstate(), NOERRN, NULL, subre::op, parsebranch(), REG_EPAREN, subre::right, SEE, subre(), and UP.
Referenced by CommandComplete(), compile(), parseqatom(), Tcl_EvalEx(), Tcl_ParseVar(), Tcl_SubstObj(), TclCompileExpr(), TclCompileScript(), TestexprparserObjCmd(), TestparserObjCmd(), and TestparsevarnameObjCmd().596 {
597   struct state *left; /* scaffolding for branch */
598   struct state *right;
599   struct subre *branches; /* top level */
600   struct subre *branch; /* current branch */
601   struct subre *t;  /* temporary */
602   int firstbranch;  /* is this the first branch? */
603 
604   assert(stopper == ')' || stopper == EOS);
605 
606   branches = subre(v, '|', LONGER, init, final);
607   NOERRN();
608   branch = branches;
609   firstbranch = 1;
610   do {  /* a branch */
611     if (!firstbranch) {
612       /* need a place to hang it */
613       branch->right = subre(v, '|', LONGER, init, final);
614       NOERRN();
615       branch = branch->right;
616     }
617     firstbranch = 0;
618     left = newstate(v->nfa);
619     right = newstate(v->nfa);
620     NOERRN();
621     EMPTYARC(init, left);
622     EMPTYARC(right, final);
623     NOERRN();
624     branch->left = parsebranch(v, stopper, type, left, right, 0);
625     NOERRN();
626     branch->flags |= UP(branch->flags | branch->left->flags);
627     if ((branch->flags &~ branches->flags) != 0)  /* new flags */
628       for (t = branches; t != branch; t = t->right)
629         t->flags |= branch->flags;
630   } while (EAT('|'));
631   assert(SEE(stopper) || SEE(EOS));
632 
633   if (!SEE(stopper)) {
634     assert(stopper == ')' && SEE(EOS));
635     ERR(REG_EPAREN);
636   }
637 
638   /* optimize out simple cases */
639   if (branch == branches) { /* only one branch */
640     assert(branch->right == NULL);
641     t = branch->left;
642     branch->left = NULL;
643     freesubre(v, branches);
644     branches = t;
645   } else if (!MESSY(branches->flags)) { /* no interesting innards */
646     freesubre(v, branches->left);
647     branches->left = NULL;
648     freesubre(v, branches->right);
649     branches->right = NULL;
650     branches->op = '=';
651   }
652 
653   return branches;
654 }
static struct subre* parsebranch (struct vars * v, int stopper, int type, struct state * left, struct state * right, int partial) [static]

Definition at line 665 of file regcomp.c.
References EMPTYARC, EOS, subre::left, moveins(), newstate(), NOERRN, NOTE, parseqatom(), REG_UUNSPEC, subre::right, SEE, and subre().
Referenced by parse(), and parseqatom().672 {
673   struct state *lp; /* left end of current construct */
674   int seencontent;  /* is there anything in this branch yet? */
675   struct subre *t;
676 
677   lp = left;
678   seencontent = 0;
679   t = subre(v, '=', 0, left, right);  /* op '=' is tentative */
680   NOERRN();
681   while (!SEE('|') && !SEE(stopper) && !SEE(EOS)) {
682     if (seencontent) {  /* implicit concat operator */
683       lp = newstate(v->nfa);
684       NOERRN();
685       moveins(v->nfa, right, lp);
686     }
687     seencontent = 1;
688 
689     /* NB, recursion in parseqatom() may swallow rest of branch */
690     parseqatom(v, stopper, type, lp, right, t);
691   }
692 
693   if (!seencontent) {   /* empty branch */
694     if (!partial)
695       NOTE(REG_UUNSPEC);
696     assert(lp == left);
697     EMPTYARC(left, right);
698   }
699 
700   return t;
701 }
static VOID parseqatom (struct vars * v, int stopper, int type, struct state * lp, struct state * rp, struct subre * top) [static]

Definition at line 712 of file regcomp.c.
References AHEAD, ARCV, BACKR, BACKREF, subre::begin, BEHIND, bracket(), CAP, cbracket(), COLORLESS, COMBINE, delsub(), DIGIT, dupnfa(), EAT, EMPTYARC, subre::end, EOS, ERR, subre::flags, freesubre(), INFINITY, INSIST, ISERR, LACON, subre::left, LONGER, subre::max, MESSY, subre::min, moresubs(), moveins(), moveouts(), newlacon(), newstate(), NEXT, state::nins, NOERR, nonword(), NOTE, state::nouts, NULL, NWBDRY, okcolors(), onechr(), subre::op, parse(), parsebranch(), PLAIN, PREF, rainbow(), REG_ADVANCED, REG_ASSERT, REG_BADBR, REG_BADRPT, REG_EPAREN, REG_ESUBREG, REG_EXTENDED, REG_NLANCH, REG_NLSTOP, REG_UPBOTCH, repeat(), subre::right, SBEGIN, scannum(), SEE, SEND, SHORTER, size_t(), subre::subno, subre(), UP, WBDRY, word(), and wordchrs().
Referenced by parsebranch().719 {
720   struct state *s;  /* temporaries for new states */
721   struct state *s2;
722 # define  ARCV(t, val)  newarc(v->nfa, t, val, lp, rp)
723   int m, n;
724   struct subre *atom; /* atom's subtree */
725   struct subre *t;
726   int cap;    /* capturing parens? */
727   int pos;    /* positive lookahead? */
728   int subno;    /* capturing-parens or backref number */
729   int atomtype;
730   int qprefer;    /* quantifier short/long preference */
731   int f;
732   struct subre **atomp; /* where the pointer to atom is */
733 
734   /* initial bookkeeping */
735   atom = NULL;
736   assert(lp->nouts == 0); /* must string new code */
737   assert(rp->nins == 0);  /*  between lp and rp */
738   subno = 0;    /* just to shut lint up */
739 
740   /* an atom or constraint... */
741   atomtype = v->nexttype;
742   switch (atomtype) {
743   /* first, constraints, which end by returning */
744   case '^':
745     ARCV('^', 1);
746     if (v->cflags&REG_NLANCH)
747       ARCV(BEHIND, v->nlcolor);
748     NEXT();
749     return;
750     break;
751   case '$':
752     ARCV('$', 1);
753     if (v->cflags&REG_NLANCH)
754       ARCV(AHEAD, v->nlcolor);
755     NEXT();
756     return;
757     break;
758   case SBEGIN:
759     ARCV('^', 1); /* BOL */
760     ARCV('^', 0); /* or BOS */
761     NEXT();
762     return;
763     break;
764   case SEND:
765     ARCV('$', 1); /* EOL */
766     ARCV('$', 0); /* or EOS */
767     NEXT();
768     return;
769     break;
770   case '<':
771     wordchrs(v);  /* does NEXT() */
772     s = newstate(v->nfa);
773     NOERR();
774     nonword(v, BEHIND, lp, s);
775     word(v, AHEAD, s, rp);
776     return;
777     break;
778   case '>':
779     wordchrs(v);  /* does NEXT() */
780     s = newstate(v->nfa);
781     NOERR();
782     word(v, BEHIND, lp, s);
783     nonword(v, AHEAD, s, rp);
784     return;
785     break;
786   case WBDRY:
787     wordchrs(v);  /* does NEXT() */
788     s = newstate(v->nfa);
789     NOERR();
790     nonword(v, BEHIND, lp, s);
791     word(v, AHEAD, s, rp);
792     s = newstate(v->nfa);
793     NOERR();
794     word(v, BEHIND, lp, s);
795     nonword(v, AHEAD, s, rp);
796     return;
797     break;
798   case NWBDRY:
799     wordchrs(v);  /* does NEXT() */
800     s = newstate(v->nfa);
801     NOERR();
802     word(v, BEHIND, lp, s);
803     word(v, AHEAD, s, rp);
804     s = newstate(v->nfa);
805     NOERR();
806     nonword(v, BEHIND, lp, s);
807     nonword(v, AHEAD, s, rp);
808     return;
809     break;
810   case LACON: /* lookahead constraint */
811     pos = v->nextvalue;
812     NEXT();
813     s = newstate(v->nfa);
814     s2 = newstate(v->nfa);
815     NOERR();
816     t = parse(v, ')', LACON, s, s2);
817     freesubre(v, t);  /* internal structure irrelevant */
818     assert(SEE(')') || ISERR());
819     NEXT();
820     n = newlacon(v, s, s2, pos);
821     NOERR();
822     ARCV(LACON, n);
823     return;
824     break;
825   /* then errors, to get them out of the way */
826   case '*':
827   case '+':
828   case '?':
829   case '{':
830     ERR(REG_BADRPT);
831     return;
832     break;
833   default:
834     ERR(REG_ASSERT);
835     return;
836     break;
837   /* then plain characters, and minor variants on that theme */
838   case ')':   /* unbalanced paren */
839     if ((v->cflags&REG_ADVANCED) != REG_EXTENDED) {
840       ERR(REG_EPAREN);
841       return;
842     }
843     /* legal in EREs due to specification botch */
844     NOTE(REG_UPBOTCH);
845     /* fallthrough into case PLAIN */
846   case PLAIN:
847     onechr(v, v->nextvalue, lp, rp);
848     okcolors(v->nfa, v->cm);
849     NOERR();
850     NEXT();
851     break;
852   case '[':
853     if (v->nextvalue == 1)
854       bracket(v, lp, rp);
855     else
856       cbracket(v, lp, rp);
857     assert(SEE(']') || ISERR());
858     NEXT();
859     break;
860   case '.':
861     rainbow(v->nfa, v->cm, PLAIN,
862         (v->cflags&REG_NLSTOP) ? v->nlcolor : COLORLESS,
863         lp, rp);
864     NEXT();
865     break;
866   /* and finally the ugly stuff */
867   case '(': /* value flags as capturing or non */
868     cap = (type == LACON) ? 0 : v->nextvalue;
869     if (cap) {
870       v->nsubexp++;
871       subno = v->nsubexp;
872       if ((size_t)subno >= v->nsubs)
873         moresubs(v, subno);
874       assert((size_t)subno < v->nsubs);
875     } else
876       atomtype = PLAIN; /* something that's not '(' */
877     NEXT();
878     /* need new endpoints because tree will contain pointers */
879     s = newstate(v->nfa);
880     s2 = newstate(v->nfa);
881     NOERR();
882     EMPTYARC(lp, s);
883     EMPTYARC(s2, rp);
884     NOERR();
885     atom = parse(v, ')', PLAIN, s, s2);
886     assert(SEE(')') || ISERR());
887     NEXT();
888     NOERR();
889     if (cap) {
890       v->subs[subno] = atom;
891       t = subre(v, '(', atom->flags|CAP, lp, rp);
892       NOERR();
893       t->subno = subno;
894       t->left = atom;
895       atom = t;
896     }
897     /* postpone everything else pending possible {0} */
898     break;
899   case BACKREF: /* the Feature From The Black Lagoon */
900     INSIST(type != LACON, REG_ESUBREG);
901     INSIST(v->nextvalue < v->nsubs, REG_ESUBREG);
902     INSIST(v->subs[v->nextvalue] != NULL, REG_ESUBREG);
903     NOERR();
904     assert(v->nextvalue > 0);
905     atom = subre(v, 'b', BACKR, lp, rp);
906     subno = v->nextvalue;
907     atom->subno = subno;
908     EMPTYARC(lp, rp); /* temporarily, so there's something */
909     NEXT();
910     break;
911   }
912 
913   /* ...and an atom may be followed by a quantifier */
914   switch (v->nexttype) {
915   case '*':
916     m = 0;
917     n = INFINITY;
918     qprefer = (v->nextvalue) ? LONGER : SHORTER;
919     NEXT();
920     break;
921   case '+':
922     m = 1;
923     n = INFINITY;
924     qprefer = (v->nextvalue) ? LONGER : SHORTER;
925     NEXT();
926     break;
927   case '?':
928     m = 0;
929     n = 1;
930     qprefer = (v->nextvalue) ? LONGER : SHORTER;
931     NEXT();
932     break;
933   case '{':
934     NEXT();
935     m = scannum(v);
936     if (EAT(',')) {
937       if (SEE(DIGIT))
938         n = scannum(v);
939       else
940         n = INFINITY;
941       if (m > n) {
942         ERR(REG_BADBR);
943         return;
944       }
945       /* {m,n} exercises preference, even if it's {m,m} */
946       qprefer = (v->nextvalue) ? LONGER : SHORTER;
947     } else {
948       n = m;
949       /* {m} passes operand's preference through */
950       qprefer = 0;
951     }
952     if (!SEE('}')) {  /* catches errors too */
953       ERR(REG_BADBR);
954       return;
955     }
956     NEXT();
957     break;
958   default:    /* no quantifier */
959     m = n = 1;
960     qprefer = 0;
961     break;
962   }
963 
964   /* annoying special case:  {0} or {0,0} cancels everything */
965   if (m == 0 && n == 0) {
966     if (atom != NULL)
967       freesubre(v, atom);
968     if (atomtype == '(')
969       v->subs[subno] = NULL;
970     delsub(v->nfa, lp, rp);
971     EMPTYARC(lp, rp);
972     return;
973   }
974 
975   /* if not a messy case, avoid hard part */
976   assert(!MESSY(top->flags));
977   f = top->flags | qprefer | ((atom != NULL) ? atom->flags : 0);
978   if (atomtype != '(' && atomtype != BACKREF && !MESSY(UP(f))) {
979     if (!(m == 1 && n == 1))
980       repeat(v, lp, rp, m, n);
981     if (atom != NULL)
982       freesubre(v, atom);
983     top->flags = f;
984     return;
985   }
986 
987   /*
988    * hard part:  something messy
989    * That is, capturing parens, back reference, short/long clash, or
990    * an atom with substructure containing one of those.
991    */
992 
993   /* now we'll need a subre for the contents even if they're boring */
994   if (atom == NULL) {
995     atom = subre(v, '=', 0, lp, rp);
996     NOERR();
997   }
998 
999   /*
1000    * prepare a general-purpose state skeleton
1001    *
1002    *    ---> [s] ---prefix---> [begin] ---atom---> [end] ----rest---> [rp]
1003    *   /                                            /
1004    * [lp] ----> [s2] ----bypass---------------------
1005    *
1006    * where bypass is an empty, and prefix is some repetitions of atom
1007    */
1008   s = newstate(v->nfa);   /* first, new endpoints for the atom */
1009   s2 = newstate(v->nfa);
1010   NOERR();
1011   moveouts(v->nfa, lp, s);
1012   moveins(v->nfa, rp, s2);
1013   NOERR();
1014   atom->begin = s;
1015   atom->end = s2;
1016   s = newstate(v->nfa);   /* and spots for prefix and bypass */
1017   s2 = newstate(v->nfa);
1018   NOERR();
1019   EMPTYARC(lp, s);
1020   EMPTYARC(lp, s2);
1021   NOERR();
1022 
1023   /* break remaining subRE into x{...} and what follows */
1024   t = subre(v, '.', COMBINE(qprefer, atom->flags), lp, rp);
1025   t->left = atom;
1026   atomp = &t->left;
1027   /* here we should recurse... but we must postpone that to the end */
1028 
1029   /* split top into prefix and remaining */
1030   assert(top->op == '=' && top->left == NULL && top->right == NULL);
1031   top->left = subre(v, '=', top->flags, top->begin, lp);
1032   top->op = '.';
1033   top->right = t;
1034 
1035   /* if it's a backref, now is the time to replicate the subNFA */
1036   if (atomtype == BACKREF) {
1037     assert(atom->begin->nouts == 1);  /* just the EMPTY */
1038     delsub(v->nfa, atom->begin, atom->end);
1039     assert(v->subs[subno] != NULL);
1040     /* and here's why the recursion got postponed:  it must */
1041     /* wait until the skeleton is filled in, because it may */
1042     /* hit a backref that wants to copy the filled-in skeleton */
1043     dupnfa(v->nfa, v->subs[subno]->begin, v->subs[subno]->end,
1044             atom->begin, atom->end);
1045     NOERR();
1046   }
1047 
1048   /* it's quantifier time; first, turn x{0,...} into x{1,...}|empty */
1049   if (m == 0) {
1050     EMPTYARC(s2, atom->end);    /* the bypass */
1051     assert(PREF(qprefer) != 0);
1052     f = COMBINE(qprefer, atom->flags);
1053     t = subre(v, '|', f, lp, atom->end);
1054     NOERR();
1055     t->left = atom;
1056     t->right = subre(v, '|', PREF(f), s2, atom->end);
1057     NOERR();
1058     t->right->left = subre(v, '=', 0, s2, atom->end);
1059     NOERR();
1060     *atomp = t;
1061     atomp = &t->left;
1062     m = 1;
1063   }
1064 
1065   /* deal with the rest of the quantifier */
1066   if (atomtype == BACKREF) {
1067     /* special case:  backrefs have internal quantifiers */
1068     EMPTYARC(s, atom->begin); /* empty prefix */
1069     /* just stuff everything into atom */
1070     repeat(v, atom->begin, atom->end, m, n);
1071     atom->min = (short)m;
1072     atom->max = (short)n;
1073     atom->flags |= COMBINE(qprefer, atom->flags);
1074   } else if (m == 1 && n == 1) {
1075     /* no/vacuous quantifier:  done */
1076     EMPTYARC(s, atom->begin); /* empty prefix */
1077   } else {
1078     /* turn x{m,n} into x{m-1,n-1}x, with capturing */
1079     /*  parens in only second x */
1080     dupnfa(v->nfa, atom->begin, atom->end, s, atom->begin);
1081     assert(m >= 1 && m != INFINITY && n >= 1);
1082     repeat(v, s, atom->begin, m-1, (n == INFINITY) ? n : n-1);
1083     f = COMBINE(qprefer, atom->flags);
1084     t = subre(v, '.', f, s, atom->end); /* prefix and atom */
1085     NOERR();
1086     t->left = subre(v, '=', PREF(f), s, atom->begin);
1087     NOERR();
1088     t->right = atom;
1089     *atomp = t;
1090   }
1091 
1092   /* and finally, look after that postponed recursion */
1093   t = top->right;
1094   if (!(SEE('|') || SEE(stopper) || SEE(EOS)))
1095     t->right = parsebranch(v, stopper, type, atom->end, rp, 1);
1096   else {
1097     EMPTYARC(atom->end, rp);
1098     t->right = subre(v, '=', 0, atom->end, rp);
1099   }
1100   assert(SEE('|') || SEE(stopper) || SEE(EOS));
1101   t->flags |= COMBINE(t->flags, t->right->flags);
1102   top->flags |= COMBINE(top->flags, t->flags);
1103 }
static VOID repeat (struct vars * v, struct state * lp, struct state * rp, int m, int n) [static]

Definition at line 1173 of file regcomp.c.
References CONST, delsub(), dupnfa(), EMPTYARC, ERR, INF, moveins(), moveouts(), newstate(), NOERR, PAIR, REDUCE, REG_ASSERT, and SOME.
Referenced by parseqatom().1179 {
1180 # define  SOME  2
1181 # define  INF 3
1182 # define  PAIR(x, y)  ((x)*4 + (y))
1183 # define  REDUCE(x) ( ((x) == INFINITY) ? INF : (((x) > 1) ? SOME : (x)) )
1184   CONST int rm = REDUCE(m);
1185   CONST int rn = REDUCE(n);
1186   struct state *s;
1187   struct state *s2;
1188 
1189   switch (PAIR(rm, rn)) {
1190   case PAIR(0, 0):    /* empty string */
1191     delsub(v->nfa, lp, rp);
1192     EMPTYARC(lp, rp);
1193     break;
1194   case PAIR(0, 1):    /* do as x| */
1195     EMPTYARC(lp, rp);
1196     break;
1197   case PAIR(0, SOME):   /* do as x{1,n}| */
1198     repeat(v, lp, rp, 1, n);
1199     NOERR();
1200     EMPTYARC(lp, rp);
1201     break;
1202   case PAIR(0, INF):    /* loop x around */
1203     s = newstate(v->nfa);
1204     NOERR();
1205     moveouts(v->nfa, lp, s);
1206     moveins(v->nfa, rp, s);
1207     EMPTYARC(lp, s);
1208     EMPTYARC(s, rp);
1209     break;
1210   case PAIR(1, 1):    /* no action required */
1211     break;
1212   case PAIR(1, SOME):   /* do as x{0,n-1}x = (x{1,n-1}|)x */
1213     s = newstate(v->nfa);
1214     NOERR();
1215     moveouts(v->nfa, lp, s);
1216     dupnfa(v->nfa, s, rp, lp, s);
1217     NOERR();
1218     repeat(v, lp, s, 1, n-1);
1219     NOERR();
1220     EMPTYARC(lp, s);
1221     break;
1222   case PAIR(1, INF):    /* add loopback arc */
1223     s = newstate(v->nfa);
1224     s2 = newstate(v->nfa);
1225     NOERR();
1226     moveouts(v->nfa, lp, s);
1227     moveins(v->nfa, rp, s2);
1228     EMPTYARC(lp, s);
1229     EMPTYARC(s2, rp);
1230     EMPTYARC(s2, s);
1231     break;
1232   case PAIR(SOME, SOME):    /* do as x{m-1,n-1}x */
1233     s = newstate(v->nfa);
1234     NOERR();
1235     moveouts(v->nfa, lp, s);
1236     dupnfa(v->nfa, s, rp, lp, s);
1237     NOERR();
1238     repeat(v, lp, s, m-1, n-1);
1239     break;
1240   case PAIR(SOME, INF):   /* do as x{m-1,}x */
1241     s = newstate(v->nfa);
1242     NOERR();
1243     moveouts(v->nfa, lp, s);
1244     dupnfa(v->nfa, s, rp, lp, s);
1245     NOERR();
1246     repeat(v, lp, s, m-1, n);
1247     break;
1248   default:
1249     ERR(REG_ASSERT);
1250     break;
1251   }
1252 }
static VOID rfree (regex_t * re) [static]

Definition at line 2021 of file regcomp.c.
References guts::cmap, FREE, freecm(), freecnfa(), freelacons(), freesubre(), guts::lacons, guts::magic, guts::nlacons, NULL, NULLCNFA, REMAGIC, guts::search, and guts::tree.
Referenced by freev().2023 {
2024   struct guts *g;
2025 
2026   if (re == NULL || re->re_magic != REMAGIC)
2027     return;
2028 
2029   re->re_magic = 0; /* invalidate RE */
2030   g = (struct guts *)re->re_guts;
2031   re->re_guts = NULL;
2032   re->re_fns = NULL;
2033   g->magic = 0;
2034   freecm(&g->cmap);
2035   if (g->tree != NULL)
2036     freesubre((struct vars *)NULL, g->tree);
2037   if (g->lacons != NULL)
2038     freelacons(g->lacons, g->nlacons);
2039   if (!NULLCNFA(g->search))
2040     freecnfa(&g->search);
2041   FREE(g);
2042 }
static int scannum (struct vars * v) [static]

Definition at line 1146 of file regcomp.c.
References DIGIT, DUPMAX, ERR, NEXT, REG_BADBR, and SEE.
Referenced by parseqatom().1148 {
1149   int n = 0;
1150 
1151   while (SEE(DIGIT) && n < DUPMAX) {
1152     n = n*10 + v->nextvalue;
1153     NEXT();
1154   }
1155   if (SEE(DIGIT) || n > DUPMAX) {
1156     ERR(REG_BADBR);
1157     return 0;
1158   }
1159   return n;
1160 }
static chr* scanplain (struct vars * v) [static]

Definition at line 1475 of file regcomp.c.
References CCLASS, COLLEL, ECLASS, END, ISERR, NEXT, PLAIN, and SEE.
Referenced by brackpart().1477 {
1478   chr *endp;
1479 
1480   assert(SEE(COLLEL) || SEE(ECLASS) || SEE(CCLASS));
1481   NEXT();
1482 
1483   endp = v->now;
1484   while (SEE(PLAIN)) {
1485     endp = v->now;
1486     NEXT();
1487   }
1488 
1489   assert(SEE(END) || ISERR());
1490   NEXT();
1491 
1492   return endp;
1493 }
static VOID stdump (struct subre * t, FILE * f, int nfapresent) [static]

Definition at line 2110 of file regcomp.c.
References BACKR, CAP, dumpcnfa(), INFINITY, INUSE, LONGER, MIXED, NULL, NULLCNFA, SHORTER, and stid().
Referenced by dumpst().2114 {
2115   char idbuf[50];
2116 
2117   fprintf(f, "%s. `%c'", stid(t, idbuf, sizeof(idbuf)), t->op);
2118   if (t->flags&LONGER)
2119     fprintf(f, " longest");
2120   if (t->flags&SHORTER)
2121     fprintf(f, " shortest");
2122   if (t->flags&MIXED)
2123     fprintf(f, " hasmixed");
2124   if (t->flags&CAP)
2125     fprintf(f, " hascapture");
2126   if (t->flags&BACKR)
2127     fprintf(f, " hasbackref");
2128   if (!(t->flags&INUSE))
2129     fprintf(f, " UNUSED");
2130   if (t->subno != 0)
2131     fprintf(f, " (#%d)", t->subno);
2132   if (t->min != 1 || t->max != 1) {
2133     fprintf(f, " {%d,", t->min);
2134     if (t->max != INFINITY)
2135       fprintf(f, "%d", t->max);
2136     fprintf(f, "}");
2137   }
2138   if (nfapresent)
2139     fprintf(f, " %ld-%ld", (long)t->begin->no, (long)t->end->no);
2140   if (t->left != NULL)
2141     fprintf(f, " L:%s", stid(t->left, idbuf, sizeof(idbuf)));
2142   if (t->right != NULL)
2143     fprintf(f, " R:%s", stid(t->right, idbuf, sizeof(idbuf)));
2144   if (!NULLCNFA(t->cnfa)) {
2145     fprintf(f, "\n");
2146     dumpcnfa(&t->cnfa, f);
2147     fprintf(f, "\n");
2148   }
2149   if (t->left != NULL)
2150     stdump(t->left, f, nfapresent);
2151   if (t->right != NULL)
2152     stdump(t->right, f, nfapresent);
2153 }
static char* stid (struct subre * t, char * buf, size_t bufsize) [static]

Definition at line 2160 of file regcomp.c.
Referenced by nfanode(), and stdump().2164 {
2165   /* big enough for hex int or decimal t->retry? */
2166   if (bufsize < sizeof(void*)*2 + 3 || bufsize < sizeof(t->retry)*3 + 1)
2167     return "unable";
2168   if (t->retry != 0)
2169     sprintf(buf, "%d", t->retry);
2170   else
2171     sprintf(buf, "%p", t);
2172   return buf;
2173 }
static struct subre* subre (struct vars * v, int op, int flags, struct state * begin, struct state * end) [static]

Definition at line 1750 of file regcomp.c.
References subre::begin, subre::chain, subre::cnfa, subre::end, ERR, subre::flags, subre::left, MALLOC, subre::max, subre::min, NULL, subre::op, REG_ESPACE, subre::retry, subre::right, subre::subno, and ZAPCNFA.
Referenced by parse(), parsebranch(), and parseqatom().1756 {
1757   struct subre *ret;
1758 
1759   ret = v->treefree;
1760   if (ret != NULL)
1761     v->treefree = ret->left;
1762   else {
1763     ret = (struct subre *)MALLOC(sizeof(struct subre));
1764     if (ret == NULL) {
1765       ERR(REG_ESPACE);
1766       return NULL;
1767     }
1768     ret->chain = v->treechain;
1769     v->treechain = ret;
1770   }
1771 
1772   assert(strchr("|.b(=", op) != NULL);
1773 
1774   ret->op = op;
1775   ret->flags = flags;
1776   ret->retry = 0;
1777   ret->subno = 0;
1778   ret->min = ret->max = 1;
1779   ret->left = NULL;
1780   ret->right = NULL;
1781   ret->begin = begin;
1782   ret->end = end;
1783   ZAPCNFA(ret->cnfa);
1784 
1785   return ret;
1786 }
static VOID word (struct vars * v, int dir, struct state * lp, struct state * rp) [static]

Definition at line 1130 of file regcomp.c.
References AHEAD, BEHIND, and cloneouts().
Referenced by EscapeFromUtfProc(), ObjTraceProc(), parseqatom(), TableFromUtfProc(), TclCompileIfCmd(), and TclCompileIncrCmd().1135 {
1136   assert(dir == AHEAD || dir == BEHIND);
1137   cloneouts(v->nfa, v->wordchrs, lp, rp, dir);
1138   /* (no need for special attention to \n) */
1139 }
static VOID wordchrs (struct vars * v) [static]

Definition at line 1719 of file regcomp.c.
References bracket(), ISERR, lexword(), newstate(), NEXT, NOERR, NULL, and SEE.
Referenced by parseqatom().1721 {
1722   struct state *left;
1723   struct state *right;
1724 
1725   if (v->wordchrs != NULL) {
1726     NEXT();   /* for consistency */
1727     return;
1728   }
1729 
1730   left = newstate(v->nfa);
1731   right = newstate(v->nfa);
1732   NOERR();
1733   /* fine point:  implemented with [::], and lexer will set REG_ULOCALE */
1734   lexword(v);
1735   NEXT();
1736   assert(v->savenow != NULL && SEE('['));
1737   bracket(v, left, right);
1738   assert((v->savenow != NULL && SEE(']')) || ISERR());
1739   NEXT();
1740   NOERR();
1741   v->wordchrs = left;
1742 }

Variable Documentation
struct fns functions [static]
Initial value: {
  rfree,      
}
Definition at line 273 of file regcomp.c.
Referenced by compile().

generic/regcustom.h File Reference
#include "tclInt.h"
#include "regex.h"
Defines
#define FUNCPTR(name, args)  (*name) _ANSI_ARGS_(args)
#define MALLOC(n)  ckalloc(n)
#define FREE(p)  ckfree(VS(p))
#define REALLOC(p, n)  ckrealloc(VS(p),n)
#define __REG_WIDE_T  Tcl_UniChar
#define __REG_REGOFF_T  long
#define __REG_VOID_T  VOID
#define __REG_CONST  CONST
#define __REG_WIDE_COMPILE  TclReComp
#define __REG_WIDE_EXEC  TclReExec
#define __REG_NOFRONT
#define __REG_NOCHAR
#define regfree  TclReFree
#define regerror  TclReError
#define NOCELT  (-1)
#define CHR(c)  (UCHAR(c))
#define DIGITVAL(c)  ((c)-'0')
#define CHRBITS  16
#define CHR_MIN  0x0000
#define CHR_MAX  0xffff
#define iscalnum(x)  Tcl_UniCharIsAlnum(x)
#define iscalpha(x)  Tcl_UniCharIsAlpha(x)
#define iscdigit(x)  Tcl_UniCharIsDigit(x)
#define iscspace(x)  Tcl_UniCharIsSpace(x)
#define compile  TclReComp
#define exec  TclReExec
Typedefs
typedef Tcl_UniChar chr
typedef int pchr
typedef unsigned uchr
typedef int celt

Define Documentation
#define __REG_CONST  CONST

Definition at line 74 of file regcustom.h.#define __REG_NOCHAR

Definition at line 79 of file regcustom.h.#define __REG_NOFRONT

Definition at line 78 of file regcustom.h.#define __REG_REGOFF_T  long

Definition at line 72 of file regcustom.h.#define __REG_VOID_T  VOID

Definition at line 73 of file regcustom.h.#define __REG_WIDE_COMPILE  TclReComp

Definition at line 76 of file regcustom.h.#define __REG_WIDE_EXEC  TclReExec

Definition at line 77 of file regcustom.h.#define __REG_WIDE_T  Tcl_UniChar

Definition at line 71 of file regcustom.h.#define CHR(c)  (UCHAR(c))

Definition at line 92 of file regcustom.h.
Referenced by brenext(), lexdigits(), lexescape(), newline(), next(), prefixes(), and skip().#define CHR_MAX  0xffff

Definition at line 101 of file regcustom.h.
Referenced by initcm().#define CHR_MIN  0x0000

Definition at line 100 of file regcustom.h.
Referenced by initcm().#define CHRBITS  16

Definition at line 99 of file regcustom.h.#define compile  TclReComp

Definition at line 111 of file regcustom.h.#define DIGITVAL(c)  ((c)-'0')

Definition at line 93 of file regcustom.h.
Referenced by brenext(), lexdigits(), and next().#define exec  TclReExec

Definition at line 112 of file regcustom.h.
Referenced by TclpDlopen().#define FREE(p)  ckfree(VS(p))

Definition at line 35 of file regcustom.h.
Referenced by cleanst(), cmtreefree(), compact(), destroystate(), exec(), freecm(), freecnfa(), freecolor(), freecvec(), freedfa(), freelacons(), freenfa(), freesrnode(), freev(), and rfree().#define FUNCPTR(name, args)  (*name) _ANSI_ARGS_(args)

Definition at line 33 of file regcustom.h.#define iscalnum(x)  Tcl_UniCharIsAlnum(x)

Definition at line 105 of file regcustom.h.
Referenced by brenext(), lexescape(), and next().#define iscalpha(x)  Tcl_UniCharIsAlpha(x)

Definition at line 106 of file regcustom.h.
Referenced by lexescape(), and prefixes().#define iscdigit(x)  Tcl_UniCharIsDigit(x)

Definition at line 107 of file regcustom.h.
Referenced by next().#define iscspace(x)  Tcl_UniCharIsSpace(x)

Definition at line 108 of file regcustom.h.
Referenced by skip().#define MALLOC(n)  ckalloc(n)

Definition at line 34 of file regcustom.h.
Referenced by allocarc(), compact(), compile(), exec(), moresubs(), newcolor(), newcvec(), newdfa(), newlacon(), newnfa(), newstate(), setcolor(), subblock(), and subre().#define NOCELT  (-1)

Definition at line 91 of file regcustom.h.
Referenced by dovec(), and nextleader().#define REALLOC(p, n)  ckrealloc(VS(p),n)

Definition at line 36 of file regcustom.h.
Referenced by moresubs(), newcolor(), and newlacon().#define regerror  TclReError

Definition at line 81 of file regcustom.h.#define regfree  TclReFree

Definition at line 80 of file regcustom.h.
Typedef Documentation
typedef int celt

Definition at line 90 of file regcustom.h.typedef Tcl_UniChar chr

Definition at line 87 of file regcustom.h.typedef int pchr

Definition at line 88 of file regcustom.h.typedef unsigned uchr

Definition at line 89 of file regcustom.h.

generic/rege_dfa.c File Reference
Functions
static chr * longest (struct vars *v, struct dfa *d, chr *start, chr *stop, int *hitstopp)
static chr * shortest (struct vars *v, struct dfa *d, chr *start, chr *min, chr *max, chr **coldp, int *hitstopp)
static chr * lastcold (struct vars *v, struct dfa *d)
static struct dfa * newdfa (struct vars *v, struct cnfa *cnfa, struct colormap *cm, struct smalldfa *small)
static VOID freedfa (struct dfa *d)
static unsigned hash (unsigned *uv, int n)
static struct sset * initialize (struct vars *v, struct dfa *d, chr *start)
static struct sset * miss (struct vars *v, struct dfa *d, struct sset *css, pcolor co, chr *cp, chr *start)
static int lacon (struct vars *v, struct cnfa *pcnfa, chr *cp, pcolor co)
static struct sset * getvacant (struct vars *v, struct dfa *d, chr *cp, chr *start)
static struct sset * pickss (struct vars *v, struct dfa *d, chr *cp, chr *start)

Function Documentation
static VOID freedfa (struct dfa * d) [static]

Definition at line 337 of file rege_dfa.c.
References FREE, and NULL.
Referenced by altdissect(), caltdissect(), ccondissect(), cfind(), condissect(), crevdissect(), find(), lacon(), and newdfa().339 {
340   if (d->cptsmalloced) {
341     if (d->ssets != NULL)
342       FREE(d->ssets);
343     if (d->statesarea != NULL)
344       FREE(d->statesarea);
345     if (d->outsarea != NULL)
346       FREE(d->outsarea);
347     if (d->incarea != NULL)
348       FREE(d->incarea);
349   }
350 
351   if (d->mallocarea != NULL)
352     FREE(d->mallocarea);
353 }
static struct sset* getvacant (struct vars * v, struct dfa * d, chr * cp, chr * start) [static]

Definition at line 554 of file rege_dfa.c.
References arcp::co, FDEBUG, sset::flags, sset::inchain, sset::ins, dfa::lastnopr, dfa::lastpost, sset::lastseen, LOCKED, dfa::ncolors, NOPROGRESS, NULL, sset::outs, pickss(), POSTSTATE, arcp::ss, and dfa::ssets.
Referenced by initialize().559 {
560   int i;
561   struct sset *ss;
562   struct sset *p;
563   struct arcp ap;
564   struct arcp lastap = {NULL, 0}; /* silence gcc 4 warning */
565   color co;
566 
567   ss = pickss(v, d, cp, start);
568   assert(!(ss->flags&LOCKED));
569 
570   /* clear out its inarcs, including self-referential ones */
571   ap = ss->ins;
572   while ((p = ap.ss) != NULL) {
573     co = ap.co;
574     FDEBUG(("zapping c%d's %ld outarc\n", p - d->ssets, (long)co));
575     p->outs[co] = NULL;
576     ap = p->inchain[co];
577     p->inchain[co].ss = NULL; /* paranoia */
578   }
579   ss->ins.ss = NULL;
580 
581   /* take it off the inarc chains of the ssets reached by its outarcs */
582   for (i = 0; i < d->ncolors; i++) {
583     p = ss->outs[i];
584     assert(p != ss);    /* not self-referential */
585     if (p == NULL)
586       continue;   /* NOTE CONTINUE */
587     FDEBUG(("del outarc %d from c%d's in chn\n", i, p - d->ssets));
588     if (p->ins.ss == ss && p->ins.co == i)
589       p->ins = ss->inchain[i];
590     else {
591       assert(p->ins.ss != NULL);
592       for (ap = p->ins; ap.ss != NULL &&
593             !(ap.ss == ss && ap.co == i);
594             ap = ap.ss->inchain[ap.co])
595         lastap = ap;
596       assert(ap.ss != NULL);
597       lastap.ss->inchain[lastap.co] = ss->inchain[i];
598     }
599     ss->outs[i] = NULL;
600     ss->inchain[i].ss = NULL;
601   }
602 
603   /* if ss was a success state, may need to remember location */
604   if ((ss->flags&POSTSTATE) && ss->lastseen != d->lastpost &&
605       (d->lastpost == NULL || d->lastpost < ss->lastseen))
606     d->lastpost = ss->lastseen;
607 
608   /* likewise for a no-progress state */
609   if ((ss->flags&NOPROGRESS) && ss->lastseen != d->lastnopr &&
610       (d->lastnopr == NULL || d->lastnopr < ss->lastseen))
611     d->lastnopr = ss->lastseen;
612 
613   return ss;
614 }
static unsigned hash (unsigned * uv, int n) [static]

Definition at line 361 of file rege_dfa.c.
Referenced by RebuildTable(), Tcl_CreateHashEntry(), Tcl_FindHashEntry(), and TclRegisterLiteral().364 {
365   int i;
366   unsigned h;
367 
368   h = 0;
369   for (i = 0; i < n; i++)
370     h ^= uv[i];
371   return h;
372 }
static struct sset* initialize (struct vars * v, struct dfa * d, chr * start) [static]

Definition at line 379 of file rege_dfa.c.
References BSET, dfa::cnfa, sset::flags, getvacant(), HASH, sset::hash, dfa::lastnopr, dfa::lastpost, sset::lastseen, LOCKED, NOPROGRESS, dfa::nssused, NULL, cnfa::post, cnfa::pre, dfa::ssets, STARTER, sset::states, and dfa::wordsper.
Referenced by longest(), and shortest().383 {
384   struct sset *ss;
385   int i;
386 
387   /* is previous one still there? */
388   if (d->nssused > 0 && (d->ssets[0].flags&STARTER))
389     ss = &d->ssets[0];
390   else {        /* no, must (re)build it */
391     ss = getvacant(v, d, start, start);
392     for (i = 0; i < d->wordsper; i++)
393       ss->states[i] = 0;
394     BSET(ss->states, d->cnfa->pre);
395     ss->hash = HASH(ss->states, d->wordsper);
396     assert(d->cnfa->pre != d->cnfa->post);
397     ss->flags = STARTER|LOCKED|NOPROGRESS;
398     /* lastseen dealt with below */
399   }
400 
401   for (i = 0; i < d->nssused; i++)
402     d->ssets[i].lastseen = NULL;
403   ss->lastseen = start;   /* maybe untrue, but harmless */
404   d->lastpost = NULL;
405   d->lastnopr = NULL;
406   return ss;
407 }
static int lacon (struct vars * v, struct cnfa * pcnfa, chr * cp, pcolor co) [static]

Definition at line 520 of file rege_dfa.c.
References subre::cnfa, ERR, FDEBUG, freedfa(), longest(), cnfa::ncolors, newdfa(), NULL, REG_ESPACE, and subre::subno.525 {
526   int n;
527   struct subre *sub;
528   struct dfa *d;
529   struct smalldfa sd;
530   chr *end;
531 
532   n = co - pcnfa->ncolors;
533   assert(n < v->g->nlacons && v->g->lacons != NULL);
534   FDEBUG(("=== testing lacon %d\n", n));
535   sub = &v->g->lacons[n];
536   d = newdfa(v, &sub->cnfa, &v->g->cmap, &sd);
537   if (d == NULL) {
538     ERR(REG_ESPACE);
539     return 0;
540   }
541   end = longest(v, d, cp, v->stop, (int *)NULL);
542   freedfa(d);
543   FDEBUG(("=== lacon %d match %d\n", n, (end != NULL)));
544   return (sub->subno) ? (end != NULL) : (end == NULL);
545 }
static chr* lastcold (struct vars * v, struct dfa * d) [static]

Definition at line 238 of file rege_dfa.c.
References sset::flags, dfa::lastnopr, sset::lastseen, NOPROGRESS, dfa::nssused, NULL, and dfa::ssets.
Referenced by shortest().241 {
242   struct sset *ss;
243   chr *nopr;
244   int i;
245 
246   nopr = d->lastnopr;
247   if (nopr == NULL)
248     nopr = v->start;
249   for (ss = d->ssets, i = d->nssused; i > 0; ss++, i--)
250     if ((ss->flags&NOPROGRESS) && nopr < ss->lastseen)
251       nopr = ss->lastseen;
252   return nopr;
253 }
static chr* longest (struct vars * v, struct dfa * d, chr * start, chr * stop, int * hitstopp) [static]

Definition at line 38 of file rege_dfa.c.
References cnfa::bos, dfa::cm, dfa::cnfa, cnfa::eos, FDEBUG, sset::flags, initialize(), dfa::lastpost, sset::lastseen, miss(), dfa::nssused, NULL, sset::outs, POSTSTATE, REG_FTRACE, REG_NOTBOL, REG_NOTEOL, and dfa::ssets.
Referenced by altdissect(), caltdissect(), ccondissect(), cfindloop(), condissect(), crevdissect(), EscapeToUtfProc(), find(), and lacon().44 {
45   chr *cp;
46   chr *realstop = (stop == v->stop) ? stop : stop + 1;
47   color co;
48   struct sset *css;
49   struct sset *ss;
50   chr *post;
51   int i;
52   struct colormap *cm = d->cm;
53 
54   /* initialize */
55   css = initialize(v, d, start);
56   cp = start;
57   if (hitstopp != NULL)
58     *hitstopp = 0;
59 
60   /* startup */
61   FDEBUG(("+++ startup +++\n"));
62   if (cp == v->start) {
63     co = d->cnfa->bos[(v->eflags&REG_NOTBOL) ? 0 : 1];
64     FDEBUG(("color %ld\n", (long)co));
65   } else {
66     co = GETCOLOR(cm, *(cp - 1));
67     FDEBUG(("char %c, color %ld\n", (char)*(cp-1), (long)co));
68   }
69   css = miss(v, d, css, co, cp, start);
70   if (css == NULL)
71     return NULL;
72   css->lastseen = cp;
73 
74   /* main loop */
75   if (v->eflags&REG_FTRACE)
76     while (cp < realstop) {
77       FDEBUG(("+++ at c%d +++\n", css - d->ssets));
78       co = GETCOLOR(cm, *cp);
79       FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
80       ss = css->outs[co];
81       if (ss == NULL) {
82         ss = miss(v, d, css, co, cp+1, start);
83         if (ss == NULL)
84           break;  /* NOTE BREAK OUT */
85       }
86       cp++;
87       ss->lastseen = cp;
88       css = ss;
89     }
90   else
91     while (cp < realstop) {
92       co = GETCOLOR(cm, *cp);
93       ss = css->outs[co];
94       if (ss == NULL) {
95         ss = miss(v, d, css, co, cp+1, start);
96         if (ss == NULL)
97           break;  /* NOTE BREAK OUT */
98       }
99       cp++;
100       ss->lastseen = cp;
101       css = ss;
102     }
103 
104   /* shutdown */
105   FDEBUG(("+++ shutdown at c%d +++\n", css - d->ssets));
106   if (cp == v->stop && stop == v->stop) {
107     if (hitstopp != NULL)
108       *hitstopp = 1;
109     co = d->cnfa->eos[(v->eflags&REG_NOTEOL) ? 0 : 1];
110     FDEBUG(("color %ld\n", (long)co));
111     ss = miss(v, d, css, co, cp, start);
112     /* special case:  match ended at eol? */
113     if (ss != NULL && (ss->flags&POSTSTATE))
114       return cp;
115     else if (ss != NULL)
116       ss->lastseen = cp;  /* to be tidy */
117   }
118 
119   /* find last match, if any */
120   post = d->lastpost;
121   for (ss = d->ssets, i = d->nssused; i > 0; ss++, i--)
122     if ((ss->flags&POSTSTATE) && post != ss->lastseen &&
123           (post == NULL || post < ss->lastseen))
124       post = ss->lastseen;
125   if (post != NULL)   /* found one */
126     return post - 1;
127 
128   return NULL;
129 }
static struct sset* miss (struct vars * v, struct dfa * d, struct sset * css, pcolor co, chr * cp, chr * start) [static]

Definition at line 415 of file rege_dfa.c.
References BSET, dfa::cnfa, carc::co, COLORLESS, FDEBUG, ISBSET, dfa::nstates, NULL, sset::outs, cnfa::post, cnfa::states, sset::states, carc::to, dfa::wordsper, and dfa::work.
Referenced by longest(), and shortest().422 {
423   struct cnfa *cnfa = d->cnfa;
424   int i;
425   unsigned h;
426   struct carc *ca;
427   struct sset *p;
428   int ispost;
429   int noprogress;
430   int gotstate;
431   int dolacons;
432   int sawlacons;
433 
434   /* for convenience, we can be called even if it might not be a miss */
435   if (css->outs[co] != NULL) {
436     FDEBUG(("hit\n"));
437     return css->outs[co];
438   }
439   FDEBUG(("miss\n"));
440 
441   /* first, what set of states would we end up in? */
442   for (i = 0; i < d->wordsper; i++)
443     d->work[i] = 0;
444   ispost = 0;
445   noprogress = 1;
446   gotstate = 0;
447   for (i = 0; i < d->nstates; i++)
448     if (ISBSET(css->states, i))
449       for (ca = cnfa->states[i]+1; ca->co != COLORLESS; ca++)
450         if (ca->co == co) {
451           BSET(d->work, ca->to);
452           gotstate = 1;
453           if (ca->to == cnfa->post)
454             ispost = 1;
455           if (!cnfa->states[ca->to]->co)
456             noprogress = 0;
457           FDEBUG(("%d -> %d\n", i, ca->to));
458         }
459   dolacons = (gotstate) ? (cnfa->flags&HASLACONS) : 0;
460   sawlacons = 0;
461   while (dolacons) {    /* transitive closure */
462     dolacons = 0;
463     for (i = 0; i < d->nstates; i++)
464       if (ISBSET(d->work, i))
465         for (ca = cnfa->states[i]+1; ca->co != COLORLESS;
466                   ca++) {
467           if (ca->co <= cnfa->ncolors)
468             continue; /* NOTE CONTINUE */
469           sawlacons = 1;
470           if (ISBSET(d->work, ca->to))
471             continue; /* NOTE CONTINUE */
472           if (!lacon(v, cnfa, cp, ca->co))
473             continue; /* NOTE CONTINUE */
474           BSET(d->work, ca->to);
475           dolacons = 1;
476           if (ca->to == cnfa->post)
477             ispost = 1;
478           if (!cnfa->states[ca->to]->co)
479             noprogress = 0;
480           FDEBUG(("%d :> %d\n", i, ca->to));
481         }
482   }
483   if (!gotstate)
484     return NULL;
485   h = HASH(d->work, d->wordsper);
486 
487   /* next, is that in the cache? */
488   for (p = d->ssets, i = d->nssused; i > 0; p++, i--)
489     if (HIT(h, d->work, p, d->wordsper)) {
490       FDEBUG(("cached c%d\n", p - d->ssets));
491       break;      /* NOTE BREAK OUT */
492     }
493   if (i == 0) {   /* nope, need a new cache entry */
494     p = getvacant(v, d, cp, start);
495     assert(p != css);
496     for (i = 0; i < d->wordsper; i++)
497       p->states[i] = d->work[i];
498     p->hash = h;
499     p->flags = (ispost) ? POSTSTATE : 0;
500     if (noprogress)
501       p->flags |= NOPROGRESS;
502     /* lastseen to be dealt with by caller */
503   }
504 
505   if (!sawlacons) {   /* lookahead conds. always cache miss */
506     FDEBUG(("c%d[%d]->c%d\n", css - d->ssets, co, p - d->ssets));
507     css->outs[co] = p;
508     css->inchain[co] = p->ins;
509     p->ins.ss = css;
510     p->ins.co = (color)co;
511   }
512   return p;
513 }
static struct dfa* newdfa (struct vars * v, struct cnfa * cnfa, struct colormap * cm, struct smalldfa * small) [static]

Definition at line 261 of file rege_dfa.c.
References dfa::cm, dfa::cnfa, dfa::cptsmalloced, smalldfa::dfa, ERR, FEWCOLORS, freedfa(), smalldfa::incarea, dfa::incarea, dfa::lastnopr, dfa::lastpost, MALLOC, dfa::mallocarea, dfa::ncolors, cnfa::ncolors, dfa::nssets, dfa::nssused, dfa::nstates, cnfa::nstates, NULL, smalldfa::outsarea, dfa::outsarea, REG_ESPACE, REG_SMALL, dfa::search, size_t(), smalldfa::ssets, dfa::ssets, smalldfa::statesarea, dfa::statesarea, UBITS, dfa::wordsper, WORK, and dfa::work.
Referenced by altdissect(), caltdissect(), ccondissect(), cfind(), condissect(), crevdissect(), find(), and lacon().266 {
267   struct dfa *d;
268   size_t nss = cnfa->nstates * 2;
269   int wordsper = (cnfa->nstates + UBITS - 1) / UBITS;
270   struct smalldfa *smallwas = small;
271 
272   assert(cnfa != NULL && cnfa->nstates != 0);
273 
274   if (nss <= FEWSTATES && cnfa->ncolors <= FEWCOLORS) {
275     assert(wordsper == 1);
276     if (small == NULL) {
277       small = (struct smalldfa *)MALLOC(
278             sizeof(struct smalldfa));
279       if (small == NULL) {
280         ERR(REG_ESPACE);
281         return NULL;
282       }
283     }
284     d = &small->dfa;
285     d->ssets = small->ssets;
286     d->statesarea = small->statesarea;
287     d->work = &d->statesarea[nss];
288     d->outsarea = small->outsarea;
289     d->incarea = small->incarea;
290     d->cptsmalloced = 0;
291     d->mallocarea = (smallwas == NULL) ? (char *)small : NULL;
292   } else {
293     d = (struct dfa *)MALLOC(sizeof(struct dfa));
294     if (d == NULL) {
295       ERR(REG_ESPACE);
296       return NULL;
297     }
298     d->ssets = (struct sset *)MALLOC(nss * sizeof(struct sset));
299     d->statesarea = (unsigned *)MALLOC((nss+WORK) * wordsper *
300               sizeof(unsigned));
301     d->work = &d->statesarea[nss * wordsper];
302     d->outsarea = (struct sset **)MALLOC(nss * cnfa->ncolors *
303               sizeof(struct sset *));
304     d->incarea = (struct arcp *)MALLOC(nss * cnfa->ncolors *
305               sizeof(struct arcp));
306     d->cptsmalloced = 1;
307     d->mallocarea = (char *)d;
308     if (d->ssets == NULL || d->statesarea == NULL ||
309         d->outsarea == NULL || d->incarea == NULL) {
310       freedfa(d);
311       ERR(REG_ESPACE);
312       return NULL;
313     }
314   }
315 
316   d->nssets = (v->eflags&REG_SMALL) ? 7 : nss;
317   d->nssused = 0;
318   d->nstates = cnfa->nstates;
319   d->ncolors = cnfa->ncolors;
320   d->wordsper = wordsper;
321   d->cnfa = cnfa;
322   d->cm = cm;
323   d->lastpost = NULL;
324   d->lastnopr = NULL;
325   d->search = d->ssets;
326 
327   /* initialization of sset fields is done as needed */
328 
329   return d;
330 }
static struct sset* pickss (struct vars * v, struct dfa * d, chr * cp, chr * start) [static]

Definition at line 621 of file rege_dfa.c.
References arcp::co, FDEBUG, sset::flags, dfa::incarea, sset::inchain, sset::ins, sset::lastseen, LOCKED, dfa::ncolors, dfa::nssets, dfa::nssused, NULL, sset::outs, dfa::outsarea, dfa::search, arcp::ss, dfa::ssets, sset::states, dfa::statesarea, WHITE, and dfa::wordsper.
Referenced by getvacant().626 {
627   int i;
628   struct sset *ss;
629   struct sset *end;
630   chr *ancient;
631 
632   /* shortcut for cases where cache isn't full */
633   if (d->nssused < d->nssets) {
634     i = d->nssused;
635     d->nssused++;
636     ss = &d->ssets[i];
637     FDEBUG(("new c%d\n", i));
638     /* set up innards */
639     ss->states = &d->statesarea[i * d->wordsper];
640     ss->flags = 0;
641     ss->ins.ss = NULL;
642     ss->ins.co = WHITE;   /* give it some value */
643     ss->outs = &d->outsarea[i * d->ncolors];
644     ss->inchain = &d->incarea[i * d->ncolors];
645     for (i = 0; i < d->ncolors; i++) {
646       ss->outs[i] = NULL;
647       ss->inchain[i].ss = NULL;
648     }
649     return ss;
650   }
651 
652   /* look for oldest, or old enough anyway */
653   if (cp - start > d->nssets*2/3)   /* oldest 33% are expendable */
654     ancient = cp - d->nssets*2/3;
655   else
656     ancient = start;
657   for (ss = d->search, end = &d->ssets[d->nssets]; ss < end; ss++)
658     if ((ss->lastseen == NULL || ss->lastseen < ancient) &&
659               !(ss->flags&LOCKED)) {
660       d->search = ss + 1;
661       FDEBUG(("replacing c%d\n", ss - d->ssets));
662       return ss;
663     }
664   for (ss = d->ssets, end = d->search; ss < end; ss++)
665     if ((ss->lastseen == NULL || ss->lastseen < ancient) &&
666               !(ss->flags&LOCKED)) {
667       d->search = ss + 1;
668       FDEBUG(("replacing c%d\n", ss - d->ssets));
669       return ss;
670     }
671 
672   /* nobody's old enough?!? -- something's really wrong */
673   FDEBUG(("can't find victim to replace!\n"));
674   assert(NOTREACHED);
675   ERR(REG_ASSERT);
676   return d->ssets;
677 }
static chr* shortest (struct vars * v, struct dfa * d, chr * start, chr * min, chr * max, chr ** coldp, int * hitstopp) [static]

Definition at line 137 of file rege_dfa.c.
References cnfa::bos, dfa::cm, dfa::cnfa, cnfa::eos, FDEBUG, sset::flags, initialize(), lastcold(), sset::lastseen, miss(), NULL, sset::outs, POSTSTATE, REG_FTRACE, REG_NOTBOL, REG_NOTEOL, and dfa::ssets.
Referenced by cfindloop(), condissect(), crevdissect(), and find().145 {
146   chr *cp;
147   chr *realmin = (min == v->stop) ? min : min + 1;
148   chr *realmax = (max == v->stop) ? max : max + 1;
149   color co;
150   struct sset *css;
151   struct sset *ss;
152   struct colormap *cm = d->cm;
153 
154   /* initialize */
155   css = initialize(v, d, start);
156   cp = start;
157   if (hitstopp != NULL)
158     *hitstopp = 0;
159 
160   /* startup */
161   FDEBUG(("--- startup ---\n"));
162   if (cp == v->start) {
163     co = d->cnfa->bos[(v->eflags&REG_NOTBOL) ? 0 : 1];
164     FDEBUG(("color %ld\n", (long)co));
165   } else {
166     co = GETCOLOR(cm, *(cp - 1));
167     FDEBUG(("char %c, color %ld\n", (char)*(cp-1), (long)co));
168   }
169   css = miss(v, d, css, co, cp, start);
170   if (css == NULL)
171     return NULL;
172   css->lastseen = cp;
173   ss = css;
174 
175   /* main loop */
176   if (v->eflags&REG_FTRACE)
177     while (cp < realmax) {
178       FDEBUG(("--- at c%d ---\n", css - d->ssets));
179       co = GETCOLOR(cm, *cp);
180       FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
181       ss = css->outs[co];
182       if (ss == NULL) {
183         ss = miss(v, d, css, co, cp+1, start);
184         if (ss == NULL)
185           break;  /* NOTE BREAK OUT */
186       }
187       cp++;
188       ss->lastseen = cp;
189       css = ss;
190       if ((ss->flags&POSTSTATE) && cp >= realmin)
191         break;    /* NOTE BREAK OUT */
192     }
193   else
194     while (cp < realmax) {
195       co = GETCOLOR(cm, *cp);
196       ss = css->outs[co];
197       if (ss == NULL) {
198         ss = miss(v, d, css, co, cp+1, start);
199         if (ss == NULL)
200           break;  /* NOTE BREAK OUT */
201       }
202       cp++;
203       ss->lastseen = cp;
204       css = ss;
205       if ((ss->flags&POSTSTATE) && cp >= realmin)
206         break;    /* NOTE BREAK OUT */
207     }
208 
209   if (ss == NULL)
210     return NULL;
211 
212   if (coldp != NULL)  /* report last no-progress state set, if any */
213     *coldp = lastcold(v, d);
214 
215   if ((ss->flags&POSTSTATE) && cp > min) {
216     assert(cp >= realmin);
217     cp--;
218   } else if (cp == v->stop && max == v->stop) {
219     co = d->cnfa->eos[(v->eflags&REG_NOTEOL) ? 0 : 1];
220     FDEBUG(("color %ld\n", (long)co));
221     ss = miss(v, d, css, co, cp, start);
222     /* match might have ended at eol */
223     if ((ss == NULL || !(ss->flags&POSTSTATE)) && hitstopp != NULL)
224       *hitstopp = 1;
225   }
226 
227   if (ss == NULL || !(ss->flags&POSTSTATE))
228     return NULL;
229 
230   return cp;
231 }

generic/regerror.c File Reference
#include "regguts.h"
#include "regerrs.h"
Classes
struct rerr
Functions
size_t regerror (int code, CONST regex_t *preg, char *errbuf, size_t errbuf_size)
Variables
static char unk [] = "*** unknown regex error code 0x%x ***"
static struct rerr rerrs []

Function Documentation
size_t regerror (int code, CONST regex_t * preg, char * errbuf, size_t errbuf_size)

Definition at line 72 of file regerror.c.73                :    /* convert number to name */
74     icode = atoi(errbuf); /* not our problem if this fails */
75     for (r = rerrs; r->code >= 0; r++)
76       if (r->code == icode)
77         break;
78     if (r->code >= 0)
79       msg = r->name;
80     else {      /* unknown; tell him the number */
81       sprintf(convbuf, "REG_%u", (unsigned)icode);
82       msg = convbuf;
83     }
84     break;
85   default:    /* a real, normal error code */
86     for (r = rerrs; r->code >= 0; r++)
87       if (r->code == code)
88         break;
89     if (r->code >= 0)
90       msg = r->explain;
91     else {      /* unknown; say so */
92       sprintf(convbuf, unk, code);
93       msg = convbuf;
94     }
95     break;
96   }
97 
98   len = strlen(msg) + 1;    /* space needed, including NUL */
99   if (errbuf_size > 0) {
100     if (errbuf_size > len)
101       strcpy(errbuf, msg);
102     else {      /* truncate to fit */
103       strncpy(errbuf, msg, errbuf_size-1);
104       errbuf[errbuf_size-1] = '\0';
105     }
106   }
107 
108   return len;
109 }
110 }

Variable Documentation
struct rerr  rerrs[] [static]
char unk[] = "*** unknown regex error code 0x%x ***" [static]

Definition at line 35 of file regerror.c.

generic/regerrs.h File Reference

generic/regex.h File Reference
Classes
struct regex_t
struct regmatch_t
struct rm_detail_t
Defines
#define _REGEX_H_
#define __REG_WIDE_T  Tcl_UniChar
#define __REG_REGOFF_T  long
#define __REG_VOID_T  VOID
#define __REG_CONST  CONST
#define __REG_WIDE_COMPILE  TclReComp
#define __REG_WIDE_EXEC  TclReExec
#define __REG_NOFRONT
#define __REG_NOCHAR
#define regfree  TclReFree
#define regerror  TclReError
#define REG_UBACKREF  000001
#define REG_ULOOKAHEAD  000002
#define REG_UBOUNDS  000004
#define REG_UBRACES  000010
#define REG_UBSALNUM  000020
#define REG_UPBOTCH  000040
#define REG_UBBS  000100
#define REG_UNONPOSIX  000200
#define REG_UUNSPEC  000400
#define REG_UUNPORT  001000
#define REG_ULOCALE  002000
#define REG_UEMPTYMATCH  004000
#define REG_UIMPOSSIBLE  010000
#define REG_USHORTEST  020000
#define REG_BASIC  000000
#define REG_EXTENDED  000001
#define REG_ADVF  000002
#define REG_ADVANCED  000003
#define REG_QUOTE  000004
#define REG_NOSPEC  REG_QUOTE
#define REG_ICASE  000010
#define REG_NOSUB  000020
#define REG_EXPANDED  000040
#define REG_NLSTOP  000100
#define REG_NLANCH  000200
#define REG_NEWLINE  000300
#define REG_PEND  000400
#define REG_EXPECT  001000
#define REG_BOSONLY  002000
#define REG_DUMP  004000
#define REG_FAKE  010000
#define REG_PROGRESS  020000
#define REG_NOTBOL  0001
#define REG_NOTEOL  0002
#define REG_STARTEND  0004
#define REG_FTRACE  0010
#define REG_MTRACE  0020
#define REG_SMALL  0040
#define REG_OKAY  0
#define REG_NOMATCH  1
#define REG_BADPAT  2
#define REG_ECOLLATE  3
#define REG_ECTYPE  4
#define REG_EESCAPE  5
#define REG_ESUBREG  6
#define REG_EBRACK  7
#define REG_EPAREN  8
#define REG_EBRACE  9
#define REG_BADBR  10
#define REG_ERANGE  11
#define REG_ESPACE  12
#define REG_BADRPT  13
#define REG_ASSERT  15
#define REG_INVARG  16
#define REG_MIXED  17
#define REG_BADOPT  18
#define REG_ATOI  101
#define REG_ITOA  102
Typedefs
typedef __REG_REGOFF_T regoff_t
typedef __REG_VOID_T re_void
Functions
int __REG_WIDE_COMPILE _ANSI_ARGS_ ((regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int))
int __REG_WIDE_EXEC _ANSI_ARGS_ ((regex_t *, __REG_CONST __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t[], int))
re_void regfree _ANSI_ARGS_ ((regex_t *))
size_t regerror _ANSI_ARGS_ ((int, __REG_CONST regex_t *, char *, size_t))

Define Documentation
#define __REG_CONST  CONST

Definition at line 114 of file regex.h.#define __REG_NOCHAR

Definition at line 119 of file regex.h.#define __REG_NOFRONT

Definition at line 118 of file regex.h.#define __REG_REGOFF_T  long

Definition at line 112 of file regex.h.#define __REG_VOID_T  VOID

Definition at line 113 of file regex.h.#define __REG_WIDE_COMPILE  TclReComp

Definition at line 116 of file regex.h.#define __REG_WIDE_EXEC  TclReExec

Definition at line 117 of file regex.h.#define __REG_WIDE_T  Tcl_UniChar

Definition at line 111 of file regex.h.#define _REGEX_H_

Definition at line 2 of file regex.h.#define REG_ADVANCED  000003

Definition at line 218 of file regex.h.
Referenced by compile(), lexstart(), parseqatom(), prefixes(), SetRegexpFromAny(), SplitMacPath(), Tcl_RegExpCompile(), TclpGetNativePathType(), TestregexpObjCmd(), and TestregexpXflags().#define REG_ADVF  000002

Definition at line 217 of file regex.h.
Referenced by compile(), lexescape(), lexstart(), next(), prefixes(), and TestregexpXflags().#define REG_ASSERT  15

Definition at line 291 of file regex.h.
Referenced by altdissect(), brackpart(), cdissect(), condissect(), dissect(), dovec(), next(), parseqatom(), and repeat().#define REG_ATOI  101

Definition at line 296 of file regex.h.#define REG_BADBR  10

Definition at line 287 of file regex.h.
Referenced by next(), parseqatom(), and scannum().#define REG_BADOPT  18

Definition at line 294 of file regex.h.
Referenced by prefixes().#define REG_BADPAT  2

Definition at line 279 of file regex.h.
Referenced by prefixes().#define REG_BADRPT  13

Definition at line 290 of file regex.h.
Referenced by next(), parseqatom(), and prefixes().#define REG_BASIC  000000

Definition at line 215 of file regex.h.#define REG_BOSONLY  002000

Definition at line 229 of file regex.h.
Referenced by next(), and TestregexpXflags().#define REG_DUMP  004000

Definition at line 230 of file regex.h.
Referenced by compile(), and TestregexpXflags().#define REG_EBRACE  9

Definition at line 286 of file regex.h.
Referenced by next().#define REG_EBRACK  7

Definition at line 284 of file regex.h.
Referenced by next().#define REG_ECOLLATE  3

Definition at line 280 of file regex.h.
Referenced by brackpart().#define REG_ECTYPE  4

Definition at line 281 of file regex.h.
Referenced by brackpart(), and cclass().#define REG_EESCAPE  5

Definition at line 282 of file regex.h.
Referenced by brenext(), lexdigits(), lexescape(), and next().#define REG_EPAREN  8

Definition at line 285 of file regex.h.
Referenced by parse(), and parseqatom().#define REG_ERANGE  11

Definition at line 288 of file regex.h.
Referenced by brackpart(), and range().#define REG_ESPACE  12

Definition at line 289 of file regex.h.
Referenced by allocarc(), cclass(), compact(), compile(), exec(), getcvec(), lacon(), moresubs(), newcolor(), newdfa(), newlacon(), newstate(), setcolor(), subblock(), and subre().#define REG_ESUBREG  6

Definition at line 283 of file regex.h.
Referenced by parseqatom().#define REG_EXPANDED  000040

Definition at line 223 of file regex.h.
Referenced by brenext(), compile(), lexstart(), next(), prefixes(), skip(), and TestregexpObjCmd().#define REG_EXPECT  001000

Definition at line 228 of file regex.h.
Referenced by cfind(), exec(), find(), TclRegExpRangeUniChar(), TestregexpObjCmd(), and TestregexpXflags().#define REG_EXTENDED  000001

Definition at line 216 of file regex.h.
Referenced by compile(), lexstart(), next(), parseqatom(), prefixes(), and TestregexpXflags().#define REG_FAKE  010000

Definition at line 231 of file regex.h.
Referenced by eclass(), and TestregexpXflags().#define REG_FTRACE  0010

Definition at line 253 of file regex.h.
Referenced by longest(), shortest(), and TestregexpXflags().#define REG_ICASE  000010

Definition at line 221 of file regex.h.
Referenced by brackpart(), compile(), onechr(), prefixes(), and TestregexpObjCmd().#define REG_INVARG  16

Definition at line 292 of file regex.h.
Referenced by compile(), and exec().#define REG_ITOA  102

Definition at line 297 of file regex.h.
Referenced by TclRegError().#define REG_MIXED  17

Definition at line 293 of file regex.h.
Referenced by exec().#define REG_MTRACE  0020

Definition at line 254 of file regex.h.
Referenced by TestregexpXflags().#define REG_NEWLINE  000300

Definition at line 226 of file regex.h.
Referenced by compile(), lexstart(), prefixes(), and TestregexpObjCmd().#define REG_NLANCH  000200

Definition at line 225 of file regex.h.
Referenced by compile(), parseqatom(), prefixes(), and TestregexpObjCmd().#define REG_NLSTOP  000100

Definition at line 224 of file regex.h.
Referenced by cbracket(), compile(), parseqatom(), prefixes(), and TestregexpObjCmd().#define REG_NOMATCH  1

Definition at line 278 of file regex.h.
Referenced by caltdissect(), cbrdissect(), ccondissect(), cfindloop(), crevdissect(), exec(), find(), and RegExpExecUniChar().#define REG_NOSPEC  REG_QUOTE

Definition at line 220 of file regex.h.#define REG_NOSUB  000020

Definition at line 222 of file regex.h.
Referenced by exec(), next(), and TestregexpXflags().#define REG_NOTBOL  0001

Definition at line 250 of file regex.h.
Referenced by longest(), shortest(), Tcl_RegExpExec(), and TestregexpXflags().#define REG_NOTEOL  0002

Definition at line 251 of file regex.h.
Referenced by longest(), shortest(), and TestregexpXflags().#define REG_OKAY  0

Definition at line 277 of file regex.h.
Referenced by cbrdissect(), ccondissect(), cdissect(), cfindloop(), CompileRegexp(), condissect(), crevdissect(), dissect(), exec(), find(), and RegExpExecUniChar().#define REG_PEND  000400

Definition at line 227 of file regex.h.
Referenced by regcomp().#define REG_PROGRESS  020000

Definition at line 232 of file regex.h.
Referenced by compile(), and TestregexpXflags().#define REG_QUOTE  000004

Definition at line 219 of file regex.h.
Referenced by compile(), lexstart(), prefixes(), and TestregexpXflags().#define REG_SMALL  0040

Definition at line 255 of file regex.h.
Referenced by newdfa(), and TestregexpXflags().#define REG_STARTEND  0004

Definition at line 252 of file regex.h.
Referenced by regexec().#define REG_UBACKREF  000001

Definition at line 169 of file regex.h.
Referenced by brenext(), exec(), lexescape(), and TclRegAbout().#define REG_UBBS  000100

Definition at line 175 of file regex.h.
Referenced by next(), and TclRegAbout().#define REG_UBOUNDS  000004

Definition at line 171 of file regex.h.
Referenced by brenext(), next(), and TclRegAbout().#define REG_UBRACES  000010

Definition at line 172 of file regex.h.
Referenced by next(), and TclRegAbout().#define REG_UBSALNUM  000020

Definition at line 173 of file regex.h.
Referenced by brenext(), next(), and TclRegAbout().#define REG_UEMPTYMATCH  004000

Definition at line 180 of file regex.h.
Referenced by analyze(), and TclRegAbout().#define REG_UIMPOSSIBLE  010000

Definition at line 181 of file regex.h.
Referenced by analyze(), exec(), and TclRegAbout().#define REG_ULOCALE  002000

Definition at line 179 of file regex.h.
Referenced by cbracket(), dovec(), element(), lexescape(), next(), and TclRegAbout().#define REG_ULOOKAHEAD  000002

Definition at line 170 of file regex.h.
Referenced by next(), and TclRegAbout().#define REG_UNONPOSIX  000200

Definition at line 176 of file regex.h.
Referenced by brenext(), lexescape(), next(), prefixes(), skip(), and TclRegAbout().#define REG_UPBOTCH  000040

Definition at line 174 of file regex.h.
Referenced by parseqatom(), and TclRegAbout().#define REG_USHORTEST  020000

Definition at line 182 of file regex.h.
Referenced by compile(), and TclRegAbout().#define REG_UUNPORT  001000

Definition at line 178 of file regex.h.
Referenced by brackpart(), lexescape(), and TclRegAbout().#define REG_UUNSPEC  000400

Definition at line 177 of file regex.h.
Referenced by brenext(), next(), parsebranch(), and TclRegAbout().#define regerror  TclReError

Definition at line 121 of file regex.h.#define regfree  TclReFree

Definition at line 120 of file regex.h.
Typedef Documentation
typedef __REG_VOID_T re_void

Definition at line 145 of file regex.h.typedef __REG_REGOFF_T regoff_t

Definition at line 135 of file regex.h.
Function Documentation
size_t regerror _ANSI_ARGS_ ((int, __REG_CONST regex_t *, char *, size_t))
re_void regfree _ANSI_ARGS_ ((regex_t *))
int __REG_WIDE_EXEC _ANSI_ARGS_ ((regex_t *, __REG_CONST __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t[], int))
int __REG_WIDE_COMPILE _ANSI_ARGS_ ((regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int))

generic/regexec.c File Reference
#include "regguts.h"
#include "rege_dfa.c"
Classes
struct arcp
struct sset
struct dfa
struct smalldfa
struct vars
Defines
#define HASH(bv, nw)  (((nw) == 1) ? *(bv) : hash(bv, nw))
#define HIT(h, bv, ss, nw)
#define STARTER  01
#define POSTSTATE  02
#define LOCKED  04
#define NOPROGRESS  010
#define WORK  1
#define FEWSTATES  20
#define FEWCOLORS  15
#define DOMALLOC  ((struct smalldfa *)NULL)
#define VISERR(vv)  ((vv)->err != 0)
#define ISERR()  VISERR(v)
#define VERR(vv, e)  (((vv)->err) ? (vv)->err : ((vv)->err = (e)))
#define ERR(e)  VERR(v, e)
#define NOERR()  {if (ISERR()) return v->err;}
#define OFF(p)  ((p) - v->start)
#define LOFF(p)  ((long)OFF(p))
#define LOCALMAT  20
#define LOCALMEM  40
#define UNTRIED  0
#define TRYING  1
#define TRIED  2
Functions
int exec _ANSI_ARGS_ ((regex_t *, CONST chr *, size_t, rm_detail_t *, size_t, regmatch_t[], int))
static int find _ANSI_ARGS_ ((struct vars *, struct cnfa *, struct colormap *))
static int cfindloop _ANSI_ARGS_ ((struct vars *, struct cnfa *, struct colormap *, struct dfa *, struct dfa *, chr **))
static VOID zapsubs _ANSI_ARGS_ ((regmatch_t *, size_t))
static VOID zapmem _ANSI_ARGS_ ((struct vars *, struct subre *))
static VOID subset _ANSI_ARGS_ ((struct vars *, struct subre *, chr *, chr *))
static chr *longest _ANSI_ARGS_ ((struct vars *, struct dfa *, chr *, chr *, int *))
static chr *shortest _ANSI_ARGS_ ((struct vars *, struct dfa *, chr *, chr *, chr *, chr **, int *))
static chr *lastcold _ANSI_ARGS_ ((struct vars *, struct dfa *))
static struct dfa *newdfa _ANSI_ARGS_ ((struct vars *, struct cnfa *, struct colormap *, struct smalldfa *))
static VOID freedfa _ANSI_ARGS_ ((struct dfa *))
static unsigned hash _ANSI_ARGS_ ((unsigned *, int))
static struct sset *initialize _ANSI_ARGS_ ((struct vars *, struct dfa *, chr *))
static struct sset *miss _ANSI_ARGS_ ((struct vars *, struct dfa *, struct sset *, pcolor, chr *, chr *))
static int lacon _ANSI_ARGS_ ((struct vars *, struct cnfa *, chr *, pcolor))
static struct sset *getvacant _ANSI_ARGS_ ((struct vars *, struct dfa *, chr *, chr *))
int exec (regex_t *re, CONST chr *string, size_t len, rm_detail_t *details, size_t nmatch, pmatch, int flags)
static int find (struct vars *v, struct cnfa *cnfa, struct colormap *cm)
static int cfind (struct vars *v, struct cnfa *cnfa, struct colormap *cm)
static int cfindloop (struct vars *v, struct cnfa *cnfa, struct colormap *cm, struct dfa *d, struct dfa *s, chr **coldp)
static VOID zapsubs (regmatch_t *p, size_t n)
static VOID zapmem (struct vars *v, struct subre *t)
static VOID subset (struct vars *v, struct subre *sub, chr *begin, chr *end)
static int dissect (struct vars *v, struct subre *t, chr *begin, chr *end)
static int condissect (struct vars *v, struct subre *t, chr *begin, chr *end)
static int altdissect (struct vars *v, struct subre *t, chr *begin, chr *end)
static int cdissect (struct vars *v, struct subre *t, chr *begin, chr *end)
static int ccondissect (struct vars *v, struct subre *t, chr *begin, chr *end)
static int crevdissect (struct vars *v, struct subre *t, chr *begin, chr *end)
static int cbrdissect (struct vars *v, struct subre *t, chr *begin, chr *end)
static int caltdissect (struct vars *v, struct subre *t, chr *begin, chr *end)

Define Documentation
#define DOMALLOC  ((struct smalldfa *)NULL)

Definition at line 91 of file regexec.c.
Referenced by caltdissect(), ccondissect(), and crevdissect().#define ERR(e)  VERR(v, e)

Definition at line 113 of file regexec.c.#define FEWCOLORS  15

Definition at line 83 of file regexec.c.
Referenced by newdfa().#define FEWSTATES  20

Definition at line 82 of file regexec.c.#define HASH(bv, nw)  (((nw) == 1) ? *(bv) : hash(bv, nw))

Definition at line 45 of file regexec.c.
Referenced by initialize().#define HIT(h, bv, ss, nw)
Value:((ss)->hash == (h) && ((nw) == 1 || \
    memcmp(VS(bv), VS((ss)->states), (nw)*sizeof(unsigned)) == 0))
Definition at line 46 of file regexec.c.#define ISERR()  VISERR(v)

Definition at line 111 of file regexec.c.#define LOCALMAT  20

Referenced by exec().#define LOCALMEM  40

Referenced by exec().#define LOCKED  04

Definition at line 51 of file regexec.c.
Referenced by getvacant(), initialize(), and pickss().#define LOFF(p)  ((long)OFF(p))

Definition at line 116 of file regexec.c.
Referenced by ccondissect(), cdissect(), cfindloop(), condissect(), crevdissect(), dissect(), and find().#define NOERR()  {if (ISERR()) return v->err;}

Definition at line 114 of file regexec.c.#define NOPROGRESS  010

Definition at line 52 of file regexec.c.
Referenced by getvacant(), initialize(), and lastcold().#define OFF(p)  ((p) - v->start)

Definition at line 115 of file regexec.c.
Referenced by cfind(), cfindloop(), find(), and subset().#define POSTSTATE  02

Definition at line 50 of file regexec.c.
Referenced by getvacant(), longest(), and shortest().#define STARTER  01

Definition at line 49 of file regexec.c.
Referenced by initialize().#define TRIED  2

Referenced by caltdissect().#define TRYING  1

Referenced by caltdissect().#define UNTRIED  0

Referenced by caltdissect().#define VERR(vv, e)  (((vv)->err) ? (vv)->err : ((vv)->err = (e)))

Definition at line 112 of file regexec.c.#define VISERR(vv)  ((vv)->err != 0)

Definition at line 110 of file regexec.c.#define WORK  1

Definition at line 79 of file regexec.c.
Referenced by newdfa().
Function Documentation
static struct sset* getvacant _ANSI_ARGS_ ((struct vars *, struct dfa *, chr *, chr *)) [static]
static int lacon _ANSI_ARGS_ ((struct vars *, struct cnfa *, chr *, pcolor)) [static]
static struct sset* miss _ANSI_ARGS_ ((struct vars *, struct dfa *, struct sset *, pcolor, chr *, chr *)) [static]
static struct sset* initialize _ANSI_ARGS_ ((struct vars *, struct dfa *, chr *)) [static]
static unsigned hash _ANSI_ARGS_ ((unsigned *, int)) [static]
static VOID freedfa _ANSI_ARGS_ ((struct dfa *)) [static]
static struct dfa* newdfa _ANSI_ARGS_ ((struct vars *, struct cnfa *, struct colormap *, struct smalldfa *)) [static]
static chr* lastcold _ANSI_ARGS_ ((struct vars *, struct dfa *)) [static]
static chr* shortest _ANSI_ARGS_ ((struct vars *, struct dfa *, chr *, chr *, chr *, chr **, int *)) [static]
static chr* longest _ANSI_ARGS_ ((struct vars *, struct dfa *, chr *, chr *, int *)) [static]
static VOID subset _ANSI_ARGS_ ((struct vars *, struct subre *, chr *, chr *)) [static]
static VOID zapmem _ANSI_ARGS_ ((struct vars *, struct subre *)) [static]
static VOID zapsubs _ANSI_ARGS_ ((regmatch_t *, size_t)) [static]
static int cfindloop _ANSI_ARGS_ ((struct vars *, struct cnfa *, struct colormap *, struct dfa *, struct dfa *, chr **)) [static]
static int find _ANSI_ARGS_ ((struct vars *, struct cnfa *, struct colormap *)) [static]
int exec _ANSI_ARGS_ ((regex_t *, CONST chr *, size_t, rm_detail_t *, size_t, regmatch_t[], int))
static int altdissect (struct vars * v, struct subre * t, chr * begin, chr * end) [static]

Definition at line 657 of file regexec.c.
References subre::cnfa, dissect(), freedfa(), ISERR, subre::left, longest(), MDEBUG, newdfa(), cnfa::nstates, NULL, subre::op, REG_ASSERT, and subre::right.
Referenced by dissect().662 {
663   struct dfa *d;
664   int i;
665 
666   assert(t != NULL);
667   assert(t->op == '|');
668 
669   for (i = 0; t != NULL; t = t->right, i++) {
670     MDEBUG(("trying %dth\n", i));
671     assert(t->left != NULL && t->left->cnfa.nstates > 0);
672     d = newdfa(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
673     if (ISERR())
674       return v->err;
675     if (longest(v, d, begin, end, (int *)NULL) == end) {
676       MDEBUG(("success\n"));
677       freedfa(d);
678       return dissect(v, t->left, begin, end);
679     }
680     freedfa(d);
681   }
682   return REG_ASSERT;  /* none of them matched?!? */
683 }
static int caltdissect (struct vars * v, struct subre * t, chr * begin, chr * end) [static]

Definition at line 993 of file regexec.c.
References cdissect(), subre::cnfa, DOMALLOC, freedfa(), ISERR, subre::left, longest(), MDEBUG, newdfa(), NULL, subre::op, REG_NOMATCH, subre::retry, subre::right, TRIED, TRYING, and UNTRIED.
Referenced by cdissect().998 {
999   struct dfa *d;
1000   int er;
1001 # define  UNTRIED 0 /* not yet tried at all */
1002 # define  TRYING  1 /* top matched, trying submatches */
1003 # define  TRIED 2 /* top didn't match or submatches exhausted */
1004 
1005   if (t == NULL)
1006     return REG_NOMATCH;
1007   assert(t->op == '|');
1008   if (v->mem[t->retry] == TRIED)
1009     return caltdissect(v, t->right, begin, end);
1010 
1011   MDEBUG(("calt n%d\n", t->retry));
1012   assert(t->left != NULL);
1013 
1014   if (v->mem[t->retry] == UNTRIED) {
1015     d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
1016     if (ISERR())
1017       return v->err;
1018     if (longest(v, d, begin, end, (int *)NULL) != end) {
1019       freedfa(d);
1020       v->mem[t->retry] = TRIED;
1021       return caltdissect(v, t->right, begin, end);
1022     }
1023     freedfa(d);
1024     MDEBUG(("calt matched\n"));
1025     v->mem[t->retry] = TRYING;
1026   }
1027 
1028   er = cdissect(v, t->left, begin, end);
1029   if (er != REG_NOMATCH)
1030     return er;
1031 
1032   v->mem[t->retry] = TRIED;
1033   return caltdissect(v, t->right, begin, end);
1034 }
static int cbrdissect (struct vars * v, struct subre * t, chr * begin, chr * end) [static]

Definition at line 926 of file regexec.c.
References INFINITY, subre::max, MDEBUG, subre::min, NULL, subre::op, REG_NOMATCH, REG_OKAY, subre::retry, size_t(), and subre::subno.
Referenced by cdissect().931 {
932   int i;
933   int n = t->subno;
934   size_t len;
935   chr *paren;
936   chr *p;
937   chr *stop;
938   int min = t->min;
939   int max = t->max;
940 
941   assert(t != NULL);
942   assert(t->op == 'b');
943   assert(n >= 0);
944   assert((size_t)n < v->nmatch);
945 
946   MDEBUG(("cbackref n%d %d{%d-%d}\n", t->retry, n, min, max));
947 
948   if (v->pmatch[n].rm_so == -1)
949     return REG_NOMATCH;
950   paren = v->start + v->pmatch[n].rm_so;
951   len = v->pmatch[n].rm_eo - v->pmatch[n].rm_so;
952 
953   /* no room to maneuver -- retries are pointless */
954   if (v->mem[t->retry])
955     return REG_NOMATCH;
956   v->mem[t->retry] = 1;
957 
958   /* special-case zero-length string */
959   if (len == 0) {
960     if (begin == end)
961       return REG_OKAY;
962     return REG_NOMATCH;
963   }
964 
965   /* and too-short string */
966   assert(end >= begin);
967   if ((size_t)(end - begin) < len)
968     return REG_NOMATCH;
969   stop = end - len;
970 
971   /* count occurrences */
972   i = 0;
973   for (p = begin; p <= stop && (i < max || max == INFINITY); p += len) {
974     if ((*v->g->compare)(paren, p, len) != 0)
975         break;
976     i++;
977   }
978   MDEBUG(("cbackref found %d\n", i));
979 
980   /* and sort it out */
981   if (p != end)     /* didn't consume all of it */
982     return REG_NOMATCH;
983   if (min <= i && (i <= max || max == INFINITY))
984     return REG_OKAY;
985   return REG_NOMATCH;   /* out of range */
986 }
static int ccondissect (struct vars * v, struct subre * t, chr * begin, chr * end) [static]

Definition at line 741 of file regexec.c.
References cdissect(), subre::cnfa, crevdissect(), DOMALLOC, subre::flags, freedfa(), ISERR, subre::left, LOFF, longest(), MDEBUG, newdfa(), cnfa::nstates, NULL, subre::op, REG_NOMATCH, REG_OKAY, subre::retry, subre::right, SHORTER, and zapmem().
Referenced by cdissect().746 {
747   struct dfa *d;
748   struct dfa *d2;
749   chr *mid;
750   int er;
751 
752   assert(t->op == '.');
753   assert(t->left != NULL && t->left->cnfa.nstates > 0);
754   assert(t->right != NULL && t->right->cnfa.nstates > 0);
755 
756   if (t->left->flags&SHORTER)   /* reverse scan */
757     return crevdissect(v, t, begin, end);
758 
759   d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
760   if (ISERR())
761     return v->err;
762   d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, DOMALLOC);
763   if (ISERR()) {
764     freedfa(d);
765     return v->err;
766   }
767   MDEBUG(("cconcat %d\n", t->retry));
768 
769   /* pick a tentative midpoint */
770   if (v->mem[t->retry] == 0) {
771     mid = longest(v, d, begin, end, (int *)NULL);
772     if (mid == NULL) {
773       freedfa(d);
774       freedfa(d2);
775       return REG_NOMATCH;
776     }
777     MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
778     v->mem[t->retry] = (mid - begin) + 1;
779   } else {
780     mid = begin + (v->mem[t->retry] - 1);
781     MDEBUG(("working midpoint %ld\n", LOFF(mid)));
782   }
783 
784   /* iterate until satisfaction or failure */
785   for (;;) {
786     /* try this midpoint on for size */
787     er = cdissect(v, t->left, begin, mid);
788     if (er == REG_OKAY &&
789         longest(v, d2, mid, end, (int *)NULL) == end &&
790         (er = cdissect(v, t->right, mid, end)) == 
791                 REG_OKAY)
792       break;      /* NOTE BREAK OUT */
793     if (er != REG_OKAY && er != REG_NOMATCH) {
794       freedfa(d);
795       freedfa(d2);
796       return er;
797     }
798 
799     /* that midpoint didn't work, find a new one */
800     if (mid == begin) {
801       /* all possibilities exhausted */
802       MDEBUG(("%d no midpoint\n", t->retry));
803       freedfa(d);
804       freedfa(d2);
805       return REG_NOMATCH;
806     }
807     mid = longest(v, d, begin, mid-1, (int *)NULL);
808     if (mid == NULL) {
809       /* failed to find a new one */
810       MDEBUG(("%d failed midpoint\n", t->retry));
811       freedfa(d);
812       freedfa(d2);
813       return REG_NOMATCH;
814     }
815     MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
816     v->mem[t->retry] = (mid - begin) + 1;
817     zapmem(v, t->left);
818     zapmem(v, t->right);
819   }
820 
821   /* satisfaction */
822   MDEBUG(("successful\n"));
823   freedfa(d);
824   freedfa(d2);
825   return REG_OKAY;
826 }
static int cdissect (struct vars * v, struct subre * t, chr * begin, chr * end) [static]

Definition at line 692 of file regexec.c.
References caltdissect(), cbrdissect(), ccondissect(), subre::left, LOFF, MDEBUG, NULL, subre::op, REG_ASSERT, REG_OKAY, subre::right, subre::subno, and subset().
Referenced by caltdissect(), ccondissect(), cfindloop(), and crevdissect().697 {
698   int er;
699 
700   assert(t != NULL);
701   MDEBUG(("cdissect %ld-%ld %c\n", LOFF(begin), LOFF(end), t->op));
702 
703   switch (t->op) {
704   case '=':   /* terminal node */
705     assert(t->left == NULL && t->right == NULL);
706     return REG_OKAY;  /* no action, parent did the work */
707     break;
708   case '|':   /* alternation */
709     assert(t->left != NULL);
710     return caltdissect(v, t, begin, end);
711     break;
712   case 'b':   /* back ref -- shouldn't be calling us! */
713     assert(t->left == NULL && t->right == NULL);
714     return cbrdissect(v, t, begin, end);
715     break;
716   case '.':   /* concatenation */
717     assert(t->left != NULL && t->right != NULL);
718     return ccondissect(v, t, begin, end);
719     break;
720   case '(':   /* capturing */
721     assert(t->left != NULL && t->right == NULL);
722     assert(t->subno > 0);
723     er = cdissect(v, t->left, begin, end);
724     if (er == REG_OKAY)
725       subset(v, t, begin, end);
726     return er;
727     break;
728   default:
729     return REG_ASSERT;
730     break;
731   }
732 }
static int cfind (struct vars * v, struct cnfa * cnfa, struct colormap * cm) [static]

Definition at line 345 of file regexec.c.
References cfindloop(), dfa::cm, dfa::cnfa, freedfa(), ISERR, newdfa(), NOERR, NULL, OFF, and REG_EXPECT.
Referenced by exec().349 {
350   struct dfa *s;
351   struct dfa *d;
352   chr *cold = NULL; /* silence gcc 4 warning */
353   int ret;
354 
355   s = newdfa(v, &v->g->search, cm, &v->dfa1);
356   NOERR();
357   d = newdfa(v, cnfa, cm, &v->dfa2);
358   if (ISERR()) {
359     assert(d == NULL);
360     freedfa(s);
361     return v->err;
362   }
363 
364   ret = cfindloop(v, cnfa, cm, d, s, &cold);
365 
366   freedfa(d);
367   freedfa(s);
368   NOERR();
369   if (v->g->cflags&REG_EXPECT) {
370     assert(v->details != NULL);
371     if (cold != NULL)
372       v->details->rm_extend.rm_so = OFF(cold);
373     else
374       v->details->rm_extend.rm_so = OFF(v->stop);
375     v->details->rm_extend.rm_eo = OFF(v->stop); /* unknown */
376   }
377   return ret;
378 }
static int cfindloop (struct vars * v, struct cnfa * cnfa, struct colormap * cm, struct dfa * d, struct dfa * s, chr ** coldp) [static]

Definition at line 386 of file regexec.c.
References cdissect(), ERR, LOFF, longest(), MDEBUG, NULL, OFF, REG_NOMATCH, REG_OKAY, SHORTER, shortest(), zapmem(), and zapsubs().
Referenced by cfind().393 {
394   chr *begin;
395   chr *end;
396   chr *cold;
397   chr *open;    /* open and close of range of possible starts */
398   chr *close;
399   chr *estart;
400   chr *estop;
401   int er;
402   int shorter = v->g->tree->flags&SHORTER;
403   int hitend;
404 
405   assert(d != NULL && s != NULL);
406   cold = NULL;
407   close = v->start;
408   do {
409     MDEBUG(("\ncsearch at %ld\n", LOFF(close)));
410     close = shortest(v, s, close, close, v->stop, &cold, (int *)NULL);
411     if (close == NULL)
412       break;        /* NOTE BREAK */
413     assert(cold != NULL);
414     open = cold;
415     cold = NULL;
416     MDEBUG(("cbetween %ld and %ld\n", LOFF(open), LOFF(close)));
417     for (begin = open; begin <= close; begin++) {
418       MDEBUG(("\ncfind trying at %ld\n", LOFF(begin)));
419       estart = begin;
420       estop = v->stop;
421       for (;;) {
422         if (shorter)
423           end = shortest(v, d, begin, estart,
424             estop, (chr **)NULL, &hitend);
425         else
426           end = longest(v, d, begin, estop,
427                 &hitend);
428         if (hitend && cold == NULL)
429           cold = begin;
430         if (end == NULL)
431           break;    /* NOTE BREAK OUT */
432         MDEBUG(("tentative end %ld\n", LOFF(end)));
433         zapsubs(v->pmatch, v->nmatch);
434         zapmem(v, v->g->tree);
435         er = cdissect(v, v->g->tree, begin, end);
436         if (er == REG_OKAY) {
437           if (v->nmatch > 0) {
438             v->pmatch[0].rm_so = OFF(begin);
439             v->pmatch[0].rm_eo = OFF(end);
440           }
441           *coldp = cold;
442           return REG_OKAY;
443         }
444         if (er != REG_NOMATCH) {
445           ERR(er);
446           return er;
447         }
448         if ((shorter) ? end == estop : end == begin) {
449           /* no point in trying again */
450           *coldp = cold;
451           return REG_NOMATCH;
452         }
453         /* go around and try again */
454         if (shorter)
455           estart = end + 1;
456         else
457           estop = end - 1;
458       }
459     }
460   } while (close < v->stop);
461 
462   *coldp = cold;
463   return REG_NOMATCH;
464 }
static int condissect (struct vars * v, struct subre * t, chr * begin, chr * end) [static]

Definition at line 578 of file regexec.c.
References subre::cnfa, dissect(), subre::flags, freedfa(), ISERR, subre::left, LOFF, longest(), MDEBUG, newdfa(), NOERR, cnfa::nstates, NULL, subre::op, REG_ASSERT, REG_OKAY, subre::right, SHORTER, and shortest().
Referenced by dissect().583 {
584   struct dfa *d;
585   struct dfa *d2;
586   chr *mid;
587   int i;
588   int shorter = (t->left->flags&SHORTER) ? 1 : 0;
589   chr *stop = (shorter) ? end : begin;
590 
591   assert(t->op == '.');
592   assert(t->left != NULL && t->left->cnfa.nstates > 0);
593   assert(t->right != NULL && t->right->cnfa.nstates > 0);
594 
595   d = newdfa(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
596   NOERR();
597   d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, &v->dfa2);
598   if (ISERR()) {
599     assert(d2 == NULL);
600     freedfa(d);
601     return v->err;
602   }
603 
604   /* pick a tentative midpoint */
605   if (shorter)
606     mid = shortest(v, d, begin, begin, end, (chr **)NULL,
607                 (int *)NULL);
608   else
609     mid = longest(v, d, begin, end, (int *)NULL);
610   if (mid == NULL) {
611     freedfa(d);
612     freedfa(d2);
613     return REG_ASSERT;
614   }
615   MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
616 
617   /* iterate until satisfaction or failure */
618   while (longest(v, d2, mid, end, (int *)NULL) != end) {
619     /* that midpoint didn't work, find a new one */
620     if (mid == stop) {
621       /* all possibilities exhausted! */
622       MDEBUG(("no midpoint!\n"));
623       freedfa(d);
624       freedfa(d2);
625       return REG_ASSERT;
626     }
627     if (shorter)
628       mid = shortest(v, d, begin, mid+1, end, (chr **)NULL,
629                 (int *)NULL);
630     else
631       mid = longest(v, d, begin, mid-1, (int *)NULL);
632     if (mid == NULL) {
633       /* failed to find a new one! */
634       MDEBUG(("failed midpoint!\n"));
635       freedfa(d);
636       freedfa(d2);
637       return REG_ASSERT;
638     }
639     MDEBUG(("new midpoint %ld\n", LOFF(mid)));
640   }
641 
642   /* satisfaction */
643   MDEBUG(("successful\n"));
644   freedfa(d);
645   freedfa(d2);
646   i = dissect(v, t->left, begin, mid);
647   if (i != REG_OKAY)
648     return i;
649   return dissect(v, t->right, mid, end);
650 }
static int crevdissect (struct vars * v, struct subre * t, chr * begin, chr * end) [static]

Definition at line 835 of file regexec.c.
References cdissect(), subre::cnfa, DOMALLOC, subre::flags, freedfa(), ISERR, subre::left, LOFF, longest(), MDEBUG, newdfa(), cnfa::nstates, NULL, subre::op, REG_NOMATCH, REG_OKAY, subre::retry, subre::right, SHORTER, shortest(), and zapmem().
Referenced by ccondissect().840 {
841   struct dfa *d;
842   struct dfa *d2;
843   chr *mid;
844   int er;
845 
846   assert(t->op == '.');
847   assert(t->left != NULL && t->left->cnfa.nstates > 0);
848   assert(t->right != NULL && t->right->cnfa.nstates > 0);
849   assert(t->left->flags&SHORTER);
850 
851   /* concatenation -- need to split the substring between parts */
852   d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
853   if (ISERR())
854     return v->err;
855   d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, DOMALLOC);
856   if (ISERR()) {
857     freedfa(d);
858     return v->err;
859   }
860   MDEBUG(("crev %d\n", t->retry));
861 
862   /* pick a tentative midpoint */
863   if (v->mem[t->retry] == 0) {
864     mid = shortest(v, d, begin, begin, end, (chr **)NULL, (int *)NULL);
865     if (mid == NULL) {
866       freedfa(d);
867       freedfa(d2);
868       return REG_NOMATCH;
869     }
870     MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
871     v->mem[t->retry] = (mid - begin) + 1;
872   } else {
873     mid = begin + (v->mem[t->retry] - 1);
874     MDEBUG(("working midpoint %ld\n", LOFF(mid)));
875   }
876 
877   /* iterate until satisfaction or failure */
878   for (;;) {
879     /* try this midpoint on for size */
880     er = cdissect(v, t->left, begin, mid);
881     if (er == REG_OKAY &&
882         longest(v, d2, mid, end, (int *)NULL) == end &&
883         (er = cdissect(v, t->right, mid, end)) == 
884                 REG_OKAY)
885       break;      /* NOTE BREAK OUT */
886     if (er != REG_OKAY && er != REG_NOMATCH) {
887       freedfa(d);
888       freedfa(d2);
889       return er;
890     }
891 
892     /* that midpoint didn't work, find a new one */
893     if (mid == end) {
894       /* all possibilities exhausted */
895       MDEBUG(("%d no midpoint\n", t->retry));
896       freedfa(d);
897       freedfa(d2);
898       return REG_NOMATCH;
899     }
900     mid = shortest(v, d, begin, mid+1, end, (chr **)NULL, (int *)NULL);
901     if (mid == NULL) {
902       /* failed to find a new one */
903       MDEBUG(("%d failed midpoint\n", t->retry));
904       freedfa(d);
905       freedfa(d2);
906       return REG_NOMATCH;
907     }
908     MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
909     v->mem[t->retry] = (mid - begin) + 1;
910     zapmem(v, t->left);
911     zapmem(v, t->right);
912   }
913 
914   /* satisfaction */
915   MDEBUG(("successful\n"));
916   freedfa(d);
917   freedfa(d2);
918   return REG_OKAY;
919 }
static int dissect (struct vars * v, struct subre * t, chr * begin, chr * end) [static]

Definition at line 536 of file regexec.c.
References altdissect(), condissect(), subre::left, LOFF, MDEBUG, NULL, subre::op, REG_ASSERT, REG_OKAY, subre::right, subre::subno, and subset().
Referenced by altdissect(), condissect(), and find().541 {
542   assert(t != NULL);
543   MDEBUG(("dissect %ld-%ld\n", LOFF(begin), LOFF(end)));
544 
545   switch (t->op) {
546   case '=':   /* terminal node */
547     assert(t->left == NULL && t->right == NULL);
548     return REG_OKAY;  /* no action, parent did the work */
549     break;
550   case '|':   /* alternation */
551     assert(t->left != NULL);
552     return altdissect(v, t, begin, end);
553     break;
554   case 'b':   /* back ref -- shouldn't be calling us! */
555     return REG_ASSERT;
556     break;
557   case '.':   /* concatenation */
558     assert(t->left != NULL && t->right != NULL);
559     return condissect(v, t, begin, end);
560     break;
561   case '(':   /* capturing */
562     assert(t->left != NULL && t->right == NULL);
563     assert(t->subno > 0);
564     subset(v, t, begin, end);
565     return dissect(v, t->left, begin, end);
566     break;
567   default:
568     return REG_ASSERT;
569     break;
570   }
571 }
int exec (regex_t * re, CONST chr * string, size_t len, rm_detail_t * details, size_t nmatch, pmatch, int flags)

Definition at line 164 of file regexec.c.
References cfind(), guts::cflags, guts::cmap, subre::cnfa, vars::details, vars::eflags, vars::err, find(), FREE, vars::g, guts::info, LOCALMAT, LOCALMEM, MALLOC, vars::mem, vars::nmatch, guts::nsub, guts::ntree, NULL, vars::pmatch, vars::re, REG_ESPACE, REG_EXPECT, REG_INVARG, REG_MIXED, REG_NOMATCH, REG_NOSUB, REG_OKAY, REG_UBACKREF, REG_UIMPOSSIBLE, REMAGIC, size_t(), vars::start, vars::stop, guts::tree, VS, and zapsubs().172 {
173   struct vars var;
174   register struct vars *v = &var;
175   int st;
176   size_t n;
177   int backref;
178 # define  LOCALMAT  20
179   regmatch_t mat[LOCALMAT];
180 # define  LOCALMEM  40
181   regoff_t mem[LOCALMEM];
182 
183   /* sanity checks */
184   if (re == NULL || string == NULL || re->re_magic != REMAGIC)
185     return REG_INVARG;
186   if (re->re_csize != sizeof(chr))
187     return REG_MIXED;
188 
189   /* setup */
190   v->re = re;
191   v->g = (struct guts *)re->re_guts;
192   if ((v->g->cflags&REG_EXPECT) && details == NULL)
193     return REG_INVARG;
194   if (v->g->info&REG_UIMPOSSIBLE)
195     return REG_NOMATCH;
196   backref = (v->g->info&REG_UBACKREF) ? 1 : 0;
197   v->eflags = flags;
198   if (v->g->cflags&REG_NOSUB)
199     nmatch = 0;   /* override client */
200   v->nmatch = nmatch;
201   if (backref) {
202     /* need work area */
203     if (v->g->nsub + 1 <= LOCALMAT)
204       v->pmatch = mat;
205     else
206       v->pmatch = (regmatch_t *)MALLOC((v->g->nsub + 1) *
207               sizeof(regmatch_t));
208     if (v->pmatch == NULL)
209       return REG_ESPACE;
210     v->nmatch = v->g->nsub + 1;
211   } else
212     v->pmatch = pmatch;
213   v->details = details;
214   v->start = (chr *)string;
215   v->stop = (chr *)string + len;
216   v->err = 0;
217   if (backref) {
218     /* need retry memory */
219     assert(v->g->ntree >= 0);
220     n = (size_t)v->g->ntree;
221     if (n <= LOCALMEM)
222       v->mem = mem;
223     else
224       v->mem = (regoff_t *)MALLOC(n*sizeof(regoff_t));
225     if (v->mem == NULL) {
226       if (v->pmatch != pmatch && v->pmatch != mat)
227         FREE(v->pmatch);
228       return REG_ESPACE;
229     }
230   } else
231     v->mem = NULL;
232 
233   /* do it */
234   assert(v->g->tree != NULL);
235   if (backref)
236     st = cfind(v, &v->g->tree->cnfa, &v->g->cmap);
237   else
238     st = find(v, &v->g->tree->cnfa, &v->g->cmap);
239 
240   /* copy (portion of) match vector over if necessary */
241   if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) {
242     zapsubs(pmatch, nmatch);
243     n = (nmatch < v->nmatch) ? nmatch : v->nmatch;
244     memcpy(VS(pmatch), VS(v->pmatch), n*sizeof(regmatch_t));
245   }
246 
247   /* clean up */
248   if (v->pmatch != pmatch && v->pmatch != mat)
249     FREE(v->pmatch);
250   if (v->mem != NULL && v->mem != mem)
251     FREE(v->mem);
252   return st;
253 }
static int find (struct vars * v, struct cnfa * cnfa, struct colormap * cm) [static]

Definition at line 260 of file regexec.c.
References dfa::cm, dfa::cnfa, dissect(), freedfa(), ISERR, LOFF, longest(), MDEBUG, newdfa(), NOERR, NULL, OFF, REG_EXPECT, REG_NOMATCH, REG_OKAY, SHORTER, shortest(), and zapsubs().
Referenced by DoRemoveJustDirectory(), exec(), Tcl_GlobObjCmd(), Tcl_UtfFindFirst(), and Tcl_UtfFindLast().264 {
265   struct dfa *s;
266   struct dfa *d;
267   chr *begin;
268   chr *end = NULL;
269   chr *cold;
270   chr *open;    /* open and close of range of possible starts */
271   chr *close;
272   int hitend;
273   int shorter = (v->g->tree->flags&SHORTER) ? 1 : 0;
274 
275   /* first, a shot with the search RE */
276   s = newdfa(v, &v->g->search, cm, &v->dfa1);
277   assert(!(ISERR() && s != NULL));
278   NOERR();
279   MDEBUG(("\nsearch at %ld\n", LOFF(v->start)));
280   cold = NULL;
281   close = shortest(v, s, v->start, v->start, v->stop, &cold, (int *)NULL);
282   freedfa(s);
283   NOERR();
284   if (v->g->cflags&REG_EXPECT) {
285     assert(v->details != NULL);
286     if (cold != NULL)
287       v->details->rm_extend.rm_so = OFF(cold);
288     else
289       v->details->rm_extend.rm_so = OFF(v->stop);
290     v->details->rm_extend.rm_eo = OFF(v->stop); /* unknown */
291   }
292   if (close == NULL)    /* not found */
293     return REG_NOMATCH;
294   if (v->nmatch == 0)   /* found, don't need exact location */
295     return REG_OKAY;
296 
297   /* find starting point and match */
298   assert(cold != NULL);
299   open = cold;
300   cold = NULL;
301   MDEBUG(("between %ld and %ld\n", LOFF(open), LOFF(close)));
302   d = newdfa(v, cnfa, cm, &v->dfa1);
303   assert(!(ISERR() && d != NULL));
304   NOERR();
305   for (begin = open; begin <= close; begin++) {
306     MDEBUG(("\nfind trying at %ld\n", LOFF(begin)));
307     if (shorter)
308       end = shortest(v, d, begin, begin, v->stop,
309               (chr **)NULL, &hitend);
310     else
311       end = longest(v, d, begin, v->stop, &hitend);
312     NOERR();
313     if (hitend && cold == NULL)
314       cold = begin;
315     if (end != NULL)
316       break;    /* NOTE BREAK OUT */
317   }
318   assert(end != NULL);    /* search RE succeeded so loop should */
319   freedfa(d);
320 
321   /* and pin down details */
322   assert(v->nmatch > 0);
323   v->pmatch[0].rm_so = OFF(begin);
324   v->pmatch[0].rm_eo = OFF(end);
325   if (v->g->cflags&REG_EXPECT) {
326     if (cold != NULL)
327       v->details->rm_extend.rm_so = OFF(cold);
328     else
329       v->details->rm_extend.rm_so = OFF(v->stop);
330     v->details->rm_extend.rm_eo = OFF(v->stop); /* unknown */
331   }
332   if (v->nmatch == 1)   /* no need for submatches */
333     return REG_OKAY;
334 
335   /* submatches */
336   zapsubs(v->pmatch, v->nmatch);
337   return dissect(v, v->g->tree, begin, end);
338 }
static VOID subset (struct vars * v, struct subre * sub, chr * begin, chr * end) [static]

Definition at line 514 of file regexec.c.
References MDEBUG, OFF, size_t(), and subre::subno.
Referenced by cdissect(), and dissect().519 {
520   int n = sub->subno;
521 
522   assert(n > 0);
523   if ((size_t)n >= v->nmatch)
524     return;
525 
526   MDEBUG(("setting %d\n", n));
527   v->pmatch[n].rm_so = OFF(begin);
528   v->pmatch[n].rm_eo = OFF(end);
529 }
static VOID zapmem (struct vars * v, struct subre * t) [static]

Definition at line 488 of file regexec.c.
References subre::left, NULL, subre::op, subre::retry, subre::right, and subre::subno.
Referenced by ccondissect(), cfindloop(), and crevdissect().491 {
492   if (t == NULL)
493     return;
494 
495   assert(v->mem != NULL);
496   v->mem[t->retry] = 0;
497   if (t->op == '(') {
498     assert(t->subno > 0);
499     v->pmatch[t->subno].rm_so = -1;
500     v->pmatch[t->subno].rm_eo = -1;
501   }
502 
503   if (t->left != NULL)
504     zapmem(v, t->left);
505   if (t->right != NULL)
506     zapmem(v, t->right);
507 }
static VOID zapsubs (regmatch_t * p, size_t n) [static]

Definition at line 471 of file regexec.c.
References size_t().
Referenced by cfindloop(), exec(), and find().474 {
475   size_t i;
476 
477   for (i = n-1; i > 0; i--) {
478     p[i].rm_so = -1;
479     p[i].rm_eo = -1;
480   }
481 }

generic/regfree.c File Reference
#include "regguts.h"
Functions
VOID regfree (regex_t *re)

Function Documentation
VOID regfree (regex_t * re)

Definition at line 47 of file regfree.c.
References NULL.49 {
50   if (re == NULL)
51     return;
52   (*((struct fns *)re->re_fns)->free)(re);
53 }

generic/regfronts.c File Reference
#include "regguts.h"
Functions
int regcomp (regex_t *re, CONST char *str, int flags)
int regexec (regex_t *re, CONST char *str, size_t nmatch, pmatch, int flags)

Function Documentation
int regcomp (regex_t * re, CONST char * str, int flags)

Definition at line 41 of file regfronts.c.
References REG_PEND, and size_t().45 {
46   size_t len;
47   int f = flags;
48 
49   if (f&REG_PEND) {
50     len = re->re_endp - str;
51     f &= ~REG_PEND;
52   } else
53     len = strlen(str);
54 
55   return re_comp(re, str, len, f);
56 }
int regexec (regex_t * re, CONST char * str, size_t nmatch, pmatch, int flags)

Definition at line 62 of file regfronts.c.
References CONST, REG_STARTEND, regmatch_t::rm_eo, regmatch_t::rm_so, and size_t().68 {
69   CONST char *start;
70   size_t len;
71   int f = flags;
72 
73   if (f&REG_STARTEND) {
74     start = str + pmatch[0].rm_so;
75     len = pmatch[0].rm_eo - pmatch[0].rm_so;
76     f &= ~REG_STARTEND;
77   } else {
78     start = str;
79     len = strlen(str);
80   }
81 
82   return re_exec(re, start, len, nmatch, pmatch, f);
83 }

generic/regguts.h File Reference
#include "regcustom.h"
#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
#include <limits.h>
#include <string.h>
#include <assert.h>
Classes
struct colors
struct ptrs
union tree
struct colordesc
struct colormap
struct cvec
struct arc
struct arcbatch
struct state
struct nfa
struct carc
struct cnfa
struct subre
struct fns
struct guts
Defines
#define NDEBUG
#define DISCARD  VOID
#define PVOID  VOID *
#define VS(x)  ((PVOID)(x))
#define NOPARMS  VOID
#define _POSIX2_RE_DUP_MAX  255
#define NOTREACHED  0
#define xxx  1
#define DUPMAX  _POSIX2_RE_DUP_MAX
#define INFINITY  (DUPMAX+1)
#define REMAGIC  0xfed7
#define FDEBUG(arglist)  {}
#define MDEBUG(arglist)  {}
#define UBITS  (CHAR_BIT * sizeof(unsigned))
#define BSET(uv, sn)  ((uv)[(sn)/UBITS] |= (unsigned)1 << ((sn)%UBITS))
#define ISBSET(uv, sn)  ((uv)[(sn)/UBITS] & ((unsigned)1 << ((sn)%UBITS)))
#define BYTBITS  8
#define BYTTAB  (1<<BYTBITS)
#define BYTMASK  (BYTTAB-1)
#define NBYTS  ((CHRBITS+BYTBITS-1)/BYTBITS)
#define COLORLESS  (-1)
#define WHITE  0
#define tcolor  colors.ccolor
#define tptr  ptrs.pptr
#define NOSUB  COLORLESS
#define FREECOL  01
#define PSEUDO  02
#define UNUSEDCOLOR(cd)  ((cd)->flags&FREECOL)
#define CMMAGIC  0x876
#define CDEND(cm)  (&(cm)->cd[(cm)->max + 1])
#define NINLINECDS  ((size_t)10)
#define B0(c)  ((c) & BYTMASK)
#define B1(c)  (((c)>>BYTBITS) & BYTMASK)
#define B2(c)  (((c)>>(2*BYTBITS)) & BYTMASK)
#define B3(c)  (((c)>>(3*BYTBITS)) & BYTMASK)
#define MAXMCCE  2
#define ARCFREE  '\0'
#define freechain  outchain
#define ABSIZE  10
#define FREESTATE  (-1)
#define HASLACONS  01
#define ZAPCNFA(cnfa)  ((cnfa).nstates = 0)
#define NULLCNFA(cnfa)  ((cnfa).nstates == 0)
#define LONGER  01
#define SHORTER  02
#define MIXED  04
#define CAP  010
#define BACKR  020
#define INUSE  0100
#define LOCAL  03
#define LMIX(f)  ((f)<<2)
#define SMIX(f)  ((f)<<1)
#define UP(f)  (((f)&~LOCAL) | (LMIX(f) & SMIX(f) & MIXED))
#define MESSY(f)  ((f)&(MIXED|CAP|BACKR))
#define PREF(f)  ((f)&LOCAL)
#define PREF2(f1, f2)  ((PREF(f1) != 0) ? PREF(f1) : PREF(f2))
#define COMBINE(f1, f2)  (UP((f1)|(f2)) | PREF2(f1, f2))
#define GUTSMAGIC  0xfed9
Typedefs
typedef short color
typedef int pcolor

Define Documentation
#define _POSIX2_RE_DUP_MAX  255

Definition at line 112 of file regguts.h.#define ABSIZE  10

Definition at line 297 of file regguts.h.
Referenced by allocarc().#define ARCFREE  '\0'

Definition at line 285 of file regguts.h.#define B0(c)  ((c) & BYTMASK)

Definition at line 235 of file regguts.h.#define B1(c)  (((c)>>BYTBITS) & BYTMASK)

Definition at line 236 of file regguts.h.#define B2(c)  (((c)>>(2*BYTBITS)) & BYTMASK)

Definition at line 237 of file regguts.h.#define B3(c)  (((c)>>(3*BYTBITS)) & BYTMASK)

Definition at line 238 of file regguts.h.#define BACKR  020

Definition at line 370 of file regguts.h.
Referenced by parseqatom(), and stdump().#define BSET(uv, sn)  ((uv)[(sn)/UBITS] |= (unsigned)1 << ((sn)%UBITS))

Definition at line 150 of file regguts.h.
Referenced by initialize(), and miss().#define BYTBITS  8

Definition at line 162 of file regguts.h.
Referenced by setcolor(), and subblock().#define BYTMASK  (BYTTAB-1)

Definition at line 165 of file regguts.h.
Referenced by setcolor(), subblock(), and subrange().#define BYTTAB  (1<<BYTBITS)

Definition at line 164 of file regguts.h.
Referenced by cmtreefree(), initcm(), setcolor(), subblock(), and subrange().#define CAP  010

Definition at line 369 of file regguts.h.
Referenced by parseqatom(), and stdump().#define CDEND(cm)  (&(cm)->cd[(cm)->max + 1])

Definition at line 228 of file regguts.h.
Referenced by colorcomplement(), okcolors(), and rainbow().#define CMMAGIC  0x876

Definition at line 222 of file regguts.h.
Referenced by initcm(), and setcolor().#define COLORLESS  (-1)

Definition at line 177 of file regguts.h.
Referenced by compact(), compile(), dumpcnfa(), dumpnfa(), makesearch(), maxcolor(), miss(), newcolor(), newnfa(), newsub(), parseqatom(), pseudocolor(), setcolor(), specialcolors(), and subcolor().#define COMBINE(f1, f2)  (UP((f1)|(f2)) | PREF2(f1, f2))

Definition at line 379 of file regguts.h.
Referenced by parseqatom().#define DISCARD  VOID

Definition at line 70 of file regguts.h.
Referenced by compile(), next(), and nfatree().#define DUPMAX  _POSIX2_RE_DUP_MAX

Definition at line 124 of file regguts.h.
Referenced by scannum().#define FDEBUG(arglist)  {}

Definition at line 140 of file regguts.h.
Referenced by getvacant(), lacon(), longest(), miss(), pickss(), and shortest().#define freechain  outchain

Definition at line 290 of file regguts.h.#define FREECOL  01

Definition at line 213 of file regguts.h.
Referenced by freecolor().#define FREESTATE  (-1)

Definition at line 303 of file regguts.h.
Referenced by delsub(), deltraverse(), destroystate(), fixempties(), freestate(), pullback(), and pushfwd().#define GUTSMAGIC  0xfed9

Definition at line 409 of file regguts.h.
Referenced by compile(), and dump().#define HASLACONS  01

Definition at line 347 of file regguts.h.
Referenced by compact(), and dumpcnfa().#define INFINITY  (DUPMAX+1)

Definition at line 125 of file regguts.h.
Referenced by cbrdissect(), parseqatom(), and stdump().#define INUSE  0100

Definition at line 371 of file regguts.h.
Referenced by cleanst(), markst(), and stdump().#define ISBSET(uv, sn)  ((uv)[(sn)/UBITS] & ((unsigned)1 << ((sn)%UBITS)))

Definition at line 151 of file regguts.h.
Referenced by miss().#define LMIX(f)  ((f)<<2)

Definition at line 373 of file regguts.h.#define LOCAL  03

Definition at line 372 of file regguts.h.#define LONGER  01

Definition at line 366 of file regguts.h.
Referenced by parse(), parseqatom(), and stdump().#define MAXMCCE  2

Definition at line 271 of file regguts.h.
Referenced by newcvec().#define MDEBUG(arglist)  {}

Definition at line 141 of file regguts.h.
Referenced by altdissect(), caltdissect(), cbrdissect(), ccondissect(), cdissect(), cfindloop(), condissect(), crevdissect(), dissect(), find(), and subset().#define MESSY(f)  ((f)&(MIXED|CAP|BACKR))

Definition at line 376 of file regguts.h.
Referenced by parse(), and parseqatom().#define MIXED  04

Definition at line 368 of file regguts.h.
Referenced by stdump().#define NBYTS  ((CHRBITS+BYTBITS-1)/BYTBITS)

Definition at line 166 of file regguts.h.
Referenced by cmtreefree(), freecm(), initcm(), setcolor(), and subblock().#define NDEBUG

Definition at line 59 of file regguts.h.#define NINLINECDS  ((size_t)10)

Definition at line 229 of file regguts.h.
Referenced by initcm().#define NOPARMS  VOID

Definition at line 79 of file regguts.h.#define NOSUB  COLORLESS

Definition at line 210 of file regguts.h.
Referenced by freecolor(), initcm(), newcolor(), newsub(), okcolors(), and singleton().#define NOTREACHED  0

Definition at line 121 of file regguts.h.
Referenced by brenext(), combine(), compact(), lexescape(), next(), pull(), and push().#define NULLCNFA(cnfa)  ((cnfa).nstates == 0)

Definition at line 356 of file regguts.h.
Referenced by dump(), freelacons(), freesrnode(), rfree(), and stdump().#define PREF(f)  ((f)&LOCAL)

Definition at line 377 of file regguts.h.
Referenced by parseqatom().#define PREF2(f1, f2)  ((PREF(f1) != 0) ? PREF(f1) : PREF(f2))

Definition at line 378 of file regguts.h.#define PSEUDO  02

Definition at line 214 of file regguts.h.
Referenced by colorcomplement(), pseudocolor(), and rainbow().#define PVOID  VOID *

Definition at line 73 of file regguts.h.#define REMAGIC  0xfed7

Definition at line 127 of file regguts.h.
Referenced by compile(), dump(), exec(), and rfree().#define SHORTER  02

Definition at line 367 of file regguts.h.
Referenced by ccondissect(), cfindloop(), compile(), condissect(), crevdissect(), find(), parseqatom(), and stdump().#define SMIX(f)  ((f)<<1)

Definition at line 374 of file regguts.h.#define tcolor  colors.ccolor

Definition at line 203 of file regguts.h.
Referenced by subblock().#define tptr  ptrs.pptr

Definition at line 204 of file regguts.h.#define UBITS  (CHAR_BIT * sizeof(unsigned))

Definition at line 149 of file regguts.h.
Referenced by newdfa().#define UNUSEDCOLOR(cd)  ((cd)->flags&FREECOL)

Definition at line 215 of file regguts.h.
Referenced by colorcomplement(), freecm(), freecolor(), newcolor(), okcolors(), and rainbow().#define UP(f)  (((f)&~LOCAL) | (LMIX(f) & SMIX(f) & MIXED))

Definition at line 375 of file regguts.h.
Referenced by parse(), and parseqatom().#define VS(x)  ((PVOID)(x))

Definition at line 76 of file regguts.h.
Referenced by cmp(), compile(), exec(), moresubs(), newcolor(), setcolor(), and subblock().#define WHITE  0

Definition at line 178 of file regguts.h.
Referenced by freecolor(), initcm(), and pickss().#define xxx  1

Definition at line 122 of file regguts.h.#define ZAPCNFA(cnfa)  ((cnfa).nstates = 0)

Definition at line 355 of file regguts.h.
Referenced by compile(), newlacon(), and subre().
Typedef Documentation
typedef short color

Definition at line 175 of file regguts.h.typedef int pcolor

Definition at line 176 of file regguts.h.

generic/tcl.h File Reference
#include <stdio.h>
#include <stdarg.h>
#include <limits.h>
#include "tclDecls.h"
#include "tclPlatDecls.h"
Classes
struct Tcl_Interp
struct Tcl_RegExpIndices
struct Tcl_RegExpInfo
struct Tcl_Value
struct Tcl_ObjType
struct Tcl_Obj
struct Tcl_SavedResult
struct Tcl_Namespace
struct Tcl_CallFrame
struct Tcl_CmdInfo
struct Tcl_DString
struct Tcl_HashEntry
struct Tcl_HashKeyType
struct Tcl_HashTable
struct Tcl_HashSearch
struct Tcl_Event
struct Tcl_Time
struct Tcl_ChannelType
struct Tcl_GlobTypeData
struct Tcl_Filesystem
struct Tcl_NotifierProcs
struct Tcl_EncodingType
struct Tcl_Token
struct Tcl_Parse
Defines
#define TCL_ALPHA_RELEASE  0
#define TCL_BETA_RELEASE  1
#define TCL_FINAL_RELEASE  2
#define TCL_MAJOR_VERSION  8
#define TCL_MINOR_VERSION  4
#define TCL_RELEASE_LEVEL  TCL_FINAL_RELEASE
#define TCL_RELEASE_SERIAL  14
#define TCL_VERSION  "8.4"
#define TCL_PATCH_LEVEL  "8.4.14"
#define STRINGIFY(x)  STRINGIFY1(x)
#define STRINGIFY1(x)  #x
#define JOIN(a, b)  JOIN1(a,b)
#define JOIN1(a, b)  a##b
#define TCL_DECLARE_MUTEX(name)
#define Tcl_MutexLock(mutexPtr)
#define Tcl_MutexUnlock(mutexPtr)
#define Tcl_MutexFinalize(mutexPtr)
#define Tcl_ConditionNotify(condPtr)
#define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
#define Tcl_ConditionFinalize(condPtr)
#define TCL_VARARGS(type, name)  (type name, ...)
#define TCL_VARARGS_DEF(type, name)  (type name, ...)
#define TCL_VARARGS_START(type, name, list)  (va_start(list, name), name)
#define DLLIMPORT
#define DLLEXPORT
#define TCL_STORAGE_CLASS  DLLIMPORT
#define CONST  const
#define _ANSI_ARGS_(x)  x
#define CONST84  CONST
#define CONST84_RETURN  CONST
#define EXTERN  extern TCL_STORAGE_CLASS
#define VOID  void
#define _CLIENTDATA
#define TCL_WIDE_INT_TYPE  long long
#define TCL_LL_MODIFIER  "ll"
#define TCL_LL_MODIFIER_SIZE  2
#define Tcl_WideAsLong(val)  ((long)((Tcl_WideInt)(val)))
#define Tcl_LongAsWide(val)  ((Tcl_WideInt)((long)(val)))
#define Tcl_WideAsDouble(val)  ((double)((Tcl_WideInt)(val)))
#define Tcl_DoubleAsWide(val)  ((Tcl_WideInt)((double)(val)))
#define TCL_PRESERVE_BINARY_COMPATABILITY  1
#define Tcl_ThreadCreateType  void
#define TCL_THREAD_CREATE_RETURN
#define TCL_THREAD_STACK_DEFAULT  (0)
#define TCL_THREAD_NOFLAGS  (0000)
#define TCL_THREAD_JOINABLE  (0001)
#define TCL_REG_BASIC  000000
#define TCL_REG_EXTENDED  000001
#define TCL_REG_ADVF  000002
#define TCL_REG_ADVANCED  000003
#define TCL_REG_QUOTE  000004
#define TCL_REG_NOCASE  000010
#define TCL_REG_NOSUB  000020
#define TCL_REG_EXPANDED  000040
#define TCL_REG_NLSTOP  000100
#define TCL_REG_NLANCH  000200
#define TCL_REG_NEWLINE  000300
#define TCL_REG_CANMATCH  001000
#define TCL_REG_BOSONLY  002000
#define TCL_REG_NOTBOL  0001
#define TCL_REG_NOTEOL  0002
#define TCL_OK  0
#define TCL_ERROR  1
#define TCL_RETURN  2
#define TCL_BREAK  3
#define TCL_CONTINUE  4
#define TCL_RESULT_SIZE  200
#define TCL_SUBST_COMMANDS  001
#define TCL_SUBST_VARIABLES  002
#define TCL_SUBST_BACKSLASHES  004
#define TCL_SUBST_ALL  007
#define Tcl_IncrRefCount(objPtr)  ++(objPtr)->refCount
#define Tcl_DecrRefCount(objPtr)  if (--(objPtr)->refCount > 0) ; else TclFreeObj(objPtr)
#define Tcl_IsShared(objPtr)  ((objPtr)->refCount > 1)
#define TCL_DSTRING_STATIC_SIZE  200
#define Tcl_DStringLength(dsPtr)  ((dsPtr)->length)
#define Tcl_DStringValue(dsPtr)  ((dsPtr)->string)
#define Tcl_DStringTrunc  Tcl_DStringSetLength
#define TCL_MAX_PREC  17
#define TCL_DOUBLE_SPACE  (TCL_MAX_PREC+10)
#define TCL_INTEGER_SPACE  24
#define TCL_DONT_USE_BRACES  1
#define TCL_EXACT  1
#define TCL_NO_EVAL  0x10000
#define TCL_EVAL_GLOBAL  0x20000
#define TCL_EVAL_DIRECT  0x40000
#define TCL_EVAL_INVOKE  0x80000
#define TCL_VOLATILE  ((Tcl_FreeProc *) 1)
#define TCL_STATIC  ((Tcl_FreeProc *) 0)
#define TCL_DYNAMIC  ((Tcl_FreeProc *) 3)
#define TCL_GLOBAL_ONLY  1
#define TCL_NAMESPACE_ONLY  2
#define TCL_APPEND_VALUE  4
#define TCL_LIST_ELEMENT  8
#define TCL_TRACE_READS  0x10
#define TCL_TRACE_WRITES  0x20
#define TCL_TRACE_UNSETS  0x40
#define TCL_TRACE_DESTROYED  0x80
#define TCL_INTERP_DESTROYED  0x100
#define TCL_LEAVE_ERR_MSG  0x200
#define TCL_TRACE_ARRAY  0x800
#define TCL_TRACE_OLD_STYLE  0x1000
#define TCL_TRACE_RESULT_DYNAMIC  0x8000
#define TCL_TRACE_RESULT_OBJECT  0x10000
#define TCL_TRACE_RENAME  0x2000
#define TCL_TRACE_DELETE  0x4000
#define TCL_ALLOW_INLINE_COMPILATION  0x20000
#define TCL_TRACE_ENTER_EXEC  1
#define TCL_TRACE_LEAVE_EXEC  2
#define TCL_PARSE_PART1  0x400
#define TCL_LINK_INT  1
#define TCL_LINK_DOUBLE  2
#define TCL_LINK_BOOLEAN  3
#define TCL_LINK_STRING  4
#define TCL_LINK_WIDE_INT  5
#define TCL_LINK_READ_ONLY  0x80
#define TCL_HASH_KEY_STORE_HASH  1
#define TCL_HASH_KEY_RANDOMIZE_HASH  0x1
#define TCL_HASH_KEY_TYPE_VERSION  1
#define TCL_SMALL_HASH_TABLE  4
#define TCL_STRING_KEYS  0
#define TCL_ONE_WORD_KEYS  1
#define TCL_CUSTOM_TYPE_KEYS  -2
#define TCL_CUSTOM_PTR_KEYS  -1
#define Tcl_GetHashValue(h)  ((h)->clientData)
#define Tcl_SetHashValue(h, value)  ((h)->clientData = (ClientData) (value))
#define Tcl_GetHashKey(tablePtr, h)
#define Tcl_FindHashEntry(tablePtr, key)  (*((tablePtr)->findProc))(tablePtr, key)
#define Tcl_CreateHashEntry(tablePtr, key, newPtr)  (*((tablePtr)->createProc))(tablePtr, key, newPtr)
#define TCL_DONT_WAIT  (1<<1)
#define TCL_WINDOW_EVENTS  (1<<2)
#define TCL_FILE_EVENTS  (1<<3)
#define TCL_TIMER_EVENTS  (1<<4)
#define TCL_IDLE_EVENTS  (1<<5)
#define TCL_ALL_EVENTS  (~TCL_DONT_WAIT)
#define TCL_SERVICE_NONE  0
#define TCL_SERVICE_ALL  1
#define TCL_READABLE  (1<<1)
#define TCL_WRITABLE  (1<<2)
#define TCL_EXCEPTION  (1<<3)
#define TCL_STDIN  (1<<1)
#define TCL_STDOUT  (1<<2)
#define TCL_STDERR  (1<<3)
#define TCL_ENFORCE_MODE  (1<<4)
#define TCL_CLOSE_READ  (1<<1)
#define TCL_CLOSE_WRITE  (1<<2)
#define TCL_CLOSE2PROC  ((Tcl_DriverCloseProc *)1)
#define TCL_CHANNEL_VERSION_1  ((Tcl_ChannelTypeVersion) 0x1)
#define TCL_CHANNEL_VERSION_2  ((Tcl_ChannelTypeVersion) 0x2)
#define TCL_CHANNEL_VERSION_3  ((Tcl_ChannelTypeVersion) 0x3)
#define TCL_CHANNEL_VERSION_4  ((Tcl_ChannelTypeVersion) 0x4)
#define TCL_CHANNEL_THREAD_INSERT  (0)
#define TCL_CHANNEL_THREAD_REMOVE  (1)
#define ckalloc(x)  Tcl_Alloc(x)
#define ckfree(x)  Tcl_Free(x)
#define ckrealloc(x, y)  Tcl_Realloc(x,y)
#define attemptckalloc(x)  Tcl_AttemptAlloc(x)
#define attemptckrealloc(x, y)  Tcl_AttemptRealloc(x,y)
#define Tcl_InitMemory(x)
#define Tcl_DumpActiveMemory(x)
#define Tcl_ValidateAllMemory(x, y)
#define TCL_MODE_BLOCKING  0
#define TCL_MODE_NONBLOCKING  1
#define TCL_GLOB_TYPE_BLOCK  (1<<0)
#define TCL_GLOB_TYPE_CHAR  (1<<1)
#define TCL_GLOB_TYPE_DIR  (1<<2)
#define TCL_GLOB_TYPE_PIPE  (1<<3)
#define TCL_GLOB_TYPE_FILE  (1<<4)
#define TCL_GLOB_TYPE_LINK  (1<<5)
#define TCL_GLOB_TYPE_SOCK  (1<<6)
#define TCL_GLOB_TYPE_MOUNT  (1<<7)
#define TCL_GLOB_PERM_RONLY  (1<<0)
#define TCL_GLOB_PERM_HIDDEN  (1<<1)
#define TCL_GLOB_PERM_R  (1<<2)
#define TCL_GLOB_PERM_W  (1<<3)
#define TCL_GLOB_PERM_X  (1<<4)
#define TCL_FILESYSTEM_VERSION_1  ((Tcl_FSVersion) 0x1)
#define TCL_CREATE_SYMBOLIC_LINK  0x01
#define TCL_CREATE_HARD_LINK  0x02
#define TCL_ENCODING_START  0x01
#define TCL_ENCODING_END  0x02
#define TCL_ENCODING_STOPONERROR  0x04
#define TCL_TOKEN_WORD  1
#define TCL_TOKEN_SIMPLE_WORD  2
#define TCL_TOKEN_TEXT  4
#define TCL_TOKEN_BS  8
#define TCL_TOKEN_COMMAND  16
#define TCL_TOKEN_VARIABLE  32
#define TCL_TOKEN_SUB_EXPR  64
#define TCL_TOKEN_OPERATOR  128
#define TCL_PARSE_SUCCESS  0
#define TCL_PARSE_QUOTE_EXTRA  1
#define TCL_PARSE_BRACE_EXTRA  2
#define TCL_PARSE_MISSING_BRACE  3
#define TCL_PARSE_MISSING_BRACKET  4
#define TCL_PARSE_MISSING_PAREN  5
#define TCL_PARSE_MISSING_QUOTE  6
#define TCL_PARSE_MISSING_VAR_BRACE  7
#define TCL_PARSE_SYNTAX  8
#define TCL_PARSE_BAD_NUMBER  9
#define NUM_STATIC_TOKENS  20
#define TCL_CONVERT_MULTIBYTE  -1
#define TCL_CONVERT_SYNTAX  -2
#define TCL_CONVERT_UNKNOWN  -3
#define TCL_CONVERT_NOSPACE  -4
#define TCL_UTF_MAX  3
#define Tcl_EvalObj(interp, objPtr)  Tcl_EvalObjEx((interp),(objPtr),0)
#define Tcl_GlobalEvalObj(interp, objPtr)  Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
#define Tcl_Ckalloc  Tcl_Alloc
#define Tcl_Ckfree  Tcl_Free
#define Tcl_Ckrealloc  Tcl_Realloc
#define Tcl_Return  Tcl_SetResult
#define Tcl_TildeSubst  Tcl_TranslateFileName
#define panic  Tcl_Panic
#define panicVA  Tcl_PanicVA
#define TCL_STUB_MAGIC  ((int)0xFCA3BACF)
#define Tcl_InitStubs(interp, version, exact)  Tcl_PkgRequire(interp, "Tcl", version, exact)
#define TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS  DLLIMPORT
Typedefs
typedef void * ClientData
typedef TCL_WIDE_INT_TYPE Tcl_WideInt
typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt
typedef stat Tcl_StatBuf
typedef Tcl_AsyncHandler_ * Tcl_AsyncHandler
typedef Tcl_Channel_ * Tcl_Channel
typedef Tcl_Command_ * Tcl_Command
typedef Tcl_Condition_ * Tcl_Condition
typedef Tcl_EncodingState_ * Tcl_EncodingState
typedef Tcl_Encoding_ * Tcl_Encoding
typedef Tcl_Event Tcl_Event
typedef Tcl_Mutex_ * Tcl_Mutex
typedef Tcl_Pid_ * Tcl_Pid
typedef Tcl_RegExp_ * Tcl_RegExp
typedef Tcl_ThreadDataKey_ * Tcl_ThreadDataKey
typedef Tcl_ThreadId_ * Tcl_ThreadId
typedef Tcl_TimerToken_ * Tcl_TimerToken
typedef Tcl_Trace_ * Tcl_Trace
typedef Tcl_Var_ * Tcl_Var
typedef Tcl_ChannelTypeVersion_ * Tcl_ChannelTypeVersion
typedef Tcl_LoadHandle_ * Tcl_LoadHandle
typedef Tcl_StatBuf * Tcl_Stat_
typedef stat * Tcl_OldStat_
typedef Tcl_Interp * interp
typedef Tcl_Interp int code
typedef int mask
typedef Tcl_Interp * interp
typedef Tcl_Interp int argc
typedef Tcl_Interp int CONST84 char * argv []
typedef Tcl_Interp * interp
typedef Tcl_Interp int level
typedef Tcl_Interp int char * command
typedef Tcl_Interp int char Tcl_CmdProc * proc
typedef Tcl_Interp int char Tcl_CmdProc ClientData cmdClientData
typedef Tcl_Interp int char Tcl_CmdProc ClientData int argc
typedef Tcl_Interp int char Tcl_CmdProc ClientData int CONST84 char * argv []
typedef Tcl_Interp * interp
typedef Tcl_Interp int level
typedef Tcl_Interp int CONST char * command
typedef Tcl_Interp int CONST char Tcl_Command commandInfo
typedef Tcl_Interp int CONST char Tcl_Command int objc
typedef Tcl_Interp int CONST char Tcl_Command int struct Tcl_Obj *CONST * objv
typedef Tcl_Obj * dupPtr
typedef CONST char * src
typedef CONST char int srcLen
typedef CONST char int int flags
typedef CONST char int int Tcl_EncodingState * statePtr
typedef CONST char int int Tcl_EncodingState char * dst
typedef CONST char int int Tcl_EncodingState char int dstLen
typedef CONST char int int Tcl_EncodingState char int int * srcReadPtr
typedef CONST char int int Tcl_EncodingState char int int int * dstWrotePtr
typedef CONST char int int Tcl_EncodingState char int int int int * dstCharsPtr
typedef int flags
typedef int flags
typedef ClientData clientData
typedef int flags
typedef int mask
typedef Tcl_Interp * interp
typedef Tcl_Interp * interp
typedef Tcl_Interp Tcl_Value * args
typedef Tcl_Interp Tcl_Value Tcl_Value * resultPtr
typedef Tcl_Interp * interp
typedef Tcl_Interp int objc
typedef Tcl_Interp int struct Tcl_Obj *CONST * objv
typedef Tcl_Channel chan
typedef Tcl_Channel char * address
typedef Tcl_Channel char int port
typedef Tcl_Obj * objPtr
typedef char *Tcl_VarTraceProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, CONST84 char *part1, CONST84 char *part2, int flags))
typedef Tcl_Interp * interp
typedef Tcl_Interp CONST char * oldName
typedef Tcl_Interp CONST char CONST char * newName
typedef Tcl_Interp CONST char CONST char int flags
typedef int mask
typedef int Tcl_FileProc * proc
typedef int Tcl_FileProc ClientData clientData
typedef Tcl_HashKeyType Tcl_HashKeyType
typedef Tcl_HashTable Tcl_HashTable
typedef Tcl_HashEntry Tcl_HashEntry
typedef unsigned int (Tcl_HashKeyProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr
typedef unsigned VOID * keyPtr
typedef Tcl_HashEntry * hPtr
typedef Tcl_HashEntry *Tcl_AllocHashEntryProc _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, VOID *keyPtr))
typedef int mode
typedef Tcl_Interp * interp
typedef Tcl_Interp * interp
typedef Tcl_Interp int flags
typedef char * buf
typedef char int toRead
typedef char int int * errorCodePtr
typedef CONST84 char * buf
typedef CONST84 char int toWrite
typedef CONST84 char int int * errorCodePtr
typedef long offset
typedef long int mode
typedef long int int * errorCodePtr
typedef Tcl_Interp * interp
typedef Tcl_Interp CONST char * optionName
typedef Tcl_Interp CONST char CONST char * value
typedef Tcl_Interp * interp
typedef Tcl_Interp CONST84 char * optionName
typedef Tcl_Interp CONST84 char Tcl_DString * dsPtr
typedef int mask
typedef int direction
typedef int ClientData * handlePtr
typedef int interestMask
typedef Tcl_WideInt offset
typedef Tcl_WideInt int mode
typedef Tcl_WideInt int int * errorCodePtr
typedef int action
typedef Tcl_StatBuf * buf
typedef int mode
typedef Tcl_Obj * pathPtr
typedef Tcl_Obj int mode
typedef Tcl_Obj int int permissions
typedef Tcl_Obj * result
typedef Tcl_Obj Tcl_Obj * pathPtr
typedef Tcl_Obj Tcl_Obj CONST char * pattern
typedef Tcl_Obj Tcl_Obj CONST char Tcl_GlobTypeData * types
typedef Tcl_Obj *Tcl_FSGetCwdProc _ANSI_ARGS_ ((Tcl_Interp *interp))
typedef Tcl_StatBuf * buf
typedef Tcl_Obj * destPathPtr
typedef Tcl_Obj Tcl_Obj ** errorPtr
typedef Tcl_Obj * destPathPtr
typedef int recursive
typedef int Tcl_Obj ** errorPtr
typedef Tcl_Obj * destPathPtr
typedef Tcl_Obj *Tcl_FSListVolumesProc _ANSI_ARGS_ ((void))
typedef utimbuf * tval
typedef Tcl_Obj * pathPtr
typedef Tcl_Obj int nextCheckpoint
typedef int index
typedef int Tcl_Obj * pathPtr
typedef int Tcl_Obj Tcl_Obj ** objPtrRef
typedef CONST char **Tcl_FSFileAttrStringsProc _ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef))
typedef int index
typedef int Tcl_Obj * pathPtr
typedef int Tcl_Obj Tcl_Obj * objPtr
typedef Tcl_Obj *Tcl_FSLinkProc _ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkType))
typedef Tcl_Obj * pathPtr
typedef Tcl_Obj Tcl_LoadHandle * handlePtr
typedef Tcl_Obj Tcl_LoadHandle Tcl_FSUnloadFileProc ** unloadProcPtr
typedef ClientData * clientDataPtr
typedef Tcl_Obj *Tcl_FSFilesystemPathTypeProc _ANSI_ARGS_ ((Tcl_Obj *pathPtr))
typedef Tcl_Obj *Tcl_FSFilesystemSeparatorProc _ANSI_ARGS_ ((Tcl_Obj *pathPtr))
typedef Tcl_Obj *Tcl_FSInternalToNormalizedProc _ANSI_ARGS_ ((ClientData clientData))
typedef Tcl_FSVersion_ * Tcl_FSVersion
typedef unsigned short Tcl_UniChar
Enumerations
enum Tcl_ValueType { TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT }
enum Tcl_QueuePosition { TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK }
enum Tcl_PathType { TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, TCL_PATH_VOLUME_RELATIVE }
Functions
typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData))
typedef int (Tcl_AppInitProc) _ANSI_ARGS_((Tcl_Interp *interp))
typedef int (Tcl_AsyncProc) _ANSI_ARGS_((ClientData clientData
typedef void (Tcl_ChannelProc) _ANSI_ARGS_((ClientData clientData
typedef void (Tcl_CloseProc) _ANSI_ARGS_((ClientData data))
typedef void (Tcl_CmdDeleteProc) _ANSI_ARGS_((ClientData clientData))
typedef int (Tcl_CmdProc) _ANSI_ARGS_((ClientData clientData
typedef void (Tcl_CmdTraceProc) _ANSI_ARGS_((ClientData clientData
typedef int (Tcl_CmdObjTraceProc) _ANSI_ARGS_((ClientData clientData
typedef void (Tcl_CmdObjTraceDeleteProc) _ANSI_ARGS_((ClientData clientData))
typedef void (Tcl_DupInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *srcPtr
typedef int (Tcl_EncodingConvertProc) _ANSI_ARGS_((ClientData clientData
typedef void (Tcl_EncodingFreeProc) _ANSI_ARGS_((ClientData clientData))
typedef int (Tcl_EventProc) _ANSI_ARGS_((Tcl_Event *evPtr
typedef void (Tcl_EventCheckProc) _ANSI_ARGS_((ClientData clientData
typedef int (Tcl_EventDeleteProc) _ANSI_ARGS_((Tcl_Event *evPtr
typedef void (Tcl_EventSetupProc) _ANSI_ARGS_((ClientData clientData
typedef void (Tcl_ExitProc) _ANSI_ARGS_((ClientData clientData))
typedef void (Tcl_FileProc) _ANSI_ARGS_((ClientData clientData
typedef void (Tcl_FileFreeProc) _ANSI_ARGS_((ClientData clientData))
typedef void (Tcl_FreeInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr))
typedef void (Tcl_FreeProc) _ANSI_ARGS_((char *blockPtr))
typedef void (Tcl_IdleProc) _ANSI_ARGS_((ClientData clientData))
typedef void (Tcl_InterpDeleteProc) _ANSI_ARGS_((ClientData clientData
typedef int (Tcl_MathProc) _ANSI_ARGS_((ClientData clientData
typedef void (Tcl_NamespaceDeleteProc) _ANSI_ARGS_((ClientData clientData))
typedef int (Tcl_ObjCmdProc) _ANSI_ARGS_((ClientData clientData
typedef int (Tcl_PackageInitProc) _ANSI_ARGS_((Tcl_Interp *interp))
typedef void (Tcl_PanicProc) _ANSI_ARGS_(TCL_VARARGS(CONST char *
typedef void (Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData
typedef void (Tcl_TimerProc) _ANSI_ARGS_((ClientData clientData))
typedef int (Tcl_SetFromAnyProc) _ANSI_ARGS_((Tcl_Interp *interp
typedef void (Tcl_UpdateStringProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr))
typedef void (Tcl_CommandTraceProc) _ANSI_ARGS_((ClientData clientData
typedef void (Tcl_CreateFileHandlerProc) _ANSI_ARGS_((int fd
typedef void (Tcl_DeleteFileHandlerProc) _ANSI_ARGS_((int fd))
typedef void (Tcl_AlertNotifierProc) _ANSI_ARGS_((ClientData clientData))
typedef void (Tcl_ServiceModeHookProc) _ANSI_ARGS_((int mode))
typedef ClientData (Tcl_InitNotifierProc) _ANSI_ARGS_((VOID))
typedef void (Tcl_FinalizeNotifierProc) _ANSI_ARGS_((ClientData clientData))
typedef void (Tcl_MainLoopProc) _ANSI_ARGS_((void))
void Tcl_IncrRefCount _ANSI_ARGS_ ((Tcl_Obj *objPtr))
typedef int (Tcl_CompareHashKeysProc) _ANSI_ARGS_((VOID *keyPtr
typedef void (Tcl_FreeHashEntryProc) _ANSI_ARGS_((Tcl_HashEntry *hPtr))
typedef void (Tcl_SetTimerProc) _ANSI_ARGS_((Tcl_Time *timePtr))
typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr))
typedef int (Tcl_DriverBlockModeProc) _ANSI_ARGS_((ClientData instanceData
typedef int (Tcl_DriverCloseProc) _ANSI_ARGS_((ClientData instanceData
typedef int (Tcl_DriverClose2Proc) _ANSI_ARGS_((ClientData instanceData
typedef int (Tcl_DriverInputProc) _ANSI_ARGS_((ClientData instanceData
typedef int (Tcl_DriverOutputProc) _ANSI_ARGS_((ClientData instanceData
typedef int (Tcl_DriverSeekProc) _ANSI_ARGS_((ClientData instanceData
typedef int (Tcl_DriverSetOptionProc) _ANSI_ARGS_((ClientData instanceData
typedef int (Tcl_DriverGetOptionProc) _ANSI_ARGS_((ClientData instanceData
typedef void (Tcl_DriverWatchProc) _ANSI_ARGS_((ClientData instanceData
typedef int (Tcl_DriverGetHandleProc) _ANSI_ARGS_((ClientData instanceData
typedef int (Tcl_DriverFlushProc) _ANSI_ARGS_((ClientData instanceData))
typedef int (Tcl_DriverHandlerProc) _ANSI_ARGS_((ClientData instanceData
typedef Tcl_WideInt (Tcl_DriverWideSeekProc) _ANSI_ARGS_((ClientData instanceData
typedef void (Tcl_DriverThreadActionProc) _ANSI_ARGS_((ClientData instanceData
typedef int (Tcl_FSStatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr
typedef int (Tcl_FSAccessProc) _ANSI_ARGS_((Tcl_Obj *pathPtr
typedef Tcl_Channel (Tcl_FSOpenFileChannelProc) _ANSI_ARGS_((Tcl_Interp *interp
typedef int (Tcl_FSMatchInDirectoryProc) _ANSI_ARGS_((Tcl_Interp *interp
typedef int (Tcl_FSChdirProc) _ANSI_ARGS_((Tcl_Obj *pathPtr))
typedef int (Tcl_FSLstatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr
typedef int (Tcl_FSCreateDirectoryProc) _ANSI_ARGS_((Tcl_Obj *pathPtr))
typedef int (Tcl_FSDeleteFileProc) _ANSI_ARGS_((Tcl_Obj *pathPtr))
typedef int (Tcl_FSCopyDirectoryProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr
typedef int (Tcl_FSCopyFileProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr
typedef int (Tcl_FSRemoveDirectoryProc) _ANSI_ARGS_((Tcl_Obj *pathPtr
typedef int (Tcl_FSRenameFileProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr
typedef void (Tcl_FSUnloadFileProc) _ANSI_ARGS_((Tcl_LoadHandle loadHandle))
typedef int (Tcl_FSUtimeProc) _ANSI_ARGS_((Tcl_Obj *pathPtr
typedef int (Tcl_FSNormalizePathProc) _ANSI_ARGS_((Tcl_Interp *interp
typedef int (Tcl_FSFileAttrsGetProc) _ANSI_ARGS_((Tcl_Interp *interp
typedef int (Tcl_FSFileAttrsSetProc) _ANSI_ARGS_((Tcl_Interp *interp
typedef int (Tcl_FSLoadFileProc) _ANSI_ARGS_((Tcl_Interp *interp
typedef int (Tcl_FSPathInFilesystemProc) _ANSI_ARGS_((Tcl_Obj *pathPtr
typedef void (Tcl_FSFreeInternalRepProc) _ANSI_ARGS_((ClientData clientData))
typedef ClientData (Tcl_FSDupInternalRepProc) _ANSI_ARGS_((ClientData clientData))
typedef ClientData (Tcl_FSCreateInternalRepProc) _ANSI_ARGS_((Tcl_Obj *pathPtr))
EXTERN CONST char *Tcl_InitStubs _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *version, int exact))
EXTERN void Tcl_Main _ANSI_ARGS_ ((int argc, char **argv, Tcl_AppInitProc *appInitProc))
EXTERN int Tcl_AppInit _ANSI_ARGS_ ((Tcl_Interp *interp))
Variables
typedef format

Define Documentation
#define _ANSI_ARGS_(x)  x

Definition at line 250 of file tcl.h.
Referenced by ExprBinaryFunc(), ExprUnaryFunc(), main(), SetFsPathFromAny(), Tcl_RegsubObjCmd(), Tcl_StringObjCmd(), TclDoGlob(), and TclpObjChdir().#define _CLIENTDATA

Definition at line 325 of file tcl.h.#define attemptckalloc(x)  Tcl_AttemptAlloc(x)

Definition at line 1519 of file tcl.h.
Referenced by Tcl_AttemptSetObjLength().#define attemptckrealloc(x, y)  Tcl_AttemptRealloc(x,y)

Definition at line 1520 of file tcl.h.
Referenced by AppendUnicodeToUnicodeRep(), and Tcl_AttemptSetObjLength().#define ckalloc(x)  Tcl_Alloc(x)

Definition at line 1516 of file tcl.h.
Referenced by AliasCreate(), AliasObjCmd(), AllocArrayEntry(), AllocChannelBuffer(), AllocObjEntry(), AllocStringEntry(), BuildCharSet(), CallTraceProcedure(), CompileRegexp(), ConsoleCheckProc(), ConsoleOutputProc(), CopyFile(), CreateFileHandler(), CreateScriptRecord(), CreateSocket(), DdeServerProc(), DdeSetServerName(), DeleteKey(), DupByteArrayInternalRep(), DupForeachInfo(), DupFsPathInternalRep(), DupIndex(), DupListInternalRep(), DupParsedVarName(), DupStringInternalRep(), EnterCmdStartData(), ExpandLocalLiteralArray(), FileCheckProc(), FileProc(), FileRCVariables(), FindPackage(), FormatClock(), GetChannelTable(), GetTimesCmd(), GrowEvaluationStack(), LinkTraceProc(), LoadEscapeEncoding(), LoadTableEncoding(), MakeFolderEnvVar(), MakeTcpClientChannelMode(), NativeCreateNativeRep(), NewSocketInfo(), NewVar(), opendir(), OpenFileChannel(), OpenKey(), PathVariables(), PipeCheckProc(), PipeOutputProc(), ProcCompileProc(), RebuildLiteralTable(), RebuildTable(), RegisterTcpServerInterpCleanup(), RememberSyncObject(), ReplaceString(), ResultAdd(), RezRCVariables(), SerialCheckProc(), SerialOutputProc(), SetByteArrayFromAny(), SetCmdNameFromAny(), SetFsPathFromAny(), SetListFromAny(), SetNsNameFromAny(), SetStringFromAny(), SetupAppendBuffer(), SocketCheckProc(), StringTraceProc(), SystemVariables(), Tcl_AddInterpResolvers(), Tcl_AfterObjCmd(), Tcl_AllocStatBuf(), Tcl_AppendResultVA(), Tcl_AppendStringsToObjVA(), Tcl_ArrayObjCmd(), Tcl_AsyncCreate(), Tcl_BackgroundError(), Tcl_CallWhenDeleted(), Tcl_Concat(), Tcl_CreateAlias(), Tcl_CreateChannel(), Tcl_CreateChannelHandler(), Tcl_CreateCloseHandler(), Tcl_CreateCommand(), Tcl_CreateEncoding(), Tcl_CreateEventSource(), Tcl_CreateExitHandler(), Tcl_CreateFileHandler(), Tcl_CreateHashEntry(), Tcl_CreateInterp(), Tcl_CreateMathFunc(), Tcl_CreateNamespace(), Tcl_CreateObjCommand(), Tcl_CreateObjTrace(), Tcl_CreateThreadExitHandler(), Tcl_CreateTimerHandler(), Tcl_CreateTrace(), TCL_DECLARE_MUTEX(), Tcl_DetachPids(), Tcl_DoWhenIdle(), Tcl_DStringAppend(), Tcl_DStringAppendElement(), Tcl_DStringGetResult(), Tcl_DStringSetLength(), Tcl_EvalEx(), Tcl_EvalObjEx(), Tcl_EvalTokensStandard(), Tcl_ExecObjCmd(), Tcl_FindExecutable(), Tcl_ForeachObjCmd(), Tcl_FormatObjCmd(), Tcl_FSGetTranslatedStringPath(), Tcl_FSLoadFile(), Tcl_FSNewNativePath(), Tcl_FSRegister(), Tcl_GetAlias(), Tcl_GetMathFuncInfo(), Tcl_GetThreadData(), Tcl_GlobObjCmd(), Tcl_HideCommand(), Tcl_Import(), Tcl_LappendObjCmd(), Tcl_LinkVar(), Tcl_ListObjAppendElement(), Tcl_ListObjReplace(), Tcl_MacConvertTextResource(), Tcl_Main(), Tcl_MakeFileChannel(), Tcl_Merge(), Tcl_NewListObj(), Tcl_NewUnicodeObj(), Tcl_PackageObjCmd(), Tcl_PkgProvideEx(), Tcl_ReturnObjCmd(), Tcl_ScanObjCmd(), Tcl_SetAssocData(), Tcl_SetByteArrayLength(), Tcl_SetByteArrayObj(), Tcl_SetChannelBufferSize(), Tcl_SetChannelOption(), Tcl_SetDefaultEncodingDir(), Tcl_SetListObj(), Tcl_SetObjLength(), Tcl_SetResult(), Tcl_SetUnicodeObj(), Tcl_SocketObjCmd(), Tcl_SplitList(), Tcl_SplitPath(), Tcl_StackChannel(), Tcl_StringObjCmd(), Tcl_TraceCommand(), Tcl_TraceVar2(), Tcl_WaitForEvent(), TclAccessInsertProc(), TclAllocateFreeObjects(), Tclapplescript_Init(), TclArraySet(), TclChannelTransform(), TclCompileForeachCmd(), TclCopyChannel(), TclCreateAuxData(), TclCreateExceptRange(), TclCreateExecEnv(), TclCreatePipeline(), TclCreateProc(), TclEvalObjvInternal(), TclExecuteByteCode(), TclExpandCodeArray(), TclExpandJumpFixupArray(), TclExpandTokenArray(), TclFileAttrsCmd(), TclFindCompiledLocal(), TclFSMakePathFromNormalized(), TclFSMakePathRelative(), TclHandleCreate(), TclInitByteCodeObj(), TclInterpInit(), TclInvoke(), TclInvokeObjectCommand(), TclInvokeStringCommand(), TclLookupArrayElement(), TclLookupSimpleVar(), TclLookupVar(), TclMacCreateEnv(), TclMacRegisterResourceFork(), TclNativeDupInternalRep(), TclNewFSPathObj(), TclObjInterpProc(), TclObjInvoke(), TclObjLookupVar(), TclOpenFileChannelInsertProc(), tclOSAAddContext(), tclOSAAddScript(), tclOSADeleteScript(), tclOSAMakeNewComponent(), TclpCreateCommandChannel(), TclpCreateProcess(), TclpDlopen(), TclpFindExecutable(), TclpFindSymbol(), TclpFindVariable(), TclpGetDefaultStdChannel(), TclpInitLibraryPath(), TclpOpenFileChannel(), TclProcInterpProc(), TclPushVarName(), TclRegisterLiteral(), TclResetShadowedCmdRefs(), TclSetCmdNameObj(), TclSetEnv(), TclSetLibraryPath(), TclStatInsertProc(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), TclUnsetEnv(), TclWinAddProcess(), TclWinMakeFile(), TclWinOpenConsoleChannel(), TclWinOpenFileChannel(), TclWinOpenSerialChannel(), TcpAccept(), TcpOutput(), TestasyncCmd(), TestChannelEventCmd(), TestdelCmd(), TestdstringCmd(), TestencodingObjCmd(), TesteventObjCmd(), TestindexobjCmd(), TestlinkCmd(), TestplatformChmod(), TestsaveresultCmd(), TestsetassocdataCmd(), TestsetdefencdirCmd(), TimerCheckProc(), TraceExecutionProc(), UpdateLocalVarName(), UpdateParsedVarName(), UpdateStringOfBoolean(), UpdateStringOfByteArray(), UpdateStringOfDouble(), UpdateStringOfEndOffset(), UpdateStringOfIndex(), UpdateStringOfInt(), UpdateStringOfList(), UpdateStringOfNsName(), UpdateStringOfOSType(), UpdateStringOfString(), UpdateStringOfWideInt(), and ValidateFormat().#define ckfree(x)  Tcl_Free(x)

Definition at line 1517 of file tcl.h.
Referenced by AfterCleanupProc(), AfterProc(), AliasCreate(), AliasObjCmd(), AliasObjCmdDeleteProc(), AppendEnvironment(), AppInitExitHandler(), AsyncHandlerProc(), BgErrorDeleteProc(), CallCommandTraces(), CallTraceProcedure(), CleanupChannelHandlers(), CleanupTestSetassocdataTests(), CleanupVar(), CloseChannel(), closedir(), CommandObjTraceDeleted(), ComparePkgVersions(), CompileRegexp(), ConsoleCloseProc(), ConsoleOutputProc(), CopyFile(), CreateSocket(), DdeServerProc(), DelCmdProc(), DelDeleteProc(), DeleteArray(), DeleteChannelTable(), DeleteFileHandler(), DeleteImportedCmd(), DeleteInterpProc(), DeleteKey(), DeleteProc(), DeleteScriptRecord(), DeleteSearches(), DiscardInputQueued(), DisposeTraceResult(), DoRenameFile(), EncodingFreeProc(), EnterCmdStartData(), EscapeFreeProc(), FileClose(), FileCloseProc(), FinalizeRegexp(), FormatClock(), FreeAfterPtr(), FreeByteArrayInternalRep(), FreeCmdNameInternalRep(), FreeEncoding(), FreeForeachInfo(), FreeFsPathInternalRep(), FreeIndex(), FreeListInternalRep(), FreeNsNameInternalRep(), FreeObjEntry(), FreeParsedVarName(), FreeRegexp(), FreeSocketInfo(), FreeStringInternalRep(), FsThrExitProc(), FSUnloadTempFile(), GetFileSpecs(), GetInput(), GetTimesCmd(), GrowEvaluationStack(), HandleBgErrors(), InterpInfoDeleteProc(), LinkTraceProc(), LoadCleanupProc(), LoadEscapeEncoding(), NamespaceFree(), NativeFreeInternalRep(), OpenFileChannel(), OpenKey(), ParsePrimaryExpr(), ParseTokens(), PipeClose2Proc(), PipeCloseProc(), PipeOutputProc(), RebuildLiteralTable(), RecycleBuffer(), ReleaseCharSet(), RememberSyncObject(), ReplaceString(), ResetObjResult(), ResultClear(), SerialCloseProc(), SerialOutputProc(), SerialSetOptionProc(), SetListFromAny(), SetupAppendBuffer(), SocketFreeProc(), SpecialFree(), StopCopy(), StringTraceDeleteProc(), StringTraceProc(), TableFreeProc(), Tcl_AppendResultVA(), Tcl_AppendStringsToObjVA(), Tcl_ArrayObjCmd(), Tcl_AsyncDelete(), Tcl_BadChannelOption(), Tcl_CancelIdleCall(), Tcl_CaseObjCmd(), Tcl_ClearChannelHandlers(), Tcl_Close(), Tcl_CreateAlias(), Tcl_CreateCommand(), Tcl_CreateObjCommand(), TCL_DECLARE_MUTEX(), Tcl_DeleteAssocData(), Tcl_DeleteChannelHandler(), Tcl_DeleteCloseHandler(), Tcl_DeleteCommandFromToken(), Tcl_DeleteEvents(), Tcl_DeleteEventSource(), Tcl_DeleteExitHandler(), Tcl_DeleteHashEntry(), Tcl_DeleteHashTable(), Tcl_DeleteThreadExitHandler(), Tcl_DeleteTimerHandler(), Tcl_DiscardResult(), Tcl_DontCallWhenDeleted(), Tcl_DStringFree(), Tcl_DStringGetResult(), Tcl_EvalEx(), Tcl_EvalObjEx(), Tcl_EvalTokensStandard(), Tcl_ExecObjCmd(), Tcl_Export(), Tcl_ExprObj(), Tcl_Finalize(), Tcl_FinalizeThread(), Tcl_FindExecutable(), Tcl_ForeachObjCmd(), Tcl_FormatObjCmd(), Tcl_FreeParse(), Tcl_FreeResult(), Tcl_FSUnregister(), Tcl_GetObjResult(), Tcl_GlobObjCmd(), Tcl_InvalidateStringRep(), Tcl_LappendObjCmd(), Tcl_LinkVar(), Tcl_ListObjAppendElement(), Tcl_ListObjReplace(), Tcl_MacEvalResource(), Tcl_Main(), Tcl_Merge(), Tcl_OpenCommandChannel(), Tcl_OpenObjCmd(), Tcl_PackageObjCmd(), Tcl_ParseExpr(), Tcl_PopCallFrame(), Tcl_ReapDetachedProcs(), Tcl_Release(), Tcl_RemoveInterpResolvers(), Tcl_ResetResult(), Tcl_RestoreResult(), Tcl_ReturnObjCmd(), Tcl_ScanObjCmd(), Tcl_ServiceEvent(), Tcl_SetByteArrayLength(), Tcl_SetChannelBufferSize(), Tcl_SetChannelOption(), Tcl_SetObjResult(), Tcl_SetResult(), Tcl_SocketObjCmd(), Tcl_SplitList(), Tcl_StringObjCmd(), Tcl_UnlinkVar(), Tcl_UntraceCommand(), TclAccessDeleteProc(), Tclapplescript_Init(), TclChannelTransform(), TclCheckExecutionTraces(), TclCleanupCommand(), TclCompileForeachCmd(), TclCreateAuxData(), TclCreateExceptRange(), TclCreatePipeline(), TclCreateProc(), TclDeleteCompiledLocalVars(), TclDeleteExecEnv(), TclDeleteLiteralTable(), TclDeleteVars(), TclEvalObjvInternal(), TclExecuteByteCode(), TclExpandCodeArray(), TclExpandJumpFixupArray(), TclExpandTokenArray(), TclFileAttrsCmd(), TclFinalizeEnvironment(), TclFinalizeFilesystem(), TclFinalizeLoad(), TclFinalizeNotifier(), TclFinalizePreserve(), TclFinalizeSynchronization(), TclFinalizeThreadData(), TclFreeCompileEnv(), TclFreeJumpFixupArray(), TclFreeObj(), TclFreePackageInfo(), TclGetAndDetachPids(), TclGetOpenMode(), TclHandleFree(), TclHandleRelease(), TclInvoke(), TclInvokeObjectCommand(), TclInvokeStringCommand(), TclLookupVar(), TclMacCreateEnv(), TclMacUnRegisterResourceFork(), TclObjInvoke(), TclOpenFileChannelDeleteProc(), tclOSAClose(), tclOSADeleteCmd(), tclOSADeleteContext(), tclOSADeleteScript(), tclOSAMakeNewComponent(), TclpCloseFile(), TclpCreateProcess(), TclpDlopen(), TclpFindExecutable(), TclpFindVariable(), TclpInitLibraryPath(), TclProcCleanupProc(), TclProcInterpProc(), TclpUnloadFile(), TclRegisterLiteral(), TclReleaseLiteral(), TclResetShadowedCmdRefs(), TclServiceIdle(), TclSetEnv(), TclSetLibraryPath(), TclStatDeleteProc(), TclTeardownNamespace(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), TclUnsetEnv(), TclWinDriveLetterForVolMountPoint(), TclWinResetInterfaceEncodings(), TcpAcceptCallbacksDeleteProc(), TcpClose(), TcpCloseProc(), TcpOutput(), TcpServerCloseProc(), TestasyncCmd(), TestChannelEventCmd(), TestfindexecutableCmd(), TestlinkCmd(), TestpanicCmd(), TestplatformChmod(), TestsetassocdataCmd(), TestsetdefencdirCmd(), TimerExitProc(), TimerHandlerEventProc(), TraceCommandProc(), TraceExecutionProc(), TransformCloseProc(), UnlinkSymbolTable(), UnsetVarStruct(), and ValidateFormat().#define ckrealloc(x, y)  Tcl_Realloc(x,y)

Definition at line 1518 of file tcl.h.
Referenced by AppendUnicodeToUnicodeRep(), FillUnicodeRep(), getSortedHashKeys(), ResultAdd(), Tcl_AppendResultVA(), Tcl_AppendStringsToObjVA(), Tcl_DStringAppend(), Tcl_DStringAppendElement(), Tcl_DStringSetLength(), Tcl_SetObjLength(), TclSetEnv(), TclUnsetEnv(), and ValidateFormat().#define CONST  const

Definition at line 244 of file tcl.h.
Referenced by AllocStringEntry(), AppendEnvironment(), AppendUnicodeToUtfRep(), ApplicationType(), AsyncHandlerProc(), BuildCommandLine(), CallVarTraces(), cclass(), CheckVersion(), CommandComplete(), CompareArrayKeys(), CompareObjKeys(), ComparePkgVersions(), CompareStringKeys(), CompileRegexp(), CompileSubExpr(), CreateSocketAddress(), DeleteKey(), DoRemoveDirectory(), DoRemoveJustDirectory(), DoRenameFile(), DoTildeSubst(), DoWrite(), element(), EnvTraceProc(), EscapeFromUtfProc(), EscapeToUtfProc(), ExtractWinRoot(), FindLibraries(), FormatClock(), FspLLocationFromFsPath(), FspLocationFromFsPath(), GetFileFinderAttributes(), GetFileReadOnly(), GetFileSpecs(), GetGroupAttribute(), GetLexeme(), GetOwnerAttribute(), GetTimesCmd(), GetType(), GetValue(), GetWinFileAttributes(), HandleBgErrors(), HashArrayKey(), HashObjKey(), HashStringKey(), InfoCommandsCmd(), InfoHostnameCmd(), InfoLibraryCmd(), InfoNameOfExecutableCmd(), InfoPatchLevelCmd(), InfoProcsCmd(), InfoTclVersionCmd(), InfoVarsCmd(), lexdigits(), LinkTraceProc(), LoadEscapeEncoding(), LogCompilationInfo(), NativeIsExec(), NativeStat(), ObjMakeUpvar(), ObjTraceProc(), OpenEncodingFile(), ParseAddExpr(), ParseBitAndExpr(), ParseBitOrExpr(), ParseBitXorExpr(), ParseComment(), ParseCondExpr(), ParseEqualityExpr(), ParseLandExpr(), ParseLorExpr(), ParseMaxDoubleLength(), ParseMultiplyExpr(), ParsePrimaryExpr(), ParseRelationalExpr(), ParseShiftExpr(), ParseUnaryExpr(), Pkga_EqObjCmd(), ProcBodyTestInitInternal(), ReadChars(), regexec(), RegistryObjCmd(), repeat(), SerialSetOptionProc(), SetFileFinderAttributes(), SetFileReadOnly(), SetFsPathFromAny(), SetGroupAttribute(), SetListFromAny(), SetNsNameFromAny(), SetOwnerAttribute(), SetPermissionsAttribute(), SetTZIfNecessary(), SetWinFileAttributes(), SimpleCopy(), SimplePathInFilesystem(), SlaveObjCmd(), SplitMacPath(), SplitUnixPath(), SplitWinPath(), StringTraceProc(), strtod(), strtol(), strtoll(), strtoul(), strtoull(), TableFromUtfProc(), TableToUtfProc(), Tcl_AfterObjCmd(), Tcl_ArrayObjCmd(), Tcl_BackgroundError(), Tcl_BadChannelOption(), Tcl_BinaryObjCmd(), Tcl_CaseObjCmd(), Tcl_Concat(), Tcl_ConvertCountedElement(), Tcl_CreateChannel(), Tcl_CreateCommand(), Tcl_CreateNamespace(), Tcl_CreateObjCommand(), Tcl_DdeObjCmd(), TCL_DECLARE_MUTEX(), Tcl_DStringAppend(), Tcl_EncodingObjCmd(), Tcl_EvalEx(), Tcl_EvalTokensStandard(), Tcl_ExecObjCmd(), Tcl_Export(), Tcl_FcopyObjCmd(), Tcl_FileEventObjCmd(), Tcl_FileObjCmd(), Tcl_FindCommand(), Tcl_FindExecutable(), Tcl_FindNamespace(), Tcl_FindNamespaceVar(), Tcl_ForgetImport(), Tcl_FSGetNativePath(), Tcl_FSGetNormalizedPath(), Tcl_FSGetTranslatedStringPath(), Tcl_FSJoinPath(), Tcl_GetAlias(), Tcl_GetAliasObj(), Tcl_GetChannel(), Tcl_GetChannelNamesEx(), Tcl_GetIndexFromObjStruct(), Tcl_GetInt(), Tcl_GlobObjCmd(), Tcl_Import(), Tcl_InfoObjCmd(), Tcl_InitStubs(), Tcl_InterpObjCmd(), Tcl_IsChannelExisting(), Tcl_ListMathFuncs(), Tcl_LogCommandInfo(), Tcl_LsearchObjCmd(), Tcl_LsortObjCmd(), Tcl_MacEvalResource(), Tcl_NamespaceObjCmd(), Tcl_OpenObjCmd(), Tcl_PackageObjCmd(), Tcl_ParseBraces(), Tcl_ParseCommand(), Tcl_ParseVarName(), Tcl_PosixError(), Tcl_ProcObjCmd(), Tcl_PutEnv(), Tcl_RegExpExec(), Tcl_RegexpObjCmd(), Tcl_RegExpRange(), Tcl_RegisterChannel(), Tcl_RegsubObjCmd(), Tcl_ResourceObjCmd(), Tcl_ScanCountedElement(), Tcl_SeekObjCmd(), Tcl_SetChannelOption(), Tcl_SocketObjCmd(), Tcl_SourceRCFile(), Tcl_SplitList(), Tcl_SplitPath(), Tcl_StringCaseMatch(), Tcl_StringObjCmd(), Tcl_SubstObjCmd(), Tcl_SwitchObjCmd(), Tcl_TraceObjCmd(), Tcl_UniCharToUtfDString(), Tcl_UpdateObjCmd(), Tcl_UtfFindLast(), Tcl_UtfPrev(), Tcl_UtfToUniCharDString(), TCL_VARARGS_DEF(), Tcl_WinTCharToUtf(), TclCheckBadOctal(), TclCleanupChildren(), TclCompileCatchCmd(), TclCompileExprWords(), TclCompileForeachCmd(), TclCompileIfCmd(), TclCompileIncrCmd(), TclCompileScript(), TclCompileStringCmd(), TclCompileTokens(), TclCompileVariableCmd(), TclCreatePipeline(), TclCreateProc(), TclDateparse(), TclDoGlob(), TclExecuteByteCode(), TclFileAttrsCmd(), TclFindElement(), TclFSMakePathRelative(), TclGetEncodingFromObj(), TclGetEnv(), TclGetLong(), TclGetNamespaceForQualName(), TclGetOpenMode(), TclGlob(), TclGuessPackageName(), TclInvokeStringCommand(), TclIsLocalScalar(), TclLooksLikeInt(), TclLookupSimpleVar(), TclLookupVar(), TclMatchIsTrivial(), TclNativeDupInternalRep(), TclObjCommandComplete(), TclObjInvoke(), TclObjLookupVar(), tclOSALoad(), tclOSALoadCmd(), tclOSARunCmd(), tclOSAStore(), tclOSAStoreCmd(), TclParseBackslash(), TclParseHex(), TclParseInteger(), TclParseWhiteSpace(), TclpCreateTempFile(), TclpDlopen(), TclpFilesystemPathType(), TclpFindExecutable(), TclpFindSymbol(), TclpFindVariable(), TclpGetNativePathType(), TclpGetUserHome(), TclpGmtime(), TclpInitLibraryPath(), TclpLocaltime(), TclpMatchInDirectory(), TclpNativeToNormalized(), TclpObjAccess(), TclpObjChdir(), TclpObjCopyFile(), TclpObjListVolumes(), TclpObjLstat(), TclpObjNormalizePath(), TclpObjStat(), TclpOpenFile(), TclpOpenFileChannel(), TclpReadlink(), TclPrecTraceProc(), TclPrintSource(), TclpSetInitialEncodings(), TclpSetVariables(), TclPtrGetVar(), TclPushVarName(), TclpUtime(), TclRenameCommand(), TclSetEnv(), TclSockGetPort(), Tcltest_Init(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), TclUniCharMatch(), TclWinSetInterfaces(), TcpGetOptionProc(), TestChannelCmd(), TestChannelEventCmd(), TestchmodCmd(), TestencodingObjCmd(), TesteventObjCmd(), TestgetplatformCmd(), TestindexobjCmd(), TestlocaleCmd(), TestOpenFileChannelProc1(), TestOpenFileChannelProc2(), TestOpenFileChannelProc3(), TestpanicCmd(), TestparsevarObjCmd(), TestregexpObjCmd(), TestsaveresultCmd(), TestsetCmd(), TeststringobjCmd(), TesttranslatefilenameCmd(), TestwinclockCmd(), TransformGetOptionProc(), TranslateInputEOL(), TranslateOutputEOL(), TraverseUnixTree(), UnicodeToUtfProc(), UpdateStringOfFsPath(), UpdateStringOfIndex(), UtfToUnicodeProc(), UtfToUtfProc(), WinReadLinkDirectory(), and WriteTextResource().#define CONST84  CONST

Definition at line 266 of file tcl.h.#define CONST84_RETURN  CONST

Definition at line 267 of file tcl.h.#define DLLEXPORT

Definition at line 202 of file tcl.h.#define DLLIMPORT

Definition at line 201 of file tcl.h.#define EXTERN  extern TCL_STORAGE_CLASS

Definition at line 282 of file tcl.h.#define JOIN(a, b)  JOIN1(a,b)

Definition at line 116 of file tcl.h.#define JOIN1(a, b)  a##b

Definition at line 117 of file tcl.h.#define NUM_STATIC_TOKENS  20

Definition at line 2125 of file tcl.h.
Referenced by Tcl_ParseBraces(), Tcl_ParseCommand(), Tcl_ParseExpr(), Tcl_ParseQuotedString(), and Tcl_ParseVarName().#define panic  Tcl_Panic

Definition at line 2273 of file tcl.h.
Referenced by BogusCreate(), BogusFind(), CloseChannel(), CompileLandOrLorExpr(), CompileSubExpr(), DeleteImportedCmd(), DeleteInterpProc(), DoWrite(), EncodeCmdLocMap(), EnterCmdExtentData(), EnterCmdStartData(), ExprCallMathFunc(), FileClose(), FileThreadActionProc(), GetCmdLocEncodingSize(), GetTableEncoding(), InitByteCodeExecution(), InterpInfoDeleteProc(), ObjMakeUpvar(), ParseTokens(), ProcBodySetFromAny(), ProcBodyUpdateString(), RegisterTcpServerInterpCleanup(), SetListFromAny(), SlaveObjCmd(), StdIOClose(), Tcl_AfterObjCmd(), Tcl_Alloc(), Tcl_AppendStringsToObjVA(), Tcl_AppendToObj(), Tcl_AppendUnicodeToObj(), Tcl_AttemptSetObjLength(), Tcl_BadChannelOption(), Tcl_Close(), Tcl_CreateChannel(), Tcl_CreateInterp(), Tcl_CutChannel(), Tcl_DbCkalloc(), Tcl_DbCkrealloc(), Tcl_DbDecrRefCount(), Tcl_DbIncrRefCount(), Tcl_DbIsShared(), TCL_DECLARE_MUTEX(), Tcl_DeleteHashEntry(), Tcl_EvalTokensStandard(), Tcl_EventuallyFree(), Tcl_ExprObj(), Tcl_FinalizeNotifier(), Tcl_ForeachObjCmd(), Tcl_FSGetFileSystemForPath(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_InitCustomHashTable(), Tcl_InitNotifier(), Tcl_ListObjAppendElement(), Tcl_ListObjAppendList(), Tcl_ListObjReplace(), Tcl_OpenObjCmd(), Tcl_PackageObjCmd(), Tcl_PushCallFrame(), Tcl_Realloc(), Tcl_RegisterChannel(), Tcl_ResourceObjCmd(), Tcl_SetBooleanObj(), Tcl_SetByteArrayLength(), Tcl_SetByteArrayObj(), Tcl_SetDoubleObj(), Tcl_SetIntObj(), Tcl_SetListObj(), Tcl_SetLongObj(), Tcl_SetObjLength(), Tcl_SetStringObj(), Tcl_SetWideIntObj(), Tcl_SocketObjCmd(), Tcl_SpliceChannel(), Tcl_SubstObjCmd(), Tcl_SwitchObjCmd(), Tcl_TraceVar2(), Tcl_UpdateObjCmd(), Tclapplescript_Init(), TclCompEvalObj(), TclCompileCatchCmd(), TclDeleteExecEnv(), TclExecuteByteCode(), TclFixupForwardJump(), TclFreeObj(), TclGetNamespaceForQualName(), TclHandleFree(), TclHandlePreserve(), TclHandleRelease(), TclInitByteCodeObj(), TclInitLiteralTable(), TclInitSubsystems(), TclListObjSetElement(), TclMacRegisterResourceFork(), TclMacUnRegisterResourceFork(), TclObjInterpProc(), tclOSAClose(), TclpCloseFile(), TclpCreateProcess(), TclpGetDefaultStdChannel(), TclpOpenFileChannel(), TclPrintInstruction(), TclRegisterLiteral(), TclSetAppContext(), TclSetByteCodeFromAny(), TclUnixWaitForFile(), TclWinInit(), TcpClose(), TestChannelEventCmd(), TestpanicCmd(), TraceExecutionProc(), UpdateParsedVarName(), and UpdateStringOfFsPath().#define panicVA  Tcl_PanicVA

Definition at line 2274 of file tcl.h.#define STRINGIFY(x)  STRINGIFY1(x)

Definition at line 112 of file tcl.h.#define STRINGIFY1(x)  #x

Definition at line 113 of file tcl.h.#define TCL_ALL_EVENTS  (~TCL_DONT_WAIT)

Definition at line 1366 of file tcl.h.
Referenced by Tcl_CreateTimerHandler(), Tcl_DoOneEvent(), Tcl_ServiceAll(), Tcl_ServiceEvent(), Tcl_UpdateObjCmd(), and Tcl_VwaitObjCmd().#define TCL_ALLOW_INLINE_COMPILATION  0x20000

Definition at line 1077 of file tcl.h.
Referenced by Tcl_CreateObjTrace(), Tcl_DeleteTrace(), and TestcmdtraceCmd().#define TCL_ALPHA_RELEASE  0

Definition at line 34 of file tcl.h.#define TCL_APPEND_VALUE  4

Definition at line 1053 of file tcl.h.
Referenced by Tcl_AddObjErrorInfo(), Tcl_AppendObjCmd(), Tcl_SetErrorCodeVA(), TclExecuteByteCode(), TclpSetVariables(), and TclPtrSetVar().#define TCL_BETA_RELEASE  1

Definition at line 35 of file tcl.h.#define TCL_BREAK  3

Definition at line 636 of file tcl.h.
Referenced by HandleBgErrors(), ObjTraceProc(), ProcessProcResultCode(), ProcessUnexpectedResult(), Tcl_BreakObjCmd(), Tcl_ForeachObjCmd(), Tcl_ForObjCmd(), Tcl_ReturnObjCmd(), Tcl_SubstObj(), Tcl_WhileObjCmd(), and TclExecuteByteCode().#define TCL_CHANNEL_THREAD_INSERT  (0)

Definition at line 1455 of file tcl.h.
Referenced by ConsoleThreadActionProc(), FileThreadActionProc(), PipeThreadActionProc(), SerialThreadActionProc(), Tcl_SpliceChannel(), and TcpThreadActionProc().#define TCL_CHANNEL_THREAD_REMOVE  (1)

Definition at line 1456 of file tcl.h.
Referenced by FileCloseProc(), and Tcl_CutChannel().#define TCL_CHANNEL_VERSION_1  ((Tcl_ChannelTypeVersion) 0x1)

Definition at line 1446 of file tcl.h.
Referenced by Tcl_ChannelVersion().#define TCL_CHANNEL_VERSION_2  ((Tcl_ChannelTypeVersion) 0x2)

Definition at line 1447 of file tcl.h.
Referenced by Tcl_ChannelBlockModeProc(), Tcl_ChannelFlushProc(), Tcl_ChannelHandlerProc(), and Tcl_ChannelVersion().#define TCL_CHANNEL_VERSION_3  ((Tcl_ChannelTypeVersion) 0x3)

Definition at line 1448 of file tcl.h.
Referenced by Tcl_ChannelVersion(), Tcl_ChannelWideSeekProc(), Tcl_Seek(), and Tcl_Tell().#define TCL_CHANNEL_VERSION_4  ((Tcl_ChannelTypeVersion) 0x4)

Definition at line 1449 of file tcl.h.
Referenced by Tcl_ChannelThreadActionProc(), and Tcl_ChannelVersion().#define Tcl_Ckalloc  Tcl_Alloc

Definition at line 2268 of file tcl.h.#define Tcl_Ckfree  Tcl_Free

Definition at line 2269 of file tcl.h.#define Tcl_Ckrealloc  Tcl_Realloc

Definition at line 2270 of file tcl.h.#define TCL_CLOSE2PROC  ((Tcl_DriverCloseProc *)1)

Definition at line 1441 of file tcl.h.
Referenced by CloseChannel(), Tcl_Close(), Tcl_UnstackChannel(), and TclFinalizeIOSubsystem().#define TCL_CLOSE_READ  (1<<1)

Definition at line 1434 of file tcl.h.
Referenced by PipeClose2Proc(), and Tcl_Close().#define TCL_CLOSE_WRITE  (1<<2)

Definition at line 1435 of file tcl.h.
Referenced by PipeClose2Proc().#define Tcl_ConditionFinalize(condPtr)

Definition at line 154 of file tcl.h.
Referenced by Tcl_FinalizeNotifier().#define Tcl_ConditionNotify(condPtr)

Definition at line 152 of file tcl.h.
Referenced by Tcl_AlertNotifier().#define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)

Definition at line 153 of file tcl.h.
Referenced by Tcl_FinalizeNotifier(), Tcl_InitNotifier(), and Tcl_WaitForEvent().#define TCL_CONTINUE  4

Definition at line 637 of file tcl.h.
Referenced by ObjTraceProc(), ProcessProcResultCode(), ProcessUnexpectedResult(), Tcl_ContinueObjCmd(), Tcl_FindCommand(), Tcl_FindNamespaceVar(), Tcl_ForeachObjCmd(), Tcl_ForObjCmd(), Tcl_ReturnObjCmd(), Tcl_SubstObj(), Tcl_WhileObjCmd(), TclExecuteByteCode(), TclInitCompiledLocals(), and TclLookupSimpleVar().#define TCL_CONVERT_MULTIBYTE  -1

Definition at line 2214 of file tcl.h.
Referenced by EscapeFromUtfProc(), EscapeToUtfProc(), FilterInputBytes(), TableFromUtfProc(), TableToUtfProc(), UnicodeToUtfProc(), UtfToUnicodeProc(), and UtfToUtfProc().#define TCL_CONVERT_NOSPACE  -4

Definition at line 2217 of file tcl.h.
Referenced by BinaryProc(), EscapeFromUtfProc(), EscapeToUtfProc(), TableFromUtfProc(), TableToUtfProc(), Tcl_ExternalToUtfDString(), Tcl_UtfToExternalDString(), UnicodeToUtfProc(), UtfToUnicodeProc(), and UtfToUtfProc().#define TCL_CONVERT_SYNTAX  -2

Definition at line 2215 of file tcl.h.
Referenced by EscapeToUtfProc(), and TableToUtfProc().#define TCL_CONVERT_UNKNOWN  -3

Definition at line 2216 of file tcl.h.
Referenced by EscapeFromUtfProc(), and TableFromUtfProc().#define TCL_CREATE_HARD_LINK  0x02

Definition at line 1921 of file tcl.h.
Referenced by Tcl_FileObjCmd(), TestfilelinkCmd(), and WinLink().#define TCL_CREATE_SYMBOLIC_LINK  0x01

Definition at line 1920 of file tcl.h.
Referenced by Tcl_FileObjCmd(), TestfilelinkCmd(), and WinLink().#define Tcl_CreateHashEntry(tablePtr, key, newPtr)  (*((tablePtr)->createProc))(tablePtr, key, newPtr)

Definition at line 1346 of file tcl.h.
Referenced by AliasCreate(), FindPackage(), RegisterTcpServerInterpCleanup(), ScanNumber(), SlaveCreate(), Tcl_CallWhenDeleted(), Tcl_CreateCommand(), Tcl_CreateEncoding(), Tcl_CreateInterp(), Tcl_CreateMathFunc(), Tcl_CreateNamespace(), Tcl_CreateObjCommand(), Tcl_ExposeCommand(), Tcl_GetEncodingNames(), Tcl_HideCommand(), Tcl_InitCustomHashTable(), Tcl_RegisterChannel(), Tcl_RegisterObjType(), Tcl_SetAssocData(), Tcl_SplitObjCmd(), Tclapplescript_Init(), TclCompileExpr(), TclLookupArrayElement(), TclLookupSimpleVar(), TclMacRegisterResourceFork(), tclOSAAddContext(), tclOSAAddScript(), tclOSAMakeNewComponent(), TclRegisterAuxDataType(), and TclRenameCommand().#define TCL_CUSTOM_PTR_KEYS  -1

Definition at line 1313 of file tcl.h.
Referenced by RebuildTable(), Tcl_CreateHashEntry(), Tcl_DeleteHashEntry(), Tcl_DeleteHashTable(), Tcl_FindHashEntry(), Tcl_InitCustomHashTable(), and Tcl_InitObjHashTable().#define TCL_CUSTOM_TYPE_KEYS  -2

Definition at line 1312 of file tcl.h.
Referenced by RebuildTable(), Tcl_CreateHashEntry(), Tcl_DeleteHashEntry(), Tcl_DeleteHashTable(), Tcl_FindHashEntry(), and Tcl_InitCustomHashTable().#define TCL_DECLARE_MUTEX(name)

Definition at line 140 of file tcl.h.
Referenced by TestplatformChmod().#define Tcl_DecrRefCount(objPtr)  if (--(objPtr)->refCount > 0) ; else TclFreeObj(objPtr)

Definition at line 832 of file tcl.h.
Referenced by AfterCleanupProc(), AfterProc(), AliasCreate(), AliasObjCmd(), AliasObjCmdDeleteProc(), CleanupChannelHandlers(), CloseLibraryResource(), ComparePkgVersions(), ConvertFileNameFormat(), CopyData(), CopyRenameOneFile(), CreateScriptRecord(), DdeServerProc(), DeleteChannelTable(), DeleteInterpProc(), DeleteScanNumberCache(), DeleteScriptRecord(), DisposeTraceResult(), DoWriteChars(), ExecuteCallback(), FileBasename(), FileCopyRename(), FileNameCleanup(), FreeAfterPtr(), FreeFsPathInternalRep(), FreeListInternalRep(), FreeObjEntry(), FsAddMountsToGlobResult(), FsThrExitProc(), FSUnloadTempFile(), FsUpdateCwd(), GetLexeme(), GetPathType(), GetTimesCmd(), InfoDefaultCmd(), InfoScriptCmd(), LinkTraceProc(), LoadTableEncoding(), NamespaceInscopeCmd(), OpenEncodingFile(), ParseKeyName(), ParsePrimaryExpr(), PretendTclpAccess(), PretendTclpOpenFileChannel(), PretendTclpStat(), ProcBodyTestProcObjCmd(), SetFsPathFromAny(), SetListFromAny(), SetVarToObj(), SimpleCopy(), SimpleOpenFileChannel(), SimpleStat(), SlaveCreate(), SlaveEval(), StdinProc(), StopCopy(), StoreStatData(), Tcl_Access(), Tcl_AddObjErrorInfo(), Tcl_AfterObjCmd(), Tcl_ArrayObjCmd(), Tcl_BinaryObjCmd(), Tcl_CdObjCmd(), Tcl_Chdir(), Tcl_ClearChannelHandlers(), Tcl_CreateAlias(), Tcl_CreateAliasObj(), Tcl_CreateSlave(), Tcl_DdeObjCmd(), Tcl_EvalEx(), Tcl_EvalFile(), Tcl_EvalTokensStandard(), Tcl_ExecObjCmd(), Tcl_ExprBoolean(), Tcl_ExprBooleanObj(), Tcl_ExprDouble(), Tcl_ExprDoubleObj(), Tcl_ExprLong(), Tcl_ExprLongObj(), Tcl_ExprObjCmd(), Tcl_ExprString(), Tcl_FileObjCmd(), Tcl_FinalizeThread(), Tcl_ForeachObjCmd(), Tcl_FormatObjCmd(), Tcl_FSAccess(), Tcl_FSChdir(), Tcl_FSEvalFile(), Tcl_FSGetCwd(), Tcl_FSGetNormalizedPath(), Tcl_FSGetTranslatedStringPath(), Tcl_FSJoinPath(), Tcl_FSJoinToPath(), Tcl_FSListVolumes(), Tcl_FSLoadFile(), Tcl_FSMatchInDirectory(), Tcl_FSOpenFileChannel(), Tcl_FSRemoveDirectory(), Tcl_FSStat(), Tcl_GetCwd(), Tcl_GetEncodingNames(), Tcl_GetPathType(), Tcl_Gets(), Tcl_GetSlave(), Tcl_GetsObjCmd(), Tcl_GlobObjCmd(), Tcl_Import(), Tcl_Init(), Tcl_InterpObjCmd(), Tcl_JoinPath(), Tcl_LappendObjCmd(), Tcl_LindexObjCmd(), Tcl_LinkVar(), Tcl_LinsertObjCmd(), Tcl_ListMathFuncs(), Tcl_LreplaceObjCmd(), Tcl_LsearchObjCmd(), Tcl_LsetObjCmd(), Tcl_LsObjCmd(), Tcl_LsortObjCmd(), Tcl_Main(), Tcl_OpenFileChannel(), Tcl_PackageObjCmd(), Tcl_PkgRequireEx(), Tcl_PwdObjCmd(), Tcl_ReadObjCmd(), Tcl_RecordAndEval(), Tcl_RecordAndEvalObj(), Tcl_RegexpObjCmd(), Tcl_RegsubObjCmd(), Tcl_ResourceObjCmd(), Tcl_RestoreResult(), Tcl_ScanObjCmd(), Tcl_SetVar2(), Tcl_SplitPath(), Tcl_Stat(), Tcl_StringObjCmd(), Tcl_SubstObj(), Tcl_TraceObjCmd(), Tcl_TranslateFileName(), Tcl_UnlinkVar(), Tcl_UpdateLinkedVar(), TclChannelTransform(), TclCleanupByteCode(), TclCleanupChildren(), TclCompileIncrCmd(), TclCompileStringCmd(), TclCompileWhileCmd(), TclCreateProc(), TclDeleteNamespaceVars(), TclDeleteVars(), TclDoGlob(), TclEvalObjvInternal(), TclFileAttrsCmd(), TclFileDirname(), TclFileMakeDirsCmd(), TclFinalizeFilesystem(), TclFSCwdPointerEquals(), TclFSNormalizeAbsolutePath(), TclGlob(), TclInvoke(), TclInvokeObjectCommand(), TclLindexFlat(), TclLindexList(), TclListObjSetElement(), TclLsetFlat(), TclLsetList(), TclObjInvoke(), TclpCreateProcess(), TclpFilesystemPathType(), TclpMatchInDirectory(), TclpObjCopyDirectory(), TclpObjNormalizePath(), TclpObjRemoveDirectory(), TclpObjStat(), TclProcCleanupProc(), TclPtrIncrVar(), TclPtrSetVar(), TclReleaseLiteral(), TclSetLibraryPath(), TclSetStartupScriptPath(), TclTeardownNamespace(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclUpdateReturnInfo(), TestChannelEventCmd(), TestcmdtokenCmd(), TesteventDeleteProc(), TesteventProc(), TestfileCmd(), TestfilelinkCmd(), TestlinkCmd(), TestobjCmd(), TestregexpObjCmd(), TestReportFreeInternalRep(), TestReportInFilesystem(), TestsetobjerrorcodeCmd(), TestSimpleFilesystemObjCmd(), TraceExecutionProc(), TraceVarProc(), TransformCloseProc(), and UpdateStringOfFsPath().#define TCL_DONT_USE_BRACES  1

Definition at line 1022 of file tcl.h.
Referenced by Tcl_ConvertCountedElement(), and Tcl_ScanCountedElement().#define TCL_DONT_WAIT  (1<<1)

Definition at line 1361 of file tcl.h.
Referenced by Tcl_DoOneEvent(), Tcl_UpdateObjCmd(), TclOSAActiveProc(), and TestfilehandlerCmd().#define TCL_DOUBLE_SPACE  (TCL_MAX_PREC+10)

Definition at line 1008 of file tcl.h.
Referenced by Tcl_ExprString(), TestlinkCmd(), and UpdateStringOfDouble().#define Tcl_DoubleAsWide(val)  ((Tcl_WideInt)((double)(val)))

Definition at line 446 of file tcl.h.
Referenced by ExprRoundFunc(), and ExprWideFunc().#define TCL_DSTRING_STATIC_SIZE  200

Definition at line 985 of file tcl.h.
Referenced by GetValue(), Tcl_DStringFree(), Tcl_DStringGetResult(), Tcl_DStringInit(), and Tcl_DStringResult().#define Tcl_DStringLength(dsPtr)  ((dsPtr)->length)

Definition at line 998 of file tcl.h.
Referenced by AppendEnvironment(), AppendSystemError(), AppendUnicodeToUtfRep(), ApplicationType(), BuildCommandLine(), CompileRegexp(), ConvertFileNameFormat(), DoRenameFile(), GetKeyNames(), GetOwnerAttribute(), GetValue(), GetValueNames(), LoadEscapeEncoding(), NativeCreateNativeRep(), NativeStat(), prepareScriptData(), SetFsPathFromAny(), SetValue(), SplitWinPath(), Tcl_EncodingObjCmd(), Tcl_EvalObjv(), Tcl_ExternalToUtfDString(), Tcl_FileObjCmd(), Tcl_FindExecutable(), Tcl_GlobObjCmd(), Tcl_MacConvertTextResource(), Tcl_MacEvalResource(), Tcl_MacFindResource(), Tcl_Main(), Tcl_RegExpExec(), Tcl_ResourceObjCmd(), Tcl_SourceRCFile(), Tcl_UniCharToUtfDString(), Tcl_UtfToExternalDString(), Tcl_UtfToUniCharDString(), TclCompileTokens(), TclDoGlob(), TclGlob(), tclOSALoad(), tclOSAStore(), TclpFilesystemPathType(), TclpFindExecutable(), TclpFindSymbol(), TclpGetNativePathType(), TclpInitLibraryPath(), TclpMatchInDirectory(), TclpNativeToNormalized(), TclpObjListVolumes(), TclpObjNormalizePath(), TclpObjRemoveDirectory(), TclpReadlink(), TclpSetInitialEncodings(), TclpSetVariables(), TclUnsetEnv(), TestdstringCmd(), TraceCommandProc(), TraceVarProc(), TraversalCopy(), TraversalDelete(), TraverseUnixTree(), TraverseWinTree(), and WinReadLinkDirectory().#define Tcl_DStringTrunc  Tcl_DStringSetLength

Definition at line 1000 of file tcl.h.
Referenced by TestdstringCmd().#define Tcl_DStringValue(dsPtr)  ((dsPtr)->string)

Definition at line 999 of file tcl.h.
Referenced by AppendSystemError(), ApplicationType(), BuildCommandLine(), CallVarTraces(), ConvertFileNameFormat(), DdeServerProc(), DeleteValue(), DoRemoveDirectory(), DoTildeSubst(), FormatClock(), GetKeyNames(), GetValue(), GetValueNames(), LoadEncodingFile(), LoadEscapeEncoding(), LoadTableEncoding(), NamespaceChildrenCmd(), NativeCreateNativeRep(), prepareScriptData(), RecursiveDeleteKey(), SetFsPathFromAny(), SetValue(), SplitWinPath(), Tcl_BadChannelOption(), Tcl_CreateNamespace(), Tcl_EncodingObjCmd(), Tcl_EvalObjv(), Tcl_ExternalToUtfDString(), Tcl_FindExecutable(), Tcl_GetCwd(), Tcl_GlobObjCmd(), Tcl_Import(), Tcl_JoinPath(), Tcl_LoadObjCmd(), Tcl_MacConvertTextResource(), Tcl_MacEvalResource(), Tcl_MacFindResource(), Tcl_Main(), Tcl_ProcObjCmd(), Tcl_ResourceObjCmd(), Tcl_SourceRCFile(), Tcl_TranslateFileName(), Tcl_UniCharToUtfDString(), Tcl_UtfToExternalDString(), Tcl_UtfToUniCharDString(), Tcl_VarEvalVA(), TclCompileForeachCmd(), TclCompileScript(), TclCompileTokens(), TclCreatePipeline(), TclDoGlob(), TclFindEncodings(), TclGetEnv(), TclGetNamespaceForQualName(), TclGlob(), TclGuessPackageName(), TclOSACompileCmd(), tclOSAExecuteCmd(), tclOSALoad(), tclOSAStore(), TclpCreateProcess(), TclpDlopen(), TclpFilesystemPathType(), TclpFindExecutable(), TclpFindSymbol(), TclpGetCwd(), TclpGetNativePathType(), TclpGetUserHome(), TclpInitLibraryPath(), TclpMatchInDirectory(), TclpNativeToNormalized(), TclpObjCopyDirectory(), TclpObjGetCwd(), TclpObjListVolumes(), TclpObjNormalizePath(), TclpObjRemoveDirectory(), TclpReadlink(), TclpSetInitialEncodings(), TclpSetVariables(), TclRenameCommand(), TclUnsetEnv(), TcpGetOptionProc(), TestcmdtraceCmd(), TestdstringCmd(), TestOpenFileChannelProc1(), TestOpenFileChannelProc2(), TestOpenFileChannelProc3(), TestReport(), TraceCommandProc(), TraceExecutionProc(), TraceVarProc(), TraversalCopy(), TraversalDelete(), TraverseUnixTree(), TraverseWinTree(), and WinReadLinkDirectory().#define Tcl_DumpActiveMemory(x)

Definition at line 1522 of file tcl.h.
Referenced by TclFinalizeMemorySubsystem().#define TCL_DYNAMIC  ((Tcl_FreeProc *) 3)

Definition at line 1046 of file tcl.h.
Referenced by BgErrorDeleteProc(), CloseChannel(), DeleteArray(), DeleteProc(), Tcl_DeleteTrace(), Tcl_DiscardResult(), Tcl_DStringGetResult(), Tcl_DStringResult(), Tcl_FreeResult(), Tcl_GetObjResult(), Tcl_PackageObjCmd(), Tcl_Release(), Tcl_ResetResult(), Tcl_SetObjResult(), Tcl_SetResult(), Tcl_UnstackChannel(), Tcl_UntraceVar2(), TclDeleteNamespaceVars(), TclDeleteVars(), TclFreePackageInfo(), TcpServerCloseProc(), TestdstringCmd(), TestsaveresultCmd(), and UnsetVarStruct().#define TCL_ENCODING_END  0x02

Definition at line 1997 of file tcl.h.
Referenced by EscapeFromUtfProc(), EscapeToUtfProc(), GetInput(), ReadChars(), TableFromUtfProc(), Tcl_Close(), Tcl_ExternalToUtf(), Tcl_ExternalToUtfDString(), Tcl_SetChannelOption(), Tcl_UtfToExternal(), Tcl_UtfToExternalDString(), UtfToUnicodeProc(), UtfToUtfProc(), and WriteChars().#define TCL_ENCODING_START  0x01

Definition at line 1996 of file tcl.h.
Referenced by EscapeFromUtfProc(), EscapeToUtfProc(), FilterInputBytes(), ReadChars(), Tcl_CreateChannel(), Tcl_ExternalToUtf(), Tcl_ExternalToUtfDString(), Tcl_SetChannelOption(), Tcl_UtfToExternal(), Tcl_UtfToExternalDString(), and WriteChars().#define TCL_ENCODING_STOPONERROR  0x04

Definition at line 1998 of file tcl.h.
Referenced by EscapeFromUtfProc(), EscapeToUtfProc(), TableFromUtfProc(), and TableToUtfProc().#define TCL_ENFORCE_MODE  (1<<4)

Definition at line 1428 of file tcl.h.
Referenced by Tcl_OpenCommandChannel(), and Tcl_OpenObjCmd().#define TCL_ERROR  1

Definition at line 634 of file tcl.h.
Referenced by AliasCreate(), AliasDelete(), BroadcastValue(), CallVarTraces(), CannotSetAttribute(), CheckVersion(), CommonGetHandle(), ComparePkgVersions(), CompileMathFuncCall(), CompileSubExpr(), ConvertFileNameFormat(), CopyData(), CopyFile(), CopyFileAtts(), CopyRenameOneFile(), CreatedCommandProc(), CreatedCommandProc2(), DeleteKey(), DeleteValue(), DetachChannel(), DoCopyDirectory(), DoCopyFile(), DoCreateDirectory(), DoRemoveDirectory(), DoRemoveJustDirectory(), DoRenameFile(), ExecuteCallback(), ExecuteRemoteObject(), ExprAbsFunc(), ExprBinaryFunc(), ExprCallMathFunc(), ExprDoubleFunc(), ExprIntFunc(), ExprRoundFunc(), ExprSrandFunc(), ExprUnaryFunc(), ExprWideFunc(), FileCopyRename(), FileGetHandleProc(), FindLibraries(), FormatClock(), FormatNumber(), GetFileFinderAttributes(), GetFileReadOnly(), GetFinderFont(), GetGroupAttribute(), GetKeyNames(), GetLexeme(), GetModeFromPermString(), GetOwnerAttribute(), GetPermissionsAttribute(), GetStatBuf(), GetTimesCmd(), GetType(), GetValue(), GetValueNames(), GetVariableIndex(), GetWinFileAttributes(), HandleBgErrors(), InfoArgsCmd(), InfoBodyCmd(), InfoCmdCountCmd(), InfoCommandsCmd(), InfoCompleteCmd(), InfoDefaultCmd(), InfoExistsCmd(), InfoFunctionsCmd(), InfoGlobalsCmd(), InfoHostnameCmd(), InfoLevelCmd(), InfoLibraryCmd(), InfoLoadedCmd(), InfoLocalsCmd(), InfoNameOfExecutableCmd(), InfoPatchLevelCmd(), InfoProcsCmd(), InfoScriptCmd(), InfoSharedlibCmd(), InfoTclVersionCmd(), InfoVarsCmd(), MakeDdeConnection(), MakeTcpClientChannelMode(), NamespaceChildrenCmd(), NamespaceCodeCmd(), NamespaceCurrentCmd(), NamespaceDeleteCmd(), NamespaceEvalCmd(), NamespaceExistsCmd(), NamespaceExportCmd(), NamespaceForgetCmd(), NamespaceImportCmd(), NamespaceInscopeCmd(), NamespaceOriginCmd(), NamespaceParentCmd(), NamespaceQualifiersCmd(), NamespaceTailCmd(), NamespaceWhichCmd(), ObjMakeUpvar(), ObjTraceProc(), OpenKey(), ParseCondExpr(), ParseKeyName(), ParsePrimaryExpr(), ParseTokens(), PipeGetHandleProc(), Pkga_EqObjCmd(), Pkga_Init(), Pkga_QuoteObjCmd(), Pkgb_Init(), Pkgb_SafeInit(), Pkgb_SubObjCmd(), Pkgc_Init(), Pkgc_SafeInit(), Pkgc_SubObjCmd(), Pkgd_Init(), Pkgd_SafeInit(), Pkgd_SubObjCmd(), Pkge_Init(), Pkgf_Init(), prepareScriptData(), ProcBodyTestInitInternal(), ProcBodyTestProcObjCmd(), ProcCompileProc(), ProcessProcResultCode(), RegisterCommand(), Registry_Init(), RegistryObjCmd(), SerialGetOptionProc(), SerialSetOptionProc(), SetArraySearchObj(), SetBlockMode(), SetBooleanFromAny(), SetDoubleFromAny(), SetEndOffsetFromAny(), SetFileFinderAttributes(), SetFileReadOnly(), SetFsPathFromAny(), SetGroupAttribute(), SetIndexFromAny(), SetIntFromAny(), SetIntOrWideFromAny(), SetOSTypeFromAny(), SetOwnerAttribute(), SetPermissionsAttribute(), SetRegexpFromAny(), SetValue(), SetWideIntFromAny(), SetWinFileAttributes(), SlaveCreate(), SlaveExpose(), SlaveHide(), SlaveInvokeHidden(), SlaveMarkTrusted(), SlaveObjCmd(), SlaveRecursionLimit(), SortCompare(), Tcl_AfterObjCmd(), Tcl_AppendAllObjTypes(), Tcl_AppendObjCmd(), Tcl_AppInit(), Tcl_ArrayObjCmd(), Tcl_BadChannelOption(), Tcl_BeepObjCmd(), Tcl_BinaryObjCmd(), Tcl_BreakObjCmd(), Tcl_CaseObjCmd(), Tcl_CatchObjCmd(), Tcl_CdObjCmd(), Tcl_Close(), Tcl_CloseObjCmd(), Tcl_ContinueObjCmd(), Tcl_CreateThread(), Tcl_DdeObjCmd(), TCL_DECLARE_MUTEX(), Tcl_DetachChannel(), Tcl_EchoCmd(), Tcl_EncodingObjCmd(), Tcl_EofObjCmd(), Tcl_ErrorObjCmd(), Tcl_EvalEx(), Tcl_EvalObjCmd(), Tcl_EvalObjEx(), Tcl_EvalObjv(), Tcl_EvalTokensStandard(), Tcl_ExecObjCmd(), Tcl_ExitObjCmd(), Tcl_Export(), Tcl_ExposeCommand(), Tcl_ExprDouble(), Tcl_ExprLong(), Tcl_ExprObjCmd(), Tcl_FblockedObjCmd(), Tcl_FconfigureObjCmd(), Tcl_FcopyObjCmd(), Tcl_FileEventObjCmd(), Tcl_FileObjCmd(), Tcl_Flush(), Tcl_FlushObjCmd(), Tcl_ForeachObjCmd(), Tcl_ForgetImport(), Tcl_FormatObjCmd(), Tcl_ForObjCmd(), Tcl_FSEvalFile(), Tcl_FSLoadFile(), Tcl_FSMatchInDirectory(), Tcl_FSRegister(), Tcl_FSUnregister(), Tcl_GetAlias(), Tcl_GetAliasObj(), Tcl_GetBoolean(), Tcl_GetChannelNamesEx(), Tcl_GetChannelOption(), Tcl_GetDouble(), Tcl_GetInt(), Tcl_GetInterpPath(), Tcl_GetIntFromObj(), Tcl_GetLongFromObj(), Tcl_GetMathFuncInfo(), Tcl_GetOpenFile(), Tcl_GetsObjCmd(), Tcl_GlobalObjCmd(), Tcl_GlobObjCmd(), Tcl_HideCommand(), Tcl_IfObjCmd(), Tcl_Import(), Tcl_IncrObjCmd(), Tcl_InfoObjCmd(), Tcl_Init(), Tcl_InterpObjCmd(), Tcl_JoinObjCmd(), Tcl_JoinThread(), Tcl_LappendObjCmd(), Tcl_LindexObjCmd(), Tcl_LinkVar(), Tcl_LinsertObjCmd(), Tcl_LlengthObjCmd(), Tcl_LoadObjCmd(), Tcl_LrangeObjCmd(), Tcl_LreplaceObjCmd(), Tcl_LsearchObjCmd(), Tcl_LsetObjCmd(), Tcl_LsObjCmd(), Tcl_LsortObjCmd(), Tcl_MacBGNotifyObjCmd(), Tcl_MacEvalResource(), Tcl_MacOSXOpenVersionedBundleResources(), Tcl_MacSourceObjCmd(), Tcl_NamespaceObjCmd(), Tcl_OpenObjCmd(), Tcl_OpenTcpClient(), Tcl_OpenTcpServer(), Tcl_OSACmd(), Tcl_OSAComponentCmd(), Tcl_PackageObjCmd(), Tcl_ParseBraces(), Tcl_ParseCommand(), Tcl_ParseExpr(), Tcl_ParseQuotedString(), Tcl_ParseVarName(), Tcl_PidObjCmd(), Tcl_PkgProvideEx(), Tcl_PkgRequireProc(), Tcl_ProcObjCmd(), Tcl_PutsObjCmd(), Tcl_PwdObjCmd(), Tcl_ReadObjCmd(), Tcl_RegexpObjCmd(), Tcl_RegsubObjCmd(), Tcl_RenameObjCmd(), Tcl_ResourceObjCmd(), Tcl_ReturnObjCmd(), Tcl_ScanObjCmd(), Tcl_SeekObjCmd(), Tcl_SetChannelOption(), Tcl_SetObjCmd(), Tcl_SetSystemEncoding(), Tcl_SocketObjCmd(), Tcl_SourceObjCmd(), Tcl_SplitList(), Tcl_SplitObjCmd(), Tcl_StringObjCmd(), Tcl_SubstObj(), Tcl_SubstObjCmd(), Tcl_SwitchObjCmd(), Tcl_TellObjCmd(), Tcl_TimeObjCmd(), Tcl_TraceCommand(), Tcl_TraceObjCmd(), Tcl_TraceVar2(), Tcl_UnregisterChannel(), Tcl_UnsetObjCmd(), Tcl_UnstackChannel(), Tcl_UpdateObjCmd(), Tcl_UplevelObjCmd(), Tcl_UpVar2(), Tcl_UpvarObjCmd(), Tcl_VariableObjCmd(), Tcl_VwaitObjCmd(), Tcl_WhileObjCmd(), TclAccessDeleteProc(), TclAccessInsertProc(), Tclapplescript_Init(), TclArraySet(), TclChannelTransform(), TclCleanupChildren(), TclCompEvalObj(), TclCompileAppendCmd(), TclCompileBreakCmd(), TclCompileCatchCmd(), TclCompileContinueCmd(), TclCompileExprCmd(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileIncrCmd(), TclCompileLappendCmd(), TclCompileLlengthCmd(), TclCompileScript(), TclCompileSetCmd(), TclCompileWhileCmd(), TclCopyChannel(), TclCreateProc(), TclCrossFilesystemCopy(), TclDoGlob(), TclEvalObjvInternal(), TclExecuteByteCode(), TclFileAttrsCmd(), TclFileDeleteCmd(), TclFileMakeDirsCmd(), TclFindElement(), TclFSEnsureEpochOk(), TclFSMakePathFromNormalized(), TclGetEncodingFromObj(), TclGetIntForIndex(), TclGetLoadedPackages(), TclGetLong(), TclGlob(), TclHideUnsafeCommands(), TclInterpReady(), TclListObjSetElement(), TclLsetFlat(), TclLsetList(), TclMacRegisterResourceFork(), TclObjInterpProc(), TclObjInvoke(), TclObjUnsetVar2(), TclOpenFileChannelDeleteProc(), TclOpenFileChannelInsertProc(), tclOSAAddScript(), TclOSACompileCmd(), tclOSADecompileCmd(), tclOSADeleteCmd(), tclOSADeleteContext(), tclOSADeleteScript(), tclOSAExecuteCmd(), tclOSAGetContextID(), tclOSAGetScriptID(), tclOSAInfoCmd(), tclOSALoad(), tclOSALoadCmd(), tclOSAMakeContext(), tclOSARunCmd(), tclOSAStore(), tclOSAStoreCmd(), TclpCheckStackSpace(), TclpCreateProcess(), TclpDeleteFile(), TclpDlopen(), TclpGetDefaultStdChannel(), TclpHasSockets(), TclpLoadFile(), TclpMatchInDirectory(), TclpObjCopyDirectory(), TclpObjCopyFile(), TclpObjRemoveDirectory(), TclPreventAliasLoop(), TclpSetInitialEncodings(), TclpThreadCreate(), TclPtrGetVar(), TclPtrSetVar(), TclRenameCommand(), TclSockGetPort(), TclStatDeleteProc(), TclStatInsertProc(), Tcltest_Init(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), TclTransferResult(), TclUpdateReturnInfo(), TclWinCPUID(), Tclxttest_Init(), TcpAccept(), TcpGetOptionProc(), TcpSetOptionProc(), TestaccessprocCmd(), TestalarmCmd(), TestasyncCmd(), TestbooleanobjCmd(), TestChannelCmd(), TestChannelEventCmd(), TestchmodCmd(), TestcmdinfoCmd(), TestcmdtokenCmd(), TestcmdtraceCmd(), TestconvertobjCmd(), TestcreatecommandCmd(), TestdcallCmd(), TestdelassocdataCmd(), TestdelCmd(), TestdoubleobjCmd(), TestdstringCmd(), TestencodingObjCmd(), TestevalexObjCmd(), TestevalobjvObjCmd(), TesteventloopCmd(), TesteventObjCmd(), TestExceptionCmd(), TestexithandlerCmd(), TestexprparserObjCmd(), TestexprstringCmd(), TestfeventCmd(), TestfileCmd(), TestfilehandlerCmd(), TestfilelinkCmd(), TestFilesystemObjCmd(), TestfilewaitCmd(), TestfindexecutableCmd(), TestgetassocdataCmd(), TestgetdefencdirCmd(), TestGetIndexFromObjStructObjCmd(), TestgetopenfileCmd(), TestgetplatformCmd(), TestgetvarfullnameCmd(), TestindexobjCmd(), TestinterpdeleteCmd(), TestintobjCmd(), TestlinkCmd(), TestlocaleCmd(), TestmainthreadCmd(), TestMathFunc2(), TestobjCmd(), TestopenfilechannelprocCmd(), TestparserObjCmd(), TestparsevarnameObjCmd(), TestparsevarObjCmd(), TestregexpObjCmd(), TestsaveresultCmd(), TestsetassocdataCmd(), TestsetCmd(), TestsetdefencdirCmd(), TestseterrorcodeCmd(), TestsetobjerrorcodeCmd(), TestsetplatformCmd(), TestSimpleFilesystemObjCmd(), TeststaticpkgCmd(), TeststatprocCmd(), TeststringobjCmd(), TesttranslatefilenameCmd(), TestupvarCmd(), TestvolumetypeCmd(), TestwinclockCmd(), TestwincpuidCmd(), TestwinsleepCmd(), TestWrongNumArgsObjCmd(), TransformGetOptionProc(), TransformSetOptionProc(), TraversalCopy(), TraversalDelete(), TraverseUnixTree(), TraverseWinTree(), TryToLoad(), ValidateFormat(), and WriteTextResource().#define TCL_EVAL_DIRECT  0x40000

Definition at line 1037 of file tcl.h.
Referenced by CopyRenameOneFile(), NamespaceEvalCmd(), NamespaceInscopeCmd(), Tcl_EvalObjCmd(), Tcl_EvalObjEx(), Tcl_UplevelObjCmd(), and TesteventProc().#define TCL_EVAL_GLOBAL  0x20000

Definition at line 1036 of file tcl.h.
Referenced by AfterProc(), CopyData(), CopyRenameOneFile(), ExecuteCallback(), ExecuteRemoteObject(), Prompt(), StdinProc(), Tcl_DdeObjCmd(), Tcl_EvalEx(), Tcl_EvalObjEx(), Tcl_GlobalEvalObj(), Tcl_Main(), Tcl_RecordAndEvalObj(), TclChannelEventScriptInvoker(), TclEvalObjvInternal(), TestevalexObjCmd(), TestevalobjvObjCmd(), and TesteventProc().#define TCL_EVAL_INVOKE  0x80000

Definition at line 1038 of file tcl.h.
Referenced by AliasObjCmd(), Tcl_EvalObjv(), and TclEvalObjvInternal().#define Tcl_EvalObj(interp, objPtr)  Tcl_EvalObjEx((interp),(objPtr),0)

Definition at line 2257 of file tcl.h.#define TCL_EXACT  1

Definition at line 1028 of file tcl.h.
Referenced by ParseKeyName(), Tcl_ExecObjCmd(), Tcl_GetIndexFromObjStruct(), Tcl_RegexpObjCmd(), Tcl_RegsubObjCmd(), Tcl_SocketObjCmd(), Tcltest_Init(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), TesteventObjCmd(), and TestregexpObjCmd().#define TCL_EXCEPTION  (1<<3)

Definition at line 1418 of file tcl.h.
Referenced by CreateFileHandler(), DeleteFileHandler(), FileProc(), PipeWatchProc(), Tcl_CreateFileHandler(), Tcl_DeleteFileHandler(), Tcl_MakeFileChannel(), Tcl_WaitForEvent(), TclpOpenFileChannel(), TclUnixWaitForFile(), UpdateInterest(), and WaitForConnect().#define TCL_FILE_EVENTS  (1<<3)

Definition at line 1363 of file tcl.h.
Referenced by ConsoleCheckProc(), ConsoleEventProc(), ConsoleSetupProc(), FileCheckProc(), FileEventProc(), FileHandlerEventProc(), FileSetupProc(), PipeCheckProc(), PipeEventProc(), PipeSetupProc(), SerialCheckProc(), SerialEventProc(), SerialSetupProc(), SocketCheckProc(), SocketEventProc(), SocketSetupProc(), and TestfilehandlerCmd().#define TCL_FILESYSTEM_VERSION_1  ((Tcl_FSVersion) 0x1)

Definition at line 1721 of file tcl.h.
Referenced by TCL_DECLARE_MUTEX().#define TCL_FINAL_RELEASE  2

Definition at line 36 of file tcl.h.#define Tcl_FindHashEntry(tablePtr, key)  (*((tablePtr)->findProc))(tablePtr, key)

Definition at line 1344 of file tcl.h.
Referenced by AliasDelete(), AliasDescribe(), CompileMathFuncCall(), CompileSubExpr(), DetachChannel(), ExprCallMathFunc(), GetInterp(), GetRsrcRefFromObj(), GetTimesCmd(), InfoCommandsCmd(), InfoGlobalsCmd(), InfoProcsCmd(), InfoVarsCmd(), ParsePrimaryExpr(), Tcl_CreateNamespace(), Tcl_DeleteAssocData(), Tcl_DeleteNamespace(), Tcl_ExposeCommand(), Tcl_FindCommand(), Tcl_FindNamespaceVar(), Tcl_GetAlias(), Tcl_GetAliasObj(), Tcl_GetAssocData(), Tcl_GetChannel(), Tcl_GetEncoding(), Tcl_GetMathFuncInfo(), Tcl_GetObjType(), Tcl_Import(), Tcl_InitCustomHashTable(), Tcl_InterpObjCmd(), Tcl_IsChannelRegistered(), Tcl_MacFindResource(), Tcl_OSACmd(), Tcl_PackageObjCmd(), Tcl_PkgPresentEx(), TclGetAuxDataType(), TclGetNamespaceForQualName(), TclLookupArrayElement(), TclLookupSimpleVar(), TclMacRegisterResourceFork(), TclMacUnRegisterResourceFork(), TclObjInvoke(), tclOSAClose(), tclOSADeleteContext(), tclOSADeleteScript(), tclOSAGetContextID(), tclOSAGetScript(), TclRegisterAuxDataType(), TclRenameCommand(), TclResetShadowedCmdRefs(), TclTeardownNamespace(), and UnregisterTcpServerInterpCleanupProc().#define Tcl_GetHashKey(tablePtr, h)
Value:((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \
        (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \
       ? (h)->key.oneWordValue \
       : (h)->key.string))
Definition at line 1326 of file tcl.h.
Referenced by AppendLocals(), DeleteArray(), getSortedHashKeys(), InfoCommandsCmd(), InfoGlobalsCmd(), InfoProcsCmd(), InfoVarsCmd(), RebuildTable(), SlaveHidden(), Tcl_AppendAllObjTypes(), Tcl_ArrayObjCmd(), Tcl_ForgetImport(), Tcl_GetCommandFullName(), Tcl_GetCommandName(), Tcl_GetEncodingNames(), Tcl_GetInterpPath(), Tcl_GetVariableFullName(), Tcl_Import(), Tcl_InterpObjCmd(), Tcl_ListMathFuncs(), Tcl_OSACmd(), Tcl_PackageObjCmd(), TclDeleteVars(), TclMacRegisterResourceFork(), TclResetShadowedCmdRefs(), and TestChannelCmd().#define Tcl_GetHashValue(h)  ((h)->clientData)

Definition at line 1323 of file tcl.h.
Referenced by AliasCreate(), AliasDelete(), AliasDescribe(), AliasList(), AliasObjCmdDeleteProc(), AppendLocals(), BumpCmdRefEpochs(), CompileMathFuncCall(), CompileSubExpr(), DeleteArray(), DeleteChannelTable(), DeleteInterpProc(), DeleteScanNumberCache(), DetachChannel(), ExprCallMathFunc(), FindPackage(), GetInterp(), GetRsrcRefFromObj(), InfoCommandsCmd(), InfoGlobalsCmd(), InfoProcsCmd(), InfoVarsCmd(), InterpInfoDeleteProc(), NamespaceChildrenCmd(), ScanNumber(), Tcl_ArrayObjCmd(), Tcl_CreateCommand(), Tcl_CreateEncoding(), Tcl_CreateMathFunc(), Tcl_CreateObjCommand(), Tcl_DeleteAssocData(), Tcl_DontCallWhenDeleted(), Tcl_ExposeCommand(), Tcl_FindCommand(), Tcl_FindNamespaceVar(), Tcl_ForgetImport(), Tcl_GetAlias(), Tcl_GetAliasObj(), Tcl_GetAssocData(), Tcl_GetChannel(), Tcl_GetChannelNamesEx(), Tcl_GetEncoding(), Tcl_GetEncodingNames(), Tcl_GetMathFuncInfo(), Tcl_GetObjType(), Tcl_Import(), Tcl_InterpObjCmd(), Tcl_IsChannelRegistered(), Tcl_MacFindResource(), Tcl_OSACmd(), Tcl_PackageObjCmd(), Tcl_PkgPresentEx(), Tcl_RegisterChannel(), Tcl_SetAssocData(), Tcl_SplitObjCmd(), TclDeleteNamespaceVars(), TclDeleteVars(), TclFinalizeEncodingSubsystem(), TclFreePackageInfo(), TclGetAuxDataType(), TclGetNamespaceForQualName(), TclLookupArrayElement(), TclLookupSimpleVar(), TclMacRegisterResourceFork(), TclMacUnRegisterResourceFork(), TclObjInvoke(), tclOSAAddScript(), tclOSAClose(), tclOSADeleteContext(), tclOSADeleteScript(), tclOSAGetContextID(), tclOSAGetScript(), TclResetShadowedCmdRefs(), TclTeardownNamespace(), TcpAcceptCallbacksDeleteProc(), and TestChannelCmd().#define TCL_GLOB_PERM_HIDDEN  (1<<1)

Definition at line 1644 of file tcl.h.
Referenced by NativeMatchType(), Tcl_GlobObjCmd(), and TclpMatchInDirectory().#define TCL_GLOB_PERM_R  (1<<2)

Definition at line 1645 of file tcl.h.
Referenced by NativeMatchType(), and Tcl_GlobObjCmd().#define TCL_GLOB_PERM_RONLY  (1<<0)

Definition at line 1643 of file tcl.h.
Referenced by NativeMatchType(), and Tcl_GlobObjCmd().#define TCL_GLOB_PERM_W  (1<<3)

Definition at line 1646 of file tcl.h.
Referenced by NativeMatchType(), and Tcl_GlobObjCmd().#define TCL_GLOB_PERM_X  (1<<4)

Definition at line 1647 of file tcl.h.
Referenced by NativeMatchType(), and Tcl_GlobObjCmd().#define TCL_GLOB_TYPE_BLOCK  (1<<0)

Definition at line 1634 of file tcl.h.
Referenced by NativeMatchType(), and Tcl_GlobObjCmd().#define TCL_GLOB_TYPE_CHAR  (1<<1)

Definition at line 1635 of file tcl.h.
Referenced by NativeMatchType(), and Tcl_GlobObjCmd().#define TCL_GLOB_TYPE_DIR  (1<<2)

Definition at line 1636 of file tcl.h.
Referenced by FsAddMountsToGlobResult(), NativeMatchType(), Tcl_GlobObjCmd(), and TclDoGlob().#define TCL_GLOB_TYPE_FILE  (1<<4)

Definition at line 1638 of file tcl.h.
Referenced by NativeMatchType(), and Tcl_GlobObjCmd().#define TCL_GLOB_TYPE_LINK  (1<<5)

Definition at line 1639 of file tcl.h.
Referenced by NativeMatchType(), and Tcl_GlobObjCmd().#define TCL_GLOB_TYPE_MOUNT  (1<<7)

Definition at line 1641 of file tcl.h.
Referenced by FsListMounts(), and TestReportMatchInDirectory().#define TCL_GLOB_TYPE_PIPE  (1<<3)

Definition at line 1637 of file tcl.h.
Referenced by NativeMatchType(), and Tcl_GlobObjCmd().#define TCL_GLOB_TYPE_SOCK  (1<<6)

Definition at line 1640 of file tcl.h.
Referenced by NativeMatchType(), and Tcl_GlobObjCmd().#define TCL_GLOBAL_ONLY  1

Definition at line 1051 of file tcl.h.
Referenced by DdeServerProc(), EnvTraceProc(), ExecuteRemoteObject(), FormatClock(), HandleBgErrors(), InfoLibraryCmd(), InfoPatchLevelCmd(), InfoTclVersionCmd(), LinkTraceProc(), ObjMakeUpvar(), Prompt(), SlaveCreate(), StaticInitProc(), Tcl_AddObjErrorInfo(), Tcl_AppInit(), Tcl_ArrayObjCmd(), Tcl_BackgroundError(), Tcl_DdeObjCmd(), Tcl_ErrorObjCmd(), Tcl_FindCommand(), Tcl_FindNamespaceVar(), Tcl_GlobalObjCmd(), Tcl_HideCommand(), Tcl_Import(), Tcl_Init(), Tcl_LinkVar(), Tcl_Main(), Tcl_MakeSafe(), Tcl_SetErrorCodeVA(), Tcl_SetObjErrorCode(), Tcl_SourceRCFile(), Tcl_TraceVar2(), Tcl_UnlinkVar(), Tcl_UntraceVar2(), Tcl_UpdateLinkedVar(), Tcl_VarTraceInfo2(), Tcl_VwaitObjCmd(), TclDeleteNamespaceVars(), TclDeleteVars(), TclGetNamespaceForQualName(), TclLookupSimpleVar(), TclObjInvoke(), TclObjLookupVar(), TclPrecTraceProc(), TclpSetVariables(), TclPtrGetVar(), TclPtrSetVar(), TclTeardownNamespace(), Tcltest_Init(), TclTraceVariableObjCmd(), TclTransferResult(), TclUpdateReturnInfo(), TestgetvarfullnameCmd(), TestupvarCmd(), and UnsetVarStruct().#define Tcl_GlobalEvalObj(interp, objPtr)  Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)

Definition at line 2259 of file tcl.h.#define TCL_HASH_KEY_RANDOMIZE_HASH  0x1

Definition at line 1187 of file tcl.h.
Referenced by RebuildTable(), Tcl_CreateHashEntry(), Tcl_DeleteHashEntry(), and Tcl_FindHashEntry().#define TCL_HASH_KEY_STORE_HASH  1

Definition at line 1133 of file tcl.h.#define TCL_HASH_KEY_TYPE_VERSION  1

Definition at line 1193 of file tcl.h.#define TCL_IDLE_EVENTS  (1<<5)

Definition at line 1365 of file tcl.h.
Referenced by Tcl_DoOneEvent(), Tcl_UpdateObjCmd(), and TimerSetupProc().#define Tcl_IncrRefCount(objPtr)  ++(objPtr)->refCount

Definition at line 827 of file tcl.h.
Referenced by AliasCreate(), AliasObjCmd(), AllocObjEntry(), CallCommandTraces(), ConvertFileNameFormat(), CopyData(), CopyRenameOneFile(), CreateScriptRecord(), DdeServerProc(), DupFsPathInternalRep(), DupListInternalRep(), DupParsedVarName(), ExecuteCallback(), FileBasename(), FileCopyRename(), FsUpdateCwd(), GetLexeme(), GetPathType(), InfoDefaultCmd(), InfoScriptCmd(), LinkTraceProc(), OpenEncodingFile(), OpenLibraryResource(), ParsePrimaryExpr(), PretendTclpAccess(), PretendTclpOpenFileChannel(), PretendTclpStat(), ProcBodyTestProcObjCmd(), ProcCompileProc(), ResetObjResult(), ResourceInit(), ScanNumber(), SetFsPathFromAny(), SetListFromAny(), SetVarToObj(), SimpleCopy(), SimpleListVolumes(), SlaveEval(), StdinProc(), StoreStatData(), Tcl_Access(), Tcl_AddObjErrorInfo(), Tcl_AfterObjCmd(), Tcl_ArrayObjCmd(), Tcl_BinaryObjCmd(), Tcl_CdObjCmd(), Tcl_Chdir(), Tcl_CreateAlias(), Tcl_CreateAliasObj(), Tcl_CreateInterp(), Tcl_DdeObjCmd(), Tcl_EvalEx(), Tcl_EvalFile(), Tcl_EvalObjEx(), Tcl_EvalTokens(), Tcl_EvalTokensStandard(), Tcl_ExprBoolean(), Tcl_ExprDouble(), Tcl_ExprLong(), Tcl_ExprObj(), Tcl_ExprObjCmd(), Tcl_ExprString(), Tcl_ForeachObjCmd(), Tcl_FSChdir(), Tcl_FSEvalFile(), Tcl_FSGetCwd(), Tcl_FSGetNormalizedPath(), Tcl_FSGetTranslatedPath(), Tcl_FSLoadFile(), Tcl_FSMatchInDirectory(), Tcl_GetEncodingNames(), Tcl_GetPathType(), Tcl_GlobObjCmd(), Tcl_Import(), Tcl_Init(), Tcl_JoinPath(), Tcl_LappendObjCmd(), Tcl_LinkVar(), Tcl_ListObjAppendElement(), Tcl_ListObjReplace(), Tcl_LsearchObjCmd(), Tcl_LsObjCmd(), Tcl_LsortObjCmd(), Tcl_Main(), Tcl_NewListObj(), Tcl_OpenFileChannel(), Tcl_PackageObjCmd(), Tcl_ParseVar(), Tcl_PkgRequireEx(), Tcl_ReadObjCmd(), Tcl_RecordAndEval(), Tcl_RecordAndEvalObj(), Tcl_RegexpObjCmd(), Tcl_RegsubObjCmd(), Tcl_SaveResult(), Tcl_ScanObjCmd(), Tcl_SetListObj(), Tcl_SetObjResult(), Tcl_SetVar2(), Tcl_SplitPath(), Tcl_Stat(), Tcl_StringObjCmd(), Tcl_TraceObjCmd(), Tcl_TranslateFileName(), Tcl_UnsetVar2(), Tcl_UpdateLinkedVar(), Tcl_UpVar2(), TclAddLiteralObj(), TclChannelTransform(), TclCompileIncrCmd(), TclCompileStringCmd(), TclCompileWhileCmd(), TclCopyChannel(), TclCreateExecEnv(), TclCreateProc(), TclDeleteNamespaceVars(), TclDeleteVars(), TclDoGlob(), TclEvalObjvInternal(), TclExecuteByteCode(), TclFileAttrsCmd(), TclFileDirname(), TclFileMakeDirsCmd(), TclFSCwdPointerEquals(), TclFSMakePathRelative(), TclFSNormalizeAbsolutePath(), TclGetLibraryPath(), TclGlob(), TclHideLiteral(), TclInvoke(), TclInvokeObjectCommand(), TclLindexFlat(), TclLindexList(), TclListObjSetElement(), TclLsetFlat(), TclLsetList(), TclNewFSPathObj(), TclObjInterpProc(), TclObjInvoke(), TclObjLookupVar(), TclpCreateProcess(), TclpFilesystemPathType(), TclpGetNativePathType(), TclpMatchInDirectory(), TclpObjCopyDirectory(), TclpObjGetCwd(), TclpObjListVolumes(), TclpObjRemoveDirectory(), TclProcInterpProc(), TclPtrSetVar(), TclRegisterLiteral(), TclRenameCommand(), TclSetLibraryPath(), TclSetStartupScriptPath(), TclTeardownNamespace(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclUpdateReturnInfo(), TestChannelEventCmd(), TesteventObjCmd(), TestregexpObjCmd(), TestReportDupInternalRep(), TestReportInFilesystem(), TestsetobjerrorcodeCmd(), TraceVarProc(), UpdateStringOfFsPath(), and WinReadLinkDirectory().#define Tcl_InitMemory(x)

Definition at line 1521 of file tcl.h.
Referenced by SlaveCreate(), and Tcl_Main().#define Tcl_InitStubs(interp, version, exact)  Tcl_PkgRequire(interp, "Tcl", version, exact)

Definition at line 2304 of file tcl.h.
Referenced by Pkga_Init(), Pkgb_Init(), Pkgb_SafeInit(), Pkgc_Init(), Pkgc_SafeInit(), Pkgd_Init(), Pkgd_SafeInit(), Pkge_Init(), Pkgf_Init(), Registry_Init(), TCL_DECLARE_MUTEX(), Tclapplescript_Init(), and Tclxttest_Init().#define TCL_INTEGER_SPACE  24

Definition at line 1015 of file tcl.h.
Referenced by AcceptCallbackProc(), AppendSystemError(), AsyncHandlerProc(), CheckIfVarUnset(), DelCallbackProc(), ExitProcEven(), ExitProcOdd(), GetTimesCmd(), MakeTcpClientChannelMode(), NamespaceEvalCmd(), NamespaceInscopeCmd(), OpenFileChannel(), ProcessProcResultCode(), ProcessUnexpectedResult(), SerialErrorStr(), SerialGetOptionProc(), SortCompare(), Tcl_AfterObjCmd(), Tcl_ArrayObjCmd(), Tcl_CallWhenDeleted(), Tcl_CaseObjCmd(), Tcl_EvalObjCmd(), Tcl_ForeachObjCmd(), Tcl_ForObjCmd(), Tcl_FSEvalFile(), Tcl_InterpObjCmd(), Tcl_Main(), Tcl_MakeFileChannel(), Tcl_MakeTcpClientChannel(), Tcl_OpenTcpClient(), Tcl_OpenTcpServer(), Tcl_PidObjCmd(), Tcl_StringObjCmd(), Tcl_SwitchObjCmd(), Tcl_UplevelObjCmd(), Tcl_WhileObjCmd(), TclCleanupChildren(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileStringCmd(), TclCompileWhileCmd(), TclCreateProc(), TclExprFloatError(), TclGetAndDetachPids(), tclOSAAddContext(), tclOSALoad(), tclOSAStore(), TclpCreateCommandChannel(), TclpCreateProcess(), TclpDlopen(), TclpGetDefaultStdChannel(), TclpOpenFileChannel(), TclpSetInitialEncodings(), TclpSetVariables(), TclRegAbout(), TclRegisterLiteral(), TclWinOpenConsoleChannel(), TcpAccept(), TcpGetOptionProc(), TestasyncCmd(), TestChannelCmd(), TestdstringCmd(), TestexprlongCmd(), TestfilehandlerCmd(), TestobjCmd(), TestregexpObjCmd(), UpdateStringOfEndOffset(), UpdateStringOfInt(), and UpdateStringOfWideInt().#define TCL_INTERP_DESTROYED  0x100

Definition at line 1059 of file tcl.h.
Referenced by LinkTraceProc(), TclDeleteNamespaceVars(), TclDeleteVars(), TclPrecTraceProc(), TraceCommandProc(), TraceExecutionProc(), and TraceVarProc().#define Tcl_IsShared(objPtr)  ((objPtr)->refCount > 1)

Definition at line 834 of file tcl.h.
Referenced by FsAddMountsToGlobResult(), ResetObjResult(), StdinProc(), Tcl_AppendStringsToObjVA(), Tcl_AppendToObj(), Tcl_AppendUnicodeToObj(), Tcl_AttemptSetObjLength(), Tcl_LappendObjCmd(), Tcl_LinsertObjCmd(), Tcl_ListObjAppendElement(), Tcl_ListObjAppendList(), Tcl_ListObjReplace(), Tcl_LreplaceObjCmd(), Tcl_Main(), Tcl_ParseVar(), Tcl_SetBooleanObj(), Tcl_SetByteArrayLength(), Tcl_SetByteArrayObj(), Tcl_SetDoubleObj(), Tcl_SetIntObj(), Tcl_SetListObj(), Tcl_SetLongObj(), Tcl_SetObjLength(), Tcl_SetStringObj(), Tcl_SetWideIntObj(), TclCreateProc(), TclExecuteByteCode(), TclGlob(), TclListObjSetElement(), TclLsetFlat(), TclLsetList(), TclPtrIncrVar(), TclPtrSetVar(), TestbooleanobjCmd(), TestdoubleobjCmd(), TestintobjCmd(), and TeststringobjCmd().#define TCL_LEAVE_ERR_MSG  0x200

Definition at line 1060 of file tcl.h.
Referenced by GetTimesCmd(), InfoPatchLevelCmd(), InfoTclVersionCmd(), ObjMakeUpvar(), ProcBodyTestProcObjCmd(), Tcl_AppendObjCmd(), Tcl_ArrayObjCmd(), Tcl_BinaryObjCmd(), Tcl_CommandTraceInfo(), Tcl_CreateNamespace(), Tcl_EvalTokensStandard(), Tcl_Export(), Tcl_FindCommand(), Tcl_FindNamespace(), Tcl_FindNamespaceVar(), Tcl_ForgetImport(), Tcl_GetsObjCmd(), Tcl_HideCommand(), Tcl_Import(), Tcl_IncrObjCmd(), Tcl_LappendObjCmd(), Tcl_LinkVar(), Tcl_LsetObjCmd(), Tcl_SetObjCmd(), Tcl_StringObjCmd(), Tcl_TraceCommand(), Tcl_TraceVar2(), Tcl_UnsetObjCmd(), Tcl_UntraceCommand(), Tcl_VariableObjCmd(), TclArraySet(), TclExecuteByteCode(), TclLookupArrayElement(), TclLookupSimpleVar(), TclLookupVar(), TclObjLookupVar(), TclObjUnsetVar2(), TclPtrGetVar(), TclPtrSetVar(), Tcltest_Init(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), and TestgetvarfullnameCmd().#define TCL_LINK_BOOLEAN  3

Definition at line 1104 of file tcl.h.
Referenced by LinkTraceProc(), ObjValue(), Tcl_Main(), and TestlinkCmd().#define TCL_LINK_DOUBLE  2

Definition at line 1103 of file tcl.h.
Referenced by LinkTraceProc(), ObjValue(), and TestlinkCmd().#define TCL_LINK_INT  1

Definition at line 1102 of file tcl.h.
Referenced by InitByteCodeExecution(), LinkTraceProc(), ObjValue(), TclSetByteCodeFromAny(), and TestlinkCmd().#define TCL_LINK_READ_ONLY  0x80

Definition at line 1107 of file tcl.h.
Referenced by Tcl_LinkVar(), and TestlinkCmd().#define TCL_LINK_STRING  4

Definition at line 1105 of file tcl.h.
Referenced by LinkTraceProc(), ObjValue(), and TestlinkCmd().#define TCL_LINK_WIDE_INT  5

Definition at line 1106 of file tcl.h.
Referenced by LinkTraceProc(), ObjValue(), and TestlinkCmd().#define TCL_LIST_ELEMENT  8

Definition at line 1054 of file tcl.h.
Referenced by Tcl_SetErrorCodeVA(), TclExecuteByteCode(), and TclPtrSetVar().#define TCL_LL_MODIFIER  "ll"

Definition at line 440 of file tcl.h.
Referenced by Tcl_FormatObjCmd(), Tcl_ScanObjCmd(), and UpdateStringOfWideInt().#define TCL_LL_MODIFIER_SIZE  2

Definition at line 441 of file tcl.h.
Referenced by Tcl_FormatObjCmd().#define Tcl_LongAsWide(val)  ((Tcl_WideInt)((long)(val)))

Definition at line 444 of file tcl.h.
Referenced by ExprCallMathFunc(), ExprWideFunc(), FileSeekProc(), SetBooleanFromAny(), strtoll(), strtoull(), Tcl_FSStat(), Tcl_GetIntFromObj(), Tcl_GetWideIntFromObj(), Tcl_IncrObjCmd(), Tcl_Seek(), Tcl_SeekObjCmd(), Tcl_SeekOld(), Tcl_Tell(), TclExecuteByteCode(), TclPtrIncrVar(), TestlinkCmd(), TestMathFunc2(), and TransformWideSeekProc().#define TCL_MAJOR_VERSION  8

Definition at line 59 of file tcl.h.
Referenced by Tcl_GetVersion().#define TCL_MAX_PREC  17

Definition at line 1007 of file tcl.h.
Referenced by TclPrecTraceProc().#define TCL_MINOR_VERSION  4

Definition at line 60 of file tcl.h.
Referenced by Tcl_GetVersion().#define TCL_MODE_BLOCKING  0

Definition at line 1602 of file tcl.h.
Referenced by FileBlockModeProc(), PeekAhead(), PipeBlockModeProc(), SetBlockMode(), StopCopy(), Tcl_Seek(), Tcl_SetChannelOption(), TclCopyChannel(), TcpBlockMode(), and TcpBlockModeProc().#define TCL_MODE_NONBLOCKING  1

Definition at line 1603 of file tcl.h.
Referenced by ConsoleBlockModeProc(), FileBlockProc(), PeekAhead(), PipeBlockModeProc(), SerialBlockProc(), StdIOBlockMode(), StopCopy(), Tcl_Seek(), Tcl_SetChannelOption(), TclCopyChannel(), TcpBlockProc(), and TransformBlockModeProc().#define Tcl_MutexFinalize(mutexPtr)

Definition at line 151 of file tcl.h.
Referenced by TclFinalizeAsync(), and TclFinalizeNotifier().#define Tcl_MutexLock(mutexPtr)

Definition at line 149 of file tcl.h.
Referenced by AliasCreate(), ConsoleCloseProc(), ConsoleInit(), ConsoleReaderThread(), ConsoleThreadActionProc(), ConsoleWriterThread(), FormatClock(), FsGetFirstFilesystem(), FsUpdateCwd(), Initialize(), PipeClose2Proc(), PipeInit(), PipeReaderThread(), PipeThreadActionProc(), PipeWriterThread(), ProcExitHandler(), QueueEvent(), SerialCloseProc(), SerialInit(), SerialThreadActionProc(), SerialWriterThread(), SetTZIfNecessary(), SocketExitHandler(), SocketsEnabled(), Tcl_AlertNotifier(), Tcl_AppendAllObjTypes(), Tcl_AsyncCreate(), Tcl_AsyncDelete(), Tcl_AsyncInvoke(), Tcl_AsyncMark(), Tcl_CreateEncoding(), Tcl_CreateExitHandler(), Tcl_CreateNamespace(), Tcl_DbIsShared(), TCL_DECLARE_MUTEX(), Tcl_DeleteEvents(), Tcl_DeleteExitHandler(), Tcl_DetachPids(), Tcl_EventuallyFree(), Tcl_Finalize(), Tcl_FinalizeNotifier(), Tcl_FreeEncoding(), Tcl_FSAccess(), Tcl_FSMountsChanged(), Tcl_FSOpenFileChannel(), Tcl_FSRegister(), Tcl_FSStat(), Tcl_FSUnregister(), Tcl_GetEncoding(), Tcl_GetEncodingNames(), Tcl_GetHostName(), Tcl_GetObjType(), Tcl_InitNotifier(), Tcl_LoadObjCmd(), Tcl_Preserve(), Tcl_PrintDouble(), Tcl_ReapDetachedProcs(), Tcl_RegisterObjType(), Tcl_Release(), Tcl_ServiceEvent(), Tcl_SetSystemEncoding(), Tcl_StaticPackage(), Tcl_ThreadAlert(), Tcl_ThreadQueueEvent(), Tcl_WaitForEvent(), Tcl_WaitPid(), TclAccessDeleteProc(), TclAccessInsertProc(), TclCompileExpr(), TclCreateExecEnv(), TclFinalizeAuxDataTypeTable(), TclFinalizeCompilation(), TclFinalizeEncodingSubsystem(), TclFinalizeExecution(), TclFinalizeMemorySubsystem(), TclFinalizeNotifier(), TclFinalizeObjects(), TclFinalizePreserve(), TclFreeObj(), TclFSCwdPointerEquals(), TclGetAuxDataType(), TclGetEnv(), TclGetLoadedPackages(), TclInitEncodingSubsystem(), TclInitObjSubsystem(), TclOpenFileChannelDeleteProc(), TclOpenFileChannelInsertProc(), TclpGetGMTOffset(), TclpGetGrGid(), TclpGetGrNam(), TclpGetHostByAddr(), TclpGetHostByName(), TclpGetPid(), TclpGetPwNam(), TclpGetPwUid(), TclpGmtime(), TclpHasSockets(), TclpLocaltime(), TclPrecTraceProc(), TclRegisterAuxDataType(), TclSetEnv(), TclStatDeleteProc(), TclStatInsertProc(), TclUnsetEnv(), TclWinAddProcess(), TclWinDriveLetterForVolMountPoint(), TclWinResetInterfaceEncodings(), TcpThreadActionProc(), and TestplatformChmod().#define Tcl_MutexUnlock(mutexPtr)

Definition at line 150 of file tcl.h.
Referenced by AliasCreate(), ConsoleCloseProc(), ConsoleInit(), ConsoleReaderThread(), ConsoleThreadActionProc(), ConsoleWriterThread(), FormatClock(), FsGetFirstFilesystem(), FsUpdateCwd(), Initialize(), PipeClose2Proc(), PipeInit(), PipeReaderThread(), PipeThreadActionProc(), PipeWriterThread(), ProcExitHandler(), QueueEvent(), SerialCloseProc(), SerialInit(), SerialThreadActionProc(), SerialWriterThread(), SetTZIfNecessary(), SocketExitHandler(), SocketsEnabled(), Tcl_AlertNotifier(), Tcl_AppendAllObjTypes(), Tcl_AsyncCreate(), Tcl_AsyncDelete(), Tcl_AsyncInvoke(), Tcl_AsyncMark(), Tcl_CreateEncoding(), Tcl_CreateExitHandler(), Tcl_CreateNamespace(), Tcl_DbIsShared(), TCL_DECLARE_MUTEX(), Tcl_DeleteEvents(), Tcl_DetachPids(), Tcl_Finalize(), Tcl_FinalizeNotifier(), Tcl_FreeEncoding(), Tcl_FSAccess(), Tcl_FSMountsChanged(), Tcl_FSOpenFileChannel(), Tcl_FSRegister(), Tcl_FSStat(), Tcl_FSUnregister(), Tcl_GetEncoding(), Tcl_GetEncodingNames(), Tcl_GetHostName(), Tcl_GetObjType(), Tcl_InitNotifier(), Tcl_LoadObjCmd(), Tcl_Preserve(), Tcl_PrintDouble(), Tcl_ReapDetachedProcs(), Tcl_RegisterObjType(), Tcl_Release(), Tcl_ServiceEvent(), Tcl_SetSystemEncoding(), Tcl_ThreadQueueEvent(), Tcl_WaitForEvent(), TclAccessDeleteProc(), TclAccessInsertProc(), TclCompileExpr(), TclCreateExecEnv(), TclFinalizeAuxDataTypeTable(), TclFinalizeCompilation(), TclFinalizeEncodingSubsystem(), TclFinalizeExecution(), TclFinalizeMemorySubsystem(), TclFinalizeNotifier(), TclFinalizeObjects(), TclFinalizePreserve(), TclFreeObj(), TclFSCwdPointerEquals(), TclGetAuxDataType(), TclGetEnv(), TclGetLoadedPackages(), TclInitEncodingSubsystem(), TclInitObjSubsystem(), TclOpenFileChannelDeleteProc(), TclOpenFileChannelInsertProc(), TclpGetGMTOffset(), TclpGetGrGid(), TclpGetGrNam(), TclpGetHostByAddr(), TclpGetHostByName(), TclpGetPid(), TclpGetPwNam(), TclpGetPwUid(), TclpGmtime(), TclpHasSockets(), TclpLocaltime(), TclPrecTraceProc(), TclRegisterAuxDataType(), TclSetEnv(), TclStatDeleteProc(), TclStatInsertProc(), TclUnsetEnv(), TclWinAddProcess(), TclWinDriveLetterForVolMountPoint(), TclWinResetInterfaceEncodings(), TcpThreadActionProc(), and TestplatformChmod().#define TCL_NAMESPACE_ONLY  2

Definition at line 1052 of file tcl.h.
Referenced by ObjMakeUpvar(), Tcl_ArrayObjCmd(), Tcl_Export(), Tcl_ForgetImport(), Tcl_Import(), Tcl_TraceVar2(), Tcl_UntraceVar2(), Tcl_VariableObjCmd(), Tcl_VarTraceInfo2(), TclDeleteNamespaceVars(), TclDeleteVars(), TclGetNamespaceForQualName(), TclLookupSimpleVar(), TclObjLookupVar(), TclPtrGetVar(), TclPtrSetVar(), TclTraceVariableObjCmd(), TestgetvarfullnameCmd(), TestupvarCmd(), and UnsetVarStruct().#define TCL_NO_EVAL  0x10000

Definition at line 1035 of file tcl.h.
Referenced by Tcl_RecordAndEvalObj().#define TCL_OK  0

Definition at line 633 of file tcl.h.
Referenced by AcceptCallbackProc(), AfterProc(), AliasCreate(), AliasDelete(), AliasDescribe(), AliasList(), BinaryProc(), BroadcastValue(), CallVarTraces(), CheckAccess(), CheckVersion(), CmdProc1(), CmdProc2(), CommandComplete(), CommonGetHandle(), ComparePkgVersions(), CompileCondExpr(), CompileLandOrLorExpr(), CompileMathFuncCall(), CompileSubExpr(), ConsoleGetHandleProc(), ConvertFileNameFormat(), CopyData(), CopyFile(), CopyFileAtts(), CopyRenameOneFile(), CreatedCommandProc(), CreatedCommandProc2(), DdeCreateClient(), DdeGetServicesList(), DebuggerCmd(), DelCmdProc(), DeleteKey(), DeleteValue(), DetachChannel(), DoCopyDirectory(), DoCopyFile(), DoCreateDirectory(), DoRemoveDirectory(), DoRemoveJustDirectory(), DoRenameFile(), EncodingFromUtfProc(), EncodingToUtfProc(), EscapeFromUtfProc(), EscapeToUtfProc(), ExecuteCallback(), ExprAbsFunc(), ExprBinaryFunc(), ExprCallMathFunc(), ExprDoubleFunc(), ExprIntFunc(), ExprRandFunc(), ExprRoundFunc(), ExprSrandFunc(), ExprUnaryFunc(), ExprWideFunc(), FileBasename(), FileCopyRename(), FileGetHandleProc(), FindLibraries(), FormatClock(), FormatNumber(), FsAddMountsToGlobResult(), FSGetPathType(), FSUnloadTempFile(), GetFileFinderAttributes(), GetFileReadOnly(), GetFinderFont(), GetGroupAttribute(), GetHostFromString(), GetInterp(), GetKeyNames(), GetLexeme(), GetModeFromPermString(), GetNamespaceFromObj(), GetOwnerAttribute(), GetPathType(), GetPermissionsAttribute(), GetStatBuf(), GetTimesCmd(), GetType(), GetValue(), GetValueNames(), GetVariableIndex(), GetWinFileAttributes(), IllegalExprOperandType(), InfoArgsCmd(), InfoBodyCmd(), InfoCmdCountCmd(), InfoCommandsCmd(), InfoCompleteCmd(), InfoDefaultCmd(), InfoExistsCmd(), InfoFunctionsCmd(), InfoGlobalsCmd(), InfoHostnameCmd(), InfoLevelCmd(), InfoLibraryCmd(), InfoLocalsCmd(), InfoNameOfExecutableCmd(), InfoPatchLevelCmd(), InfoProcsCmd(), InfoScriptCmd(), InfoSharedlibCmd(), InfoTclVersionCmd(), InfoVarsCmd(), InitByteCodeExecution(), LinkTraceProc(), LoadEscapeEncoding(), MacintoshInit(), main(), MakeDdeConnection(), NamespaceChildrenCmd(), NamespaceCodeCmd(), NamespaceCurrentCmd(), NamespaceDeleteCmd(), NamespaceEvalCmd(), NamespaceExistsCmd(), NamespaceExportCmd(), NamespaceForgetCmd(), NamespaceImportCmd(), NamespaceInscopeCmd(), NamespaceOriginCmd(), NamespaceParentCmd(), NamespaceQualifiersCmd(), NamespaceTailCmd(), NamespaceWhichCmd(), NativePathInFilesystem(), NoopCmd(), NoopObjCmd(), ObjMakeUpvar(), ObjTraceProc(), OpenKey(), ParseAddExpr(), ParseBitAndExpr(), ParseBitOrExpr(), ParseBitXorExpr(), ParseCondExpr(), ParseEqualityExpr(), ParseKeyName(), ParseLandExpr(), ParseLorExpr(), ParseMultiplyExpr(), ParsePrimaryExpr(), ParseRelationalExpr(), ParseSearchId(), ParseShiftExpr(), ParseTokens(), ParseUnaryExpr(), PipeGetHandleProc(), Pkga_EqObjCmd(), Pkga_Init(), Pkga_QuoteObjCmd(), Pkgb_Init(), Pkgb_SafeInit(), Pkgb_SubObjCmd(), Pkgb_UnsafeObjCmd(), Pkgc_Init(), Pkgc_SafeInit(), Pkgc_SubObjCmd(), Pkgc_UnsafeObjCmd(), Pkgd_Init(), Pkgd_SafeInit(), Pkgd_SubObjCmd(), Pkgd_UnsafeObjCmd(), prepareScriptData(), ProcBodySetFromAny(), ProcBodyTestInitInternal(), ProcessProcResultCode(), Prompt(), RegisterCommand(), RegistryObjCmd(), SerialGetHandleProc(), SerialGetOptionProc(), SerialSetOptionProc(), SetArraySearchObj(), SetBlockMode(), SetBooleanFromAny(), SetByteArrayFromAny(), SetCmdNameFromAny(), SetDoubleFromAny(), SetEndOffsetFromAny(), SetFileFinderAttributes(), SetFileReadOnly(), SetFsPathFromAny(), SetGroupAttribute(), SetIntFromAny(), SetIntOrWideFromAny(), SetListFromAny(), SetNsNameFromAny(), SetOSTypeFromAny(), SetOwnerAttribute(), SetPermissionsAttribute(), SetRegexpFromAny(), SetStringFromAny(), SetValue(), SetWideIntFromAny(), SetWinFileAttributes(), SimpleAccess(), SimpleCopy(), SimplePathInFilesystem(), SimpleStat(), SlaveCreate(), SlaveExpose(), SlaveHidden(), SlaveHide(), SlaveMarkTrusted(), SlaveObjCmd(), SlaveRecursionLimit(), SortCompare(), StaticInitProc(), StdinProc(), StoreStatData(), StringTraceProc(), TableFromUtfProc(), TableToUtfProc(), Tcl_AfterObjCmd(), Tcl_AppendAllObjTypes(), Tcl_AppendExportList(), Tcl_AppendObjCmd(), Tcl_AppInit(), Tcl_ArrayObjCmd(), Tcl_BadChannelOption(), Tcl_BeepObjCmd(), Tcl_BinaryObjCmd(), Tcl_CaseObjCmd(), Tcl_CatchObjCmd(), Tcl_CdObjCmd(), Tcl_Close(), Tcl_CloseObjCmd(), Tcl_ConcatObjCmd(), Tcl_ConvertToType(), Tcl_CreateInterp(), Tcl_CreateThread(), Tcl_DdeObjCmd(), TCL_DECLARE_MUTEX(), Tcl_DumpActiveMemory(), Tcl_EchoCmd(), Tcl_EncodingObjCmd(), Tcl_EofObjCmd(), Tcl_EvalEx(), Tcl_EvalObjEx(), Tcl_EvalObjv(), Tcl_EvalTokens(), Tcl_EvalTokensStandard(), Tcl_ExecObjCmd(), Tcl_ExitObjCmd(), Tcl_Export(), Tcl_ExposeCommand(), Tcl_ExprBoolean(), Tcl_ExprBooleanObj(), Tcl_ExprDouble(), Tcl_ExprDoubleObj(), Tcl_ExprLong(), Tcl_ExprLongObj(), Tcl_ExprObj(), Tcl_ExprObjCmd(), Tcl_ExprString(), Tcl_FblockedObjCmd(), Tcl_FconfigureObjCmd(), Tcl_FcopyObjCmd(), Tcl_FileEventObjCmd(), Tcl_FileObjCmd(), Tcl_FindCommand(), Tcl_FindNamespaceVar(), Tcl_Flush(), Tcl_FlushObjCmd(), Tcl_ForeachObjCmd(), Tcl_ForgetImport(), Tcl_FormatObjCmd(), Tcl_ForObjCmd(), Tcl_FSConvertToPathType(), Tcl_FSEvalFile(), Tcl_FSGetFileSystemForPath(), Tcl_FSGetInternalRep(), Tcl_FSGetNormalizedPath(), Tcl_FSGetTranslatedPath(), Tcl_FSJoinPath(), Tcl_FSLoadFile(), Tcl_FSMatchInDirectory(), Tcl_FSRegister(), Tcl_FSUnregister(), Tcl_GetAlias(), Tcl_GetAliasObj(), Tcl_GetBoolean(), Tcl_GetBooleanFromObj(), Tcl_GetChannelNamesEx(), Tcl_GetChannelOption(), Tcl_GetCommandFromObj(), Tcl_GetDouble(), Tcl_GetDoubleFromObj(), Tcl_GetEncodingNames(), Tcl_GetHostName(), Tcl_GetIndexFromObj(), Tcl_GetIndexFromObjStruct(), Tcl_GetInt(), Tcl_GetInterpPath(), Tcl_GetIntFromObj(), Tcl_GetLongFromObj(), Tcl_GetOpenFile(), Tcl_GetOSTypeFromObj(), Tcl_GetsObjCmd(), Tcl_GetTime(), Tcl_GetWideIntFromObj(), Tcl_GlobalObjCmd(), Tcl_GlobObjCmd(), Tcl_HideCommand(), Tcl_IfObjCmd(), Tcl_Import(), Tcl_IncrObjCmd(), Tcl_InfoObjCmd(), Tcl_InitNotifier(), Tcl_InterpObjCmd(), Tcl_JoinObjCmd(), Tcl_JoinThread(), Tcl_LappendObjCmd(), Tcl_LindexObjCmd(), Tcl_LinkVar(), Tcl_LinsertObjCmd(), Tcl_ListMathFuncs(), Tcl_ListObjAppendElement(), Tcl_ListObjAppendList(), Tcl_ListObjCmd(), Tcl_ListObjGetElements(), Tcl_ListObjIndex(), Tcl_ListObjLength(), Tcl_ListObjReplace(), Tcl_LlengthObjCmd(), Tcl_LoadObjCmd(), Tcl_LrangeObjCmd(), Tcl_LreplaceObjCmd(), Tcl_LsearchObjCmd(), Tcl_LsetObjCmd(), Tcl_LsObjCmd(), Tcl_LsortObjCmd(), Tcl_MacBGNotifyObjCmd(), Tcl_MacEvalResource(), Tcl_MacOSXOpenVersionedBundleResources(), Tcl_MacSourceObjCmd(), Tcl_Main(), Tcl_MakeSafe(), Tcl_MakeTcpClientChannel(), Tcl_NamespaceObjCmd(), Tcl_OpenObjCmd(), Tcl_OpenTcpClient(), Tcl_OpenTcpServer(), Tcl_OSACmd(), Tcl_OSAComponentCmd(), Tcl_PackageObjCmd(), Tcl_ParseBraces(), Tcl_ParseCommand(), Tcl_ParseExpr(), Tcl_ParseQuotedString(), Tcl_ParseVar(), Tcl_ParseVarName(), Tcl_PidObjCmd(), Tcl_PkgPresentEx(), Tcl_PkgProvideEx(), Tcl_PkgRequireEx(), Tcl_ProcObjCmd(), Tcl_PushCallFrame(), Tcl_PutsObjCmd(), Tcl_PwdObjCmd(), Tcl_ReadObjCmd(), Tcl_RecordAndEval(), Tcl_RecordAndEvalObj(), Tcl_RegexpObjCmd(), Tcl_RegsubObjCmd(), Tcl_ResourceObjCmd(), Tcl_ReturnObjCmd(), Tcl_ScanObjCmd(), Tcl_SeekObjCmd(), Tcl_SetChannelOption(), Tcl_SetObjCmd(), Tcl_SetSystemEncoding(), Tcl_SocketObjCmd(), Tcl_SourceRCFile(), Tcl_SplitList(), Tcl_SplitObjCmd(), Tcl_StackChannel(), Tcl_StringObjCmd(), Tcl_SubstObj(), Tcl_SubstObjCmd(), Tcl_SwitchObjCmd(), Tcl_TellObjCmd(), Tcl_TimeObjCmd(), Tcl_TraceCommand(), Tcl_TraceObjCmd(), Tcl_TraceVar2(), Tcl_UnregisterChannel(), Tcl_UnsetObjCmd(), Tcl_UnstackChannel(), Tcl_UpdateObjCmd(), Tcl_UpvarObjCmd(), Tcl_VariableObjCmd(), Tcl_VwaitObjCmd(), Tcl_WhileObjCmd(), TclAccessDeleteProc(), TclAccessInsertProc(), TclArraySet(), TclChannelEventScriptInvoker(), TclChannelTransform(), TclCheckExecutionTraces(), TclCheckInterpTraces(), TclCleanupChildren(), TclCompEvalObj(), TclCompileAppendCmd(), TclCompileBreakCmd(), TclCompileCatchCmd(), TclCompileCmdWord(), TclCompileContinueCmd(), TclCompileExpr(), TclCompileExprWords(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileIncrCmd(), TclCompileLappendCmd(), TclCompileLindexCmd(), TclCompileListCmd(), TclCompileLlengthCmd(), TclCompileLsetCmd(), TclCompileNoOp(), TclCompileReturnCmd(), TclCompileScript(), TclCompileSetCmd(), TclCompileStringCmd(), TclCompileTokens(), TclCompileWhileCmd(), TclCopyChannel(), TclCreatePipeline(), TclCreateProc(), TclCrossFilesystemCopy(), TclDoGlob(), TclEvalObjvInternal(), TclExecuteByteCode(), TclFileAttrsCmd(), TclFileDeleteCmd(), TclFileMakeDirsCmd(), TclFindElement(), TclFSEnsureEpochOk(), TclFSMakePathFromNormalized(), TclGetEncodingFromObj(), TclGetFrame(), TclGetIntForIndex(), TclGetLoadedPackages(), TclGetLong(), TclGetNamespaceForQualName(), TclGetOpenMode(), TclGlob(), TclInitCompiledLocals(), TclInterpInit(), TclInterpReady(), TclLindexFlat(), TclLindexList(), TclListObjSetElement(), TclLookupSimpleVar(), TclLsetFlat(), TclLsetList(), TclMacRegisterResourceFork(), TclObjInterpProc(), TclObjTest_Init(), TclObjUnsetVar2(), TclOpenFileChannelDeleteProc(), TclOpenFileChannelInsertProc(), tclOSAAddScript(), TclOSACompileCmd(), tclOSADecompileCmd(), tclOSADeleteCmd(), tclOSADeleteContext(), tclOSADeleteScript(), tclOSAExecuteCmd(), tclOSAGetContextID(), tclOSAGetScriptID(), tclOSAInfoCmd(), tclOSALoad(), tclOSALoadCmd(), tclOSAMakeContext(), tclOSAMakeNewComponent(), tclOSARunCmd(), tclOSAStore(), tclOSAStoreCmd(), TclpCheckStackSpace(), TclpCreateProcess(), TclpDeleteFile(), TclpDlopen(), TclpFindSymbol(), TclpHasSockets(), TclpInitLibraryPath(), TclplatformtestInit(), TclpLoadFile(), TclpMakeFile(), TclpMatchInDirectory(), TclpObjCopyDirectory(), TclpObjRemoveDirectory(), TclpOpenFileChannel(), TclPreventAliasLoop(), TclpSetInitialEncodings(), TclpSetVariables(), TclpThreadCreate(), TclPtrIncrVar(), TclPtrSetVar(), TclPushVarName(), TclRegisterLiteral(), TclRenameCommand(), TclSetByteCodeFromAny(), TclSockGetPort(), TclSockMinimumBuffers(), TclStatDeleteProc(), TclStatInsertProc(), Tcltest_Init(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), TclUpdateReturnInfo(), TclWinCPUID(), Tclxttest_Init(), TcpGetHandle(), TcpGetHandleProc(), TcpGetOptionProc(), TestalarmCmd(), TestasyncCmd(), TestbooleanobjCmd(), TestChannelCmd(), TestChannelEventCmd(), TestchmodCmd(), TestcmdinfoCmd(), TestcmdtokenCmd(), TestcmdtraceCmd(), TestconvertobjCmd(), TestcreatecommandCmd(), TestdcallCmd(), TestdelassocdataCmd(), TestdelCmd(), TestdoubleobjCmd(), TestdstringCmd(), TestencodingObjCmd(), TestevalexObjCmd(), TestevalobjvObjCmd(), TesteventloopCmd(), TesteventObjCmd(), TesteventProc(), TestExceptionCmd(), TestexithandlerCmd(), TestexitmainloopCmd(), TestexprlongCmd(), TestexprparserObjCmd(), TestfeventCmd(), TestfileCmd(), TestfilehandlerCmd(), TestfilelinkCmd(), TestFilesystemObjCmd(), TestfilewaitCmd(), TestfindexecutableCmd(), TestgetassocdataCmd(), TestgetdefencdirCmd(), TestGetIndexFromObjStructObjCmd(), TestgetopenfileCmd(), TestgetplatformCmd(), TestgetvarfullnameCmd(), TestgotsigCmd(), TestindexobjCmd(), TestinterpdeleteCmd(), TestintobjCmd(), TestlinkCmd(), TestlocaleCmd(), TestmainthreadCmd(), TestMathFunc(), TestMathFunc2(), TestNumUtfCharsCmd(), TestobjCmd(), TestpanicCmd(), TestparserObjCmd(), TestparsevarnameObjCmd(), TestparsevarObjCmd(), TestregexpObjCmd(), TestReportInFilesystem(), TestReportMatchInDirectory(), TestsaveresultCmd(), TestsetassocdataCmd(), TestsetCmd(), TestsetdefencdirCmd(), TestsetmainloopCmd(), TestsetplatformCmd(), TestSimpleFilesystemObjCmd(), TeststaticpkgCmd(), TeststringobjCmd(), TesttranslatefilenameCmd(), TestvolumetypeCmd(), TestwinclockCmd(), TestwincpuidCmd(), TestwinsleepCmd(), TestWrongNumArgsObjCmd(), TraceCommandProc(), TraceExecutionProc(), TraceVarProc(), TransformCloseProc(), TransformGetOptionProc(), TransformInputProc(), TransformOutputProc(), TraversalCopy(), TraversalDelete(), TraverseUnixTree(), TraverseWinTree(), TryToLoad(), UnicodeToUtfProc(), UtfToUnicodeProc(), UtfToUtfProc(), ValidateFormat(), VerifyExprObjType(), and WriteTextResource().#define TCL_ONE_WORD_KEYS  1

Definition at line 1309 of file tcl.h.
Referenced by RebuildTable(), RegisterTcpServerInterpCleanup(), ResourceInit(), Tcl_BinaryObjCmd(), Tcl_CreateHashEntry(), Tcl_DeleteHashEntry(), Tcl_DeleteHashTable(), Tcl_FindHashEntry(), Tcl_InitCustomHashTable(), Tcl_SplitObjCmd(), and TclInterpInit().#define TCL_PARSE_BAD_NUMBER  9

Definition at line 2119 of file tcl.h.
Referenced by GetLexeme().#define TCL_PARSE_BRACE_EXTRA  2

Definition at line 2112 of file tcl.h.
Referenced by Tcl_ParseCommand().#define TCL_PARSE_MISSING_BRACE  3

Definition at line 2113 of file tcl.h.
Referenced by Tcl_ParseBraces().#define TCL_PARSE_MISSING_BRACKET  4

Definition at line 2114 of file tcl.h.
Referenced by ParsePrimaryExpr(), and ParseTokens().#define TCL_PARSE_MISSING_PAREN  5

Definition at line 2115 of file tcl.h.
Referenced by Tcl_ParseVarName().#define TCL_PARSE_MISSING_QUOTE  6

Definition at line 2116 of file tcl.h.
Referenced by Tcl_ParseQuotedString().#define TCL_PARSE_MISSING_VAR_BRACE  7

Definition at line 2117 of file tcl.h.
Referenced by Tcl_ParseVarName().#define TCL_PARSE_PART1  0x400

Definition at line 1095 of file tcl.h.#define TCL_PARSE_QUOTE_EXTRA  1

Definition at line 2111 of file tcl.h.
Referenced by Tcl_ParseCommand().#define TCL_PARSE_SUCCESS  0

Definition at line 2110 of file tcl.h.
Referenced by Tcl_ParseBraces(), Tcl_ParseCommand(), Tcl_ParseQuotedString(), and Tcl_ParseVarName().#define TCL_PARSE_SYNTAX  8

Definition at line 2118 of file tcl.h.
Referenced by LogSyntaxError().#define TCL_PATCH_LEVEL  "8.4.14"

Definition at line 65 of file tcl.h.
Referenced by TclpInitLibraryPath(), and Tcltest_Init().#define TCL_PRESERVE_BINARY_COMPATABILITY  1

Definition at line 456 of file tcl.h.#define TCL_READABLE  (1<<1)

Definition at line 1416 of file tcl.h.
Referenced by ChannelTimerProc(), CheckChannelErrors(), CommonGetHandle(), ConsoleCheckProc(), ConsoleCloseProc(), ConsoleEventProc(), ConsoleSetupProc(), CopyData(), CreateFileHandler(), DeleteFileHandler(), FileProc(), IOCompletionRoutine(), OpenFileChannel(), PipeCheckProc(), PipeClose2Proc(), PipeCloseProc(), PipeEventProc(), PipeGetHandleProc(), PipeSetupProc(), PipeWatchProc(), RecycleBuffer(), SerialCheckProc(), SerialCloseProc(), SerialEventProc(), SerialSetupProc(), SetupStdFile(), SocketEventProc(), SocketReady(), StdinProc(), Tcl_CreateFileHandler(), TCL_DECLARE_MUTEX(), Tcl_DeleteFileHandler(), Tcl_ExecObjCmd(), Tcl_FblockedObjCmd(), Tcl_FcopyObjCmd(), Tcl_FileEventObjCmd(), Tcl_GetChannel(), Tcl_GetChannelMode(), Tcl_GetChannelOption(), Tcl_GetOpenFile(), Tcl_GetsObj(), Tcl_GetsObjCmd(), Tcl_Main(), Tcl_MakeFileChannel(), Tcl_MakeTcpClientChannel(), Tcl_NotifyChannel(), Tcl_OpenTcpClient(), Tcl_OpenTcpServer(), Tcl_Read(), Tcl_ReadChars(), Tcl_ReadObjCmd(), Tcl_ReadRaw(), Tcl_Seek(), Tcl_SetChannelOption(), Tcl_StackChannel(), Tcl_Tell(), Tcl_Ungets(), Tcl_UnstackChannel(), Tcl_WaitForEvent(), TclChannelTransform(), TclCreatePipeline(), TclpCreateCommandChannel(), TclpGetDefaultStdChannel(), TclpOpenFileChannel(), TclUnixWaitForFile(), TclWinOpenConsoleChannel(), TclWinOpenSerialChannel(), TcpAccept(), TcpInput(), TcpWatchProc(), TestChannelCmd(), TestChannelEventCmd(), TestfilehandlerCmd(), TestFileHandlerProc(), TestfilewaitCmd(), TransformChannelHandlerTimer(), TransformCloseProc(), TransformSeekProc(), TransformWatchProc(), TransformWideSeekProc(), UpdateInterest(), and WaitForSocketEvent().#define TCL_REG_ADVANCED  000003

Definition at line 559 of file tcl.h.
Referenced by Tcl_LsearchObjCmd(), Tcl_RegExpMatchObj(), Tcl_RegexpObjCmd(), and Tcl_RegsubObjCmd().#define TCL_REG_ADVF  000002

Definition at line 558 of file tcl.h.#define TCL_REG_BASIC  000000

Definition at line 556 of file tcl.h.#define TCL_REG_BOSONLY  002000

Definition at line 575 of file tcl.h.#define TCL_REG_CANMATCH  001000

Definition at line 568 of file tcl.h.
Referenced by TestregexpObjCmd(), and TestregexpXflags().#define TCL_REG_EXPANDED  000040

Definition at line 563 of file tcl.h.
Referenced by Tcl_RegexpObjCmd(), and Tcl_RegsubObjCmd().#define TCL_REG_EXTENDED  000001

Definition at line 557 of file tcl.h.#define TCL_REG_NEWLINE  000300

Definition at line 567 of file tcl.h.
Referenced by Tcl_RegexpObjCmd(), and Tcl_RegsubObjCmd().#define TCL_REG_NLANCH  000200

Definition at line 566 of file tcl.h.
Referenced by Tcl_RegexpObjCmd(), and Tcl_RegsubObjCmd().#define TCL_REG_NLSTOP  000100

Definition at line 565 of file tcl.h.
Referenced by Tcl_RegexpObjCmd(), and Tcl_RegsubObjCmd().#define TCL_REG_NOCASE  000010

Definition at line 561 of file tcl.h.
Referenced by Tcl_RegexpObjCmd(), and Tcl_RegsubObjCmd().#define TCL_REG_NOSUB  000020

Definition at line 562 of file tcl.h.
Referenced by Tcl_LsearchObjCmd(), and Tcl_RegExpMatchObj().#define TCL_REG_NOTBOL  0001

Definition at line 582 of file tcl.h.
Referenced by Tcl_RegexpObjCmd(), and Tcl_RegsubObjCmd().#define TCL_REG_NOTEOL  0002

Definition at line 583 of file tcl.h.#define TCL_REG_QUOTE  000004

Definition at line 560 of file tcl.h.#define TCL_RELEASE_LEVEL  TCL_FINAL_RELEASE

Definition at line 61 of file tcl.h.
Referenced by Tcl_GetVersion().#define TCL_RELEASE_SERIAL  14

Definition at line 62 of file tcl.h.
Referenced by Tcl_GetVersion().#define TCL_RESULT_SIZE  200

Definition at line 639 of file tcl.h.
Referenced by Tcl_DStringResult(), and Tcl_SetResult().#define Tcl_Return  Tcl_SetResult

Definition at line 2271 of file tcl.h.#define TCL_RETURN  2

Definition at line 635 of file tcl.h.
Referenced by ObjTraceProc(), ProcessProcResultCode(), Tcl_EvalEx(), Tcl_EvalObjEx(), Tcl_EvalObjv(), Tcl_FSEvalFile(), Tcl_MacEvalResource(), Tcl_ReturnObjCmd(), and TclExecuteByteCode().#define TCL_SERVICE_ALL  1

Definition at line 1394 of file tcl.h.
Referenced by Tcl_ServiceAll(), Tcl_ServiceModeHook(), and TesteventloopCmd().#define TCL_SERVICE_NONE  0

Definition at line 1393 of file tcl.h.
Referenced by Tcl_DoOneEvent(), Tcl_ServiceAll(), and WaitForSocketEvent().#define Tcl_SetHashValue(h, value)  ((h)->clientData = (ClientData) (value))

Definition at line 1324 of file tcl.h.
Referenced by AliasCreate(), FindPackage(), RegisterTcpServerInterpCleanup(), ScanNumber(), SlaveCreate(), Tcl_CallWhenDeleted(), Tcl_CreateCommand(), Tcl_CreateEncoding(), Tcl_CreateInterp(), Tcl_CreateMathFunc(), Tcl_CreateNamespace(), Tcl_CreateObjCommand(), Tcl_ExposeCommand(), Tcl_HideCommand(), Tcl_RegisterChannel(), Tcl_RegisterObjType(), Tcl_SetAssocData(), Tcl_SplitObjCmd(), Tclapplescript_Init(), TclCompileExpr(), TclLookupArrayElement(), TclLookupSimpleVar(), TclMacRegisterResourceFork(), tclOSAAddContext(), tclOSAAddScript(), tclOSAMakeNewComponent(), TclRegisterAuxDataType(), and TclRenameCommand().#define TCL_SMALL_HASH_TABLE  4

Definition at line 1238 of file tcl.h.
Referenced by Tcl_InitCustomHashTable(), and TclInitLiteralTable().#define TCL_STATIC  ((Tcl_FreeProc *) 0)

Definition at line 1045 of file tcl.h.
Referenced by HasStubSupport(), ObjMakeUpvar(), ParsePrimaryExpr(), ParseTokens(), Tcl_ArrayObjCmd(), Tcl_ExprDouble(), Tcl_ExprLong(), Tcl_FormatObjCmd(), Tcl_FSMatchInDirectory(), Tcl_GetInt(), Tcl_LoadObjCmd(), Tcl_ParseBraces(), Tcl_ParseCommand(), Tcl_ParseQuotedString(), Tcl_ParseVarName(), Tcl_SplitList(), TclCompileLlengthCmd(), TclCreatePipeline(), TclDoGlob(), TclFindElement(), TclGetLong(), tclOSAInfoCmd(), TclpDlopen(), TclpFindSymbol(), TclpGetCwd(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), TestasyncCmd(), TestcmdinfoCmd(), TestcmdtraceCmd(), TestdelCmd(), TestdstringCmd(), TestevalexObjCmd(), TestexprlongCmd(), TestfilehandlerCmd(), TestfilewaitCmd(), TestmainthreadCmd(), TestMathFunc2(), TestsetCmd(), TestseterrorcodeCmd(), TestWrongNumArgsObjCmd(), and ValidateFormat().#define TCL_STDERR  (1<<3)

Definition at line 1427 of file tcl.h.
Referenced by GetChannelTable(), HandleBgErrors(), Prompt(), SetupStdFile(), StdinProc(), Tcl_AppInit(), Tcl_CreateChannel(), Tcl_ExecObjCmd(), Tcl_GetChannel(), Tcl_GetStdChannel(), Tcl_Main(), Tcl_MakeSafe(), Tcl_OpenCommandChannel(), Tcl_OpenObjCmd(), Tcl_SetStdChannel(), Tcl_SourceRCFile(), TclCreatePipeline(), TclpCreateProcess(), and TclpGetDefaultStdChannel().#define TCL_STDIN  (1<<1)

Definition at line 1425 of file tcl.h.
Referenced by GetChannelTable(), SetupStdFile(), StdinProc(), Tcl_AppInit(), Tcl_CreateChannel(), Tcl_GetChannel(), Tcl_GetStdChannel(), Tcl_Main(), Tcl_MakeSafe(), Tcl_OpenCommandChannel(), Tcl_OpenObjCmd(), Tcl_SetStdChannel(), TclCreatePipeline(), TclpCreateProcess(), and TclpGetDefaultStdChannel().#define TCL_STDOUT  (1<<2)

Definition at line 1426 of file tcl.h.
Referenced by GetChannelTable(), Prompt(), SetupStdFile(), StdinProc(), Tcl_AppInit(), Tcl_CreateChannel(), Tcl_ExecObjCmd(), Tcl_GetChannel(), Tcl_GetStdChannel(), Tcl_Main(), Tcl_MakeSafe(), Tcl_OpenCommandChannel(), Tcl_OpenObjCmd(), Tcl_SetStdChannel(), TclCreatePipeline(), TclpCreateProcess(), and TclpGetDefaultStdChannel().#define TCL_STORAGE_CLASS  DLLIMPORT

Definition at line 2350 of file tcl.h.#define TCL_STORAGE_CLASS

Definition at line 2350 of file tcl.h.#define TCL_STORAGE_CLASS  DLLIMPORT

Definition at line 2350 of file tcl.h.#define TCL_STRING_KEYS  0

Definition at line 1308 of file tcl.h.
Referenced by GetChannelTable(), RebuildTable(), ResourceInit(), SlaveCreate(), Tcl_CallWhenDeleted(), Tcl_CreateHashEntry(), Tcl_CreateInterp(), Tcl_CreateNamespace(), Tcl_DeleteHashEntry(), Tcl_DeleteHashTable(), Tcl_FindHashEntry(), Tcl_GetEncodingNames(), Tcl_HideCommand(), Tcl_InitCustomHashTable(), Tcl_SetAssocData(), Tclapplescript_Init(), TclArraySet(), TclCompileExpr(), TclInitAuxDataTypeTable(), TclInitEncodingSubsystem(), TclInitObjSubsystem(), TclInterpInit(), TclLookupArrayElement(), TclLookupSimpleVar(), tclOSAMakeNewComponent(), and TclTeardownNamespace().#define TCL_STUB_MAGIC  ((int)0xFCA3BACF)

Definition at line 2285 of file tcl.h.
Referenced by HasStubSupport().#define TCL_SUBST_ALL  007

Definition at line 647 of file tcl.h.
Referenced by Tcl_SubstObjCmd().#define TCL_SUBST_BACKSLASHES  004

Definition at line 646 of file tcl.h.
Referenced by Tcl_SubstObj(), and Tcl_SubstObjCmd().#define TCL_SUBST_COMMANDS  001

Definition at line 644 of file tcl.h.
Referenced by Tcl_SubstObj(), and Tcl_SubstObjCmd().#define TCL_SUBST_VARIABLES  002

Definition at line 645 of file tcl.h.
Referenced by Tcl_SubstObj(), and Tcl_SubstObjCmd().#define TCL_THREAD_CREATE_RETURN

Definition at line 541 of file tcl.h.
Referenced by Tcl_UpdateObjCmd().#define TCL_THREAD_JOINABLE  (0001)

Definition at line 551 of file tcl.h.
Referenced by Tcl_CreateThread(), Tcl_InitNotifier(), and TclpThreadCreate().#define TCL_THREAD_NOFLAGS  (0000)

Definition at line 550 of file tcl.h.#define TCL_THREAD_STACK_DEFAULT  (0)

Definition at line 549 of file tcl.h.
Referenced by Tcl_CreateThread(), Tcl_InitNotifier(), and TclpThreadCreate().#define Tcl_ThreadCreateType  void

Definition at line 540 of file tcl.h.
Referenced by Tcl_UpdateObjCmd().#define Tcl_TildeSubst  Tcl_TranslateFileName

Definition at line 2272 of file tcl.h.#define TCL_TIMER_EVENTS  (1<<4)

Definition at line 1364 of file tcl.h.
Referenced by TimerCheckProc(), TimerHandlerEventProc(), and TimerSetupProc().#define TCL_TOKEN_BS  8

Definition at line 2099 of file tcl.h.
Referenced by CompileSubExpr(), ParseTokens(), PrintParse(), Tcl_EvalTokensStandard(), Tcl_ParseBraces(), and TclCompileTokens().#define TCL_TOKEN_COMMAND  16

Definition at line 2100 of file tcl.h.
Referenced by CompileSubExpr(), ParsePrimaryExpr(), ParseTokens(), PrintParse(), Tcl_EvalTokensStandard(), and TclCompileTokens().#define TCL_TOKEN_OPERATOR  128

Definition at line 2103 of file tcl.h.
Referenced by CompileSubExpr(), ParseCondExpr(), ParsePrimaryExpr(), PrependSubExprTokens(), and PrintParse().#define TCL_TOKEN_SIMPLE_WORD  2

Definition at line 2097 of file tcl.h.
Referenced by PrintParse(), Tcl_ParseCommand(), TclCompileAppendCmd(), TclCompileCatchCmd(), TclCompileExprWords(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileIfCmd(), TclCompileIncrCmd(), TclCompileLappendCmd(), TclCompileLindexCmd(), TclCompileListCmd(), TclCompileLlengthCmd(), TclCompileLsetCmd(), TclCompileNoOp(), TclCompileRegexpCmd(), TclCompileReturnCmd(), TclCompileScript(), TclCompileSetCmd(), TclCompileStringCmd(), TclCompileVariableCmd(), TclCompileWhileCmd(), and TclPushVarName().#define TCL_TOKEN_SUB_EXPR  64

Definition at line 2102 of file tcl.h.
Referenced by CompileSubExpr(), ParseCondExpr(), ParsePrimaryExpr(), PrependSubExprTokens(), and PrintParse().#define TCL_TOKEN_TEXT  4

Definition at line 2098 of file tcl.h.
Referenced by CompileSubExpr(), ParsePrimaryExpr(), ParseTokens(), PrintParse(), Tcl_EvalTokensStandard(), Tcl_ParseBraces(), Tcl_ParseCommand(), Tcl_ParseVarName(), TclCompileCmdWord(), TclCompileTokens(), and TclPushVarName().#define TCL_TOKEN_VARIABLE  32

Definition at line 2101 of file tcl.h.
Referenced by CompileSubExpr(), PrintParse(), Tcl_EvalTokensStandard(), Tcl_ParseVarName(), and TclCompileTokens().#define TCL_TOKEN_WORD  1

Definition at line 2096 of file tcl.h.
Referenced by CompileSubExpr(), ParsePrimaryExpr(), PrintParse(), and Tcl_ParseCommand().#define TCL_TRACE_ARRAY  0x800

Definition at line 1061 of file tcl.h.
Referenced by CallVarTraces(), EnvTraceProc(), Tcl_ArrayObjCmd(), Tcl_TraceObjCmd(), Tcl_TraceVar2(), Tcl_UntraceVar2(), TclTraceVariableObjCmd(), and TraceVarProc().#define TCL_TRACE_DELETE  0x4000

Definition at line 1075 of file tcl.h.
Referenced by CallCommandTraces(), Tcl_DeleteCommandFromToken(), Tcl_TraceCommand(), Tcl_UntraceCommand(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), and TraceCommandProc().#define TCL_TRACE_DESTROYED  0x80

Definition at line 1058 of file tcl.h.
Referenced by CallCommandTraces(), CallVarTraces(), LinkTraceProc(), TclPrecTraceProc(), TclTraceCommandObjCmd(), TraceCommandProc(), TraceExecutionProc(), and TraceVarProc().#define TCL_TRACE_ENTER_EXEC  1

Definition at line 1084 of file tcl.h.
Referenced by TclCheckInterpTraces(), TclEvalObjvInternal(), TclTraceExecutionObjCmd(), TraceCommandProc(), and TraceExecutionProc().#define TCL_TRACE_LEAVE_EXEC  2

Definition at line 1085 of file tcl.h.
Referenced by TclCheckExecutionTraces(), TclCheckInterpTraces(), TclEvalObjvInternal(), TclTraceExecutionObjCmd(), TraceCommandProc(), and TraceExecutionProc().#define TCL_TRACE_OLD_STYLE  0x1000

Definition at line 1064 of file tcl.h.
Referenced by Tcl_TraceVar2(), Tcl_UntraceVar2(), TclTraceVariableObjCmd(), and TraceVarProc().#define TCL_TRACE_READS  0x10

Definition at line 1055 of file tcl.h.
Referenced by CallVarTraces(), EnvTraceProc(), LinkTraceProc(), Tcl_GetVar2Ex(), Tcl_LappendObjCmd(), Tcl_LinkVar(), Tcl_ObjGetVar2(), Tcl_TraceObjCmd(), Tcl_TraceVar2(), Tcl_UnlinkVar(), Tcl_UntraceVar2(), TclExecuteByteCode(), TclPrecTraceProc(), TclPtrGetVar(), TclPtrSetVar(), TclTraceVariableObjCmd(), TclVarTraceExists(), and TraceVarProc().#define TCL_TRACE_RENAME  0x2000

Definition at line 1074 of file tcl.h.
Referenced by CallCommandTraces(), Tcl_TraceCommand(), Tcl_UntraceCommand(), TclRenameCommand(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), and TraceCommandProc().#define TCL_TRACE_RESULT_DYNAMIC  0x8000

Definition at line 1067 of file tcl.h.
Referenced by DisposeTraceResult(), Tcl_TraceVar2(), Tcl_UntraceVar2(), and TclTraceVariableObjCmd().#define TCL_TRACE_RESULT_OBJECT  0x10000

Definition at line 1068 of file tcl.h.
Referenced by CallVarTraces(), DisposeTraceResult(), Tcl_TraceVar2(), Tcl_UntraceVar2(), and TclTraceVariableObjCmd().#define TCL_TRACE_UNSETS  0x40

Definition at line 1057 of file tcl.h.
Referenced by CallVarTraces(), EnvTraceProc(), LinkTraceProc(), Tcl_LinkVar(), Tcl_TraceObjCmd(), Tcl_TraceVar2(), Tcl_UnlinkVar(), Tcl_UntraceVar2(), Tcl_VwaitObjCmd(), TclDeleteCompiledLocalVars(), TclDeleteVars(), TclPrecTraceProc(), TclTraceVariableObjCmd(), TraceVarProc(), and UnsetVarStruct().#define TCL_TRACE_WRITES  0x20

Definition at line 1056 of file tcl.h.
Referenced by CallVarTraces(), EnvTraceProc(), LinkTraceProc(), Tcl_LinkVar(), Tcl_TraceObjCmd(), Tcl_TraceVar2(), Tcl_UnlinkVar(), Tcl_UntraceVar2(), Tcl_VwaitObjCmd(), TclPrecTraceProc(), TclPtrSetVar(), TclTraceVariableObjCmd(), and TraceVarProc().#define TCL_UTF_MAX  3

Definition at line 2230 of file tcl.h.
Referenced by AppendDllPath(), AppendEnvironment(), BinaryProc(), CompileSubExpr(), EscapeFromUtfProc(), EscapeToUtfProc(), FilterInputBytes(), GetLexeme(), ReadChars(), TableFromUtfProc(), TableToUtfProc(), Tcl_Backslash(), Tcl_BinaryObjCmd(), Tcl_EvalTokensStandard(), Tcl_FormatObjCmd(), Tcl_GetsObj(), Tcl_ParseVarName(), Tcl_StringObjCmd(), Tcl_SubstObj(), Tcl_UniCharToUtfDString(), Tcl_UtfPrev(), TclCompileTokens(), TclExecuteByteCode(), TclParseBackslash(), TclpCreateProcess(), TclpFindExecutable(), UnicodeToUtfProc(), UpdateStringOfString(), UtfToUnicodeProc(), UtfToUtfProc(), and ValidateFormat().#define Tcl_ValidateAllMemory(x, y)

Definition at line 1523 of file tcl.h.#define TCL_VARARGS(type, name)  (type name, ...)

Definition at line 174 of file tcl.h.#define TCL_VARARGS_DEF(type, name)  (type name, ...)

Definition at line 175 of file tcl.h.#define TCL_VARARGS_START(type, name, list)  (va_start(list, name), name)

Definition at line 176 of file tcl.h.
Referenced by TCL_VARARGS_DEF().#define TCL_VERSION  "8.4"

Definition at line 64 of file tcl.h.
Referenced by Pkga_Init(), Pkgb_Init(), Pkgb_SafeInit(), Pkgc_Init(), Pkgc_SafeInit(), Pkgd_Init(), Pkgd_SafeInit(), Pkge_Init(), Pkgf_Init(), TclpInitLibraryPath(), Tcltest_Init(), and Tclxttest_Init().#define TCL_VOLATILE  ((Tcl_FreeProc *) 1)

Definition at line 1044 of file tcl.h.
Referenced by FlushChannel(), ProcessUnexpectedResult(), Tcl_AppendElement(), Tcl_AppendResultVA(), Tcl_DStringGetResult(), Tcl_DStringResult(), Tcl_Eval(), Tcl_ExprBoolean(), Tcl_ExprDouble(), Tcl_ExprLong(), Tcl_ExprString(), Tcl_FormatObjCmd(), Tcl_GetStringResult(), Tcl_OSACmd(), Tcl_PackageObjCmd(), Tcl_RecordAndEval(), Tcl_SetResult(), TclFindElement(), TclInvoke(), TclInvokeObjectCommand(), TclOSACompileCmd(), tclOSALoadCmd(), tclOSARunCmd(), TclProcInterpProc(), TestasyncCmd(), TestcmdtokenCmd(), TestdstringCmd(), TestfilehandlerCmd(), TestFilesystemObjCmd(), TestfindexecutableCmd(), TestobjCmd(), TestsaveresultCmd(), TestSimpleFilesystemObjCmd(), and TestvolumetypeCmd().#define TCL_WIDE_INT_TYPE  long long

Definition at line 406 of file tcl.h.#define Tcl_WideAsDouble(val)  ((double)((Tcl_WideInt)(val)))

Definition at line 445 of file tcl.h.
Referenced by ExprRoundFunc(), ExprWideFunc(), TclExecuteByteCode(), and TestMathFunc2().#define Tcl_WideAsLong(val)  ((long)((Tcl_WideInt)(val)))

Definition at line 443 of file tcl.h.
Referenced by ExprSrandFunc(), FileSeekProc(), Tcl_ExprDouble(), Tcl_ExprLong(), Tcl_FormatObjCmd(), Tcl_GetLongFromObj(), Tcl_IncrObjCmd(), Tcl_Seek(), Tcl_SeekOld(), Tcl_TellOld(), TclPtrIncrVar(), and TransformWideSeekProc().#define TCL_WINDOW_EVENTS  (1<<2)

Definition at line 1362 of file tcl.h.
Referenced by Tcl_UpdateObjCmd(), and TestfilehandlerCmd().#define TCL_WRITABLE  (1<<2)

Definition at line 1417 of file tcl.h.
Referenced by CheckChannelErrors(), CloseChannel(), CommonGetHandle(), ConsoleCheckProc(), ConsoleCloseProc(), ConsoleEventProc(), ConsoleSetupProc(), CopyData(), CreateFileHandler(), DeleteFileHandler(), FileProc(), IOCompletionRoutine(), OpenFileChannel(), PipeCheckProc(), PipeClose2Proc(), PipeEventProc(), PipeGetHandleProc(), PipeSetupProc(), PipeWatchProc(), RecycleBuffer(), SerialCheckProc(), SerialCloseProc(), SerialEventProc(), SerialSetupProc(), SetupStdFile(), SocketEventProc(), SocketReady(), Tcl_Close(), Tcl_CreateChannel(), Tcl_CreateFileHandler(), TCL_DECLARE_MUTEX(), Tcl_DeleteFileHandler(), Tcl_FcopyObjCmd(), Tcl_FileEventObjCmd(), Tcl_Flush(), Tcl_FlushObjCmd(), Tcl_GetChannel(), Tcl_GetChannelMode(), Tcl_GetChannelOption(), Tcl_GetOpenFile(), Tcl_MakeFileChannel(), Tcl_MakeTcpClientChannel(), Tcl_NotifyChannel(), Tcl_OpenTcpClient(), Tcl_PutsObjCmd(), Tcl_Seek(), Tcl_SetChannelBufferSize(), Tcl_SetChannelOption(), Tcl_StackChannel(), Tcl_Tell(), Tcl_UnstackChannel(), Tcl_WaitForEvent(), Tcl_Write(), Tcl_WriteChars(), Tcl_WriteObj(), Tcl_WriteRaw(), TclChannelTransform(), TclCreatePipeline(), TclpCreateCommandChannel(), TclpGetDefaultStdChannel(), TclpOpenFileChannel(), TclUnixWaitForFile(), TclWinOpenConsoleChannel(), TclWinOpenSerialChannel(), TcpAccept(), TcpGetOptionProc(), TcpOutput(), TcpWatchProc(), TestChannelCmd(), TestChannelEventCmd(), TestfilehandlerCmd(), TestFileHandlerProc(), TestfilewaitCmd(), TransformCloseProc(), TransformSeekProc(), TransformWideSeekProc(), UpdateInterest(), WaitForConnect(), and WaitForSocketEvent().#define VOID  void

Definition at line 310 of file tcl.h.
Referenced by AliasObjCmd(), AppendUnicodeToUnicodeRep(), AppendUtfToUtfRep(), CallTraceProcedure(), CreateSocketAddress(), dlopen(), DupByteArrayInternalRep(), DupCmdNameInternalRep(), DupEncodingIntRep(), DupFsPathInternalRep(), DupIndex(), DupListInternalRep(), DupLocalVarName(), DupNsVarName(), DupParsedVarName(), DupStringInternalRep(), EnterCmdStartData(), EscapeFromUtfProc(), ExpandLocalLiteralArray(), FilterInputBytes(), FormatNumber(), getSortedHashKeys(), GrowEvaluationStack(), LoadEscapeEncoding(), NativeCreateNativeRep(), ParseCondExpr(), ParsePrimaryExpr(), PrependSubExprTokens(), ProcBodyDup(), ReadChars(), RebuildTable(), ReplaceString(), ResultCopy(), ScanNumber(), SetArraySearchObj(), SetCmdNameFromAny(), SetFsPathFromAny(), SetListFromAny(), Tcl_AttemptSetObjLength(), Tcl_BinaryObjCmd(), Tcl_Concat(), Tcl_CreateHashEntry(), Tcl_CreateInterp(), TCL_DECLARE_MUTEX(), Tcl_DStringAppend(), Tcl_DStringAppendElement(), Tcl_DStringSetLength(), Tcl_FindHashEntry(), Tcl_FSGetTranslatedStringPath(), Tcl_FSNewNativePath(), Tcl_GetIndexFromObj(), Tcl_GetRegExpFromObj(), Tcl_GetThreadData(), Tcl_JoinThread(), Tcl_LappendObjCmd(), Tcl_ListObjAppendElement(), Tcl_ListObjReplace(), Tcl_MacConvertTextResource(), Tcl_NewListObj(), Tcl_NewUnicodeObj(), Tcl_SetByteArrayLength(), Tcl_SetByteArrayObj(), Tcl_SetListObj(), Tcl_SetObjLength(), Tcl_SetUnicodeObj(), Tcl_SplitList(), Tcl_SplitPath(), TclAllocateFreeObjects(), TclChannelTransform(), TclCreateAuxData(), TclCreateExceptRange(), TclExecuteByteCode(), TclExpandCodeArray(), TclExpandJumpFixupArray(), TclExpandTokenArray(), TclFindCompiledLocal(), TclFreeObj(), TclFSMakePathFromNormalized(), TclFSMakePathRelative(), TclGetEncodingFromObj(), TclInitByteCodeObj(), TclLsetFlat(), TclLsetList(), TclNativeDupInternalRep(), TclNewFSPathObj(), TclNewProcBodyObj(), TclObjLookupVar(), TclpDlopen(), TclpFindSymbol(), TclpFindVariable(), TclpGmtime(), TclpLocaltime(), TclpUnloadFile(), TclRegError(), TclSetCmdNameObj(), TclSetEnv(), TclThreadDataKeyGet(), TclUnixWaitForFile(), TclUnsetEnv(), TclWinSetInterfaces(), TestcmdtokenCmd(), TestfilehandlerCmd(), TestindexobjCmd(), TransformCloseProc(), TranslateInputEOL(), UpdateStringOfByteArray(), WinSymLinkDirectory(), and WriteChars().
Typedef Documentation
typedef Tcl_Obj* Tcl_FSInternalToNormalizedProc _ANSI_ARGS_((ClientData clientData))

Definition at line 1707 of file tcl.h.typedef Tcl_Obj* Tcl_FSFilesystemSeparatorProc _ANSI_ARGS_((Tcl_Obj *pathPtr))

Definition at line 1702 of file tcl.h.typedef Tcl_Obj* Tcl_FSFilesystemPathTypeProc _ANSI_ARGS_((Tcl_Obj *pathPtr))

Definition at line 1700 of file tcl.h.typedef Tcl_Obj* Tcl_FSLinkProc _ANSI_ARGS_((Tcl_Obj *pathPtr,Tcl_Obj *toPtr, int linkType))

Definition at line 1691 of file tcl.h.typedef CONST char** Tcl_FSFileAttrStringsProc _ANSI_ARGS_((Tcl_Obj *pathPtr,Tcl_Obj **objPtrRef))

Definition at line 1686 of file tcl.h.typedef Tcl_Obj* Tcl_FSListVolumesProc _ANSI_ARGS_((void))

Definition at line 1676 of file tcl.h.typedef Tcl_Obj* Tcl_FSGetCwdProc _ANSI_ARGS_((Tcl_Interp *interp))

Definition at line 1661 of file tcl.h.typedef Tcl_HashEntry* Tcl_AllocHashEntryProc _ANSI_ARGS_((Tcl_HashTable *tablePtr, VOID *keyPtr))

Definition at line 1121 of file tcl.h.static int TestwincpuidCmd _ANSI_ARGS_

Definition at line 726 of file tcl.h.typedef int action

Definition at line 1494 of file tcl.h.typedef Tcl_Channel char* address

Definition at line 721 of file tcl.h.typedef Tcl_Interp int char Tcl_CmdProc ClientData int argc

Definition at line 685 of file tcl.h.typedef Tcl_Interp int argc

Definition at line 683 of file tcl.h.typedef Tcl_Interp Tcl_Value* args

Definition at line 714 of file tcl.h.typedef Tcl_Interp int char Tcl_CmdProc ClientData int CONST84 char* argv[]

Definition at line 685 of file tcl.h.typedef Tcl_Interp int CONST84 char* argv[]

Definition at line 683 of file tcl.h.typedef Tcl_StatBuf* buf

Definition at line 1664 of file tcl.h.typedef Tcl_StatBuf* buf

Definition at line 1653 of file tcl.h.typedef CONST84 char* buf

Definition at line 1470 of file tcl.h.typedef char* buf

Definition at line 1468 of file tcl.h.typedef Tcl_Channel chan

Definition at line 721 of file tcl.h.typedef int Tcl_FileProc ClientData clientData

Definition at line 731 of file tcl.h.typedef ClientData clientData

Definition at line 702 of file tcl.h.typedef void* ClientData

Definition at line 321 of file tcl.h.typedef ClientData* clientDataPtr

Definition at line 1698 of file tcl.h.typedef Tcl_Interp int char Tcl_CmdProc ClientData cmdClientData

Definition at line 685 of file tcl.h.typedef Tcl_Interp int code

Definition at line 678 of file tcl.h.typedef Tcl_Interp int CONST char* command

Definition at line 688 of file tcl.h.typedef Tcl_Interp int char* command

Definition at line 685 of file tcl.h.typedef Tcl_Interp int CONST char Tcl_Command commandInfo

Definition at line 688 of file tcl.h.typedef Tcl_Obj* destPathPtr

Definition at line 1674 of file tcl.h.typedef Tcl_Obj* destPathPtr

Definition at line 1670 of file tcl.h.typedef Tcl_Obj* destPathPtr

Definition at line 1668 of file tcl.h.typedef int direction

Definition at line 1482 of file tcl.h.typedef Tcl_Interp CONST84 char Tcl_DString* dsPtr

Definition at line 1477 of file tcl.h.typedef CONST char int int Tcl_EncodingState char* dst

Definition at line 694 of file tcl.h.typedef CONST char int int Tcl_EncodingState char int int int int* dstCharsPtr

Definition at line 694 of file tcl.h.typedef CONST char int int Tcl_EncodingState char int dstLen

Definition at line 694 of file tcl.h.typedef CONST char int int Tcl_EncodingState char int int int* dstWrotePtr

Definition at line 694 of file tcl.h.typedef struct Tcl_Obj* dupPtr

Definition at line 692 of file tcl.h.typedef Tcl_WideInt int int* errorCodePtr

Definition at line 1489 of file tcl.h.typedef long int int* errorCodePtr

Definition at line 1472 of file tcl.h.typedef CONST84 char int int* errorCodePtr

Definition at line 1470 of file tcl.h.typedef char int int* errorCodePtr

Definition at line 1468 of file tcl.h.typedef int Tcl_Obj** errorPtr

Definition at line 1672 of file tcl.h.typedef Tcl_Obj Tcl_Obj** errorPtr

Definition at line 1668 of file tcl.h.typedef Tcl_Interp int flags

Definition at line 1466 of file tcl.h.typedef Tcl_Interp CONST char CONST char int flags

Definition at line 729 of file tcl.h.typedef int flags

Definition at line 704 of file tcl.h.typedef int flags

Definition at line 700 of file tcl.h.typedef int flags

Definition at line 698 of file tcl.h.typedef CONST char int int flags

Definition at line 694 of file tcl.h.typedef Tcl_Obj Tcl_LoadHandle* handlePtr

Definition at line 1694 of file tcl.h.typedef int ClientData* handlePtr

Definition at line 1482 of file tcl.h.typedef Tcl_HashEntry* hPtr

Definition at line 1120 of file tcl.h.typedef int index

Definition at line 1689 of file tcl.h.typedef int index

Definition at line 1684 of file tcl.h.typedef unsigned int(Tcl_HashKeyProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr

Definition at line 1117 of file tcl.h.typedef int interestMask

Definition at line 1487 of file tcl.h.typedef Tcl_Interp* interp

Definition at line 1477 of file tcl.h.typedef Tcl_Interp* interp

Definition at line 1474 of file tcl.h.typedef Tcl_Interp* interp

Definition at line 1466 of file tcl.h.typedef Tcl_Interp* interp

Definition at line 1464 of file tcl.h.typedef Tcl_Interp* interp

Definition at line 729 of file tcl.h.typedef Tcl_Interp* interp

Definition at line 717 of file tcl.h.typedef Tcl_Interp* interp

Definition at line 714 of file tcl.h.typedef Tcl_Interp* interp

Definition at line 712 of file tcl.h.typedef Tcl_Interp* interp

Definition at line 688 of file tcl.h.typedef Tcl_Interp* interp

Definition at line 685 of file tcl.h.typedef Tcl_Interp* interp

Definition at line 683 of file tcl.h.typedef Tcl_Interp* interp

Definition at line 678 of file tcl.h.typedef unsigned VOID* keyPtr

Definition at line 1118 of file tcl.h.typedef Tcl_Interp int level

Definition at line 688 of file tcl.h.typedef Tcl_Interp int level

Definition at line 685 of file tcl.h.typedef int mask

Definition at line 1480 of file tcl.h.typedef int mask

Definition at line 731 of file tcl.h.typedef int mask

Definition at line 706 of file tcl.h.typedef int mask

Definition at line 679 of file tcl.h.typedef Tcl_Obj int mode

Definition at line 1656 of file tcl.h.typedef int mode

Definition at line 1654 of file tcl.h.typedef Tcl_WideInt int mode

Definition at line 1489 of file tcl.h.typedef long int mode

Definition at line 1472 of file tcl.h.typedef int mode

Definition at line 1462 of file tcl.h.typedef Tcl_Interp CONST char CONST char* newName

Definition at line 729 of file tcl.h.typedef Tcl_Obj int nextCheckpoint

Definition at line 1682 of file tcl.h.typedef Tcl_Interp int objc

Definition at line 717 of file tcl.h.typedef Tcl_Interp int CONST char Tcl_Command int objc

Definition at line 688 of file tcl.h.typedef int Tcl_Obj Tcl_Obj* objPtr

Definition at line 1689 of file tcl.h.typedef struct Tcl_Obj* objPtr

Definition at line 724 of file tcl.h.typedef int Tcl_Obj Tcl_Obj** objPtrRef

Definition at line 1684 of file tcl.h.typedef Tcl_Interp int struct Tcl_Obj* CONST* objv

Definition at line 717 of file tcl.h.typedef Tcl_Interp int CONST char Tcl_Command int struct Tcl_Obj* CONST* objv

Definition at line 689 of file tcl.h.typedef Tcl_WideInt offset

Definition at line 1489 of file tcl.h.typedef long offset

Definition at line 1472 of file tcl.h.typedef Tcl_Interp CONST char* oldName

Definition at line 729 of file tcl.h.typedef Tcl_Interp CONST84 char* optionName

Definition at line 1477 of file tcl.h.typedef Tcl_Interp CONST char* optionName

Definition at line 1474 of file tcl.h.typedef Tcl_Obj* pathPtr

Definition at line 1694 of file tcl.h.typedef int Tcl_Obj* pathPtr

Definition at line 1689 of file tcl.h.typedef int Tcl_Obj* pathPtr

Definition at line 1684 of file tcl.h.typedef Tcl_Obj* pathPtr

Definition at line 1682 of file tcl.h.typedef Tcl_Obj Tcl_Obj* pathPtr

Definition at line 1659 of file tcl.h.typedef Tcl_Obj* pathPtr

Definition at line 1656 of file tcl.h.typedef Tcl_Obj Tcl_Obj CONST char* pattern

Definition at line 1659 of file tcl.h.typedef Tcl_Obj int int permissions

Definition at line 1656 of file tcl.h.typedef Tcl_Channel char int port

Definition at line 721 of file tcl.h.typedef int Tcl_FileProc* proc

Definition at line 731 of file tcl.h.typedef Tcl_Interp int char Tcl_CmdProc* proc

Definition at line 685 of file tcl.h.typedef int recursive

Definition at line 1672 of file tcl.h.typedef Tcl_Obj* result

Definition at line 1659 of file tcl.h.typedef Tcl_Interp Tcl_Value Tcl_Value* resultPtr

Definition at line 714 of file tcl.h.typedef CONST char* src

Definition at line 694 of file tcl.h.typedef CONST char int srcLen

Definition at line 694 of file tcl.h.typedef CONST char int int Tcl_EncodingState char int int* srcReadPtr

Definition at line 694 of file tcl.h.typedef CONST char int int Tcl_EncodingState* statePtr

Definition at line 694 of file tcl.h.typedef struct Tcl_AsyncHandler_* Tcl_AsyncHandler

Definition at line 495 of file tcl.h.typedef struct Tcl_Channel_* Tcl_Channel

Definition at line 496 of file tcl.h.typedef struct Tcl_ChannelTypeVersion_* Tcl_ChannelTypeVersion

Definition at line 510 of file tcl.h.typedef struct Tcl_Command_* Tcl_Command

Definition at line 497 of file tcl.h.typedef struct Tcl_Condition_* Tcl_Condition

Definition at line 498 of file tcl.h.typedef struct Tcl_Encoding_* Tcl_Encoding

Definition at line 500 of file tcl.h.typedef struct Tcl_EncodingState_* Tcl_EncodingState

Definition at line 499 of file tcl.h.typedef struct Tcl_Event Tcl_Event

Definition at line 501 of file tcl.h.typedef struct Tcl_FSVersion_* Tcl_FSVersion

Definition at line 1710 of file tcl.h.typedef struct Tcl_HashEntry Tcl_HashEntry

Definition at line 1115 of file tcl.h.typedef struct Tcl_HashKeyType Tcl_HashKeyType

Definition at line 1113 of file tcl.h.typedef struct Tcl_HashTable Tcl_HashTable

Definition at line 1114 of file tcl.h.typedef struct Tcl_LoadHandle_* Tcl_LoadHandle

Definition at line 511 of file tcl.h.typedef struct Tcl_Mutex_* Tcl_Mutex

Definition at line 502 of file tcl.h.typedef struct stat* Tcl_OldStat_

Definition at line 611 of file tcl.h.typedef struct Tcl_Pid_* Tcl_Pid

Definition at line 503 of file tcl.h.typedef struct Tcl_RegExp_* Tcl_RegExp

Definition at line 504 of file tcl.h.typedef Tcl_StatBuf* Tcl_Stat_

Definition at line 610 of file tcl.h.typedef struct stat Tcl_StatBuf

Definition at line 438 of file tcl.h.typedef struct Tcl_ThreadDataKey_* Tcl_ThreadDataKey

Definition at line 505 of file tcl.h.typedef struct Tcl_ThreadId_* Tcl_ThreadId

Definition at line 506 of file tcl.h.typedef struct Tcl_TimerToken_* Tcl_TimerToken

Definition at line 507 of file tcl.h.typedef struct Tcl_Trace_* Tcl_Trace

Definition at line 508 of file tcl.h.typedef unsigned short Tcl_UniChar

Definition at line 2249 of file tcl.h.typedef struct Tcl_Var_* Tcl_Var

Definition at line 509 of file tcl.h.typedef TCL_WIDE_INT_TYPE Tcl_WideInt

Definition at line 416 of file tcl.h.typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt

Definition at line 417 of file tcl.h.typedef char int toRead

Definition at line 1468 of file tcl.h.typedef CONST84 char int toWrite

Definition at line 1470 of file tcl.h.typedef struct utimbuf* tval

Definition at line 1680 of file tcl.h.typedef Tcl_Obj Tcl_Obj CONST char Tcl_GlobTypeData* types

Definition at line 1659 of file tcl.h.typedef Tcl_Obj Tcl_LoadHandle Tcl_FSUnloadFileProc** unloadProcPtr

Definition at line 1694 of file tcl.h.typedef Tcl_Interp CONST char CONST char* value

Definition at line 1474 of file tcl.h.
Enumeration Type Documentation
enum Tcl_PathType

Enumerator: 
TCL_PATH_ABSOLUTE  
TCL_PATH_RELATIVE  
TCL_PATH_VOLUME_RELATIVE  

Definition at line 1609 of file tcl.h.1609                           {
1610     TCL_PATH_ABSOLUTE,
1611     TCL_PATH_RELATIVE,
1612     TCL_PATH_VOLUME_RELATIVE
1613 } Tcl_PathType;
enum Tcl_QueuePosition

Enumerator: 
TCL_QUEUE_TAIL  
TCL_QUEUE_HEAD  
TCL_QUEUE_MARK  

Definition at line 1385 of file tcl.h.1385              {
1386     TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK
1387 } Tcl_QueuePosition;
enum Tcl_ValueType

Enumerator: 
TCL_INT  
TCL_DOUBLE  
TCL_EITHER  
TCL_WIDE_INT  

Definition at line 653 of file tcl.h.653              {
654     TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT
655 } Tcl_ValueType;

Function Documentation
EXTERN int Tcl_AppInit _ANSI_ARGS_ ((Tcl_Interp *interp))
EXTERN void Tcl_Main _ANSI_ARGS_ ((int argc, char **argv, Tcl_AppInitProc *appInitProc))
EXTERN CONST char* Tcl_InitStubs _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *version, int exact))
void Tcl_IncrRefCount _ANSI_ARGS_ ((Tcl_Obj *objPtr))
typedef ClientData (Tcl_FSCreateInternalRepProc)
typedef ClientData (Tcl_FSDupInternalRepProc)
typedef ClientData (Tcl_InitNotifierProc)
typedef int (Tcl_FSPathInFilesystemProc)
typedef int (Tcl_FSLoadFileProc)
typedef int (Tcl_FSFileAttrsSetProc)
typedef int (Tcl_FSFileAttrsGetProc)
typedef int (Tcl_FSNormalizePathProc)
typedef int (Tcl_FSUtimeProc)
typedef int (Tcl_FSRenameFileProc)
typedef int (Tcl_FSRemoveDirectoryProc)
typedef int (Tcl_FSCopyFileProc)
typedef int (Tcl_FSCopyDirectoryProc)
typedef int (Tcl_FSDeleteFileProc)
typedef int (Tcl_FSCreateDirectoryProc)
typedef int (Tcl_FSLstatProc)
typedef int (Tcl_FSChdirProc)
typedef int (Tcl_FSMatchInDirectoryProc)
typedef int (Tcl_FSAccessProc)
typedef int (Tcl_FSStatProc)
typedef int (Tcl_DriverHandlerProc)
typedef int (Tcl_DriverFlushProc)
typedef int (Tcl_DriverGetHandleProc)
typedef int (Tcl_DriverGetOptionProc)
typedef int (Tcl_DriverSetOptionProc)
typedef int (Tcl_DriverSeekProc)
typedef int (Tcl_DriverOutputProc)
typedef int (Tcl_DriverInputProc)
typedef int (Tcl_DriverClose2Proc)
typedef int (Tcl_DriverCloseProc)
typedef int (Tcl_DriverBlockModeProc)
typedef int (Tcl_WaitForEventProc)
typedef int (Tcl_CompareHashKeysProc)
typedef int (Tcl_SetFromAnyProc)
typedef int (Tcl_PackageInitProc)
typedef int (Tcl_ObjCmdProc)
typedef int (Tcl_MathProc)
typedef int (Tcl_EventDeleteProc)
typedef int (Tcl_EventProc)
typedef int (Tcl_EncodingConvertProc)
typedef int (Tcl_CmdObjTraceProc)
typedef int (Tcl_CmdProc)
typedef int (Tcl_AsyncProc)
typedef int (Tcl_AppInitProc)
typedef Tcl_Channel (Tcl_FSOpenFileChannelProc)
typedef Tcl_WideInt (Tcl_DriverWideSeekProc)
typedef void (Tcl_FSFreeInternalRepProc)
typedef void (Tcl_FSUnloadFileProc)
typedef void (Tcl_DriverThreadActionProc)
typedef void (Tcl_DriverWatchProc)
typedef void (Tcl_SetTimerProc)
typedef void (Tcl_FreeHashEntryProc)
typedef void (Tcl_MainLoopProc)
typedef void (Tcl_FinalizeNotifierProc)
typedef void (Tcl_ServiceModeHookProc)
typedef void (Tcl_AlertNotifierProc)
typedef void (Tcl_DeleteFileHandlerProc)
typedef void (Tcl_CreateFileHandlerProc)
typedef void (Tcl_CommandTraceProc)
typedef void (Tcl_UpdateStringProc)
typedef void (Tcl_TimerProc)
typedef void (Tcl_TcpAcceptProc)
typedef void (Tcl_PanicProc)
typedef void (Tcl_NamespaceDeleteProc)
typedef void (Tcl_InterpDeleteProc)
typedef void (Tcl_IdleProc)
typedef void (Tcl_FreeProc)
typedef void (Tcl_FreeInternalRepProc)
typedef void (Tcl_FileFreeProc)
typedef void (Tcl_FileProc)
typedef void (Tcl_ExitProc)
typedef void (Tcl_EventSetupProc)
typedef void (Tcl_EventCheckProc)
typedef void (Tcl_EncodingFreeProc)
typedef void (Tcl_DupInternalRepProc)
typedef void (Tcl_CmdObjTraceDeleteProc)
typedef void (Tcl_CmdTraceProc)
typedef void (Tcl_CmdDeleteProc)
typedef void (Tcl_CloseProc)
typedef void (Tcl_ChannelProc)
typedef void (Tcl_ThreadCreateProc)

Referenced by CopyEventProc(), CreateSocket(), CreateSocketAddress(), DeleteChannelTable(), FileRCVariables(), FindLibraries(), FSpPathFromLocation(), GetChannelTable(), InfoBodyCmd(), RegisterTcpServerInterpCleanup(), Tcl_DoOneEvent(), Tcl_Finalize(), Tcl_FindExecutable(), Tcl_FSMountsChanged(), Tcl_GetStdChannel(), Tcl_GetTime(), Tcl_PanicVA(), Tcl_RecordAndEvalObj(), Tcl_ServiceAll(), Tcl_ServiceEvent(), Tcl_SetErrorCodeVA(), Tcl_Sleep(), Tcl_StringObjCmd(), TclCompileVariableCmd(), TclEvalObjvInternal(), TclExecuteByteCode(), TclFinalizeIOSubsystem(), TclFSNormalizeToUniquePath(), TclGetNamespaceForQualName(), TclInitIOSubsystem(), TclInitSubsystems(), TclpDlopen(), TclpInitPlatform(), TclWinSetInterfaces(), TcpAccept(), TestalarmCmd(), TesteventloopCmd(), TestNumUtfCharsCmd(), tmpnam(), UnlinkSymbolTable(), WaitForConnect(), and WaitForSocketEvent().
Variable Documentation
typedef format

Definition at line 719 of file tcl.h.
Referenced by Tcl_BinaryObjCmd(), Tcl_FormatObjCmd(), Tcl_ScanObjCmd(), and TCL_VARARGS_DEF().

generic/tclAlloc.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Functions
char * TclpAlloc (unsigned int nbytes)
void TclpFree (char *cp)
char * TclpRealloc (char *cp, unsigned int nbytes)

Function Documentation
char* TclpAlloc (unsigned int nbytes)

Definition at line 676 of file tclAlloc.c.
Referenced by Tcl_Alloc(), Tcl_AttemptAlloc(), Tcl_AttemptDbCkalloc(), and Tcl_DbCkalloc().678 {
679     return (char*) malloc(nbytes);
680 }
void TclpFree (char * cp)

Definition at line 699 of file tclAlloc.c.
Referenced by Tcl_DbCkfree(), Tcl_Free(), and TclFinalizeMemorySubsystem().701 {   
702     free(cp);
703     return;
704 }
char* TclpRealloc (char * cp, unsigned int nbytes)

Definition at line 723 of file tclAlloc.c.
Referenced by Tcl_AttemptDbCkrealloc(), Tcl_AttemptRealloc(), Tcl_DbCkrealloc(), and Tcl_Realloc().726 {   
727     return (char*) realloc(cp, nbytes);
728 }

generic/tclAsync.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Classes
struct AsyncHandler
struct ThreadSpecificData
Functions
void TclFinalizeAsync ()
Tcl_AsyncHandler Tcl_AsyncCreate (Tcl_AsyncProc *proc, ClientData clientData)
void Tcl_AsyncMark (Tcl_AsyncHandler async)
int Tcl_AsyncInvoke (Tcl_Interp *interp, int code)
void Tcl_AsyncDelete (Tcl_AsyncHandler async)
int Tcl_AsyncReady ()
Variables
static Tcl_ThreadDataKey dataKey

Function Documentation
Tcl_AsyncHandler Tcl_AsyncCreate (Tcl_AsyncProc * proc, ClientData clientData)

Definition at line 128 of file tclAsync.c.
References ThreadSpecificData::asyncMutex, ckalloc, AsyncHandler::clientData, dataKey, ThreadSpecificData::firstHandler, ThreadSpecificData::lastHandler, AsyncHandler::nextPtr, NULL, AsyncHandler::originThrdId, AsyncHandler::originTsd, AsyncHandler::proc, AsyncHandler::ready, Tcl_GetCurrentThread(), Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by Tcl_AppInit(), and TestasyncCmd().132 {
133     AsyncHandler *asyncPtr;
134     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
135 
136     asyncPtr = (AsyncHandler *) ckalloc(sizeof(AsyncHandler));
137     asyncPtr->ready = 0;
138     asyncPtr->nextPtr = NULL;
139     asyncPtr->proc = proc;
140     asyncPtr->clientData = clientData;
141     asyncPtr->originTsd = tsdPtr;
142     asyncPtr->originThrdId = Tcl_GetCurrentThread();
143 
144     Tcl_MutexLock(&tsdPtr->asyncMutex);
145     if (tsdPtr->firstHandler == NULL) {
146   tsdPtr->firstHandler = asyncPtr;
147     } else {
148   tsdPtr->lastHandler->nextPtr = asyncPtr;
149     }
150     tsdPtr->lastHandler = asyncPtr;
151     Tcl_MutexUnlock(&tsdPtr->asyncMutex);
152     return (Tcl_AsyncHandler) asyncPtr;
153 }
void Tcl_AsyncDelete (Tcl_AsyncHandler async)

Definition at line 282 of file tclAsync.c.
References ThreadSpecificData::asyncMutex, ckfree, dataKey, ThreadSpecificData::firstHandler, ThreadSpecificData::lastHandler, AsyncHandler::nextPtr, NULL, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by AppInitExitHandler(), and TestasyncCmd().284 {
285     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
286     AsyncHandler *asyncPtr = (AsyncHandler *) async;
287     AsyncHandler *prevPtr;
288 
289     /*
290      * Conservatively check the existence of the linked list of
291      * registered handlers, as we may come at this point even
292      * when the TSD's for the current thread have been already
293      * garbage-collected.
294      */
295 
296     Tcl_MutexLock(&tsdPtr->asyncMutex);
297     if (tsdPtr->firstHandler != NULL ) {
298   if (tsdPtr->firstHandler == asyncPtr) {
299       tsdPtr->firstHandler = asyncPtr->nextPtr;
300       if (tsdPtr->firstHandler == NULL) {
301     tsdPtr->lastHandler = NULL;
302       }
303   } else {
304       prevPtr = tsdPtr->firstHandler;
305       while (prevPtr->nextPtr != asyncPtr) {
306     prevPtr = prevPtr->nextPtr;
307       }
308       prevPtr->nextPtr = asyncPtr->nextPtr;
309       if (tsdPtr->lastHandler == asyncPtr) {
310     tsdPtr->lastHandler = prevPtr;
311       }
312   }
313     }
314     Tcl_MutexUnlock(&tsdPtr->asyncMutex);
315     ckfree((char *) asyncPtr);
316 }
int Tcl_AsyncInvoke (Tcl_Interp * interp, int code)

Definition at line 209 of file tclAsync.c.
References ThreadSpecificData::asyncActive, ThreadSpecificData::asyncMutex, ThreadSpecificData::asyncReady, AsyncHandler::clientData, dataKey, ThreadSpecificData::firstHandler, AsyncHandler::nextPtr, NULL, AsyncHandler::proc, AsyncHandler::ready, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by Tcl_DoOneEvent(), Tcl_ServiceAll(), Tcl_ServiceEvent(), TclCompEvalObj(), and TclEvalObjvInternal().217 {
218     AsyncHandler *asyncPtr;
219     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
220 
221     Tcl_MutexLock(&tsdPtr->asyncMutex);
222 
223     if (tsdPtr->asyncReady == 0) {
224   Tcl_MutexUnlock(&tsdPtr->asyncMutex);
225   return code;
226     }
227     tsdPtr->asyncReady = 0;
228     tsdPtr->asyncActive = 1;
229     if (interp == NULL) {
230   code = 0;
231     }
232 
233     /*
234      * Make one or more passes over the list of handlers, invoking
235      * at most one handler in each pass.  After invoking a handler,
236      * go back to the start of the list again so that (a) if a new
237      * higher-priority handler gets marked while executing a lower
238      * priority handler, we execute the higher-priority handler
239      * next, and (b) if a handler gets deleted during the execution
240      * of a handler, then the list structure may change so it isn't
241      * safe to continue down the list anyway.
242      */
243 
244     while (1) {
245   for (asyncPtr = tsdPtr->firstHandler; asyncPtr != NULL;
246     asyncPtr = asyncPtr->nextPtr) {
247       if (asyncPtr->ready) {
248     break;
249       }
250   }
251   if (asyncPtr == NULL) {
252       break;
253   }
254   asyncPtr->ready = 0;
255   Tcl_MutexUnlock(&tsdPtr->asyncMutex);
256   code = (*asyncPtr->proc)(asyncPtr->clientData, interp, code);
257   Tcl_MutexLock(&tsdPtr->asyncMutex);
258     }
259     tsdPtr->asyncActive = 0;
260     Tcl_MutexUnlock(&tsdPtr->asyncMutex);
261     return code;
262 }
void Tcl_AsyncMark (Tcl_AsyncHandler async)

Definition at line 175 of file tclAsync.c.
References ThreadSpecificData::asyncActive, ThreadSpecificData::asyncMutex, ThreadSpecificData::asyncReady, AsyncHandler::originThrdId, AsyncHandler::originTsd, AsyncHandler::ready, Tcl_MutexLock, Tcl_MutexUnlock, and Tcl_ThreadAlert().
Referenced by sigHandler().177 {
178     AsyncHandler *token = (AsyncHandler *) async;
179 
180     Tcl_MutexLock(&token->originTsd->asyncMutex);
181     token->ready = 1;
182     if (!token->originTsd->asyncActive) {
183   token->originTsd->asyncReady = 1;
184   Tcl_ThreadAlert(token->originThrdId);
185     }
186     Tcl_MutexUnlock(&token->originTsd->asyncMutex);
187 }
int Tcl_AsyncReady ()

Definition at line 338 of file tclAsync.c.
References ThreadSpecificData::asyncReady, dataKey, and TCL_TSD_INIT.
Referenced by Tcl_DoOneEvent(), Tcl_ServiceAll(), Tcl_ServiceEvent(), TclCompEvalObj(), and TclEvalObjvInternal().339 {
340     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
341     return tsdPtr->asyncReady;
342 }
void TclFinalizeAsync ()

Definition at line 99 of file tclAsync.c.
References ThreadSpecificData::asyncMutex, dataKey, NULL, Tcl_MutexFinalize, and TCL_TSD_INIT.
Referenced by Tcl_FinalizeThread().100 {
101     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
102 
103     if (tsdPtr->asyncMutex != NULL) {
104   Tcl_MutexFinalize(&tsdPtr->asyncMutex);
105     }
106 }

Variable Documentation
Tcl_ThreadDataKey dataKey [static]

Definition at line 78 of file tclAsync.c.
Referenced by CheckForStdChannelsBeingClosed(), CloseChannel(), CompileRegexp(), ComputeGMT(), DdeServerProc(), DdeSetServerName(), DeleteProc(), FileCheckProc(), FileCloseProc(), FileEventProc(), FileHandlerEventProc(), FileInit(), FileNameCleanup(), FileNameInit(), FileSetupProc(), FileThreadActionProc(), FinalizeRegexp(), Initialize(), InitTimer(), NotifierProc(), SplitMacPath(), StdIOClose(), Tcl_AsyncCreate(), Tcl_AsyncDelete(), Tcl_AsyncInvoke(), Tcl_AsyncReady(), Tcl_ClearChannelHandlers(), Tcl_CreateChannel(), Tcl_CreateEventSource(), Tcl_CreateFileHandler(), Tcl_CreateThreadExitHandler(), Tcl_CutChannel(), Tcl_DdeObjCmd(), TCL_DECLARE_MUTEX(), Tcl_DeleteChannelHandler(), Tcl_DeleteEvents(), Tcl_DeleteEventSource(), Tcl_DeleteFileHandler(), Tcl_DeleteThreadExitHandler(), Tcl_DoOneEvent(), Tcl_Finalize(), Tcl_FinalizeNotifier(), Tcl_FinalizeThread(), Tcl_GetChannelNamesEx(), Tcl_GetServiceMode(), Tcl_GetStdChannel(), Tcl_InitNotifier(), Tcl_IsChannelExisting(), Tcl_IsStandardChannel(), Tcl_MakeFileChannel(), Tcl_NotifyChannel(), Tcl_QueueEvent(), Tcl_ServiceAll(), Tcl_ServiceEvent(), Tcl_ServiceModeHook(), Tcl_SetMaxBlockTime(), Tcl_SetServiceMode(), Tcl_SetStdChannel(), Tcl_SetTimer(), Tcl_SpliceChannel(), Tcl_StackChannel(), Tcl_WaitForEvent(), TclFinalizeAsync(), TclFinalizeIOSubsystem(), TclFinalizeNotifier(), TclGetLibraryPath(), TclInitIOSubsystem(), TclInitSubsystems(), TclInThreadExit(), TclpGetGrGid(), TclpGetGrNam(), TclpGetHostByAddr(), TclpGetHostByName(), TclpGetNativePathType(), TclpGetPwNam(), TclpGetPwUid(), TclpGetTZName(), TclpInetNtoa(), TclpOpenFileChannel(), TclSetLibraryPath(), and TimerExitProc().

generic/tclBasic.c File Reference
#include "tclInt.h"
#include "tclCompile.h"
#include "tclPort.h"
Classes
struct CmdInfo
struct StringTraceData
Defines
#define NUM_ARGS  20
#define NUM_ARGS  20
#define MAX_VAR_CHARS  30
#define NUM_STATIC_OBJS  20
#define TEOE_PREALLOC  10
#define NUM_ARGS  20
Functions
static char *CallCommandTraces _ANSI_ARGS_ ((Interp *iPtr, Command *cmdPtr, CONST char *oldName, CONST char *newName, int flags))
static void DeleteInterpProc _ANSI_ARGS_ ((Tcl_Interp *interp))
static void ProcessUnexpectedResult _ANSI_ARGS_ ((Tcl_Interp *interp, int returnCode))
static int StringTraceProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int level, CONST char *command, Tcl_Command commandInfo, int objc, Tcl_Obj *CONST objv[]))
static void StringTraceDeleteProc _ANSI_ARGS_ ((ClientData clientData))
Tcl_Interp * Tcl_CreateInterp ()
int TclHideUnsafeCommands (Tcl_Interp *interp)
void Tcl_CallWhenDeleted (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData)
void Tcl_DontCallWhenDeleted (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData)
void Tcl_SetAssocData (Tcl_Interp *interp, CONST char *name, Tcl_InterpDeleteProc *proc, ClientData clientData)
void Tcl_DeleteAssocData (Tcl_Interp *interp, CONST char *name)
ClientData Tcl_GetAssocData (Tcl_Interp *interp, CONST char *name, Tcl_InterpDeleteProc **procPtr)
int Tcl_InterpDeleted (Tcl_Interp *interp)
void Tcl_DeleteInterp (Tcl_Interp *interp)
static void DeleteInterpProc (Tcl_Interp *interp)
int Tcl_HideCommand (Tcl_Interp *interp, CONST char *cmdName, CONST char *hiddenCmdToken)
int Tcl_ExposeCommand (Tcl_Interp *interp, CONST char *hiddenCmdToken, CONST char *cmdName)
Tcl_Command Tcl_CreateCommand (Tcl_Interp *interp, CONST char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc)
Tcl_Command Tcl_CreateObjCommand (Tcl_Interp *interp, CONST char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc)
int TclInvokeStringCommand (ClientData clientData, Tcl_Interp *interp, int objc, objv)
int TclInvokeObjectCommand (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
int TclRenameCommand (Tcl_Interp *interp, char *oldName, char *newName)
int Tcl_SetCommandInfo (Tcl_Interp *interp, CONST char *cmdName, CONST Tcl_CmdInfo *infoPtr)
int Tcl_SetCommandInfoFromToken (Tcl_Command cmd, CONST Tcl_CmdInfo *infoPtr)
int Tcl_GetCommandInfo (Tcl_Interp *interp, CONST char *cmdName, Tcl_CmdInfo *infoPtr)
int Tcl_GetCommandInfoFromToken (Tcl_Command cmd, Tcl_CmdInfo *infoPtr)
CONST char * Tcl_GetCommandName (Tcl_Interp *interp, Tcl_Command command)
void Tcl_GetCommandFullName (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr)
int Tcl_DeleteCommand (Tcl_Interp *interp, CONST char *cmdName)
int Tcl_DeleteCommandFromToken (Tcl_Interp *interp, Tcl_Command cmd)
static char * CallCommandTraces (Interp *iPtr, Command *cmdPtr, CONST char *oldName, CONST char *newName, int flags)
void TclCleanupCommand (Command *cmdPtr)
void Tcl_CreateMathFunc (Tcl_Interp *interp, CONST char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData)
int Tcl_GetMathFuncInfo (Tcl_Interp *interp, CONST char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr)
Tcl_Obj * Tcl_ListMathFuncs (Tcl_Interp *interp, CONST char *pattern)
int TclInterpReady (Tcl_Interp *interp)
int TclEvalObjvInternal (Tcl_Interp *interp, int objc, objv, CONST char *command, int length, int flags)
int Tcl_EvalObjv (Tcl_Interp *interp, int objc, objv, int flags)
void Tcl_LogCommandInfo (Tcl_Interp *interp, CONST char *script, CONST char *command, int length)
int Tcl_EvalTokensStandard (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count)
Tcl_Obj * Tcl_EvalTokens (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count)
int Tcl_EvalEx (Tcl_Interp *interp, CONST char *script, int numBytes, int flags)
int Tcl_Eval (Tcl_Interp *interp, CONST char *string)
int Tcl_EvalObj (Tcl_Interp *interp, Tcl_Obj *objPtr)
int Tcl_GlobalEvalObj (Tcl_Interp *interp, Tcl_Obj *objPtr)
int Tcl_EvalObjEx (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
static void ProcessUnexpectedResult (Tcl_Interp *interp, int returnCode)
int Tcl_ExprLong (Tcl_Interp *interp, CONST char *string, long *ptr)
int Tcl_ExprDouble (Tcl_Interp *interp, CONST char *string, double *ptr)
int Tcl_ExprBoolean (Tcl_Interp *interp, CONST char *string, int *ptr)
int Tcl_ExprLongObj (Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr)
int Tcl_ExprDoubleObj (Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr)
int Tcl_ExprBooleanObj (Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr)
int TclInvoke (Tcl_Interp *interp, int argc, CONST char **argv, int flags)
int TclGlobalInvoke (Tcl_Interp *interp, int argc, CONST char **argv, int flags)
int TclObjInvokeGlobal (Tcl_Interp *interp, int objc, objv, int flags)
int TclObjInvoke (Tcl_Interp *interp, int objc, objv, int flags)
int Tcl_ExprString (Tcl_Interp *interp, CONST char *string)
Tcl_Trace Tcl_CreateObjTrace (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *proc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc)
Tcl_Trace Tcl_CreateTrace (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData)
static int StringTraceProc (ClientData clientData, Tcl_Interp *interp, int level, CONST char *command, Tcl_Command commandInfo, int objc, Tcl_Obj *CONST *objv)
static void StringTraceDeleteProc (ClientData clientData)
void Tcl_DeleteTrace (Tcl_Interp *interp, Tcl_Trace trace)
void Tcl_AddErrorInfo (Tcl_Interp *interp, CONST char *message)
void Tcl_AddObjErrorInfo (Tcl_Interp *interp, CONST char *message, int length)
int Tcl_VarEvalVA (Tcl_Interp *interp, va_list argList)
int Tcl_VarEval TCL_VARARGS_DEF (Tcl_Interp *, arg1)
int Tcl_GlobalEval (Tcl_Interp *interp, CONST char *command)
int Tcl_SetRecursionLimit (Tcl_Interp *interp, int depth)
void Tcl_AllowExceptions (Tcl_Interp *interp)
void Tcl_GetVersion (int *majorV, int *minorV, int *patchLevelV, int *type)
Variables
TclStubs tclStubs
static CmdInfo builtInCmds []

Define Documentation
#define MAX_VAR_CHARS  30

Referenced by Tcl_EvalTokensStandard().#define NUM_ARGS  20
#define NUM_ARGS  20
#define NUM_ARGS  20

Referenced by Tcl_ExecObjCmd(), Tcl_ForeachObjCmd(), TclInvoke(), TclInvokeObjectCommand(), TclInvokeStringCommand(), and TclProcInterpProc().#define NUM_STATIC_OBJS  20

Referenced by Tcl_EvalEx().#define TEOE_PREALLOC  10

Referenced by Tcl_EvalObjEx().
Function Documentation
static void StringTraceDeleteProc _ANSI_ARGS_ ((ClientData clientData)) [static]
static int StringTraceProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int level, CONST char *command, Tcl_Command commandInfo, int objc, Tcl_Obj *CONST objv[])) [static]
static void ProcessUnexpectedResult _ANSI_ARGS_ ((Tcl_Interp *interp, int returnCode)) [static]
static void DeleteInterpProc _ANSI_ARGS_ ((Tcl_Interp *interp)) [static]
static char* CallCommandTraces _ANSI_ARGS_ ((Interp *iPtr, Command *cmdPtr, CONST char *oldName, CONST char *newName, int flags)) [static]
static char* CallCommandTraces (Interp * iPtr, Command * cmdPtr, CONST char * oldName, CONST char * newName, int flags) [static]

Definition at line 2556 of file tclBasic.c.
References ckfree, CommandTrace::clientData, CMD_TRACE_ACTIVE, ActiveCommandTrace::cmdPtr, CommandTrace::flags, Command::flags, CommandTrace::nextPtr, ActiveCommandTrace::nextPtr, ActiveCommandTrace::nextTracePtr, CommandTrace::refCount, Command::refCount, ActiveCommandTrace::reverseScan, Tcl_GetCommandFullName(), Tcl_IncrRefCount, Tcl_Preserve(), Tcl_Release(), TCL_TRACE_DELETE, TCL_TRACE_DESTROYED, TCL_TRACE_RENAME, TclDecrRefCount, TclGetString, TclNewObj, CommandTrace::traceProc, and Command::tracePtr.
Referenced by Tcl_DeleteCommandFromToken(), and TclRenameCommand().2567 {
2568     register CommandTrace *tracePtr;
2569     ActiveCommandTrace active;
2570     char *result;
2571     Tcl_Obj *oldNamePtr = NULL;
2572     int mask = (TCL_TRACE_DELETE | TCL_TRACE_RENAME); /* Safety */
2573 
2574     flags &= mask;
2575 
2576     if (cmdPtr->flags & CMD_TRACE_ACTIVE) {
2577   /* 
2578    * While a rename trace is active, we will not process any more
2579    * rename traces; while a delete trace is active we will never
2580    * reach here -- because Tcl_DeleteCommandFromToken checks for the
2581    * condition (cmdPtr->flags & CMD_IS_DELETED) and returns immediately
2582    * when a command deletion is in progress.  For all other traces,
2583    * delete traces will not be invoked but a call to TraceCommandProc
2584    * will ensure that tracePtr->clientData is freed whenever the
2585    * command "oldName" is deleted.
2586    */
2587   if (cmdPtr->flags & TCL_TRACE_RENAME) {
2588       flags &= ~TCL_TRACE_RENAME;
2589   }
2590   if (flags == 0) {
2591       return NULL;
2592   }
2593     }
2594     cmdPtr->flags |= CMD_TRACE_ACTIVE;
2595     cmdPtr->refCount++;
2596     
2597     result = NULL;
2598     active.nextPtr = iPtr->activeCmdTracePtr;
2599     active.reverseScan = 0;
2600     iPtr->activeCmdTracePtr = &active;
2601 
2602     if (flags & TCL_TRACE_DELETE) {
2603   flags |= TCL_TRACE_DESTROYED;
2604     }
2605     active.cmdPtr = cmdPtr;
2606     
2607     Tcl_Preserve((ClientData) iPtr);
2608     
2609     for (tracePtr = cmdPtr->tracePtr; tracePtr != NULL;
2610    tracePtr = active.nextTracePtr) {
2611   int traceFlags = (tracePtr->flags & mask);
2612 
2613   active.nextTracePtr = tracePtr->nextPtr;
2614   if (!(traceFlags & flags)) {
2615       continue;
2616   }
2617   cmdPtr->flags |= traceFlags;
2618   if (oldName == NULL) {
2619       TclNewObj(oldNamePtr);
2620       Tcl_IncrRefCount(oldNamePtr);
2621       Tcl_GetCommandFullName((Tcl_Interp *) iPtr, 
2622               (Tcl_Command) cmdPtr, oldNamePtr);
2623       oldName = TclGetString(oldNamePtr);
2624   }
2625   tracePtr->refCount++;
2626   (*tracePtr->traceProc)(tracePtr->clientData,
2627     (Tcl_Interp *) iPtr, oldName, newName, flags);
2628   cmdPtr->flags &= ~traceFlags;
2629   if ((--tracePtr->refCount) <= 0) {
2630       ckfree((char*)tracePtr);
2631   }
2632     }
2633 
2634     /*
2635      * If a new object was created to hold the full oldName,
2636      * free it now.
2637      */
2638 
2639     if (oldNamePtr != NULL) {
2640   TclDecrRefCount(oldNamePtr);
2641     }
2642 
2643     /*
2644      * Restore the variable's flags, remove the record of our active
2645      * traces, and then return.
2646      */
2647 
2648     cmdPtr->flags &= ~CMD_TRACE_ACTIVE;
2649     cmdPtr->refCount--;
2650     iPtr->activeCmdTracePtr = active.nextPtr;
2651     Tcl_Release((ClientData) iPtr);
2652     return result;
2653 }
static void DeleteInterpProc (Tcl_Interp * interp) [static]

Definition at line 964 of file tclBasic.c.
References Interp::appendResult, Interp::assocData, ckfree, AssocData::clientData, DELETED, Interp::emptyObjPtr, Interp::errorCode, Interp::errorInfo, Interp::execEnvPtr, Interp::flags, Interp::globalNsPtr, Interp::handle, Interp::hiddenCmdTablePtr, Interp::literalTable, Interp::mathFuncTable, ResolverScheme::name, ResolverScheme::nextPtr, NULL, Interp::numLevels, Interp::objResultPtr, panic, AssocData::proc, Interp::resolverPtr, Tcl_DecrRefCount, Tcl_DeleteCommandFromToken(), Tcl_DeleteHashEntry(), Tcl_DeleteHashTable(), Tcl_DeleteNamespace(), Tcl_DeleteTrace(), Tcl_FirstHashEntry(), Tcl_FreeResult(), Tcl_GetHashValue, Tcl_NextHashEntry(), TclDeleteExecEnv(), TclDeleteLiteralTable(), TclFreePackageInfo(), TclHandleFree(), TclTeardownNamespace(), and Interp::tracePtr.
Referenced by Tcl_DeleteInterp().966 {
967     Interp *iPtr = (Interp *) interp;
968     Tcl_HashEntry *hPtr;
969     Tcl_HashSearch search;
970     Tcl_HashTable *hTablePtr;
971     ResolverScheme *resPtr, *nextResPtr;
972 
973     /*
974      * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup.
975      */
976     
977     if (iPtr->numLevels > 0) {
978         panic("DeleteInterpProc called with active evals");
979     }
980 
981     /*
982      * The interpreter should already be marked deleted; otherwise how
983      * did we get here?
984      */
985 
986     if (!(iPtr->flags & DELETED)) {
987         panic("DeleteInterpProc called on interpreter not marked deleted");
988     }
989 
990     TclHandleFree(iPtr->handle);
991 
992     /*
993      * Dismantle everything in the global namespace except for the
994      * "errorInfo" and "errorCode" variables. These remain until the
995      * namespace is actually destroyed, in case any errors occur.
996      *   
997      * Dismantle the namespace here, before we clear the assocData. If any
998      * background errors occur here, they will be deleted below.
999      */
1000     
1001     TclTeardownNamespace(iPtr->globalNsPtr);
1002 
1003     /*
1004      * Delete all the hidden commands.
1005      */
1006      
1007     hTablePtr = iPtr->hiddenCmdTablePtr;
1008     if (hTablePtr != NULL) {
1009   /*
1010    * Non-pernicious deletion.  The deletion callbacks will not be
1011    * allowed to create any new hidden or non-hidden commands.
1012    * Tcl_DeleteCommandFromToken() will remove the entry from the
1013    * hiddenCmdTablePtr.
1014    */
1015    
1016   hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
1017   for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
1018       Tcl_DeleteCommandFromToken(interp,
1019         (Tcl_Command) Tcl_GetHashValue(hPtr));
1020   }
1021   Tcl_DeleteHashTable(hTablePtr);
1022   ckfree((char *) hTablePtr);
1023     }
1024     /*
1025      * Tear down the math function table.
1026      */
1027 
1028     for (hPtr = Tcl_FirstHashEntry(&iPtr->mathFuncTable, &search);
1029        hPtr != NULL;
1030              hPtr = Tcl_NextHashEntry(&search)) {
1031   ckfree((char *) Tcl_GetHashValue(hPtr));
1032     }
1033     Tcl_DeleteHashTable(&iPtr->mathFuncTable);
1034 
1035     /*
1036      * Invoke deletion callbacks; note that a callback can create new
1037      * callbacks, so we iterate.
1038      */
1039 
1040     while (iPtr->assocData != (Tcl_HashTable *) NULL) {
1041   AssocData *dPtr;
1042   
1043         hTablePtr = iPtr->assocData;
1044         iPtr->assocData = (Tcl_HashTable *) NULL;
1045         for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
1046                  hPtr != NULL;
1047                  hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) {
1048             dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
1049             Tcl_DeleteHashEntry(hPtr);
1050             if (dPtr->proc != NULL) {
1051                 (*dPtr->proc)(dPtr->clientData, interp);
1052             }
1053             ckfree((char *) dPtr);
1054         }
1055         Tcl_DeleteHashTable(hTablePtr);
1056         ckfree((char *) hTablePtr);
1057     }
1058 
1059     /*
1060      * Finish deleting the global namespace.
1061      */
1062     
1063     Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr);
1064 
1065     /*
1066      * Free up the result *after* deleting variables, since variable
1067      * deletion could have transferred ownership of the result string
1068      * to Tcl.
1069      */
1070 
1071     Tcl_FreeResult(interp);
1072     interp->result = NULL;
1073     Tcl_DecrRefCount(iPtr->objResultPtr);
1074     iPtr->objResultPtr = NULL;
1075     if (iPtr->errorInfo != NULL) {
1076   ckfree(iPtr->errorInfo);
1077         iPtr->errorInfo = NULL;
1078     }
1079     if (iPtr->errorCode != NULL) {
1080   ckfree(iPtr->errorCode);
1081         iPtr->errorCode = NULL;
1082     }
1083     if (iPtr->appendResult != NULL) {
1084   ckfree(iPtr->appendResult);
1085         iPtr->appendResult = NULL;
1086     }
1087     TclFreePackageInfo(iPtr);
1088     while (iPtr->tracePtr != NULL) {
1089   Tcl_DeleteTrace((Tcl_Interp*) iPtr, (Tcl_Trace) iPtr->tracePtr);
1090     }
1091     if (iPtr->execEnvPtr != NULL) {
1092   TclDeleteExecEnv(iPtr->execEnvPtr);
1093     }
1094     Tcl_DecrRefCount(iPtr->emptyObjPtr);
1095     iPtr->emptyObjPtr = NULL;
1096 
1097     resPtr = iPtr->resolverPtr;
1098     while (resPtr) {
1099   nextResPtr = resPtr->nextPtr;
1100   ckfree(resPtr->name);
1101   ckfree((char *) resPtr);
1102         resPtr = nextResPtr;
1103     }
1104     
1105     /*
1106      * Free up literal objects created for scripts compiled by the
1107      * interpreter.
1108      */
1109 
1110     TclDeleteLiteralTable(interp, &(iPtr->literalTable));
1111     ckfree((char *) iPtr);
1112 }
static void ProcessUnexpectedResult (Tcl_Interp * interp, int returnCode) [static]

Definition at line 4124 of file tclBasic.c.
References Tcl_AppendToObj(), TCL_BREAK, TCL_CONTINUE, Tcl_GetObjResult(), TCL_INTEGER_SPACE, Tcl_ResetResult(), Tcl_SetResult(), and TCL_VOLATILE.
Referenced by Tcl_EvalEx(), Tcl_EvalObjEx(), and Tcl_EvalObjv().4128 {
4129     Tcl_ResetResult(interp);
4130     if (returnCode == TCL_BREAK) {
4131   Tcl_AppendToObj(Tcl_GetObjResult(interp),
4132           "invoked \"break\" outside of a loop", -1);
4133     } else if (returnCode == TCL_CONTINUE) {
4134   Tcl_AppendToObj(Tcl_GetObjResult(interp),
4135     "invoked \"continue\" outside of a loop", -1);
4136     } else {
4137         char buf[30 + TCL_INTEGER_SPACE];
4138 
4139   sprintf(buf, "command returned bad code: %d", returnCode);
4140   Tcl_SetResult(interp, buf, TCL_VOLATILE);
4141     }
4142 }
static void StringTraceDeleteProc (ClientData clientData) [static]

Definition at line 5145 of file tclBasic.c.
References ckfree.
Referenced by Tcl_CreateTrace().5147 {
5148     ckfree( (char*) clientData );
5149 }
static int StringTraceProc (ClientData clientData, Tcl_Interp* interp, int level, CONST char* command, Tcl_Command commandInfo, int objc, Tcl_Obj *CONST * objv) [static]

Definition at line 5086 of file tclBasic.c.
References ckalloc, ckfree, Command::clientData, StringTraceData::clientData, CONST, Command::proc, StringTraceData::proc, Tcl_GetString(), and TCL_OK.
Referenced by Tcl_CreateTrace().5094 {
5095     StringTraceData* data = (StringTraceData*) clientData;
5096     Command* cmdPtr = (Command*) commandInfo;
5097 
5098     CONST char** argv;    /* Args to pass to string trace proc */
5099 
5100     int i;
5101 
5102     /*
5103      * This is a bit messy because we have to emulate the old trace
5104      * interface, which uses strings for everything.
5105      */
5106       
5107     argv = (CONST char **) ckalloc((unsigned) ( (objc + 1)
5108             * sizeof(CONST char *) ));
5109     for (i = 0; i < objc; i++) {
5110   argv[i] = Tcl_GetString(objv[i]);
5111     }
5112     argv[objc] = 0;
5113 
5114     /*
5115      * Invoke the command procedure.  Note that we cast away const-ness
5116      * on two parameters for compatibility with legacy code; the code
5117      * MUST NOT modify either command or argv.
5118      */
5119           
5120     ( data->proc )( data->clientData, interp, level,
5121         (char*) command, cmdPtr->proc, cmdPtr->clientData,
5122         objc, argv );
5123     ckfree( (char*) argv );
5124 
5125     return TCL_OK;
5126 }
void Tcl_AddErrorInfo (Tcl_Interp * interp, CONST char * message)

Definition at line 5261 of file tclBasic.c.
References Tcl_AddObjErrorInfo().
Referenced by AfterProc(), ExprSrandFunc(), Prompt(), SortCompare(), Tcl_BackgroundError(), Tcl_ForObjCmd(), Tcl_FSEvalFile(), Tcl_IncrObjCmd(), Tcl_MacEvalResource(), Tcl_Main(), Tcl_WhileObjCmd(), TclExecuteByteCode(), TclGetOpenMode(), TclTransferResult(), TesteventProc(), TestexprparserObjCmd(), TestparserObjCmd(), and TestparsevarnameObjCmd().5265 {
5266     Tcl_AddObjErrorInfo(interp, message, -1);
5267 }
void Tcl_AddObjErrorInfo (Tcl_Interp * interp, CONST char * message, int length)

Definition at line 5293 of file tclBasic.c.
References ERR_IN_PROGRESS, ERROR_CODE_SET, ExecEnv::errorCode, ExecEnv::errorInfo, Interp::execEnvPtr, Interp::flags, Interp::objResultPtr, Interp::result, TCL_APPEND_VALUE, Tcl_DecrRefCount, TCL_GLOBAL_ONLY, Tcl_IncrRefCount, Tcl_NewStringObj(), and Tcl_ObjSetVar2().
Referenced by LogCompilationInfo(), NamespaceEvalCmd(), NamespaceInscopeCmd(), ProcessProcResultCode(), Tcl_AddErrorInfo(), Tcl_CaseObjCmd(), Tcl_DdeObjCmd(), Tcl_ErrorObjCmd(), Tcl_EvalObjCmd(), Tcl_ForeachObjCmd(), Tcl_SwitchObjCmd(), Tcl_UplevelObjCmd(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileWhileCmd(), TclExecuteByteCode(), TclIncrVar2(), TclObjInvoke(), and TclPtrIncrVar().5301 {
5302     register Interp *iPtr = (Interp *) interp;
5303     Tcl_Obj *objPtr;
5304     
5305     /*
5306      * If we are just starting to log an error, errorInfo is initialized
5307      * from the error message in the interpreter's result.
5308      */
5309 
5310     if (!(iPtr->flags & ERR_IN_PROGRESS)) { /* just starting to log error */
5311   iPtr->flags |= ERR_IN_PROGRESS;
5312 
5313   if (iPtr->result[0] == 0) {
5314       Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorInfo, NULL, 
5315               iPtr->objResultPtr, TCL_GLOBAL_ONLY);
5316   } else {    /* use the string result */
5317       objPtr = Tcl_NewStringObj(interp->result, -1);
5318       Tcl_IncrRefCount(objPtr);
5319       Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorInfo, NULL, 
5320               objPtr, TCL_GLOBAL_ONLY);
5321       Tcl_DecrRefCount(objPtr);
5322   }
5323 
5324   /*
5325    * If the errorCode variable wasn't set by the code that generated
5326    * the error, set it to "NONE".
5327    */
5328 
5329   if (!(iPtr->flags & ERROR_CODE_SET)) {
5330       objPtr = Tcl_NewStringObj("NONE", -1);
5331       Tcl_IncrRefCount(objPtr);
5332       Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorCode, NULL, 
5333               objPtr, TCL_GLOBAL_ONLY);
5334       Tcl_DecrRefCount(objPtr);
5335   }
5336     }
5337 
5338     /*
5339      * Now append "message" to the end of errorInfo.
5340      */
5341 
5342     if (length != 0) {
5343   objPtr = Tcl_NewStringObj(message, length);
5344   Tcl_IncrRefCount(objPtr);
5345   Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorInfo, NULL, 
5346           objPtr, (TCL_GLOBAL_ONLY | TCL_APPEND_VALUE));
5347   Tcl_DecrRefCount(objPtr); /* free msg object appended above */
5348     }
5349 }
void Tcl_AllowExceptions (Tcl_Interp * interp)

Definition at line 5521 of file tclBasic.c.
References Interp::evalFlags, and TCL_ALLOW_EXCEPTIONS.
Referenced by HandleBgErrors(), SlaveEval(), and SlaveInvokeHidden().5523 {
5524     Interp *iPtr = (Interp *) interp;
5525 
5526     iPtr->evalFlags |= TCL_ALLOW_EXCEPTIONS;
5527 }
void Tcl_CallWhenDeleted (Tcl_Interp * interp, Tcl_InterpDeleteProc * proc, ClientData clientData)

Definition at line 658 of file tclBasic.c.
References Interp::assocData, ckalloc, AssocData::clientData, AssocData::proc, Tcl_CreateHashEntry, Tcl_GetThreadData(), Tcl_InitHashTable(), TCL_INTEGER_SPACE, Tcl_SetHashValue, and TCL_STRING_KEYS.
Referenced by TclInterpInit(), and TestdcallCmd().663 {
664     Interp *iPtr = (Interp *) interp;
665     static Tcl_ThreadDataKey assocDataCounterKey;
666     int *assocDataCounterPtr =
667       Tcl_GetThreadData(&assocDataCounterKey, (int)sizeof(int));
668     int new;
669     char buffer[32 + TCL_INTEGER_SPACE];
670     AssocData *dPtr = (AssocData *) ckalloc(sizeof(AssocData));
671     Tcl_HashEntry *hPtr;
672 
673     sprintf(buffer, "Assoc Data Key #%d", *assocDataCounterPtr);
674     (*assocDataCounterPtr)++;
675 
676     if (iPtr->assocData == (Tcl_HashTable *) NULL) {
677         iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
678         Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
679     }
680     hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &new);
681     dPtr->proc = proc;
682     dPtr->clientData = clientData;
683     Tcl_SetHashValue(hPtr, dPtr);
684 }
Tcl_Command Tcl_CreateCommand (Tcl_Interp * interp, CONST char * cmdName, Tcl_CmdProc * proc, ClientData clientData, Tcl_CmdDeleteProc * deleteProc)

Definition at line 1450 of file tclBasic.c.
References ckalloc, ckfree, Command::clientData, Command::cmdEpoch, Namespace::cmdTable, Command::compileProc, CONST, CREATE_NS_IF_UNKNOWN, DELETED, Command::deleteData, Command::deleteProc, Command::flags, Interp::flags, Interp::globalNsPtr, Command::hPtr, ImportRef::importedCmdPtr, Command::importRefPtr, ImportRef::nextPtr, Command::nsPtr, NULL, Command::objClientData, Command::objProc, Command::proc, ImportedCmdData::realCmdPtr, Command::refCount, strstr(), Tcl_CreateHashEntry, Tcl_DeleteCommandFromToken(), Tcl_GetHashValue, Tcl_SetHashValue, TclGetNamespaceForQualName(), TclInvokeStringCommand(), TclResetShadowedCmdRefs(), and Command::tracePtr.
Referenced by Tcl_ProcObjCmd(), tclOSAMakeNewComponent(), TclplatformtestInit(), Tcltest_Init(), Tclxttest_Init(), TestcmdinfoCmd(), TestcmdtokenCmd(), TestcreatecommandCmd(), and TestdelCmd().1462 {
1463     Interp *iPtr = (Interp *) interp;
1464     ImportRef *oldRefPtr = NULL;
1465     Namespace *nsPtr, *dummy1, *dummy2;
1466     Command *cmdPtr, *refCmdPtr;
1467     Tcl_HashEntry *hPtr;
1468     CONST char *tail;
1469     int new;
1470     ImportedCmdData *dataPtr;
1471 
1472     if (iPtr->flags & DELETED) {
1473   /*
1474    * The interpreter is being deleted.  Don't create any new
1475    * commands; it's not safe to muck with the interpreter anymore.
1476    */
1477 
1478   return (Tcl_Command) NULL;
1479     }
1480 
1481     /*
1482      * Determine where the command should reside. If its name contains 
1483      * namespace qualifiers, we put it in the specified namespace; 
1484      * otherwise, we always put it in the global namespace.
1485      */
1486 
1487     if (strstr(cmdName, "::") != NULL) {
1488        TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL,
1489            CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
1490        if ((nsPtr == NULL) || (tail == NULL)) {
1491       return (Tcl_Command) NULL;
1492   }
1493     } else {
1494   nsPtr = iPtr->globalNsPtr;
1495   tail = cmdName;
1496     }
1497     
1498     hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
1499     if (!new) {
1500   /*
1501    * Command already exists. Delete the old one.
1502    * Be careful to preserve any existing import links so we can
1503    * restore them down below.  That way, you can redefine a
1504    * command and its import status will remain intact.
1505    */
1506 
1507   cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
1508   oldRefPtr = cmdPtr->importRefPtr;
1509   cmdPtr->importRefPtr = NULL;
1510 
1511   Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
1512   hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
1513   if (!new) {
1514       /*
1515        * If the deletion callback recreated the command, just throw
1516              * away the new command (if we try to delete it again, we
1517              * could get stuck in an infinite loop).
1518        */
1519 
1520        ckfree((char*) Tcl_GetHashValue(hPtr));
1521   }
1522     }
1523     cmdPtr = (Command *) ckalloc(sizeof(Command));
1524     Tcl_SetHashValue(hPtr, cmdPtr);
1525     cmdPtr->hPtr = hPtr;
1526     cmdPtr->nsPtr = nsPtr;
1527     cmdPtr->refCount = 1;
1528     cmdPtr->cmdEpoch = 0;
1529     cmdPtr->compileProc = (CompileProc *) NULL;
1530     cmdPtr->objProc = TclInvokeStringCommand;
1531     cmdPtr->objClientData = (ClientData) cmdPtr;
1532     cmdPtr->proc = proc;
1533     cmdPtr->clientData = clientData;
1534     cmdPtr->deleteProc = deleteProc;
1535     cmdPtr->deleteData = clientData;
1536     cmdPtr->flags = 0;
1537     cmdPtr->importRefPtr = NULL;
1538     cmdPtr->tracePtr = NULL;
1539 
1540     /*
1541      * Plug in any existing import references found above.  Be sure
1542      * to update all of these references to point to the new command.
1543      */
1544 
1545     if (oldRefPtr != NULL) {
1546   cmdPtr->importRefPtr = oldRefPtr;
1547   while (oldRefPtr != NULL) {
1548       refCmdPtr = oldRefPtr->importedCmdPtr;
1549       dataPtr = (ImportedCmdData*)refCmdPtr->objClientData;
1550       dataPtr->realCmdPtr = cmdPtr;
1551       oldRefPtr = oldRefPtr->nextPtr;
1552   }
1553     }
1554 
1555     /*
1556      * We just created a command, so in its namespace and all of its parent
1557      * namespaces, it may shadow global commands with the same name. If any
1558      * shadowed commands are found, invalidate all cached command references
1559      * in the affected namespaces.
1560      */
1561     
1562     TclResetShadowedCmdRefs(interp, cmdPtr);
1563     return (Tcl_Command) cmdPtr;
1564 }
Tcl_Interp* Tcl_CreateInterp ()

Definition at line 283 of file tclBasic.c.
References Interp::activeCmdTracePtr, Interp::activeInterpTracePtr, Interp::activeVarTracePtr, Interp::appendAvl, Interp::appendResult, Interp::appendUsed, Interp::assocData, builtInCmds, ckalloc, Command::clientData, Interp::cmdCount, Command::cmdEpoch, Namespace::cmdTable, Interp::compiledProcPtr, Interp::compileEpoch, Command::compileProc, CmdInfo::compileProc, Command::deleteData, Command::deleteProc, Interp::emptyObjPtr, Interp::errorCode, Interp::errorInfo, Interp::errorLine, Interp::evalFlags, Interp::execEnvPtr, Command::flags, Interp::flags, Interp::framePtr, Interp::freeProc, Interp::globalNsPtr, Interp::handle, Interp::hiddenCmdTablePtr, Command::hPtr, Command::importRefPtr, Interp::interpInfo, Interp::literalTable, Interp::mathFuncTable, MAX_NESTING_DEPTH, Interp::maxNestingDepth, CmdInfo::name, Command::nsPtr, NULL, Interp::numLevels, Command::objClientData, Command::objProc, CmdInfo::objProc, Interp::objResultPtr, Interp::packageTable, Interp::packageUnknown, panic, Command::proc, CmdInfo::proc, Command::refCount, Interp::resolverPtr, Interp::result, Interp::resultSpace, Interp::returnCode, Interp::scriptFile, Interp::stubTable, Tcl_CreateHashEntry, Tcl_CreateNamespace(), Tcl_GetCurrentThread(), Tcl_IncrRefCount, Tcl_InitHashTable(), Tcl_NewObj(), TCL_OK, Tcl_SetHashValue, TCL_STRING_KEYS, TclCreateExecEnv(), TclHandleCreate(), TclInitLiteralTable(), TclInitSubsystems(), TclInvokeObjectCommand(), TclInvokeStringCommand(), tclStubs, Interp::termOffset, Interp::threadId, Command::tracePtr, Interp::tracePtr, Interp::tracesForbiddingInline, Interp::varFramePtr, and VOID.
Referenced by SlaveCreate(), Tcl_Main(), TestdcallCmd(), and TestfeventCmd().284 {
285     Interp *iPtr;
286     Tcl_Interp *interp;
287     Command *cmdPtr;
288     BuiltinFunc *builtinFuncPtr;
289     MathFunc *mathFuncPtr;
290     Tcl_HashEntry *hPtr;
291     CmdInfo *cmdInfoPtr;
292     int i;
293     union {
294   char c[sizeof(short)];
295   short s;
296     } order;
297 #ifdef TCL_COMPILE_STATS
298     ByteCodeStats *statsPtr;
299 #endif /* TCL_COMPILE_STATS */
300 
301     TclInitSubsystems(NULL);
302 
303     /*
304      * Panic if someone updated the CallFrame structure without
305      * also updating the Tcl_CallFrame structure (or vice versa).
306      */  
307 
308     if (sizeof(Tcl_CallFrame) != sizeof(CallFrame)) {
309   /*NOTREACHED*/
310         panic("Tcl_CallFrame and CallFrame are not the same size");
311     }
312 
313     /*
314      * Initialize support for namespaces and create the global namespace
315      * (whose name is ""; an alias is "::"). This also initializes the
316      * Tcl object type table and other object management code.
317      */
318 
319     iPtr = (Interp *) ckalloc(sizeof(Interp));
320     interp = (Tcl_Interp *) iPtr;
321 
322     iPtr->result    = iPtr->resultSpace;
323     iPtr->freeProc    = NULL;
324     iPtr->errorLine   = 0;
325     iPtr->objResultPtr    = Tcl_NewObj();
326     Tcl_IncrRefCount(iPtr->objResultPtr);
327     iPtr->handle    = TclHandleCreate(iPtr);
328     iPtr->globalNsPtr   = NULL;
329     iPtr->hiddenCmdTablePtr = NULL;
330     iPtr->interpInfo    = NULL;
331     Tcl_InitHashTable(&iPtr->mathFuncTable, TCL_STRING_KEYS);
332 
333     iPtr->numLevels = 0;
334     iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
335     iPtr->framePtr = NULL;
336     iPtr->varFramePtr = NULL;
337     iPtr->activeVarTracePtr = NULL;
338     iPtr->returnCode = TCL_OK;
339     iPtr->errorInfo = NULL;
340     iPtr->errorCode = NULL;
341 
342     iPtr->appendResult = NULL;
343     iPtr->appendAvl = 0;
344     iPtr->appendUsed = 0;
345 
346     Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
347     iPtr->packageUnknown = NULL;
348 #ifdef TCL_TIP268
349     /* TIP #268 */
350     iPtr->packagePrefer = (getenv ("TCL_PKG_PREFER_LATEST") == NULL ? 
351          PKG_PREFER_STABLE   :
352          PKG_PREFER_LATEST);
353 #endif
354     iPtr->cmdCount = 0;
355     iPtr->termOffset = 0;
356     TclInitLiteralTable(&(iPtr->literalTable));
357     iPtr->compileEpoch = 0;
358     iPtr->compiledProcPtr = NULL;
359     iPtr->resolverPtr = NULL;
360     iPtr->evalFlags = 0;
361     iPtr->scriptFile = NULL;
362     iPtr->flags = 0;
363     iPtr->tracePtr = NULL;
364     iPtr->tracesForbiddingInline = 0;
365     iPtr->activeCmdTracePtr = NULL;
366     iPtr->activeInterpTracePtr = NULL;
367     iPtr->assocData = (Tcl_HashTable *) NULL;
368     iPtr->execEnvPtr = NULL;        /* set after namespaces initialized */
369     iPtr->emptyObjPtr = Tcl_NewObj(); /* another empty object */
370     Tcl_IncrRefCount(iPtr->emptyObjPtr);
371     iPtr->resultSpace[0] = 0;
372     iPtr->threadId = Tcl_GetCurrentThread();
373 
374     iPtr->globalNsPtr = NULL; /* force creation of global ns below */
375     iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "",
376       (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL);
377     if (iPtr->globalNsPtr == NULL) {
378         panic("Tcl_CreateInterp: can't create global namespace");
379     }
380 
381     /*
382      * Initialize support for code compilation and execution. We call
383      * TclCreateExecEnv after initializing namespaces since it tries to
384      * reference a Tcl variable (it links to the Tcl "tcl_traceExec"
385      * variable).
386      */
387 
388     iPtr->execEnvPtr = TclCreateExecEnv(interp);
389 
390     /*
391      * Initialize the compilation and execution statistics kept for this
392      * interpreter.
393      */
394 
395 #ifdef TCL_COMPILE_STATS
396     statsPtr = &(iPtr->stats);
397     statsPtr->numExecutions = 0;
398     statsPtr->numCompilations = 0;
399     statsPtr->numByteCodesFreed = 0;
400     (VOID *) memset(statsPtr->instructionCount, 0,
401       sizeof(statsPtr->instructionCount));
402 
403     statsPtr->totalSrcBytes = 0.0;
404     statsPtr->totalByteCodeBytes = 0.0;
405     statsPtr->currentSrcBytes = 0.0;
406     statsPtr->currentByteCodeBytes = 0.0;
407     (VOID *) memset(statsPtr->srcCount, 0, sizeof(statsPtr->srcCount));
408     (VOID *) memset(statsPtr->byteCodeCount, 0,
409       sizeof(statsPtr->byteCodeCount));
410     (VOID *) memset(statsPtr->lifetimeCount, 0,
411       sizeof(statsPtr->lifetimeCount));
412     
413     statsPtr->currentInstBytes   = 0.0;
414     statsPtr->currentLitBytes    = 0.0;
415     statsPtr->currentExceptBytes = 0.0;
416     statsPtr->currentAuxBytes    = 0.0;
417     statsPtr->currentCmdMapBytes = 0.0;
418     
419     statsPtr->numLiteralsCreated    = 0;
420     statsPtr->totalLitStringBytes   = 0.0;
421     statsPtr->currentLitStringBytes = 0.0;
422     (VOID *) memset(statsPtr->literalCount, 0,
423             sizeof(statsPtr->literalCount));
424 #endif /* TCL_COMPILE_STATS */    
425 
426     /*
427      * Initialise the stub table pointer.
428      */
429 
430     iPtr->stubTable = &tclStubs;
431 
432     
433     /*
434      * Create the core commands. Do it here, rather than calling
435      * Tcl_CreateCommand, because it's faster (there's no need to check for
436      * a pre-existing command by the same name). If a command has a
437      * Tcl_CmdProc but no Tcl_ObjCmdProc, set the Tcl_ObjCmdProc to
438      * TclInvokeStringCommand. This is an object-based wrapper procedure
439      * that extracts strings, calls the string procedure, and creates an
440      * object for the result. Similarly, if a command has a Tcl_ObjCmdProc
441      * but no Tcl_CmdProc, set the Tcl_CmdProc to TclInvokeObjectCommand.
442      */
443 
444     for (cmdInfoPtr = builtInCmds;  cmdInfoPtr->name != NULL;
445       cmdInfoPtr++) {
446   int new;
447   Tcl_HashEntry *hPtr;
448 
449   if ((cmdInfoPtr->proc == (Tcl_CmdProc *) NULL)
450           && (cmdInfoPtr->objProc == (Tcl_ObjCmdProc *) NULL)
451           && (cmdInfoPtr->compileProc == (CompileProc *) NULL)) {
452       panic("Tcl_CreateInterp: builtin command with NULL string and object command procs and a NULL compile proc\n");
453   }
454   
455   hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
456           cmdInfoPtr->name, &new);
457   if (new) {
458       cmdPtr = (Command *) ckalloc(sizeof(Command));
459       cmdPtr->hPtr = hPtr;
460       cmdPtr->nsPtr = iPtr->globalNsPtr;
461       cmdPtr->refCount = 1;
462       cmdPtr->cmdEpoch = 0;
463       cmdPtr->compileProc = cmdInfoPtr->compileProc;
464       if (cmdInfoPtr->proc == (Tcl_CmdProc *) NULL) {
465     cmdPtr->proc = TclInvokeObjectCommand;
466     cmdPtr->clientData = (ClientData) cmdPtr;
467       } else {
468     cmdPtr->proc = cmdInfoPtr->proc;
469     cmdPtr->clientData = (ClientData) NULL;
470       }
471       if (cmdInfoPtr->objProc == (Tcl_ObjCmdProc *) NULL) {
472     cmdPtr->objProc = TclInvokeStringCommand;
473     cmdPtr->objClientData = (ClientData) cmdPtr;
474       } else {
475     cmdPtr->objProc = cmdInfoPtr->objProc;
476     cmdPtr->objClientData = (ClientData) NULL;
477       }
478       cmdPtr->deleteProc = NULL;
479       cmdPtr->deleteData = (ClientData) NULL;
480       cmdPtr->flags = 0;
481       cmdPtr->importRefPtr = NULL;
482       cmdPtr->tracePtr = NULL;
483       Tcl_SetHashValue(hPtr, cmdPtr);
484   }
485     }
486 
487     /*
488      * Register the builtin math functions.
489      */
490 
491     i = 0;
492     for (builtinFuncPtr = tclBuiltinFuncTable;  builtinFuncPtr->name != NULL;
493       builtinFuncPtr++) {
494   Tcl_CreateMathFunc((Tcl_Interp *) iPtr, builtinFuncPtr->name,
495     builtinFuncPtr->numArgs, builtinFuncPtr->argTypes,
496     (Tcl_MathProc *) NULL, (ClientData) 0);
497   hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable,
498     builtinFuncPtr->name);
499   if (hPtr == NULL) {
500       panic("Tcl_CreateInterp: Tcl_CreateMathFunc incorrectly registered '%s'", builtinFuncPtr->name);
501       return NULL;
502   }
503   mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
504   mathFuncPtr->builtinFuncIndex = i;
505   i++;
506     }
507     iPtr->flags |= EXPR_INITIALIZED;
508 
509     /*
510      * Do Multiple/Safe Interps Tcl init stuff
511      */
512 
513     TclInterpInit(interp);
514 
515     /*
516      * We used to create the "errorInfo" and "errorCode" global vars at this
517      * point because so much of the Tcl implementation assumes they already
518      * exist. This is not quite enough, however, since they can be unset
519      * at any time.
520      *
521      * There are 2 choices:
522      *    + Check every place where a GetVar of those is used 
523      *      and the NULL result is not checked (like in tclLoad.c)
524      *    + Make SetVar,... NULL friendly
525      * We choose the second option because :
526      *    + It is easy and low cost to check for NULL pointer before
527      *      calling strlen()
528      *    + It can be helpfull to other people using those API
529      *    + Passing a NULL value to those closest 'meaning' is empty string
530      *      (specially with the new objects where 0 bytes strings are ok)
531      * So the following init is commented out:              -- dl
532      *
533      * (void) Tcl_SetVar2((Tcl_Interp *)iPtr, "errorInfo", (char *) NULL,
534      *       "", TCL_GLOBAL_ONLY);
535      * (void) Tcl_SetVar2((Tcl_Interp *)iPtr, "errorCode", (char *) NULL,
536      *       "NONE", TCL_GLOBAL_ONLY);
537      */
538 
539 #ifndef TCL_GENERIC_ONLY
540     TclSetupEnv(interp);
541 #endif
542 
543     /*
544      * Compute the byte order of this machine.
545      */
546 
547     order.s = 1;
548     Tcl_SetVar2(interp, "tcl_platform", "byteOrder",
549       ((order.c[0] == 1) ? "littleEndian" : "bigEndian"),
550       TCL_GLOBAL_ONLY);
551 
552     Tcl_SetVar2Ex(interp, "tcl_platform", "wordSize",
553       Tcl_NewLongObj((long) sizeof(long)), TCL_GLOBAL_ONLY);
554 
555     /*
556      * Set up other variables such as tcl_version and tcl_library
557      */
558 
559     Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
560     Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY);
561     Tcl_TraceVar2(interp, "tcl_precision", (char *) NULL,
562       TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
563       TclPrecTraceProc, (ClientData) NULL);
564     TclpSetVariables(interp);
565 
566 #ifdef TCL_THREADS
567     /*
568      * The existence of the "threaded" element of the tcl_platform array indicates
569      * that this particular Tcl shell has been compiled with threads turned on.
570      * Using "info exists tcl_platform(threaded)" a Tcl script can introspect on the 
571      * interpreter level of thread safety.
572      */
573 
574 
575     Tcl_SetVar2(interp, "tcl_platform", "threaded", "1",
576       TCL_GLOBAL_ONLY);
577 #endif
578 
579     /*
580      * Register Tcl's version number.
581      * TIP#268: Expose information about its status,
582      *          for runtime switches in the core library
583      *          and tests.
584      */
585 
586     Tcl_PkgProvideEx(interp, "Tcl", TCL_VERSION, (ClientData) &tclStubs);
587 
588 #ifdef TCL_TIP268
589     Tcl_SetVar2(interp, "tcl_platform", "tip,268", "1",
590       TCL_GLOBAL_ONLY);
591 #endif
592 #ifdef Tcl_InitStubs
593 #undef Tcl_InitStubs
594 #endif
595     Tcl_InitStubs(interp, TCL_VERSION, 1);
596 
597     return interp;
598 }
void Tcl_CreateMathFunc (Tcl_Interp * interp, CONST char * name, int numArgs, Tcl_ValueType * argTypes, Tcl_MathProc * proc, ClientData clientData)

Definition at line 2711 of file tclBasic.c.
References MathFunc::argTypes, MathFunc::builtinFuncIndex, ckalloc, MathFunc::clientData, Interp::compileEpoch, Interp::mathFuncTable, MAX_MATH_ARGS, MathFunc::numArgs, MathFunc::proc, Tcl_CreateHashEntry, Tcl_GetHashValue, and Tcl_SetHashValue.
Referenced by Tcltest_Init().2723 {
2724     Interp *iPtr = (Interp *) interp;
2725     Tcl_HashEntry *hPtr;
2726     MathFunc *mathFuncPtr;
2727     int new, i;
2728 
2729     hPtr = Tcl_CreateHashEntry(&iPtr->mathFuncTable, name, &new);
2730     if (new) {
2731   Tcl_SetHashValue(hPtr, ckalloc(sizeof(MathFunc)));
2732     }
2733     mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
2734 
2735     if (!new) { 
2736   if (mathFuncPtr->builtinFuncIndex >= 0) {
2737       /*
2738        * We are redefining a builtin math function. Invalidate the
2739              * interpreter's existing code by incrementing its
2740              * compileEpoch member. This field is checked in Tcl_EvalObj
2741              * and ObjInterpProc, and code whose compilation epoch doesn't
2742              * match is recompiled. Newly compiled code will no longer
2743              * treat the function as builtin.
2744        */
2745 
2746       iPtr->compileEpoch++;
2747   } else {
2748       /*
2749        * A non-builtin function is being redefined. We must invalidate
2750              * existing code if the number of arguments has changed. This
2751        * is because existing code was compiled assuming that number.
2752        */
2753 
2754       if (numArgs != mathFuncPtr->numArgs) {
2755     iPtr->compileEpoch++;
2756       }
2757   }
2758     }
2759     
2760     mathFuncPtr->builtinFuncIndex = -1; /* can't be a builtin function */
2761     if (numArgs > MAX_MATH_ARGS) {
2762   numArgs = MAX_MATH_ARGS;
2763     }
2764     mathFuncPtr->numArgs = numArgs;
2765     for (i = 0;  i < numArgs;  i++) {
2766   mathFuncPtr->argTypes[i] = argTypes[i];
2767     }
2768     mathFuncPtr->proc = proc;
2769     mathFuncPtr->clientData = clientData;
2770 }
Tcl_Command Tcl_CreateObjCommand (Tcl_Interp * interp, CONST char * cmdName, Tcl_ObjCmdProc * proc, ClientData clientData, Tcl_CmdDeleteProc * deleteProc)

Definition at line 1595 of file tclBasic.c.
References ckalloc, ckfree, Command::clientData, Command::cmdEpoch, Namespace::cmdTable, Command::compileProc, CONST, CREATE_NS_IF_UNKNOWN, DELETED, Command::deleteData, Command::deleteProc, Command::flags, Interp::flags, Interp::globalNsPtr, Command::hPtr, ImportRef::importedCmdPtr, Command::importRefPtr, ImportRef::nextPtr, Command::nsPtr, NULL, Command::objClientData, Command::objProc, Command::proc, ImportedCmdData::realCmdPtr, Command::refCount, strstr(), Tcl_CreateHashEntry, Tcl_DeleteCommandFromToken(), Tcl_GetHashValue, Tcl_SetHashValue, TclGetNamespaceForQualName(), TclInvokeObjectCommand(), TclInvokeStringCommand(), TclResetShadowedCmdRefs(), and Command::tracePtr.
Referenced by AliasCreate(), DdeSetServerName(), InitByteCodeExecution(), Pkga_Init(), Pkgb_Init(), Pkgb_SafeInit(), Pkgc_Init(), Pkgc_SafeInit(), Pkgd_Init(), Pkgd_SafeInit(), RegisterCommand(), Registry_Init(), SlaveCreate(), TCL_DECLARE_MUTEX(), Tcl_Import(), Tcl_Main(), Tcl_ProcObjCmd(), TclInterpInit(), TclObjTest_Init(), TclplatformtestInit(), and Tcltest_Init().1609 {
1610     Interp *iPtr = (Interp *) interp;
1611     ImportRef *oldRefPtr = NULL;
1612     Namespace *nsPtr, *dummy1, *dummy2;
1613     Command *cmdPtr, *refCmdPtr;
1614     Tcl_HashEntry *hPtr;
1615     CONST char *tail;
1616     int new;
1617     ImportedCmdData *dataPtr;
1618 
1619     if (iPtr->flags & DELETED) {
1620   /*
1621    * The interpreter is being deleted.  Don't create any new
1622    * commands;  it's not safe to muck with the interpreter anymore.
1623    */
1624 
1625   return (Tcl_Command) NULL;
1626     }
1627 
1628     /*
1629      * Determine where the command should reside. If its name contains 
1630      * namespace qualifiers, we put it in the specified namespace; 
1631      * otherwise, we always put it in the global namespace.
1632      */
1633 
1634     if (strstr(cmdName, "::") != NULL) {
1635        TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL,
1636            CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
1637        if ((nsPtr == NULL) || (tail == NULL)) {
1638       return (Tcl_Command) NULL;
1639   }
1640     } else {
1641   nsPtr = iPtr->globalNsPtr;
1642   tail = cmdName;
1643     }
1644 
1645     hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
1646     if (!new) {
1647   cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
1648 
1649   /*
1650    * Command already exists. If its object-based Tcl_ObjCmdProc is
1651    * TclInvokeStringCommand, we just set its Tcl_ObjCmdProc to the
1652    * argument "proc". Otherwise, we delete the old command. 
1653    */
1654 
1655   if (cmdPtr->objProc == TclInvokeStringCommand) {
1656       cmdPtr->objProc = proc;
1657       cmdPtr->objClientData = clientData;
1658             cmdPtr->deleteProc = deleteProc;
1659             cmdPtr->deleteData = clientData;
1660       return (Tcl_Command) cmdPtr;
1661   }
1662 
1663   /*
1664    * Otherwise, we delete the old command.  Be careful to preserve
1665    * any existing import links so we can restore them down below.
1666    * That way, you can redefine a command and its import status
1667    * will remain intact.
1668    */
1669 
1670   oldRefPtr = cmdPtr->importRefPtr;
1671   cmdPtr->importRefPtr = NULL;
1672 
1673   Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
1674   hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
1675   if (!new) {
1676       /*
1677        * If the deletion callback recreated the command, just throw
1678        * away the new command (if we try to delete it again, we
1679        * could get stuck in an infinite loop).
1680        */
1681 
1682        ckfree((char *) Tcl_GetHashValue(hPtr));
1683   }
1684     }
1685     cmdPtr = (Command *) ckalloc(sizeof(Command));
1686     Tcl_SetHashValue(hPtr, cmdPtr);
1687     cmdPtr->hPtr = hPtr;
1688     cmdPtr->nsPtr = nsPtr;
1689     cmdPtr->refCount = 1;
1690     cmdPtr->cmdEpoch = 0;
1691     cmdPtr->compileProc = (CompileProc *) NULL;
1692     cmdPtr->objProc = proc;
1693     cmdPtr->objClientData = clientData;
1694     cmdPtr->proc = TclInvokeObjectCommand;
1695     cmdPtr->clientData = (ClientData) cmdPtr;
1696     cmdPtr->deleteProc = deleteProc;
1697     cmdPtr->deleteData = clientData;
1698     cmdPtr->flags = 0;
1699     cmdPtr->importRefPtr = NULL;
1700     cmdPtr->tracePtr = NULL;
1701 
1702     /*
1703      * Plug in any existing import references found above.  Be sure
1704      * to update all of these references to point to the new command.
1705      */
1706 
1707     if (oldRefPtr != NULL) {
1708   cmdPtr->importRefPtr = oldRefPtr;
1709   while (oldRefPtr != NULL) {
1710       refCmdPtr = oldRefPtr->importedCmdPtr;
1711       dataPtr = (ImportedCmdData*)refCmdPtr->objClientData;
1712       dataPtr->realCmdPtr = cmdPtr;
1713       oldRefPtr = oldRefPtr->nextPtr;
1714   }
1715     }
1716     
1717     /*
1718      * We just created a command, so in its namespace and all of its parent
1719      * namespaces, it may shadow global commands with the same name. If any
1720      * shadowed commands are found, invalidate all cached command references
1721      * in the affected namespaces.
1722      */
1723     
1724     TclResetShadowedCmdRefs(interp, cmdPtr);
1725     return (Tcl_Command) cmdPtr;
1726 }
Tcl_Trace Tcl_CreateObjTrace (Tcl_Interp* interp, int level, int flags, Tcl_CmdObjTraceProc* proc, ClientData clientData, Tcl_CmdObjTraceDeleteProc* delProc)

Definition at line 4962 of file tclBasic.c.
References ckalloc, Trace::clientData, Interp::compileEpoch, Trace::delProc, DONT_COMPILE_CMDS_INLINE, Trace::flags, Interp::flags, Trace::level, Trace::nextPtr, Trace::proc, TCL_ALLOW_INLINE_COMPILATION, Interp::tracePtr, and Interp::tracesForbiddingInline.
Referenced by Tcl_CreateTrace(), TestcmdtraceCmd(), and TraceExecutionProc().4970 {
4971     register Trace *tracePtr;
4972     register Interp *iPtr = (Interp *) interp;
4973 
4974     /* Test if this trace allows inline compilation of commands */
4975 
4976     if (!(flags & TCL_ALLOW_INLINE_COMPILATION)) {
4977   if (iPtr->tracesForbiddingInline == 0) {
4978 
4979       /*
4980        * When the first trace forbidding inline compilation is
4981        * created, invalidate existing compiled code for this
4982        * interpreter and arrange (by setting the
4983        * DONT_COMPILE_CMDS_INLINE flag) that when compiling new
4984        * code, no commands will be compiled inline (i.e., into
4985        * an inline sequence of instructions). We do this because
4986        * commands that were compiled inline will never result in
4987        * a command trace being called.
4988        */
4989 
4990       iPtr->compileEpoch++;
4991       iPtr->flags |= DONT_COMPILE_CMDS_INLINE;
4992   }
4993   iPtr->tracesForbiddingInline++;
4994     }
4995     
4996     tracePtr = (Trace *) ckalloc(sizeof(Trace));
4997     tracePtr->level   = level;
4998     tracePtr->proc    = proc;
4999     tracePtr->clientData  = clientData;
5000     tracePtr->delProc           = delProc;
5001     tracePtr->nextPtr   = iPtr->tracePtr;
5002     tracePtr->flags   = flags;
5003     iPtr->tracePtr    = tracePtr;
5004 
5005     return (Tcl_Trace) tracePtr;
5006 }
Tcl_Trace Tcl_CreateTrace (Tcl_Interp * interp, int level, Tcl_CmdTraceProc * proc, ClientData clientData)

Definition at line 5052 of file tclBasic.c.
References ckalloc, StringTraceDeleteProc(), StringTraceProc(), and Tcl_CreateObjTrace().
Referenced by TestcmdtraceCmd().5059 {
5060     StringTraceData* data;
5061     data = (StringTraceData*) ckalloc( sizeof( *data ));
5062     data->clientData = clientData;
5063     data->proc = proc;
5064     return Tcl_CreateObjTrace( interp, level, 0, StringTraceProc,
5065              (ClientData) data, StringTraceDeleteProc );
5066 }
void Tcl_DeleteAssocData (Tcl_Interp * interp, CONST char * name)

Definition at line 800 of file tclBasic.c.
References Interp::assocData, ckfree, AssocData::clientData, NULL, AssocData::proc, Tcl_DeleteHashEntry(), Tcl_FindHashEntry, and Tcl_GetHashValue.
Referenced by TestdelassocdataCmd().803 {
804     Interp *iPtr = (Interp *) interp;
805     AssocData *dPtr;
806     Tcl_HashEntry *hPtr;
807 
808     if (iPtr->assocData == (Tcl_HashTable *) NULL) {
809         return;
810     }
811     hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
812     if (hPtr == (Tcl_HashEntry *) NULL) {
813         return;
814     }
815     dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
816     if (dPtr->proc != NULL) {
817         (dPtr->proc) (dPtr->clientData, interp);
818     }
819     ckfree((char *) dPtr);
820     Tcl_DeleteHashEntry(hPtr);
821 }
int Tcl_DeleteCommand (Tcl_Interp * interp, CONST char * cmdName)

Definition at line 2367 of file tclBasic.c.
References NULL, Tcl_DeleteCommandFromToken(), and Tcl_FindCommand().
Referenced by Tcl_OSACmd(), TestcmdinfoCmd(), and TestcreatecommandCmd().2371 {
2372     Tcl_Command cmd;
2373 
2374     /*
2375      *  Find the desired command and delete it.
2376      */
2377 
2378     cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
2379             /*flags*/ 0);
2380     if (cmd == (Tcl_Command) NULL) {
2381   return -1;
2382     }
2383     return Tcl_DeleteCommandFromToken(interp, cmd);
2384 }
int Tcl_DeleteCommandFromToken (Tcl_Interp * interp, Tcl_Command cmd)

Definition at line 2407 of file tclBasic.c.
References CallCommandTraces(), ckfree, CMD_IS_DELETED, Command::cmdEpoch, Interp::compileEpoch, Command::compileProc, Command::deleteData, Command::deleteProc, Command::flags, Command::hPtr, ImportRef::importedCmdPtr, Command::importRefPtr, ImportRef::nextPtr, CommandTrace::nextPtr, Command::objProc, CommandTrace::refCount, Tcl_DeleteHashEntry(), TCL_TRACE_DELETE, TclCleanupCommand(), and Command::tracePtr.
Referenced by AliasCreate(), AliasDelete(), DeleteInterpProc(), InterpInfoDeleteProc(), Tcl_CreateCommand(), Tcl_CreateObjCommand(), Tcl_DeleteCommand(), Tcl_ForgetImport(), Tcl_InterpObjCmd(), TclRenameCommand(), and TclTeardownNamespace().2411 {
2412     Interp *iPtr = (Interp *) interp;
2413     Command *cmdPtr = (Command *) cmd;
2414     ImportRef *refPtr, *nextRefPtr;
2415     Tcl_Command importCmd;
2416 
2417     /*
2418      * The code here is tricky.  We can't delete the hash table entry
2419      * before invoking the deletion callback because there are cases
2420      * where the deletion callback needs to invoke the command (e.g.
2421      * object systems such as OTcl). However, this means that the
2422      * callback could try to delete or rename the command. The deleted
2423      * flag allows us to detect these cases and skip nested deletes.
2424      */
2425 
2426     if (cmdPtr->flags & CMD_IS_DELETED) {
2427   /*
2428    * Another deletion is already in progress.  Remove the hash
2429    * table entry now, but don't invoke a callback or free the
2430    * command structure.
2431    */
2432 
2433         Tcl_DeleteHashEntry(cmdPtr->hPtr);
2434   cmdPtr->hPtr = NULL;
2435   return 0;
2436     }
2437 
2438     /* 
2439      * We must delete this command, even though both traces and
2440      * delete procs may try to avoid this (renaming the command etc).
2441      * Also traces and delete procs may try to delete the command
2442      * themsevles.  This flag declares that a delete is in progress
2443      * and that recursive deletes should be ignored.
2444      */
2445     cmdPtr->flags |= CMD_IS_DELETED;
2446 
2447     /*
2448      * Bump the command epoch counter. This will invalidate all cached
2449      * references that point to this command.
2450      */
2451     
2452     cmdPtr->cmdEpoch++;
2453 
2454     /*
2455      * Call trace procedures for the command being deleted. Then delete
2456      * its traces. 
2457      */
2458 
2459     if (cmdPtr->tracePtr != NULL) {
2460   CommandTrace *tracePtr;
2461   CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);
2462   /* Now delete these traces */
2463   tracePtr = cmdPtr->tracePtr;
2464   while (tracePtr != NULL) {
2465       CommandTrace *nextPtr = tracePtr->nextPtr;
2466       if ((--tracePtr->refCount) <= 0) {
2467     ckfree((char*)tracePtr);
2468       }
2469       tracePtr = nextPtr;
2470   }
2471   cmdPtr->tracePtr = NULL;
2472     }
2473     
2474     /*
2475      * If the command being deleted has a compile procedure, increment the
2476      * interpreter's compileEpoch to invalidate its compiled code. This
2477      * makes sure that we don't later try to execute old code compiled with
2478      * command-specific (i.e., inline) bytecodes for the now-deleted
2479      * command. This field is checked in Tcl_EvalObj and ObjInterpProc, and
2480      * code whose compilation epoch doesn't match is recompiled.
2481      */
2482 
2483     if (cmdPtr->compileProc != NULL) {
2484         iPtr->compileEpoch++;
2485     }
2486 
2487     if (cmdPtr->deleteProc != NULL) {
2488   /*
2489    * Delete the command's client data. If this was an imported command
2490    * created when a command was imported into a namespace, this client
2491    * data will be a pointer to a ImportedCmdData structure describing
2492    * the "real" command that this imported command refers to.
2493    */
2494   
2495   /*
2496    * If you are getting a crash during the call to deleteProc and
2497    * cmdPtr->deleteProc is a pointer to the function free(), the
2498    * most likely cause is that your extension allocated memory
2499    * for the clientData argument to Tcl_CreateObjCommand() with
2500    * the ckalloc() macro and you are now trying to deallocate
2501    * this memory with free() instead of ckfree(). You should
2502    * pass a pointer to your own method that calls ckfree().
2503    */
2504 
2505   (*cmdPtr->deleteProc)(cmdPtr->deleteData);
2506     }
2507 
2508     /*
2509      * If this command was imported into other namespaces, then imported
2510      * commands were created that refer back to this command. Delete these
2511      * imported commands now.
2512      */
2513 
2514     for (refPtr = cmdPtr->importRefPtr;  refPtr != NULL;
2515             refPtr = nextRefPtr) {
2516   nextRefPtr = refPtr->nextPtr;
2517   importCmd = (Tcl_Command) refPtr->importedCmdPtr;
2518         Tcl_DeleteCommandFromToken(interp, importCmd);
2519     }
2520 
2521     /*
2522      * Don't use hPtr to delete the hash entry here, because it's
2523      * possible that the deletion callback renamed the command.
2524      * Instead, use cmdPtr->hptr, and make sure that no-one else
2525      * has already deleted the hash entry.
2526      */
2527 
2528     if (cmdPtr->hPtr != NULL) {
2529   Tcl_DeleteHashEntry(cmdPtr->hPtr);
2530     }
2531 
2532     /*
2533      * Mark the Command structure as no longer valid. This allows
2534      * TclExecuteByteCode to recognize when a Command has logically been
2535      * deleted and a pointer to this Command structure cached in a CmdName
2536      * object is invalid. TclExecuteByteCode will look up the command again
2537      * in the interpreter's command hashtable.
2538      */
2539 
2540     cmdPtr->objProc = NULL;
2541 
2542     /*
2543      * Now free the Command structure, unless there is another reference to
2544      * it from a CmdName Tcl object in some ByteCode code sequence. In that
2545      * case, delay the cleanup until all references are either discarded
2546      * (when a ByteCode is freed) or replaced by a new reference (when a
2547      * cached CmdName Command reference is found to be invalid and
2548      * TclExecuteByteCode looks up the command in the command hashtable).
2549      */
2550     
2551     TclCleanupCommand(cmdPtr);
2552     return 0;
2553 }
void Tcl_DeleteInterp (Tcl_Interp * interp)

Definition at line 914 of file tclBasic.c.
References DELETED, DeleteInterpProc(), Interp::flags, and Tcl_EventuallyFree().
Referenced by SlaveCreate(), SlaveObjCmdDeleteProc(), Tcl_Main(), Tcltest_Init(), TestdcallCmd(), TestfeventCmd(), and TestinterpdeleteCmd().917 {
918     Interp *iPtr = (Interp *) interp;
919 
920     /*
921      * If the interpreter has already been marked deleted, just punt.
922      */
923 
924     if (iPtr->flags & DELETED) {
925         return;
926     }
927     
928     /*
929      * Mark the interpreter as deleted. No further evals will be allowed.
930      */
931 
932     iPtr->flags |= DELETED;
933 
934     /*
935      * Ensure that the interpreter is eventually deleted.
936      */
937 
938     Tcl_EventuallyFree((ClientData) interp,
939             (Tcl_FreeProc *) DeleteInterpProc);
940 }
void Tcl_DeleteTrace (Tcl_Interp * interp, Tcl_Trace trace)

Definition at line 5169 of file tclBasic.c.
References Interp::activeInterpTracePtr, Trace::clientData, Interp::compileEpoch, Trace::delProc, DONT_COMPILE_CMDS_INLINE, Interp::flags, Trace::flags, ActiveInterpTrace::nextPtr, Trace::nextPtr, ActiveInterpTrace::nextTracePtr, ActiveInterpTrace::reverseScan, TCL_ALLOW_INLINE_COMPILATION, TCL_DYNAMIC, Tcl_EventuallyFree(), Interp::tracePtr, and Interp::tracesForbiddingInline.
Referenced by CmdTraceDeleteProc(), DeleteInterpProc(), TclTraceExecutionObjCmd(), TestcmdtraceCmd(), TraceCommandProc(), and TraceExecutionProc().5173 {
5174     Interp *iPtr = (Interp *) interp;
5175     Trace *prevPtr, *tracePtr = (Trace *) trace;
5176     register Trace **tracePtr2 = &(iPtr->tracePtr);
5177     ActiveInterpTrace *activePtr;
5178 
5179     /*
5180      * Locate the trace entry in the interpreter's trace list,
5181      * and remove it from the list.
5182      */
5183 
5184     prevPtr = NULL;
5185     while ((*tracePtr2) != NULL && (*tracePtr2) != tracePtr) {
5186   prevPtr = *tracePtr2;
5187   tracePtr2 = &((*tracePtr2)->nextPtr);
5188     }
5189     if (*tracePtr2 == NULL) {
5190   return;
5191     }
5192     (*tracePtr2) = (*tracePtr2)->nextPtr;
5193 
5194     /*
5195      * The code below makes it possible to delete traces while traces
5196      * are active: it makes sure that the deleted trace won't be
5197      * processed by TclCheckInterpTraces.
5198      */
5199 
5200     for (activePtr = iPtr->activeInterpTracePtr;  activePtr != NULL;
5201       activePtr = activePtr->nextPtr) {
5202   if (activePtr->nextTracePtr == tracePtr) {
5203       if (activePtr->reverseScan) {
5204     activePtr->nextTracePtr = prevPtr;
5205       } else {
5206     activePtr->nextTracePtr = tracePtr->nextPtr;
5207       }
5208   }
5209     }
5210 
5211     /*
5212      * If the trace forbids bytecode compilation, change the interpreter's
5213      * state.  If bytecode compilation is now permitted, flag the fact and
5214      * advance the compilation epoch so that procs will be recompiled to
5215      * take advantage of it.
5216      */
5217 
5218     if (!(tracePtr->flags & TCL_ALLOW_INLINE_COMPILATION)) {
5219   iPtr->tracesForbiddingInline--;
5220   if (iPtr->tracesForbiddingInline == 0) {
5221       iPtr->flags &= ~DONT_COMPILE_CMDS_INLINE;
5222       iPtr->compileEpoch++;
5223   }
5224     }
5225 
5226     /*
5227      * Execute any delete callback.
5228      */
5229 
5230     if (tracePtr->delProc != NULL) {
5231   (tracePtr->delProc)(tracePtr->clientData);
5232     }
5233 
5234     /* Delete the trace object */
5235 
5236     Tcl_EventuallyFree((char*)tracePtr, TCL_DYNAMIC);
5237 }
void Tcl_DontCallWhenDeleted (Tcl_Interp * interp, Tcl_InterpDeleteProc * proc, ClientData clientData)

Definition at line 707 of file tclBasic.c.
References Interp::assocData, ckfree, AssocData::clientData, NULL, AssocData::proc, Tcl_DeleteHashEntry(), Tcl_FirstHashEntry(), Tcl_GetHashValue, and Tcl_NextHashEntry().
Referenced by TestdcallCmd().712 {
713     Interp *iPtr = (Interp *) interp;
714     Tcl_HashTable *hTablePtr;
715     Tcl_HashSearch hSearch;
716     Tcl_HashEntry *hPtr;
717     AssocData *dPtr;
718 
719     hTablePtr = iPtr->assocData;
720     if (hTablePtr == (Tcl_HashTable *) NULL) {
721         return;
722     }
723     for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL;
724       hPtr = Tcl_NextHashEntry(&hSearch)) {
725         dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
726         if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) {
727             ckfree((char *) dPtr);
728             Tcl_DeleteHashEntry(hPtr);
729             return;
730         }
731     }
732 }
int Tcl_Eval (Tcl_Interp * interp, CONST char * string)

Definition at line 3905 of file tclBasic.c.
References Tcl_EvalEx(), Tcl_GetObjResult(), Tcl_SetResult(), TCL_VOLATILE, and TclGetString.
Referenced by AsyncHandlerProc(), DelDeleteProc(), Pkge_Init(), Pkgf_Init(), RegisterCommand(), Tcl_GlobalEval(), Tcl_Init(), Tcl_MacEvalResource(), Tcl_Main(), Tcl_VarEvalVA(), TclpDlopen(), TestcmdtraceCmd(), TestReport(), TestsaveresultCmd(), and TraceExecutionProc().3909 {
3910     int code = Tcl_EvalEx(interp, string, -1, 0);
3911 
3912     /*
3913      * For backwards compatibility with old C code that predates the
3914      * object system in Tcl 8.0, we have to mirror the object result
3915      * back into the string result (some callers may expect it there).
3916      */
3917 
3918     Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
3919       TCL_VOLATILE);
3920     return code;
3921 }
int Tcl_EvalEx (Tcl_Interp * interp, CONST char * script, int numBytes, int flags)

Definition at line 3600 of file tclBasic.c.
References ckalloc, ckfree, CONST, ERR_ALREADY_LOGGED, Interp::evalFlags, Interp::flags, next(), NUM_STATIC_OBJS, Tcl_Token::numComponents, Interp::numLevels, parse(), ProcessUnexpectedResult(), TCL_ALLOW_EXCEPTIONS, TCL_BRACKET_TERM, Tcl_DecrRefCount, TCL_ERROR, TCL_EVAL_GLOBAL, Tcl_EvalTokensStandard(), Tcl_FreeParse(), Tcl_GetObjResult(), Tcl_IncrRefCount, Tcl_LogCommandInfo(), TCL_OK, Tcl_ParseCommand(), Tcl_ResetResult(), TCL_RETURN, TclEvalObjvInternal(), TclUpdateReturnInfo(), Interp::termOffset, and Interp::varFramePtr.
Referenced by AfterProc(), Tcl_Eval(), Tcl_EvalObjEx(), Tcl_EvalTokensStandard(), Tcl_FSEvalFile(), Tcl_SubstObj(), TestevalexObjCmd(), TraceCommandProc(), and TraceVarProc().3611 {
3612     Interp *iPtr = (Interp *) interp;
3613     CONST char *p, *next;
3614     Tcl_Parse parse;
3615 #define NUM_STATIC_OBJS 20
3616     Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv;
3617     Tcl_Token *tokenPtr;
3618     int i, code, commandLength, bytesLeft, nested;
3619     CallFrame *savedVarFramePtr;   /* Saves old copy of iPtr->varFramePtr
3620             * in case TCL_EVAL_GLOBAL was set. */
3621     int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
3622     
3623     /*
3624      * The variables below keep track of how much state has been
3625      * allocated while evaluating the script, so that it can be freed
3626      * properly if an error occurs.
3627      */
3628 
3629     int gotParse = 0, objectsUsed = 0;
3630 
3631     if (numBytes < 0) {
3632   numBytes = strlen(script);
3633     }
3634     Tcl_ResetResult(interp);
3635 
3636     savedVarFramePtr = iPtr->varFramePtr;
3637     if (flags & TCL_EVAL_GLOBAL) {
3638   iPtr->varFramePtr = NULL;
3639     }
3640 
3641     /*
3642      * Each iteration through the following loop parses the next
3643      * command from the script and then executes it.
3644      */
3645 
3646     objv = staticObjArray;
3647     p = script;
3648     bytesLeft = numBytes;
3649     if (iPtr->evalFlags & TCL_BRACKET_TERM) {
3650   nested = 1;
3651     } else {
3652   nested = 0;
3653     }
3654     iPtr->evalFlags = 0;
3655     do {
3656   if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse)
3657           != TCL_OK) {
3658       code = TCL_ERROR;
3659       goto error;
3660   }
3661   gotParse = 1; 
3662 
3663   if (nested && parse.term == (script + numBytes)) {
3664       /*
3665        * A nested script can only terminate in ']'. If
3666        * the parsing got terminated at the end of the script,
3667        * there was no closing ']'.  Report the syntax error.
3668        */
3669 
3670       code = TCL_ERROR;
3671       goto error;
3672   }
3673 
3674   if (parse.numWords > 0) {
3675       /*
3676        * Generate an array of objects for the words of the command.
3677        */
3678     
3679       if (parse.numWords <= NUM_STATIC_OBJS) {
3680     objv = staticObjArray;
3681       } else {
3682     objv = (Tcl_Obj **) ckalloc((unsigned)
3683         (parse.numWords * sizeof (Tcl_Obj *)));
3684       }
3685       for (objectsUsed = 0, tokenPtr = parse.tokenPtr;
3686         objectsUsed < parse.numWords;
3687         objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) {
3688     code = Tcl_EvalTokensStandard(interp, tokenPtr+1, 
3689                 tokenPtr->numComponents);
3690     if (code == TCL_OK) {
3691         objv[objectsUsed] = Tcl_GetObjResult(interp);
3692         Tcl_IncrRefCount(objv[objectsUsed]);
3693     } else {
3694         goto error;
3695     }
3696       }
3697     
3698       /*
3699        * Execute the command and free the objects for its words.
3700        */
3701 
3702       iPtr->numLevels++;    
3703       code = TclEvalObjvInternal(interp, objectsUsed, objv, 
3704               parse.commandStart, parse.commandSize, 0);
3705       iPtr->numLevels--;
3706       if (code != TCL_OK) {
3707     goto error;
3708       }
3709       for (i = 0; i < objectsUsed; i++) {
3710     Tcl_DecrRefCount(objv[i]);
3711       }
3712       objectsUsed = 0;
3713       if (objv != staticObjArray) {
3714     ckfree((char *) objv);
3715     objv = staticObjArray;
3716       }
3717   }
3718 
3719   /*
3720    * Advance to the next command in the script.
3721    */
3722 
3723   next = parse.commandStart + parse.commandSize;
3724   bytesLeft -= next - p;
3725   p = next;
3726   Tcl_FreeParse(&parse);
3727   gotParse = 0;
3728   if (nested && (*parse.term == ']')) {
3729       /*
3730        * We get here in the special case where the TCL_BRACKET_TERM
3731        * flag was set in the interpreter and the latest parsed command
3732        * was terminated by the matching close-bracket we seek.
3733        * Return immediately.
3734        */
3735 
3736       iPtr->termOffset = (p - 1) - script;
3737       iPtr->varFramePtr = savedVarFramePtr;
3738       return TCL_OK;
3739   }
3740     } while (bytesLeft > 0);
3741 
3742     if (nested) {
3743   /*
3744    * This nested script did not terminate in ']', it is an error.
3745    */
3746   
3747   code = TCL_ERROR;
3748   goto error;
3749     }
3750     
3751     iPtr->termOffset = p - script;
3752     iPtr->varFramePtr = savedVarFramePtr;
3753     return TCL_OK;
3754 
3755     error:
3756     /*
3757      * Generate various pieces of error information, such as the line
3758      * number where the error occurred and information to add to the
3759      * errorInfo variable.  Then free resources that had been allocated
3760      * to the command.
3761      */
3762 
3763     if (iPtr->numLevels == 0) {
3764   if (code == TCL_RETURN) {
3765       code = TclUpdateReturnInfo(iPtr);
3766   }
3767   if ((code != TCL_OK) && (code != TCL_ERROR) 
3768     && !allowExceptions) {
3769       ProcessUnexpectedResult(interp, code);
3770       code = TCL_ERROR;
3771   }
3772     }
3773     if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { 
3774   commandLength = parse.commandSize;
3775   if (parse.term == parse.commandStart + commandLength - 1) {
3776       /*
3777        * The terminator character (such as ; or ]) of the command where
3778        * the error occurred is the last character in the parsed command.
3779        * Reduce the length by one so that the error message doesn't
3780        * include the terminator character.
3781        */
3782       
3783       commandLength -= 1;
3784   }
3785   Tcl_LogCommandInfo(interp, script, parse.commandStart, commandLength);
3786     }
3787     
3788     for (i = 0; i < objectsUsed; i++) {
3789   Tcl_DecrRefCount(objv[i]);
3790     }
3791     if (gotParse) {
3792   Tcl_FreeParse(&parse);
3793     }
3794     if (objv != staticObjArray) {
3795   ckfree((char *) objv);
3796     }
3797     iPtr->varFramePtr = savedVarFramePtr;
3798 
3799     /*
3800      * All that's left to do before returning is to set iPtr->termOffset
3801      * to point past the end of the script we just evaluated.
3802      */
3803 
3804     next = parse.commandStart + parse.commandSize;
3805     bytesLeft -= next - p;
3806     p = next;
3807 
3808     if (!nested) {
3809   iPtr->termOffset = p - script;
3810   return code;
3811     }
3812 
3813     /*
3814      * When we are nested (the TCL_BRACKET_TERM flag was set in the
3815      * interpreter), we must find the matching close-bracket to
3816      * end the script we are evaluating.
3817      *
3818      * When our return code is TCL_CONTINUE or TCL_RETURN, we want
3819      * to correctly set iPtr->termOffset to point to that matching
3820      * close-bracket so our caller can move to the part of the
3821      * string beyond the script we were asked to evaluate.
3822      * So we try to parse past the rest of the commands.
3823      */
3824 
3825     next = NULL;
3826     while (bytesLeft && (*parse.term != ']')) {
3827   if (TCL_OK != Tcl_ParseCommand(NULL, p, bytesLeft, 1, &parse)) {
3828       /*
3829        * Syntax error.  Set the termOffset to the beginning of
3830        * the last command parsed.
3831        */
3832 
3833       if (next == NULL) {
3834           iPtr->termOffset = (parse.commandStart - 1) - script;
3835       } else {
3836           iPtr->termOffset = (next - 1) - script;
3837       }
3838       return code;
3839   }
3840   next = parse.commandStart + parse.commandSize;
3841   bytesLeft -= next - p;
3842   p = next;
3843   next = parse.commandStart;
3844   Tcl_FreeParse(&parse);
3845     }
3846 
3847     if (bytesLeft) {
3848   /* 
3849    * parse.term points to the close-bracket.
3850    */
3851 
3852   iPtr->termOffset = parse.term - script;
3853     } else if (parse.term == script + numBytes) {
3854   /*
3855    * There was no close-bracket.  Syntax error.
3856    */
3857 
3858   iPtr->termOffset = parse.term - script;
3859   Tcl_SetObjResult(interp,
3860     Tcl_NewStringObj("missing close-bracket", -1));
3861   return TCL_ERROR;
3862     } else if (*parse.term != ']') {
3863   /*
3864    * There was no close-bracket.  Syntax error.
3865    */
3866 
3867   iPtr->termOffset = (parse.term + 1) - script;
3868   Tcl_SetObjResult(interp,
3869     Tcl_NewStringObj("missing close-bracket", -1));
3870   return TCL_ERROR;
3871     } else {
3872   /* 
3873    * parse.term points to the close-bracket.
3874    */
3875   iPtr->termOffset = parse.term - script;
3876     }
3877     return code;
3878 }
int Tcl_EvalObj (Tcl_Interp * interp, Tcl_Obj * objPtr)

Definition at line 3942 of file tclBasic.c.
References Tcl_EvalObjEx().3945 {
3946     return Tcl_EvalObjEx(interp, objPtr, 0);
3947 }
int Tcl_EvalObjEx (Tcl_Interp * interp, Tcl_Obj * objPtr, int flags)

Definition at line 3985 of file tclBasic.c.
References ckalloc, ckfree, List::elemCount, List::elements, ERR_ALREADY_LOGGED, Interp::evalFlags, Interp::flags, Interp::numLevels, ProcessUnexpectedResult(), TCL_ALLOW_EXCEPTIONS, TCL_ERROR, TCL_EVAL_DIRECT, TCL_EVAL_GLOBAL, Tcl_EvalEx(), Tcl_EvalObjv(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_LogCommandInfo(), TCL_OK, TCL_RETURN, TclCompEvalObj(), TclDecrRefCount, tclListType, TclUpdateReturnInfo(), TEOE_PREALLOC, USE_EVAL_DIRECT, and Interp::varFramePtr.
Referenced by CopyData(), CopyRenameOneFile(), ExecuteCallback(), ExecuteRemoteObject(), NamespaceEvalCmd(), NamespaceInscopeCmd(), Prompt(), SlaveEval(), Tcl_CaseObjCmd(), Tcl_CatchObjCmd(), Tcl_DdeObjCmd(), Tcl_EvalObj(), Tcl_EvalObjCmd(), Tcl_ForeachObjCmd(), Tcl_ForObjCmd(), Tcl_GlobalEvalObj(), Tcl_IfObjCmd(), Tcl_RecordAndEvalObj(), Tcl_SwitchObjCmd(), Tcl_TimeObjCmd(), Tcl_UplevelObjCmd(), Tcl_WhileObjCmd(), TclChannelEventScriptInvoker(), TesteventProc(), and TestsaveresultCmd().3996 {
3997     register Interp *iPtr = (Interp *) interp;
3998     char *script;
3999     int numSrcBytes;
4000     int result;
4001     CallFrame *savedVarFramePtr;  /* Saves old copy of iPtr->varFramePtr
4002            * in case TCL_EVAL_GLOBAL was set. */
4003     int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
4004 
4005     Tcl_IncrRefCount(objPtr);
4006 
4007     if ((iPtr->flags & USE_EVAL_DIRECT) || (flags & TCL_EVAL_DIRECT)) {
4008   /*
4009    * We're not supposed to use the compiler or byte-code interpreter.
4010    * Let Tcl_EvalEx evaluate the command directly (and probably
4011    * more slowly).
4012    *
4013    * Pure List Optimization (no string representation).  In this
4014    * case, we can safely use Tcl_EvalObjv instead and get an
4015    * appreciable improvement in execution speed.  This is because it
4016    * allows us to avoid a setFromAny step that would just pack
4017    * everything into a string and back out again.
4018    *
4019    * USE_EVAL_DIRECT is a special flag used for testing purpose only
4020    * (ensure we go into the TCL_EVAL_DIRECT path, avoiding opt)
4021    */
4022   if (!(iPtr->flags & USE_EVAL_DIRECT) &&
4023     (objPtr->typePtr == &tclListType) && /* is a list... */
4024     (objPtr->bytes == NULL) /* ...without a string rep */) {
4025       register List *listRepPtr =
4026     (List *) objPtr->internalRep.twoPtrValue.ptr1;
4027       int i, objc = listRepPtr->elemCount;
4028 #define TEOE_PREALLOC 10
4029       Tcl_Obj *staticObjv[TEOE_PREALLOC], **objv = staticObjv;
4030 
4031       if (objc > TEOE_PREALLOC) {
4032     objv = (Tcl_Obj **) ckalloc(objc*sizeof(Tcl_Obj *));
4033       }
4034 #undef TEOE_PREALLOC
4035       /*
4036        * Copy the list elements here, to avoid a segfault if objPtr
4037        * loses its List internal rep [Bug 1119369]
4038        */
4039       
4040       for (i=0; i < objc; i++) {
4041     objv[i] = listRepPtr->elements[i];
4042     Tcl_IncrRefCount(objv[i]);
4043       }
4044       result = Tcl_EvalObjv(interp, objc, objv, flags);
4045       for (i=0; i < objc; i++) {
4046     TclDecrRefCount(objv[i]);
4047       }
4048       if (objv != staticObjv) {
4049     ckfree((char *) objv);
4050       }
4051   } else {
4052       script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
4053       result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
4054   }
4055     } else {
4056   /*
4057    * Let the compiler/engine subsystem do the evaluation.
4058    */
4059 
4060   savedVarFramePtr = iPtr->varFramePtr;
4061   if (flags & TCL_EVAL_GLOBAL) {
4062       iPtr->varFramePtr = NULL;
4063   }
4064 
4065   result = TclCompEvalObj(interp, objPtr);
4066 
4067   /*
4068    * If we are again at the top level, process any unusual 
4069    * return code returned by the evaluated code. 
4070    */
4071   
4072   if (iPtr->numLevels == 0) {
4073       if (result == TCL_RETURN) {
4074     result = TclUpdateReturnInfo(iPtr);
4075       }
4076       if ((result != TCL_OK) && (result != TCL_ERROR) 
4077           && !allowExceptions) {
4078     ProcessUnexpectedResult(interp, result);
4079     result = TCL_ERROR;
4080 
4081     /*
4082      * If an error was created here, record information about 
4083      * what was being executed when the error occurred. Remove
4084      * the extra \n added by tclMain.c in the command sent to
4085      * Tcl_LogCommandInfo [Bug 833150].
4086      */
4087 
4088     if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
4089         script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
4090         Tcl_LogCommandInfo(interp, script, script, --numSrcBytes);
4091         iPtr->flags &= ~ERR_ALREADY_LOGGED;
4092     }
4093       }
4094   }
4095   iPtr->evalFlags = 0;
4096   iPtr->varFramePtr = savedVarFramePtr; 
4097     }
4098 
4099     TclDecrRefCount(objPtr);
4100     return result;
4101 }
int Tcl_EvalObjv (Tcl_Interp * interp, int objc, objv, int flags)

Definition at line 3174 of file tclBasic.c.
References Interp::evalFlags, Trace::level, Trace::nextPtr, Interp::numLevels, ProcessUnexpectedResult(), TCL_ALLOW_EXCEPTIONS, Tcl_DStringAppendElement(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringValue, TCL_ERROR, TCL_EVAL_INVOKE, Tcl_GetString(), Tcl_LogCommandInfo(), TCL_OK, TCL_RETURN, TclEvalObjvInternal(), TclUpdateReturnInfo(), and Interp::tracePtr.
Referenced by AliasObjCmd(), SortCompare(), Tcl_EvalObjEx(), and TestevalobjvObjCmd().3185 {
3186     Interp *iPtr = (Interp *)interp;
3187     Trace *tracePtr;
3188     Tcl_DString cmdBuf;
3189     char *cmdString = ""; /* A command string is only necessary for
3190          * command traces or error logs; it will be
3191          * generated to replace this default value if
3192          * necessary. */
3193     int cmdLen = 0;   /* a non-zero value indicates that a command
3194          * string was generated. */
3195     int code = TCL_OK;
3196     int i;
3197     int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
3198 
3199     for (tracePtr = iPtr->tracePtr; tracePtr; tracePtr = tracePtr->nextPtr) {
3200   if ((tracePtr->level == 0) || (iPtr->numLevels <= tracePtr->level)) {
3201       /*
3202        * The command may be needed for an execution trace.  Generate a
3203        * command string.
3204        */
3205       
3206       Tcl_DStringInit(&cmdBuf);
3207       for (i = 0; i < objc; i++) {
3208     Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i]));
3209       }
3210       cmdString = Tcl_DStringValue(&cmdBuf);
3211       cmdLen = Tcl_DStringLength(&cmdBuf);
3212       break;
3213   }
3214     }
3215 
3216     iPtr->numLevels++;
3217     code = TclEvalObjvInternal(interp, objc, objv, cmdString, cmdLen, flags);
3218     iPtr->numLevels--;
3219 
3220     /*
3221      * If we are again at the top level, process any unusual 
3222      * return code returned by the evaluated code. 
3223      */
3224   
3225     if (iPtr->numLevels == 0) {
3226   if (code == TCL_RETURN) {
3227       code = TclUpdateReturnInfo(iPtr);
3228   }
3229   if ((code != TCL_OK) && (code != TCL_ERROR) 
3230       && !allowExceptions) {
3231       ProcessUnexpectedResult(interp, code);
3232       code = TCL_ERROR;
3233   }
3234     }
3235       
3236     if ((code == TCL_ERROR) && !(flags & TCL_EVAL_INVOKE)) {
3237 
3238   /* 
3239    * If there was an error, a command string will be needed for the 
3240    * error log: generate it now if it was not done previously.
3241    */
3242 
3243   if (cmdLen == 0) {
3244       Tcl_DStringInit(&cmdBuf);
3245       for (i = 0; i < objc; i++) {
3246     Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i]));
3247       }
3248       cmdString = Tcl_DStringValue(&cmdBuf);
3249       cmdLen = Tcl_DStringLength(&cmdBuf);
3250   }
3251   Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
3252     }
3253 
3254     if (cmdLen != 0) {
3255   Tcl_DStringFree(&cmdBuf);
3256     }
3257     return code;
3258 }
Tcl_Obj* Tcl_EvalTokens (Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)

Definition at line 3554 of file tclBasic.c.
References Tcl_EvalTokensStandard(), Tcl_GetObjResult(), Tcl_IncrRefCount, TCL_OK, and Tcl_ResetResult().3562 {
3563     int code;
3564     Tcl_Obj *resPtr;
3565     
3566     code = Tcl_EvalTokensStandard(interp, tokenPtr, count);
3567     if (code == TCL_OK) {
3568   resPtr = Tcl_GetObjResult(interp);
3569   Tcl_IncrRefCount(resPtr);
3570   Tcl_ResetResult(interp);
3571   return resPtr;
3572     } else {
3573   return NULL;
3574     }
3575 }
int Tcl_EvalTokensStandard (Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)

Definition at line 3370 of file tclBasic.c.
References ckalloc, ckfree, CONST, MAX_VAR_CHARS, Tcl_Token::numComponents, panic, Tcl_Token::size, size_t(), Tcl_Token::start, Tcl_DecrRefCount, TCL_ERROR, Tcl_EvalEx(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetVar2Ex(), Tcl_IncrRefCount, TCL_LEAVE_ERR_MSG, TCL_OK, Tcl_ResetResult(), TCL_TOKEN_BS, TCL_TOKEN_COMMAND, TCL_TOKEN_TEXT, TCL_TOKEN_VARIABLE, TCL_UTF_MAX, Tcl_UtfBackslash(), TclInterpReady(), and Tcl_Token::type.
Referenced by Tcl_EvalEx(), Tcl_EvalTokens(), Tcl_ParseVar(), and Tcl_SubstObj().3378 {
3379     Tcl_Obj *resultPtr, *indexPtr, *valuePtr;
3380     char buffer[TCL_UTF_MAX];
3381 #ifdef TCL_MEM_DEBUG
3382 #   define  MAX_VAR_CHARS 5
3383 #else
3384 #   define  MAX_VAR_CHARS 30
3385 #endif
3386     char nameBuffer[MAX_VAR_CHARS+1];
3387     char *varName, *index;
3388     CONST char *p = NULL; /* Initialized to avoid compiler warning. */
3389     int length, code;
3390 
3391     /*
3392      * The only tricky thing about this procedure is that it attempts to
3393      * avoid object creation and string copying whenever possible.  For
3394      * example, if the value is just a nested command, then use the
3395      * command's result object directly.
3396      */
3397 
3398     code = TCL_OK;
3399     resultPtr = NULL;
3400     Tcl_ResetResult(interp);
3401     for ( ; count > 0; count--, tokenPtr++) {
3402   valuePtr = NULL;
3403 
3404   /*
3405    * The switch statement below computes the next value to be
3406    * concat to the result, as either a range of text or an
3407    * object.
3408    */
3409 
3410   switch (tokenPtr->type) {
3411       case TCL_TOKEN_TEXT:
3412     p = tokenPtr->start;
3413     length = tokenPtr->size;
3414     break;
3415 
3416       case TCL_TOKEN_BS:
3417     length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
3418       buffer);
3419     p = buffer;
3420     break;
3421 
3422       case TCL_TOKEN_COMMAND: {
3423     Interp *iPtr = (Interp *) interp;
3424     iPtr->numLevels++;
3425     code = TclInterpReady(interp);
3426     if (code == TCL_OK) {
3427         code = Tcl_EvalEx(interp,
3428           tokenPtr->start+1, tokenPtr->size-2, 0);
3429     }
3430     iPtr->numLevels--;
3431     if (code != TCL_OK) {
3432         goto done;
3433     }
3434     valuePtr = Tcl_GetObjResult(interp);
3435     break;
3436       }
3437 
3438       case TCL_TOKEN_VARIABLE:
3439     if (tokenPtr->numComponents == 1) {
3440         indexPtr = NULL;
3441         index = NULL;
3442     } else {
3443         code = Tcl_EvalTokensStandard(interp, tokenPtr+2,
3444           tokenPtr->numComponents - 1);
3445         if (code != TCL_OK) {
3446       goto done;
3447         }
3448         indexPtr = Tcl_GetObjResult(interp);
3449         Tcl_IncrRefCount(indexPtr);
3450         index = Tcl_GetString(indexPtr);
3451     }
3452 
3453     /*
3454      * We have to make a copy of the variable name in order
3455      * to have a null-terminated string.  We can't make a
3456      * temporary modification to the script to null-terminate
3457      * the name, because a trace callback might potentially
3458      * reuse the script and be affected by the null character.
3459      */
3460 
3461     if (tokenPtr[1].size <= MAX_VAR_CHARS) {
3462         varName = nameBuffer;
3463     } else {
3464         varName = ckalloc((unsigned) (tokenPtr[1].size + 1));
3465     }
3466     strncpy(varName, tokenPtr[1].start, (size_t) tokenPtr[1].size);
3467     varName[tokenPtr[1].size] = 0;
3468     valuePtr = Tcl_GetVar2Ex(interp, varName, index,
3469       TCL_LEAVE_ERR_MSG);
3470     if (varName != nameBuffer) {
3471         ckfree(varName);
3472     }
3473     if (indexPtr != NULL) {
3474         Tcl_DecrRefCount(indexPtr);
3475     }
3476     if (valuePtr == NULL) {
3477         code = TCL_ERROR;
3478         goto done;
3479     }
3480     count -= tokenPtr->numComponents;
3481     tokenPtr += tokenPtr->numComponents;
3482     break;
3483 
3484       default:
3485     panic("unexpected token type in Tcl_EvalTokensStandard");
3486   }
3487 
3488   /*
3489    * If valuePtr isn't NULL, the next piece of text comes from that
3490    * object; otherwise, take length bytes starting at p.
3491    */
3492 
3493   if (resultPtr == NULL) {
3494       if (valuePtr != NULL) {
3495     resultPtr = valuePtr;
3496       } else {
3497     resultPtr = Tcl_NewStringObj(p, length);
3498       }
3499       Tcl_IncrRefCount(resultPtr);
3500   } else {
3501       if (Tcl_IsShared(resultPtr)) {
3502     Tcl_DecrRefCount(resultPtr);
3503     resultPtr = Tcl_DuplicateObj(resultPtr);
3504     Tcl_IncrRefCount(resultPtr);
3505       }
3506       if (valuePtr != NULL) {
3507     p = Tcl_GetStringFromObj(valuePtr, &length);
3508       }
3509       Tcl_AppendToObj(resultPtr, p, length);
3510   }
3511     }
3512     if (resultPtr != NULL) {
3513   Tcl_SetObjResult(interp, resultPtr);
3514     } else {
3515   code = TCL_ERROR;
3516     }
3517 
3518     done:
3519     if (resultPtr != NULL) {
3520   Tcl_DecrRefCount(resultPtr);
3521     }
3522     return code;
3523 }
int Tcl_ExposeCommand (Tcl_Interp * interp, CONST char * hiddenCmdToken, CONST char * cmdName)

Definition at line 1296 of file tclBasic.c.
References Namespace::cmdTable, Interp::compileEpoch, DELETED, Interp::flags, Interp::globalNsPtr, Interp::hiddenCmdTablePtr, Command::hPtr, Command::nsPtr, NULL, strstr(), Tcl_CreateHashEntry, Tcl_DeleteHashEntry(), TCL_ERROR, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_GetObjResult(), TCL_OK, and Tcl_SetHashValue.
Referenced by SlaveExpose().1301 {
1302     Interp *iPtr = (Interp *) interp;
1303     Command *cmdPtr;
1304     Namespace *nsPtr;
1305     Tcl_HashEntry *hPtr;
1306     Tcl_HashTable *hiddenCmdTablePtr;
1307     int new;
1308 
1309     if (iPtr->flags & DELETED) {
1310         /*
1311          * The interpreter is being deleted. Do not create any new
1312          * structures, because it is not safe to modify the interpreter.
1313          */
1314         
1315         return TCL_ERROR;
1316     }
1317 
1318     /*
1319      * Check that we have a regular name for the command
1320      * (that the user is not trying to do an expose and a rename
1321      *  (to another namespace) at the same time)
1322      */
1323 
1324     if (strstr(cmdName, "::") != NULL) {
1325         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1326                 "can not expose to a namespace ",
1327     "(use expose to toplevel, then rename)",
1328                  (char *) NULL);
1329         return TCL_ERROR;
1330     }
1331 
1332     /*
1333      * Get the command from the hidden command table:
1334      */
1335 
1336     hPtr = NULL;
1337     hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
1338     if (hiddenCmdTablePtr != NULL) {
1339   hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken);
1340     }
1341     if (hPtr == (Tcl_HashEntry *) NULL) {
1342         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1343                 "unknown hidden command \"", hiddenCmdToken,
1344                 "\"", (char *) NULL);
1345         return TCL_ERROR;
1346     }
1347     cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
1348     
1349 
1350     /*
1351      * Check that we have a true global namespace
1352      * command (enforced by Tcl_HideCommand() but let's double
1353      * check. (If it was not, we would not really know how to
1354      * handle it).
1355      */
1356     if ( cmdPtr->nsPtr != iPtr->globalNsPtr ) {
1357   /* 
1358    * This case is theoritically impossible,
1359    * we might rather panic() than 'nicely' erroring out ?
1360    */
1361         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1362                 "trying to expose a non global command name space command",
1363     (char *) NULL);
1364         return TCL_ERROR;
1365     }
1366     
1367     /* This is the global table */
1368     nsPtr = cmdPtr->nsPtr;
1369 
1370     /*
1371      * It is an error to overwrite an existing exposed command as a result
1372      * of exposing a previously hidden command.
1373      */
1374 
1375     hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &new);
1376     if (!new) {
1377         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1378                 "exposed command \"", cmdName,
1379                 "\" already exists", (char *) NULL);
1380         return TCL_ERROR;
1381     }
1382 
1383     /*
1384      * Remove the hash entry for the command from the interpreter hidden
1385      * command table.
1386      */
1387 
1388     if (cmdPtr->hPtr != NULL) {
1389         Tcl_DeleteHashEntry(cmdPtr->hPtr);
1390         cmdPtr->hPtr = NULL;
1391     }
1392 
1393     /*
1394      * Now link the hash table entry with the command structure.
1395      * This is like creating a new command, so deal with any shadowing
1396      * of commands in the global namespace.
1397      */
1398     
1399     cmdPtr->hPtr = hPtr;
1400 
1401     Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
1402 
1403     /*
1404      * Not needed as we are only in the global namespace
1405      * (but would be needed again if we supported namespace command hiding)
1406      *
1407      * TclResetShadowedCmdRefs(interp, cmdPtr);
1408      */
1409 
1410 
1411     /*
1412      * If the command being exposed has a compile procedure, increment
1413      * interpreter's compileEpoch to invalidate its compiled code. This
1414      * makes sure that we don't later try to execute old code compiled
1415      * assuming the command is hidden. This field is checked in Tcl_EvalObj
1416      * and ObjInterpProc, and code whose compilation epoch doesn't match is
1417      * recompiled.
1418      */
1419 
1420     if (cmdPtr->compileProc != NULL) {
1421   iPtr->compileEpoch++;
1422     }
1423     return TCL_OK;
1424 }
int Tcl_ExprBoolean (Tcl_Interp * interp, CONST char * string, int * ptr)

Definition at line 4304 of file tclBasic.c.
References Tcl_DecrRefCount, Tcl_ExprObj(), Tcl_GetBooleanFromObj(), Tcl_GetObjResult(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_OK, Tcl_SetResult(), TCL_VOLATILE, tclDoubleType, TclGetString, tclIntType, and tclWideIntType.4309 {
4310     register Tcl_Obj *exprPtr;
4311     Tcl_Obj *resultPtr;
4312     int length = strlen(string);
4313     int result = TCL_OK;
4314 
4315     if (length > 0) {
4316   exprPtr = Tcl_NewStringObj(string, length);
4317   Tcl_IncrRefCount(exprPtr);
4318   result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
4319   if (result == TCL_OK) {
4320       /*
4321        * Store a boolean based on the expression result.
4322        */
4323 
4324       if (resultPtr->typePtr == &tclIntType) {
4325     *ptr = (resultPtr->internalRep.longValue != 0);
4326       } else if (resultPtr->typePtr == &tclDoubleType) {
4327     *ptr = (resultPtr->internalRep.doubleValue != 0.0);
4328       } else if (resultPtr->typePtr == &tclWideIntType) {
4329 #ifndef TCL_WIDE_INT_IS_LONG
4330     *ptr = (resultPtr->internalRep.wideValue != 0);
4331 #else
4332     *ptr = (resultPtr->internalRep.longValue != 0);
4333 #endif
4334       } else {
4335     result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
4336       }
4337       Tcl_DecrRefCount(resultPtr);  /* discard the result object */
4338   }
4339   if (result != TCL_OK) {
4340       /*
4341        * Move the interpreter's object result to the string result, 
4342        * then reset the object result.
4343        */
4344 
4345       Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
4346               TCL_VOLATILE);
4347   }
4348   Tcl_DecrRefCount(exprPtr); /* discard the expression object */
4349     } else {
4350   /*
4351    * An empty string. Just set the result boolean to 0 (false).
4352    */
4353   
4354   *ptr = 0;
4355     }
4356     return result;
4357 }
int Tcl_ExprBooleanObj (Tcl_Interp * interp, Tcl_Obj * objPtr, int * ptr)

Definition at line 4436 of file tclBasic.c.
References Tcl_DecrRefCount, Tcl_ExprObj(), Tcl_GetBooleanFromObj(), TCL_OK, tclDoubleType, and tclIntType.
Referenced by Tcl_ForObjCmd(), Tcl_IfObjCmd(), and Tcl_WhileObjCmd().4441 {
4442     Tcl_Obj *resultPtr;
4443     int result;
4444 
4445     result = Tcl_ExprObj(interp, objPtr, &resultPtr);
4446     if (result == TCL_OK) {
4447   if (resultPtr->typePtr == &tclIntType) {
4448       *ptr = (resultPtr->internalRep.longValue != 0);
4449   } else if (resultPtr->typePtr == &tclDoubleType) {
4450       *ptr = (resultPtr->internalRep.doubleValue != 0.0);
4451   } else {
4452       result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
4453   }
4454   Tcl_DecrRefCount(resultPtr);  /* discard the result object */
4455     }
4456     return result;
4457 }
int Tcl_ExprDouble (Tcl_Interp * interp, CONST char * string, double * ptr)

Definition at line 4235 of file tclBasic.c.
References Tcl_DecrRefCount, TCL_ERROR, Tcl_ExprObj(), Tcl_GetObjResult(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_OK, Tcl_SetResult(), TCL_STATIC, TCL_VOLATILE, Tcl_WideAsLong, tclDoubleType, TclGetString, tclIntType, and tclWideIntType.4240 {
4241     register Tcl_Obj *exprPtr;
4242     Tcl_Obj *resultPtr;
4243     int length = strlen(string);
4244     int result = TCL_OK;
4245 
4246     if (length > 0) {
4247   exprPtr = Tcl_NewStringObj(string, length);
4248   Tcl_IncrRefCount(exprPtr);
4249   result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
4250   if (result == TCL_OK) {
4251       /*
4252        * Store a double  based on the expression result.
4253        */
4254 
4255       if (resultPtr->typePtr == &tclIntType) {
4256     *ptr = (double) resultPtr->internalRep.longValue;
4257       } else if (resultPtr->typePtr == &tclDoubleType) {
4258     *ptr = resultPtr->internalRep.doubleValue;
4259       } else if (resultPtr->typePtr == &tclWideIntType) {
4260 #ifndef TCL_WIDE_INT_IS_LONG
4261     /*
4262      * See Tcl_GetIntFromObj for conversion comments.
4263      */
4264     Tcl_WideInt w = resultPtr->internalRep.wideValue;
4265     if ((w >= -(Tcl_WideInt)(ULONG_MAX))
4266       && (w <= (Tcl_WideInt)(ULONG_MAX))) {
4267         *ptr = (double) Tcl_WideAsLong(w);
4268     } else {
4269         Tcl_SetResult(interp,
4270           "integer value too large to represent as non-long integer",
4271           TCL_STATIC);
4272         result = TCL_ERROR;
4273     }
4274 #else
4275     *ptr = (double) resultPtr->internalRep.longValue;
4276 #endif
4277       } else {
4278     Tcl_SetResult(interp,
4279             "expression didn't have numeric value", TCL_STATIC);
4280     result = TCL_ERROR;
4281       }
4282       Tcl_DecrRefCount(resultPtr);  /* discard the result object */
4283   } else {
4284       /*
4285        * Move the interpreter's object result to the string result, 
4286        * then reset the object result.
4287        */
4288 
4289       Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
4290               TCL_VOLATILE);
4291   }
4292   Tcl_DecrRefCount(exprPtr);  /* discard the expression object */
4293     } else {
4294   /*
4295    * An empty string. Just set the result double to 0.0.
4296    */
4297   
4298   *ptr = 0.0;
4299     }
4300     return result;
4301 }
int Tcl_ExprDoubleObj (Tcl_Interp * interp, Tcl_Obj * objPtr, double * ptr)

Definition at line 4409 of file tclBasic.c.
References Tcl_DecrRefCount, Tcl_ExprObj(), Tcl_GetDoubleFromObj(), TCL_OK, tclDoubleType, and tclIntType.4414 {
4415     Tcl_Obj *resultPtr;
4416     int result;
4417 
4418     result = Tcl_ExprObj(interp, objPtr, &resultPtr);
4419     if (result == TCL_OK) {
4420   if (resultPtr->typePtr == &tclIntType) {
4421       *ptr = (double) resultPtr->internalRep.longValue;
4422   } else if (resultPtr->typePtr == &tclDoubleType) {
4423       *ptr = resultPtr->internalRep.doubleValue;
4424   } else {
4425       result = Tcl_GetDoubleFromObj(interp, resultPtr, ptr);
4426       if (result != TCL_OK) {
4427     return result;
4428       }
4429   }
4430   Tcl_DecrRefCount(resultPtr);  /* discard the result object */
4431     }
4432     return result;
4433 }
int Tcl_ExprLong (Tcl_Interp * interp, CONST char * string, long * ptr)

Definition at line 4166 of file tclBasic.c.
References Tcl_DecrRefCount, TCL_ERROR, Tcl_ExprObj(), Tcl_GetObjResult(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_OK, Tcl_SetResult(), TCL_STATIC, TCL_VOLATILE, Tcl_WideAsLong, tclDoubleType, TclGetString, tclIntType, and tclWideIntType.
Referenced by TestexprlongCmd().4171 {
4172     register Tcl_Obj *exprPtr;
4173     Tcl_Obj *resultPtr;
4174     int length = strlen(string);
4175     int result = TCL_OK;
4176 
4177     if (length > 0) {
4178   exprPtr = Tcl_NewStringObj(string, length);
4179   Tcl_IncrRefCount(exprPtr);
4180   result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
4181   if (result == TCL_OK) {
4182       /*
4183        * Store an integer based on the expression result.
4184        */
4185 
4186       if (resultPtr->typePtr == &tclIntType) {
4187     *ptr = resultPtr->internalRep.longValue;
4188       } else if (resultPtr->typePtr == &tclDoubleType) {
4189     *ptr = (long) resultPtr->internalRep.doubleValue;
4190       } else if (resultPtr->typePtr == &tclWideIntType) {
4191 #ifndef TCL_WIDE_INT_IS_LONG
4192     /*
4193      * See Tcl_GetIntFromObj for conversion comments.
4194      */
4195     Tcl_WideInt w = resultPtr->internalRep.wideValue;
4196     if ((w >= -(Tcl_WideInt)(ULONG_MAX))
4197       && (w <= (Tcl_WideInt)(ULONG_MAX))) {
4198         *ptr = Tcl_WideAsLong(w);
4199     } else {
4200         Tcl_SetResult(interp,
4201           "integer value too large to represent as non-long integer",
4202           TCL_STATIC);
4203         result = TCL_ERROR;
4204     }
4205 #else
4206     *ptr = resultPtr->internalRep.longValue;
4207 #endif
4208       } else {
4209     Tcl_SetResult(interp,
4210             "expression didn't have numeric value", TCL_STATIC);
4211     result = TCL_ERROR;
4212       }
4213       Tcl_DecrRefCount(resultPtr);  /* discard the result object */
4214   } else {
4215       /*
4216        * Move the interpreter's object result to the string result, 
4217        * then reset the object result.
4218        */
4219 
4220       Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
4221               TCL_VOLATILE);
4222   }
4223   Tcl_DecrRefCount(exprPtr);  /* discard the expression object */ 
4224     } else {
4225   /*
4226    * An empty string. Just set the result integer to 0.
4227    */
4228   
4229   *ptr = 0;
4230     }
4231     return result;
4232 }
int Tcl_ExprLongObj (Tcl_Interp * interp, Tcl_Obj * objPtr, long * ptr)

Definition at line 4382 of file tclBasic.c.
References Tcl_DecrRefCount, Tcl_ExprObj(), Tcl_GetLongFromObj(), TCL_OK, tclDoubleType, and tclIntType.4387 {
4388     Tcl_Obj *resultPtr;
4389     int result;
4390 
4391     result = Tcl_ExprObj(interp, objPtr, &resultPtr);
4392     if (result == TCL_OK) {
4393   if (resultPtr->typePtr == &tclIntType) {
4394       *ptr = resultPtr->internalRep.longValue;
4395   } else if (resultPtr->typePtr == &tclDoubleType) {
4396       *ptr = (long) resultPtr->internalRep.doubleValue;
4397   } else {
4398       result = Tcl_GetLongFromObj(interp, resultPtr, ptr);
4399       if (result != TCL_OK) {
4400     return result;
4401       }
4402   }
4403   Tcl_DecrRefCount(resultPtr);  /* discard the result object */
4404     }
4405     return result;
4406 }
int Tcl_ExprString (Tcl_Interp * interp, CONST char * string)

Definition at line 4842 of file tclBasic.c.
References Tcl_DecrRefCount, TCL_DOUBLE_SPACE, Tcl_ExprObj(), Tcl_GetObjResult(), Tcl_IncrRefCount, TCL_OK, Tcl_PrintDouble(), Tcl_SetResult(), TCL_VOLATILE, tclDoubleType, TclGetString, TclInitStringRep, tclIntType, and TclNewObj.
Referenced by TestexprstringCmd().4846 {
4847     register Tcl_Obj *exprPtr;
4848     Tcl_Obj *resultPtr;
4849     int length = strlen(string);
4850     char buf[TCL_DOUBLE_SPACE];
4851     int result = TCL_OK;
4852 
4853     if (length > 0) {
4854   TclNewObj(exprPtr);
4855   TclInitStringRep(exprPtr, string, length);
4856   Tcl_IncrRefCount(exprPtr);
4857 
4858   result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
4859   if (result == TCL_OK) {
4860       /*
4861        * Set the interpreter's string result from the result object.
4862        */
4863       
4864       if (resultPtr->typePtr == &tclIntType) {
4865     sprintf(buf, "%ld", resultPtr->internalRep.longValue);
4866     Tcl_SetResult(interp, buf, TCL_VOLATILE);
4867       } else if (resultPtr->typePtr == &tclDoubleType) {
4868     Tcl_PrintDouble((Tcl_Interp *) NULL,
4869             resultPtr->internalRep.doubleValue, buf);
4870     Tcl_SetResult(interp, buf, TCL_VOLATILE);
4871       } else {
4872     /*
4873      * Set interpreter's string result from the result object.
4874      */
4875       
4876     Tcl_SetResult(interp, TclGetString(resultPtr),
4877             TCL_VOLATILE);
4878       }
4879       Tcl_DecrRefCount(resultPtr);  /* discard the result object */
4880   } else {
4881       /*
4882        * Move the interpreter's object result to the string result, 
4883        * then reset the object result.
4884        */
4885       
4886       Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
4887               TCL_VOLATILE);
4888   }
4889   Tcl_DecrRefCount(exprPtr); /* discard the expression object */
4890     } else {
4891   /*
4892    * An empty string. Just set the interpreter's result to 0.
4893    */
4894   
4895   Tcl_SetResult(interp, "0", TCL_VOLATILE);
4896     }
4897     return result;
4898 }
ClientData Tcl_GetAssocData (Tcl_Interp * interp, CONST char * name, Tcl_InterpDeleteProc ** procPtr)

Definition at line 842 of file tclBasic.c.
References Interp::assocData, AssocData::clientData, NULL, AssocData::proc, Tcl_FindHashEntry, and Tcl_GetHashValue.
Referenced by DetachChannel(), GetChannelTable(), RegisterTcpServerInterpCleanup(), Tcl_AfterObjCmd(), Tcl_BackgroundError(), Tcl_IsChannelRegistered(), Tcl_LoadObjCmd(), Tcl_OSACmd(), Tcl_PkgRequireEx(), TclGetLoadedPackages(), tclOSAClose(), tclOSAMakeNewComponent(), TestChannelCmd(), TestgetassocdataCmd(), TestsetassocdataCmd(), and UnregisterTcpServerInterpCleanupProc().847 {
848     Interp *iPtr = (Interp *) interp;
849     AssocData *dPtr;
850     Tcl_HashEntry *hPtr;
851 
852     if (iPtr->assocData == (Tcl_HashTable *) NULL) {
853         return (ClientData) NULL;
854     }
855     hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
856     if (hPtr == (Tcl_HashEntry *) NULL) {
857         return (ClientData) NULL;
858     }
859     dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
860     if (procPtr != (Tcl_InterpDeleteProc **) NULL) {
861         *procPtr = dPtr->proc;
862     }
863     return dPtr->clientData;
864 }
void Tcl_GetCommandFullName (Tcl_Interp * interp, Tcl_Command command, Tcl_Obj * objPtr)

Definition at line 2316 of file tclBasic.c.
References Namespace::fullName, Interp::globalNsPtr, Command::hPtr, Command::nsPtr, Tcl_HashEntry::tablePtr, Tcl_AppendToObj(), and Tcl_GetHashKey.
Referenced by CallCommandTraces(), InfoCommandsCmd(), InfoProcsCmd(), NamespaceOriginCmd(), NamespaceWhichCmd(), TclRenameCommand(), and TestcmdtokenCmd().2324 {
2325     Interp *iPtr = (Interp *) interp;
2326     register Command *cmdPtr = (Command *) command;
2327     char *name;
2328 
2329     /*
2330      * Add the full name of the containing namespace, followed by the "::"
2331      * separator, and the command name.
2332      */
2333 
2334     if (cmdPtr != NULL) {
2335   if (cmdPtr->nsPtr != NULL) {
2336       Tcl_AppendToObj(objPtr, cmdPtr->nsPtr->fullName, -1);
2337       if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
2338     Tcl_AppendToObj(objPtr, "::", 2);
2339       }
2340   }
2341   if (cmdPtr->hPtr != NULL) {
2342       name = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
2343       Tcl_AppendToObj(objPtr, name, -1);
2344   } 
2345     }
2346 }
int Tcl_GetCommandInfo (Tcl_Interp * interp, CONST char * cmdName, Tcl_CmdInfo * infoPtr)

Definition at line 2189 of file tclBasic.c.
References Tcl_FindCommand(), and Tcl_GetCommandInfoFromToken().
Referenced by CreatedCommandProc(), CreatedCommandProc2(), Tcl_InterpObjCmd(), and TestcmdinfoCmd().2195 {
2196     Tcl_Command cmd;
2197 
2198     cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
2199             /*flags*/ 0);
2200 
2201     return Tcl_GetCommandInfoFromToken( cmd, infoPtr );
2202 
2203 }
int Tcl_GetCommandInfoFromToken (Tcl_Command cmd, Tcl_CmdInfo* infoPtr)

Definition at line 2224 of file tclBasic.c.
References Command::clientData, Tcl_CmdInfo::clientData, Command::deleteData, Tcl_CmdInfo::deleteData, Command::deleteProc, Tcl_CmdInfo::deleteProc, Tcl_CmdInfo::isNativeObjectProc, Tcl_CmdInfo::namespacePtr, Command::nsPtr, Command::objClientData, Tcl_CmdInfo::objClientData, Tcl_CmdInfo::objProc, Command::objProc, Command::proc, Tcl_CmdInfo::proc, and TclInvokeStringCommand().
Referenced by ProcCompileProc(), Tcl_ForgetImport(), and Tcl_GetCommandInfo().2227 {
2228 
2229     Command* cmdPtr;    /* Internal representation of the command */
2230 
2231     if ( cmd == (Tcl_Command) NULL ) {
2232   return 0;
2233     }
2234 
2235     /*
2236      * Set isNativeObjectProc 1 if objProc was registered by a call to
2237      * Tcl_CreateObjCommand. Otherwise set it to 0.
2238      */
2239 
2240     cmdPtr = (Command *) cmd;
2241     infoPtr->isNativeObjectProc =
2242       (cmdPtr->objProc != TclInvokeStringCommand);
2243     infoPtr->objProc = cmdPtr->objProc;
2244     infoPtr->objClientData = cmdPtr->objClientData;
2245     infoPtr->proc = cmdPtr->proc;
2246     infoPtr->clientData = cmdPtr->clientData;
2247     infoPtr->deleteProc = cmdPtr->deleteProc;
2248     infoPtr->deleteData = cmdPtr->deleteData;
2249     infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr;
2250 
2251     return 1;
2252 
2253 }
CONST char* Tcl_GetCommandName (Tcl_Interp * interp, Tcl_Command command)

Definition at line 2274 of file tclBasic.c.
References Command::hPtr, Tcl_HashEntry::tablePtr, and Tcl_GetHashKey.
Referenced by Tcl_ForgetImport(), and TestcmdtokenCmd().2279 {
2280     Command *cmdPtr = (Command *) command;
2281 
2282     if ((cmdPtr == NULL) || (cmdPtr->hPtr == NULL)) {
2283 
2284   /*
2285    * This should only happen if command was "created" after the
2286    * interpreter began to be deleted, so there isn't really any
2287    * command. Just return an empty string.
2288    */
2289 
2290   return "";
2291     }
2292     return Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
2293 }
int Tcl_GetMathFuncInfo (Tcl_Interp * interp, CONST char * name, int * numArgsPtr, Tcl_ValueType ** argTypesPtr, Tcl_MathProc ** procPtr, ClientData * clientDataPtr)

Definition at line 2797 of file tclBasic.c.
References MathFunc::argTypes, MathFunc::builtinFuncIndex, ckalloc, Interp::mathFuncTable, MathFunc::numArgs, TCL_ERROR, Tcl_FindHashEntry, Tcl_GetHashValue, and Tcl_GetObjResult().2805 {
2806     Interp *iPtr = (Interp *) interp;
2807     Tcl_HashEntry *hPtr;
2808     MathFunc *mathFuncPtr;
2809     Tcl_ValueType *argTypes;
2810     int i,numArgs;
2811 
2812     hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, name);
2813     if (hPtr == NULL) {
2814         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
2815                 "math function \"", name, "\" not known in this interpreter",
2816     (char *) NULL);
2817   return TCL_ERROR;
2818     }
2819     mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
2820 
2821     *numArgsPtr = numArgs = mathFuncPtr->numArgs;
2822     if (numArgs == 0) {
2823   /* Avoid doing zero-sized allocs... */
2824   numArgs = 1;
2825     }
2826     *argTypesPtr = argTypes =
2827   (Tcl_ValueType *)ckalloc(numArgs * sizeof(Tcl_ValueType));
2828     for (i = 0; i < mathFuncPtr->numArgs; i++) {
2829   argTypes[i] = mathFuncPtr->argTypes[i];
2830     }
2831 
2832     if (mathFuncPtr->builtinFuncIndex == -1) {
2833   *procPtr = (Tcl_MathProc *) NULL;
2834     } else {
2835   *procPtr = mathFuncPtr->proc;
2836   *clientDataPtr = mathFuncPtr->clientData;
2837     }
2838 
2839     return TCL_OK;
2840 }
void Tcl_GetVersion (int * majorV, int * minorV, int * patchLevelV, int * type)

Definition at line 5549 of file tclBasic.c.
References TCL_MAJOR_VERSION, TCL_MINOR_VERSION, TCL_RELEASE_LEVEL, and TCL_RELEASE_SERIAL.5554 {
5555     if (majorV != NULL) {
5556         *majorV = TCL_MAJOR_VERSION;
5557     }
5558     if (minorV != NULL) {
5559         *minorV = TCL_MINOR_VERSION;
5560     }
5561     if (patchLevelV != NULL) {
5562         *patchLevelV = TCL_RELEASE_SERIAL;
5563     }
5564     if (type != NULL) {
5565         *type = TCL_RELEASE_LEVEL;
5566     }
5567 }
int Tcl_GlobalEval (Tcl_Interp * interp, CONST char * command)

Definition at line 5452 of file tclBasic.c.
References Tcl_Eval(), and Interp::varFramePtr.
Referenced by EncodingFromUtfProc(), EncodingToUtfProc(), and TestfeventCmd().5455 {
5456     register Interp *iPtr = (Interp *) interp;
5457     int result;
5458     CallFrame *savedVarFramePtr;
5459 
5460     savedVarFramePtr = iPtr->varFramePtr;
5461     iPtr->varFramePtr = NULL;
5462     result = Tcl_Eval(interp, command);
5463     iPtr->varFramePtr = savedVarFramePtr;
5464     return result;
5465 }
int Tcl_GlobalEvalObj (Tcl_Interp * interp, Tcl_Obj * objPtr)

Definition at line 3951 of file tclBasic.c.
References TCL_EVAL_GLOBAL, and Tcl_EvalObjEx().3954 {
3955     return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
3956 }
int Tcl_HideCommand (Tcl_Interp * interp, CONST char * cmdName, CONST char * hiddenCmdToken)

Definition at line 1134 of file tclBasic.c.
References ckalloc, Command::cmdEpoch, Interp::compileEpoch, DELETED, Interp::flags, Interp::globalNsPtr, Interp::hiddenCmdTablePtr, Command::hPtr, Command::nsPtr, NULL, strstr(), Tcl_CreateHashEntry, Tcl_DeleteHashEntry(), TCL_ERROR, Tcl_FindCommand(), Tcl_GetObjResult(), TCL_GLOBAL_ONLY, Tcl_InitHashTable(), TCL_LEAVE_ERR_MSG, TCL_OK, Tcl_SetHashValue, and TCL_STRING_KEYS.
Referenced by DdeSetServerName(), SlaveHide(), and TclHideUnsafeCommands().1138 {
1139     Interp *iPtr = (Interp *) interp;
1140     Tcl_Command cmd;
1141     Command *cmdPtr;
1142     Tcl_HashTable *hiddenCmdTablePtr;
1143     Tcl_HashEntry *hPtr;
1144     int new;
1145 
1146     if (iPtr->flags & DELETED) {
1147 
1148         /*
1149          * The interpreter is being deleted. Do not create any new
1150          * structures, because it is not safe to modify the interpreter.
1151          */
1152         
1153         return TCL_ERROR;
1154     }
1155 
1156     /*
1157      * Disallow hiding of commands that are currently in a namespace or
1158      * renaming (as part of hiding) into a namespace.
1159      *
1160      * (because the current implementation with a single global table
1161      *  and the needed uniqueness of names cause problems with namespaces)
1162      *
1163      * we don't need to check for "::" in cmdName because the real check is
1164      * on the nsPtr below.
1165      *
1166      * hiddenCmdToken is just a string which is not interpreted in any way.
1167      * It may contain :: but the string is not interpreted as a namespace
1168      * qualifier command name. Thus, hiding foo::bar to foo::bar and then
1169      * trying to expose or invoke ::foo::bar will NOT work; but if the
1170      * application always uses the same strings it will get consistent
1171      * behaviour.
1172      *
1173      * But as we currently limit ourselves to the global namespace only
1174      * for the source, in order to avoid potential confusion,
1175      * lets prevent "::" in the token too.  --dl
1176      */
1177 
1178     if (strstr(hiddenCmdToken, "::") != NULL) {
1179         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1180                 "cannot use namespace qualifiers in hidden command",
1181     " token (rename)", (char *) NULL);
1182         return TCL_ERROR;
1183     }
1184 
1185     /*
1186      * Find the command to hide. An error is returned if cmdName can't
1187      * be found. Look up the command only from the global namespace.
1188      * Full path of the command must be given if using namespaces.
1189      */
1190 
1191     cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
1192       /*flags*/ TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY);
1193     if (cmd == (Tcl_Command) NULL) {
1194   return TCL_ERROR;
1195     }
1196     cmdPtr = (Command *) cmd;
1197 
1198     /*
1199      * Check that the command is really in global namespace
1200      */
1201 
1202     if ( cmdPtr->nsPtr != iPtr->globalNsPtr ) {
1203         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1204                 "can only hide global namespace commands",
1205     " (use rename then hide)", (char *) NULL);
1206         return TCL_ERROR;
1207     }
1208     
1209     /*
1210      * Initialize the hidden command table if necessary.
1211      */
1212 
1213     hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
1214     if (hiddenCmdTablePtr == NULL) {
1215         hiddenCmdTablePtr = (Tcl_HashTable *)
1216           ckalloc((unsigned) sizeof(Tcl_HashTable));
1217         Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS);
1218   iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr;
1219     }
1220 
1221     /*
1222      * It is an error to move an exposed command to a hidden command with
1223      * hiddenCmdToken if a hidden command with the name hiddenCmdToken already
1224      * exists.
1225      */
1226     
1227     hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &new);
1228     if (!new) {
1229         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1230                 "hidden command named \"", hiddenCmdToken, "\" already exists",
1231                 (char *) NULL);
1232         return TCL_ERROR;
1233     }
1234 
1235     /*
1236      * Nb : This code is currently 'like' a rename to a specialy set apart
1237      * name table. Changes here and in TclRenameCommand must
1238      * be kept in synch untill the common parts are actually
1239      * factorized out.
1240      */
1241 
1242     /*
1243      * Remove the hash entry for the command from the interpreter command
1244      * table. This is like deleting the command, so bump its command epoch;
1245      * this invalidates any cached references that point to the command.
1246      */
1247 
1248     if (cmdPtr->hPtr != NULL) {
1249         Tcl_DeleteHashEntry(cmdPtr->hPtr);
1250         cmdPtr->hPtr = (Tcl_HashEntry *) NULL;
1251   cmdPtr->cmdEpoch++;
1252     }
1253 
1254     /*
1255      * Now link the hash table entry with the command structure.
1256      * We ensured above that the nsPtr was right.
1257      */
1258     
1259     cmdPtr->hPtr = hPtr;
1260     Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
1261 
1262     /*
1263      * If the command being hidden has a compile procedure, increment the
1264      * interpreter's compileEpoch to invalidate its compiled code. This
1265      * makes sure that we don't later try to execute old code compiled with
1266      * command-specific (i.e., inline) bytecodes for the now-hidden
1267      * command. This field is checked in Tcl_EvalObj and ObjInterpProc,
1268      * and code whose compilation epoch doesn't match is recompiled.
1269      */
1270 
1271     if (cmdPtr->compileProc != NULL) {
1272   iPtr->compileEpoch++;
1273     }
1274     return TCL_OK;
1275 }
int Tcl_InterpDeleted (Tcl_Interp * interp)

Definition at line 884 of file tclBasic.c.
References DELETED.
Referenced by Prompt(), Tcl_Main(), TclDeleteNamespaceVars(), TclDeleteVars(), and TclPreventAliasLoop().886 {
887     return (((Interp *) interp)->flags & DELETED) ? 1 : 0;
888 }
Tcl_Obj* Tcl_ListMathFuncs (Tcl_Interp * interp, CONST char * pattern)

Definition at line 2862 of file tclBasic.c.
References CONST, Interp::mathFuncTable, Tcl_DecrRefCount, Tcl_FirstHashEntry(), Tcl_GetHashKey, Tcl_ListObjAppendElement(), Tcl_NewObj(), Tcl_NewStringObj(), Tcl_NextHashEntry(), TCL_OK, and Tcl_StringMatch().
Referenced by InfoFunctionsCmd().2865 {
2866     Interp *iPtr = (Interp *) interp;
2867     Tcl_Obj *resultList = Tcl_NewObj();
2868     register Tcl_HashEntry *hPtr;
2869     Tcl_HashSearch hSearch;
2870     CONST char *name;
2871 
2872     for (hPtr = Tcl_FirstHashEntry(&iPtr->mathFuncTable, &hSearch);
2873    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
2874         name = Tcl_GetHashKey(&iPtr->mathFuncTable, hPtr);
2875   if ((pattern == NULL || Tcl_StringMatch(name, pattern)) &&
2876       /* I don't expect this to fail, but... */
2877       Tcl_ListObjAppendElement(interp, resultList,
2878              Tcl_NewStringObj(name,-1)) != TCL_OK) {
2879       Tcl_DecrRefCount(resultList);
2880       return NULL;
2881   }
2882     }
2883     return resultList;
2884 }
void Tcl_LogCommandInfo (Tcl_Interp * interp, CONST char * script, CONST char * command, int length)

Definition at line 3283 of file tclBasic.c.
References CONST, ERR_ALREADY_LOGGED, ERR_IN_PROGRESS, Interp::errorLine, and Interp::flags.
Referenced by Tcl_EvalEx(), Tcl_EvalObjEx(), Tcl_EvalObjv(), TclCompEvalObj(), and TclExecuteByteCode().3291 {
3292     char buffer[200];
3293     register CONST char *p;
3294     char *ellipsis = "";
3295     Interp *iPtr = (Interp *) interp;
3296 
3297     if (iPtr->flags & ERR_ALREADY_LOGGED) {
3298   /*
3299    * Someone else has already logged error information for this
3300    * command; we shouldn't add anything more.
3301    */
3302 
3303   return;
3304     }
3305 
3306     /*
3307      * Compute the line number where the error occurred.
3308      */
3309 
3310     iPtr->errorLine = 1;
3311     for (p = script; p != command; p++) {
3312   if (*p == '\n') {
3313       iPtr->errorLine++;
3314   }
3315     }
3316 
3317     /*
3318      * Create an error message to add to errorInfo, including up to a
3319      * maximum number of characters of the command.
3320      */
3321 
3322     if (length < 0) {
3323   length = strlen(command);
3324     }
3325     if (length > 150) {
3326   length = 150;
3327   ellipsis = "...";
3328     }
3329     while ( (command[length] & 0xC0) == 0x80 ) {
3330   /*
3331    * Back up truncation point so that we don't truncate in the
3332    * middle of a multi-byte character (in UTF-8)
3333    */
3334   length--;
3335   ellipsis = "...";
3336     }
3337     if (!(iPtr->flags & ERR_IN_PROGRESS)) {
3338   sprintf(buffer, "\n    while executing\n\"%.*s%s\"",
3339     length, command, ellipsis);
3340     } else {
3341   sprintf(buffer, "\n    invoked from within\n\"%.*s%s\"",
3342     length, command, ellipsis);
3343     }
3344     Tcl_AddObjErrorInfo(interp, buffer, -1);
3345     iPtr->flags &= ~ERR_ALREADY_LOGGED;
3346 }
void Tcl_SetAssocData (Tcl_Interp * interp, CONST char * name, Tcl_InterpDeleteProc * proc, ClientData clientData)

Definition at line 754 of file tclBasic.c.
References Interp::assocData, ckalloc, AssocData::clientData, AssocData::proc, Tcl_CreateHashEntry, Tcl_GetHashValue, Tcl_InitHashTable(), Tcl_SetHashValue, and TCL_STRING_KEYS.
Referenced by GetChannelTable(), RegisterTcpServerInterpCleanup(), Tcl_AfterObjCmd(), Tcl_BackgroundError(), Tcl_PkgRequireEx(), Tclapplescript_Init(), and TestsetassocdataCmd().760 {
761     Interp *iPtr = (Interp *) interp;
762     AssocData *dPtr;
763     Tcl_HashEntry *hPtr;
764     int new;
765 
766     if (iPtr->assocData == (Tcl_HashTable *) NULL) {
767         iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
768         Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
769     }
770     hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &new);
771     if (new == 0) {
772         dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
773     } else {
774         dPtr = (AssocData *) ckalloc(sizeof(AssocData));
775     }
776     dPtr->proc = proc;
777     dPtr->clientData = clientData;
778 
779     Tcl_SetHashValue(hPtr, dPtr);
780 }
int Tcl_SetCommandInfo (Tcl_Interp * interp, CONST char * cmdName, CONST Tcl_CmdInfo * infoPtr)

Definition at line 2101 of file tclBasic.c.
References Tcl_FindCommand(), and Tcl_SetCommandInfoFromToken().
Referenced by TestcmdinfoCmd().2107 {
2108     Tcl_Command cmd;
2109 
2110     cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
2111             /*flags*/ 0);
2112 
2113     return Tcl_SetCommandInfoFromToken( cmd, infoPtr );
2114 
2115 }
int Tcl_SetCommandInfoFromToken (Tcl_Command cmd, CONST Tcl_CmdInfo* infoPtr)

Definition at line 2140 of file tclBasic.c.
References Command::clientData, Command::deleteData, Command::deleteProc, Command::objClientData, Command::objProc, Command::proc, and TclInvokeStringCommand().
Referenced by ProcCompileProc(), and Tcl_SetCommandInfo().2143 {
2144     Command* cmdPtr;    /* Internal representation of the command */
2145 
2146     if (cmd == (Tcl_Command) NULL) {
2147   return 0;
2148     }
2149 
2150     /*
2151      * The isNativeObjectProc and nsPtr members of *infoPtr are ignored.
2152      */
2153     
2154     cmdPtr = (Command *) cmd;
2155     cmdPtr->proc = infoPtr->proc;
2156     cmdPtr->clientData = infoPtr->clientData;
2157     if (infoPtr->objProc == (Tcl_ObjCmdProc *) NULL) {
2158   cmdPtr->objProc = TclInvokeStringCommand;
2159   cmdPtr->objClientData = (ClientData) cmdPtr;
2160     } else {
2161   cmdPtr->objProc = infoPtr->objProc;
2162   cmdPtr->objClientData = infoPtr->objClientData;
2163     }
2164     cmdPtr->deleteProc = infoPtr->deleteProc;
2165     cmdPtr->deleteData = infoPtr->deleteData;
2166     return 1;
2167 }
int Tcl_SetRecursionLimit (Tcl_Interp * interp, int depth)

Definition at line 5485 of file tclBasic.c.
References Interp::maxNestingDepth.
Referenced by SlaveRecursionLimit().5489 {
5490     Interp *iPtr = (Interp *) interp;
5491     int old;
5492 
5493     old = iPtr->maxNestingDepth;
5494     if (depth > 0) {
5495   iPtr->maxNestingDepth = depth;
5496     }
5497     return old;
5498 }
void Tcl_SetErrorCode TCL_VARARGS_DEF (Tcl_Interp *, arg1)

Definition at line 5418 of file tclBasic.c.
References TCL_VARARGS_START, and Tcl_VarEvalVA().5419 {
5420     Tcl_Interp *interp;
5421     va_list argList;
5422     int result;
5423 
5424     interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
5425     result = Tcl_VarEvalVA(interp, argList);
5426     va_end(argList);
5427 
5428     return result;
5429 }
int Tcl_VarEvalVA (Tcl_Interp * interp, va_list argList)

Definition at line 5370 of file tclBasic.c.
References Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, and Tcl_Eval().
Referenced by TCL_VARARGS_DEF().5373 {
5374     Tcl_DString buf;
5375     char *string;
5376     int result;
5377 
5378     /*
5379      * Copy the strings one after the other into a single larger
5380      * string.  Use stack-allocated space for small commands, but if
5381      * the command gets too large than call ckalloc to create the
5382      * space.
5383      */
5384 
5385     Tcl_DStringInit(&buf);
5386     while (1) {
5387   string = va_arg(argList, char *);
5388   if (string == NULL) {
5389       break;
5390   }
5391   Tcl_DStringAppend(&buf, string, -1);
5392     }
5393 
5394     result = Tcl_Eval(interp, Tcl_DStringValue(&buf));
5395     Tcl_DStringFree(&buf);
5396     return result;
5397 }
void TclCleanupCommand (Command * cmdPtr)

Definition at line 2677 of file tclBasic.c.
References ckfree.
Referenced by FreeCmdNameInternalRep(), Tcl_DeleteCommandFromToken(), TclEvalObjvInternal(), and TclRenameCommand().2680 {
2681     cmdPtr->refCount--;
2682     if (cmdPtr->refCount <= 0) {
2683   ckfree((char *) cmdPtr);
2684     }
2685 }
int TclEvalObjvInternal (Tcl_Interp * interp, int objc, objv, CONST char * command, int length, int flags)

Definition at line 2969 of file tclBasic.c.
References ckalloc, ckfree, CMD_HAS_EXEC_TRACES, CMD_IS_DELETED, Interp::cmdCount, Command::cmdEpoch, ERR_ALREADY_LOGGED, ERR_IN_PROGRESS, ERROR_CODE_SET, Interp::flags, Command::flags, Interp::globalNsPtr, CallFrame::nsPtr, Interp::numLevels, Command::objClientData, Command::objProc, Command::refCount, Interp::result, Tcl_AsyncInvoke(), Tcl_AsyncReady(), Tcl_DecrRefCount, TCL_ERROR, TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE, Tcl_GetCommandFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_OK, TCL_TRACE_ENTER_EXEC, TCL_TRACE_LEAVE_EXEC, TclCheckExecutionTraces(), TclCheckInterpTraces(), TclCleanupCommand(), TclInterpReady(), Interp::tracePtr, Interp::varFramePtr, and void().
Referenced by Tcl_EvalEx(), Tcl_EvalObjv(), and TclExecuteByteCode().2991 {
2992     Command *cmdPtr;
2993     Interp *iPtr = (Interp *) interp;
2994     Tcl_Obj **newObjv;
2995     int i;
2996     CallFrame *savedVarFramePtr;  /* Saves old copy of iPtr->varFramePtr
2997            * in case TCL_EVAL_GLOBAL was set. */
2998     int code = TCL_OK;
2999     int traceCode = TCL_OK;
3000     int checkTraces = 1;
3001     Namespace *savedNsPtr = NULL;
3002 
3003     if (TclInterpReady(interp) == TCL_ERROR) {
3004   return TCL_ERROR;
3005     }
3006 
3007     if (objc == 0) {
3008   return TCL_OK;
3009     }
3010 
3011     /* Configure evaluation context to match the requested flags */
3012     savedVarFramePtr = iPtr->varFramePtr;
3013     if (flags & TCL_EVAL_GLOBAL) {
3014   iPtr->varFramePtr = NULL;
3015     } else if ((flags & TCL_EVAL_INVOKE) && iPtr->varFramePtr) {
3016   savedNsPtr = iPtr->varFramePtr->nsPtr;
3017   iPtr->varFramePtr->nsPtr = iPtr->globalNsPtr;
3018     }
3019 
3020     /*
3021      * If any execution traces rename or delete the current command,
3022      * we may need (at most) two passes here.
3023      */
3024     while (1) {
3025     
3026         /*
3027          * Find the procedure to execute this command. If there isn't one,
3028          * then see if there is a command "unknown".  If so, create a new
3029          * word array with "unknown" as the first word and the original
3030          * command words as arguments.  Then call ourselves recursively
3031          * to execute it.
3032          */
3033         cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
3034         if (cmdPtr == NULL) {
3035       newObjv = (Tcl_Obj **) ckalloc((unsigned)
3036     ((objc + 1) * sizeof (Tcl_Obj *)));
3037       for (i = objc-1; i >= 0; i--) {
3038           newObjv[i+1] = objv[i];
3039       }
3040       newObjv[0] = Tcl_NewStringObj("::unknown", -1);
3041       Tcl_IncrRefCount(newObjv[0]);
3042       cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
3043       if (cmdPtr == NULL) {
3044           Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
3045         "invalid command name \"", Tcl_GetString(objv[0]), "\"",
3046         (char *) NULL);
3047           code = TCL_ERROR;
3048       } else {
3049           iPtr->numLevels++;
3050           code = TclEvalObjvInternal(interp, objc+1, newObjv,
3051       command, length, 0);
3052           iPtr->numLevels--;
3053       }
3054       Tcl_DecrRefCount(newObjv[0]);
3055       ckfree((char *) newObjv);
3056       if (savedNsPtr) {
3057     iPtr->varFramePtr->nsPtr = savedNsPtr;
3058       }
3059       goto done;
3060         }
3061   if (savedNsPtr) {
3062       iPtr->varFramePtr->nsPtr = savedNsPtr;
3063   }
3064     
3065         /*
3066          * Call trace procedures if needed.
3067          */
3068         if ((checkTraces) && (command != NULL)) {
3069             int cmdEpoch = cmdPtr->cmdEpoch;
3070             cmdPtr->refCount++;
3071             /* 
3072              * If the first set of traces modifies/deletes the command or
3073              * any existing traces, then the set checkTraces to 0 and
3074              * go through this while loop one more time.
3075              */
3076             if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
3077                 traceCode = TclCheckInterpTraces(interp, command, length,
3078                                cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
3079             }
3080             if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) 
3081         && (traceCode == TCL_OK)) {
3082                 traceCode = TclCheckExecutionTraces(interp, command, length,
3083                                cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
3084             }
3085             cmdPtr->refCount--;
3086             if (cmdEpoch != cmdPtr->cmdEpoch) {
3087                 /* The command has been modified in some way */
3088                 checkTraces = 0;
3089                 continue;
3090             }
3091         }
3092         break;
3093     }
3094 
3095     /*
3096      * Finally, invoke the command's Tcl_ObjCmdProc.
3097      */
3098     cmdPtr->refCount++;
3099     iPtr->cmdCount++;
3100     if ( code == TCL_OK && traceCode == TCL_OK) {
3101   code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
3102     }
3103     if (Tcl_AsyncReady()) {
3104   code = Tcl_AsyncInvoke(interp, code);
3105     }
3106 
3107     /*
3108      * Call 'leave' command traces
3109      */
3110     if (!(cmdPtr->flags & CMD_IS_DELETED)) {
3111   int saveErrFlags = iPtr->flags 
3112     & (ERR_IN_PROGRESS | ERR_ALREADY_LOGGED | ERROR_CODE_SET);
3113         if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
3114             traceCode = TclCheckExecutionTraces (interp, command, length,
3115                    cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
3116         }
3117         if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
3118             traceCode = TclCheckInterpTraces(interp, command, length,
3119                    cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
3120         }
3121   if (traceCode == TCL_OK) {
3122       iPtr->flags |= saveErrFlags;
3123   }
3124     }
3125     TclCleanupCommand(cmdPtr);
3126 
3127     /*
3128      * If one of the trace invocation resulted in error, then 
3129      * change the result code accordingly. Note, that the
3130      * interp->result should already be set correctly by the
3131      * call to TraceExecutionProc.  
3132      */
3133 
3134     if (traceCode != TCL_OK) {
3135   code = traceCode;
3136     }
3137     
3138     /*
3139      * If the interpreter has a non-empty string result, the result
3140      * object is either empty or stale because some procedure set
3141      * interp->result directly. If so, move the string result to the
3142      * result object, then reset the string result.
3143      */
3144     
3145     if (*(iPtr->result) != 0) {
3146   (void) Tcl_GetObjResult(interp);
3147     }
3148 
3149     done:
3150     iPtr->varFramePtr = savedVarFramePtr;
3151     return code;
3152 }
int TclGlobalInvoke (Tcl_Interp * interp, int argc, CONST char ** argv, int flags)

Definition at line 4576 of file tclBasic.c.
References TclInvoke(), and Interp::varFramePtr.
Referenced by HandleBgErrors().4582                : TCL_INVOKE_HIDDEN and
4583          * TCL_INVOKE_NO_UNKNOWN. */
4584 {
4585     register Interp *iPtr = (Interp *) interp;
4586     int result;
4587     CallFrame *savedVarFramePtr;
4588 
4589     savedVarFramePtr = iPtr->varFramePtr;
4590     iPtr->varFramePtr = NULL;
4591     result = TclInvoke(interp, argc, argv, flags);
4592     iPtr->varFramePtr = savedVarFramePtr;
4593     return result;
4594 }
int TclHideUnsafeCommands (Tcl_Interp * interp)

Definition at line 618 of file tclBasic.c.
References builtInCmds, CmdInfo::isSafe, CmdInfo::name, NULL, TCL_ERROR, and Tcl_HideCommand().
Referenced by Tcl_MakeSafe().620 {
621     register CmdInfo *cmdInfoPtr;
622 
623     if (interp == (Tcl_Interp *) NULL) {
624         return TCL_ERROR;
625     }
626     for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
627         if (!cmdInfoPtr->isSafe) {
628             Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
629         }
630     }
631     return TCL_OK;
632 }
int TclInterpReady (Tcl_Interp * interp)

Definition at line 2906 of file tclBasic.c.
References DELETED, Interp::flags, Interp::maxNestingDepth, Interp::numLevels, Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), TCL_OK, Tcl_ResetResult(), and TclpCheckStackSpace().
Referenced by Tcl_EvalTokensStandard(), Tcl_SubstObj(), TclCompEvalObj(), and TclEvalObjvInternal().2908 {
2909     register Interp *iPtr = (Interp *) interp;
2910 
2911     /*
2912      * Reset both the interpreter's string and object results and clear 
2913      * out any previous error information. 
2914      */
2915 
2916     Tcl_ResetResult(interp);
2917 
2918     /*
2919      * If the interpreter has been deleted, return an error.
2920      */
2921     
2922     if (iPtr->flags & DELETED) {
2923   Tcl_ResetResult(interp);
2924   Tcl_AppendToObj(Tcl_GetObjResult(interp),
2925           "attempt to call eval in deleted interpreter", -1);
2926   Tcl_SetErrorCode(interp, "CORE", "IDELETE",
2927           "attempt to call eval in deleted interpreter",
2928     (char *) NULL);
2929   return TCL_ERROR;
2930     }
2931 
2932     /*
2933      * Check depth of nested calls to Tcl_Eval:  if this gets too large,
2934      * it's probably because of an infinite loop somewhere.
2935      */
2936 
2937     if (((iPtr->numLevels) > iPtr->maxNestingDepth) 
2938       || (TclpCheckStackSpace() == 0)) {
2939   Tcl_AppendToObj(Tcl_GetObjResult(interp),
2940     "too many nested evaluations (infinite loop?)", -1); 
2941   return TCL_ERROR;
2942     }
2943 
2944     return TCL_OK;
2945 }
int TclInvoke (Tcl_Interp * interp, int argc, CONST char ** argv, int flags)

Definition at line 4479 of file tclBasic.c.
References ckalloc, ckfree, NUM_ARGS, Tcl_DecrRefCount, Tcl_GetObjResult(), Tcl_IncrRefCount, Tcl_NewStringObj(), Tcl_SetResult(), TCL_VOLATILE, TclGetString, and TclObjInvoke().
Referenced by TclGlobalInvoke().4485                : TCL_INVOKE_HIDDEN and
4486          * TCL_INVOKE_NO_UNKNOWN. */
4487 {
4488     register Tcl_Obj *objPtr;
4489     register int i;
4490     int length, result;
4491 
4492     /*
4493      * This procedure generates an objv array for object arguments that hold
4494      * the argv strings. It starts out with stack-allocated space but uses
4495      * dynamically-allocated storage if needed.
4496      */
4497 
4498 #define NUM_ARGS 20
4499     Tcl_Obj *(objStorage[NUM_ARGS]);
4500     register Tcl_Obj **objv = objStorage;
4501 
4502     /*
4503      * Create the object argument array "objv". Make sure objv is large
4504      * enough to hold the objc arguments plus 1 extra for the zero
4505      * end-of-objv word.
4506      */
4507 
4508     if ((argc + 1) > NUM_ARGS) {
4509   objv = (Tcl_Obj **)
4510       ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *));
4511     }
4512 
4513     for (i = 0;  i < argc;  i++) {
4514   length = strlen(argv[i]);
4515   objv[i] = Tcl_NewStringObj(argv[i], length);
4516   Tcl_IncrRefCount(objv[i]);
4517     }
4518     objv[argc] = 0;
4519 
4520     /*
4521      * Use TclObjInterpProc to actually invoke the command.
4522      */
4523 
4524     result = TclObjInvoke(interp, argc, objv, flags);
4525 
4526     /*
4527      * Move the interpreter's object result to the string result, 
4528      * then reset the object result.
4529      */
4530     
4531     Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
4532       TCL_VOLATILE);
4533 
4534     /*
4535      * Decrement the ref counts on the objv elements since we are done
4536      * with them.
4537      */
4538 
4539     for (i = 0;  i < argc;  i++) {
4540   objPtr = objv[i];
4541   Tcl_DecrRefCount(objPtr);
4542     }
4543     
4544     /*
4545      * Free the objv array if malloc'ed storage was used.
4546      */
4547 
4548     if (objv != objStorage) {
4549   ckfree((char *) objv);
4550     }
4551     return result;
4552 #undef NUM_ARGS
4553 }
int TclInvokeObjectCommand (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv)

Definition at line 1824 of file tclBasic.c.
References ckalloc, ckfree, NUM_ARGS, Command::objClientData, Command::objProc, Tcl_DecrRefCount, Tcl_GetObjResult(), Tcl_IncrRefCount, Tcl_SetResult(), TCL_VOLATILE, TclGetString, TclInitStringRep, and TclNewObj.
Referenced by Tcl_CreateInterp(), and Tcl_CreateObjCommand().1829 {
1830     Command *cmdPtr = (Command *) clientData;
1831     register Tcl_Obj *objPtr;
1832     register int i;
1833     int length, result;
1834 
1835     /*
1836      * This procedure generates an objv array for object arguments that hold
1837      * the argv strings. It starts out with stack-allocated space but uses
1838      * dynamically-allocated storage if needed.
1839      */
1840 
1841 #define NUM_ARGS 20
1842     Tcl_Obj *(argStorage[NUM_ARGS]);
1843     register Tcl_Obj **objv = argStorage;
1844 
1845     /*
1846      * Create the object argument array "objv". Make sure objv is large
1847      * enough to hold the objc arguments plus 1 extra for the zero
1848      * end-of-objv word.
1849      */
1850 
1851     if (argc > NUM_ARGS) {
1852   objv = (Tcl_Obj **)
1853       ckalloc((unsigned)(argc * sizeof(Tcl_Obj *)));
1854     }
1855 
1856     for (i = 0;  i < argc;  i++) {
1857   length = strlen(argv[i]);
1858   TclNewObj(objPtr);
1859   TclInitStringRep(objPtr, argv[i], length);
1860   Tcl_IncrRefCount(objPtr);
1861   objv[i] = objPtr;
1862     }
1863 
1864     /*
1865      * Invoke the command's object-based Tcl_ObjCmdProc.
1866      */
1867 
1868     result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, argc, objv);
1869 
1870     /*
1871      * Move the interpreter's object result to the string result, 
1872      * then reset the object result.
1873      */
1874 
1875     Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
1876       TCL_VOLATILE);
1877     
1878     /*
1879      * Decrement the ref counts for the argument objects created above,
1880      * then free the objv array if malloc'ed storage was used.
1881      */
1882 
1883     for (i = 0;  i < argc;  i++) {
1884   objPtr = objv[i];
1885   Tcl_DecrRefCount(objPtr);
1886     }
1887     if (objv != argStorage) {
1888   ckfree((char *) objv);
1889     }
1890     return result;
1891 #undef NUM_ARGS
1892 }
int TclInvokeStringCommand (ClientData clientData, Tcl_Interp * interp, int objc, objv)

Definition at line 1750 of file tclBasic.c.
References ckalloc, ckfree, Command::clientData, CONST, NUM_ARGS, Command::proc, and Tcl_GetString().
Referenced by Tcl_CreateCommand(), Tcl_CreateInterp(), Tcl_CreateObjCommand(), Tcl_GetCommandInfoFromToken(), and Tcl_SetCommandInfoFromToken().1755 {
1756     register Command *cmdPtr = (Command *) clientData;
1757     register int i;
1758     int result;
1759 
1760     /*
1761      * This procedure generates an argv array for the string arguments. It
1762      * starts out with stack-allocated space but uses dynamically-allocated
1763      * storage if needed.
1764      */
1765 
1766 #define NUM_ARGS 20
1767     CONST char *(argStorage[NUM_ARGS]);
1768     CONST char **argv = argStorage;
1769 
1770     /*
1771      * Create the string argument array "argv". Make sure argv is large
1772      * enough to hold the objc arguments plus 1 extra for the zero
1773      * end-of-argv word.
1774      */
1775 
1776     if ((objc + 1) > NUM_ARGS) {
1777   argv = (CONST char **) ckalloc((unsigned)(objc + 1) * sizeof(char *));
1778     }
1779 
1780     for (i = 0;  i < objc;  i++) {
1781   argv[i] = Tcl_GetString(objv[i]);
1782     }
1783     argv[objc] = 0;
1784 
1785     /*
1786      * Invoke the command's string-based Tcl_CmdProc.
1787      */
1788 
1789     result = (*cmdPtr->proc)(cmdPtr->clientData, interp, objc, argv);
1790 
1791     /*
1792      * Free the argv array if malloc'ed storage was used.
1793      */
1794 
1795     if (argv != argStorage) {
1796   ckfree((char *) argv);
1797     }
1798     return result;
1799 #undef NUM_ARGS
1800 }
int TclObjInvoke (Tcl_Interp * interp, int objc, objv, int flags)

Definition at line 4658 of file tclBasic.c.
References ckalloc, ckfree, Interp::cmdCount, CONST, ERR_ALREADY_LOGGED, ERR_IN_PROGRESS, Interp::flags, NULL, Command::objClientData, Command::objProc, Tcl_AddObjErrorInfo(), Tcl_AppendObjToObj(), Tcl_AppendToObj(), Tcl_DecrRefCount, TCL_ERROR, Tcl_FindCommand(), Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), TCL_GLOBAL_ONLY, Tcl_IncrRefCount, TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_TRACEBACK, TCL_INVOKE_NO_UNKNOWN, Tcl_NewStringObj(), Tcl_ResetResult(), and Tcl_SetObjLength().
Referenced by SlaveInvokeHidden(), TclInvoke(), and TclObjInvokeGlobal().4665                : TCL_INVOKE_HIDDEN,
4666          * TCL_INVOKE_NO_UNKNOWN, or
4667          * TCL_INVOKE_NO_TRACEBACK. */
4668 {
4669     register Interp *iPtr = (Interp *) interp;
4670     Tcl_HashTable *hTblPtr; /* Table of hidden commands. */
4671     char *cmdName;    /* Name of the command from objv[0]. */
4672     register Tcl_HashEntry *hPtr;
4673     Tcl_Command cmd;
4674     Command *cmdPtr;
4675     int localObjc;    /* Used to invoke "unknown" if the */
4676     Tcl_Obj **localObjv = NULL; /* command is not found. */
4677     register int i;
4678     int result;
4679 
4680     if (interp == (Tcl_Interp *) NULL) {
4681         return TCL_ERROR;
4682     }
4683 
4684     if ((objc < 1) || (objv == (Tcl_Obj **) NULL)) {
4685         Tcl_AppendToObj(Tcl_GetObjResult(interp),
4686           "illegal argument vector", -1);
4687         return TCL_ERROR;
4688     }
4689 
4690     cmdName = Tcl_GetString(objv[0]);
4691     if (flags & TCL_INVOKE_HIDDEN) {
4692         /*
4693          * We never invoke "unknown" for hidden commands.
4694          */
4695         
4696   hPtr = NULL;
4697         hTblPtr = ((Interp *) interp)->hiddenCmdTablePtr;
4698         if (hTblPtr != NULL) {
4699       hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
4700   }
4701   if (hPtr == NULL) {
4702       Tcl_ResetResult(interp);
4703       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
4704          "invalid hidden command name \"", cmdName, "\"",
4705          (char *) NULL);
4706             return TCL_ERROR;
4707         }
4708   cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
4709     } else {
4710   cmdPtr = NULL;
4711   cmd = Tcl_FindCommand(interp, cmdName,
4712           (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
4713         if (cmd != (Tcl_Command) NULL) {
4714       cmdPtr = (Command *) cmd;
4715         }
4716   if (cmdPtr == NULL) {
4717             if (!(flags & TCL_INVOKE_NO_UNKNOWN)) {
4718     cmd = Tcl_FindCommand(interp, "unknown",
4719                         (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
4720     if (cmd != (Tcl_Command) NULL) {
4721               cmdPtr = (Command *) cmd;
4722                 }
4723                 if (cmdPtr != NULL) {
4724                     localObjc = (objc + 1);
4725                     localObjv = (Tcl_Obj **)
4726       ckalloc((unsigned) (sizeof(Tcl_Obj *) * localObjc));
4727         localObjv[0] = Tcl_NewStringObj("unknown", -1);
4728         Tcl_IncrRefCount(localObjv[0]);
4729                     for (i = 0;  i < objc;  i++) {
4730                         localObjv[i+1] = objv[i];
4731                     }
4732                     objc = localObjc;
4733                     objv = localObjv;
4734                 }
4735             }
4736 
4737             /*
4738              * Check again if we found the command. If not, "unknown" is
4739              * not present and we cannot help, or the caller said not to
4740              * call "unknown" (they specified TCL_INVOKE_NO_UNKNOWN).
4741              */
4742 
4743             if (cmdPtr == NULL) {
4744     Tcl_ResetResult(interp);
4745     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
4746       "invalid command name \"",  cmdName, "\"", 
4747        (char *) NULL);
4748                 return TCL_ERROR;
4749             }
4750         }
4751     }
4752 
4753     /*
4754      * Invoke the command procedure. First reset the interpreter's string
4755      * and object results to their default empty values since they could
4756      * have gotten changed by earlier invocations.
4757      */
4758 
4759     Tcl_ResetResult(interp);
4760     iPtr->cmdCount++;
4761     result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
4762 
4763     /*
4764      * If an error occurred, record information about what was being
4765      * executed when the error occurred.
4766      */
4767 
4768     if ((result == TCL_ERROR)
4769       && ((flags & TCL_INVOKE_NO_TRACEBACK) == 0)
4770       && ((iPtr->flags & ERR_ALREADY_LOGGED) == 0)) {
4771   Tcl_Obj *msg;
4772         
4773         if (!(iPtr->flags & ERR_IN_PROGRESS)) {
4774             msg = Tcl_NewStringObj("\n    while invoking\n\"", -1);
4775         } else {
4776             msg = Tcl_NewStringObj("\n    invoked from within\n\"", -1);
4777         }
4778   Tcl_IncrRefCount(msg);
4779         for (i = 0;  i < objc;  i++) {
4780       CONST char *bytes;
4781       int length;
4782 
4783       Tcl_AppendObjToObj(msg, objv[i]);
4784       bytes = Tcl_GetStringFromObj(msg, &length);
4785       if (length > 100) {
4786     /*
4787      * Back up truncation point so that we don't truncate
4788      * in the middle of a multi-byte character.
4789      */
4790     length = 100;
4791     while ( (bytes[length] & 0xC0) == 0x80 ) {
4792         length--;
4793     }
4794     Tcl_SetObjLength(msg, length);
4795     Tcl_AppendToObj(msg, "...", -1);
4796     break;
4797       }
4798       if (i != (objc - 1)) {
4799     Tcl_AppendToObj(msg, " ", -1);
4800       }
4801         }
4802 
4803   Tcl_AppendToObj(msg, "\"", -1);
4804         Tcl_AddObjErrorInfo(interp, Tcl_GetString(msg), -1);
4805   Tcl_DecrRefCount(msg);
4806   iPtr->flags &= ~ERR_ALREADY_LOGGED;
4807     }
4808 
4809     /*
4810      * Free any locally allocated storage used to call "unknown".
4811      */
4812 
4813     if (localObjv != (Tcl_Obj **) NULL) {
4814   Tcl_DecrRefCount(localObjv[0]);
4815         ckfree((char *) localObjv);
4816     }
4817     return result;
4818 }
int TclObjInvokeGlobal (Tcl_Interp * interp, int objc, objv, int flags)

Definition at line 4618 of file tclBasic.c.
References TclObjInvoke(), and Interp::varFramePtr.
Referenced by SlaveInvokeHidden().4625                : TCL_INVOKE_HIDDEN,
4626          * TCL_INVOKE_NO_UNKNOWN, or
4627          * TCL_INVOKE_NO_TRACEBACK. */
4628 {
4629     register Interp *iPtr = (Interp *) interp;
4630     int result;
4631     CallFrame *savedVarFramePtr;
4632 
4633     savedVarFramePtr = iPtr->varFramePtr;
4634     iPtr->varFramePtr = NULL;
4635     result = TclObjInvoke(interp, objc, objv, flags);
4636     iPtr->varFramePtr = savedVarFramePtr;
4637     return result;
4638 }
int TclRenameCommand (Tcl_Interp * interp, char * oldName, char * newName)

Definition at line 1919 of file tclBasic.c.
References CallCommandTraces(), Namespace::cmdTable, Interp::compileEpoch, CONST, CREATE_NS_IF_UNKNOWN, Namespace::fullName, Interp::globalNsPtr, Command::hPtr, Command::nsPtr, NULL, Tcl_CreateHashEntry, Tcl_DeleteCommandFromToken(), Tcl_DeleteHashEntry(), Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, TCL_ERROR, Tcl_FindCommand(), Tcl_FindHashEntry, Tcl_GetCommandFullName(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_IncrRefCount, Tcl_NewObj(), TCL_OK, Tcl_SetHashValue, TCL_TRACE_RENAME, TclCleanupCommand(), TclDecrRefCount, TclGetNamespaceForQualName(), TclPreventAliasLoop(), and TclResetShadowedCmdRefs().
Referenced by Tcl_RenameObjCmd().1923 {
1924     Interp *iPtr = (Interp *) interp;
1925     CONST char *newTail;
1926     Namespace *cmdNsPtr, *newNsPtr, *dummy1, *dummy2;
1927     Tcl_Command cmd;
1928     Command *cmdPtr;
1929     Tcl_HashEntry *hPtr, *oldHPtr;
1930     int new, result;
1931     Tcl_Obj* oldFullName;
1932     Tcl_DString newFullName;
1933 
1934     /*
1935      * Find the existing command. An error is returned if cmdName can't
1936      * be found.
1937      */
1938 
1939     cmd = Tcl_FindCommand(interp, oldName, (Tcl_Namespace *) NULL,
1940   /*flags*/ 0);
1941     cmdPtr = (Command *) cmd;
1942     if (cmdPtr == NULL) {
1943   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't ",
1944                 ((newName == NULL)||(*newName == '\0'))? "delete":"rename",
1945                 " \"", oldName, "\": command doesn't exist", (char *) NULL);
1946   return TCL_ERROR;
1947     }
1948     cmdNsPtr = cmdPtr->nsPtr;
1949     oldFullName = Tcl_NewObj();
1950     Tcl_IncrRefCount( oldFullName );
1951     Tcl_GetCommandFullName( interp, cmd, oldFullName );
1952 
1953     /*
1954      * If the new command name is NULL or empty, delete the command. Do this
1955      * with Tcl_DeleteCommandFromToken, since we already have the command.
1956      */
1957     
1958     if ((newName == NULL) || (*newName == '\0')) {
1959   Tcl_DeleteCommandFromToken(interp, cmd);
1960   result = TCL_OK;
1961   goto done;
1962     }
1963 
1964     /*
1965      * Make sure that the destination command does not already exist.
1966      * The rename operation is like creating a command, so we should
1967      * automatically create the containing namespaces just like
1968      * Tcl_CreateCommand would.
1969      */
1970 
1971     TclGetNamespaceForQualName(interp, newName, (Namespace *) NULL,
1972        CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail);
1973 
1974     if ((newNsPtr == NULL) || (newTail == NULL)) {
1975   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1976      "can't rename to \"", newName, "\": bad command name",
1977              (char *) NULL);
1978   result = TCL_ERROR;
1979   goto done;
1980     }
1981     if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) {
1982   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1983      "can't rename to \"", newName,
1984      "\": command already exists", (char *) NULL);
1985   result = TCL_ERROR;
1986   goto done;
1987     }
1988 
1989     /*
1990      * Warning: any changes done in the code here are likely
1991      * to be needed in Tcl_HideCommand() code too.
1992      * (until the common parts are extracted out)     --dl
1993      */
1994 
1995     /*
1996      * Put the command in the new namespace so we can check for an alias
1997      * loop. Since we are adding a new command to a namespace, we must
1998      * handle any shadowing of the global commands that this might create.
1999      */
2000     
2001     oldHPtr = cmdPtr->hPtr;
2002     hPtr = Tcl_CreateHashEntry(&newNsPtr->cmdTable, newTail, &new);
2003     Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
2004     cmdPtr->hPtr = hPtr;
2005     cmdPtr->nsPtr = newNsPtr;
2006     TclResetShadowedCmdRefs(interp, cmdPtr);
2007 
2008     /*
2009      * Now check for an alias loop. If we detect one, put everything back
2010      * the way it was and report the error.
2011      */
2012 
2013     result = TclPreventAliasLoop(interp, interp, (Tcl_Command) cmdPtr);
2014     if (result != TCL_OK) {
2015         Tcl_DeleteHashEntry(cmdPtr->hPtr);
2016         cmdPtr->hPtr = oldHPtr;
2017         cmdPtr->nsPtr = cmdNsPtr;
2018   goto done;
2019     }
2020 
2021     /*
2022      * Script for rename traces can delete the command "oldName".
2023      * Therefore increment the reference count for cmdPtr so that
2024      * it's Command structure is freed only towards the end of this
2025      * function by calling TclCleanupCommand.
2026      *
2027      * The trace procedure needs to get a fully qualified name for
2028      * old and new commands [Tcl bug #651271], or else there's no way
2029      * for the trace procedure to get the namespace from which the old
2030      * command is being renamed!
2031      */
2032 
2033     Tcl_DStringInit( &newFullName );
2034     Tcl_DStringAppend( &newFullName, newNsPtr->fullName, -1 );
2035     if ( newNsPtr != iPtr->globalNsPtr ) {
2036   Tcl_DStringAppend( &newFullName, "::", 2 );
2037     }
2038     Tcl_DStringAppend( &newFullName, newTail, -1 );
2039     cmdPtr->refCount++;
2040     CallCommandTraces( iPtr, cmdPtr,
2041            Tcl_GetString( oldFullName ),
2042            Tcl_DStringValue( &newFullName ),
2043            TCL_TRACE_RENAME);
2044     Tcl_DStringFree( &newFullName );
2045 
2046     /*
2047      * The new command name is okay, so remove the command from its
2048      * current namespace. This is like deleting the command, so bump
2049      * the cmdEpoch to invalidate any cached references to the command.
2050      */
2051     
2052     Tcl_DeleteHashEntry(oldHPtr);
2053     cmdPtr->cmdEpoch++;
2054 
2055     /*
2056      * If the command being renamed has a compile procedure, increment the
2057      * interpreter's compileEpoch to invalidate its compiled code. This
2058      * makes sure that we don't later try to execute old code compiled for
2059      * the now-renamed command.
2060      */
2061 
2062     if (cmdPtr->compileProc != NULL) {
2063   iPtr->compileEpoch++;
2064     }
2065 
2066     /*
2067      * Now free the Command structure, if the "oldName" command has
2068      * been deleted by invocation of rename traces.
2069      */
2070     TclCleanupCommand(cmdPtr);
2071     result = TCL_OK;
2072 
2073     done:
2074     TclDecrRefCount( oldFullName );
2075     return result;
2076 }

Variable Documentation
CmdInfo builtInCmds[] [static]

Definition at line 64 of file tclBasic.c.
Referenced by Tcl_CreateInterp(), and TclHideUnsafeCommands().TclStubs tclStubs

Definition at line 411 of file tclStubInit.c.
Referenced by Tcl_CreateFileHandler(), Tcl_CreateInterp(), TCL_DECLARE_MUTEX(), Tcl_DeleteFileHandler(), Tcl_SetNotifier(), Tcl_SetServiceMode(), Tcl_SetTimer(), Tcl_ThreadAlert(), Tcl_WaitForEvent(), and TclFinalizeNotifier().

generic/tclBinary.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include <math.h>
Classes
struct ByteArray
Defines
#define BINARY_ALL  -1
#define BINARY_NOCOUNT  -2
#define BINARY_SCAN_MAX_CACHE  260
#define BYTEARRAY_SIZE(len)  ((unsigned) (sizeof(ByteArray) - 4 + (len)))
#define GET_BYTEARRAY(objPtr)  ((ByteArray *) (objPtr)->internalRep.otherValuePtr)
#define SET_BYTEARRAY(objPtr, baPtr)  (objPtr)->internalRep.otherValuePtr = (VOID *) (baPtr)
Functions
static void DupByteArrayInternalRep _ANSI_ARGS_ ((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr))
static int FormatNumber _ANSI_ARGS_ ((Tcl_Interp *interp, int type, Tcl_Obj *src, unsigned char **cursorPtr))
static void CopyNumber _ANSI_ARGS_ ((CONST VOID *from, VOID *to, unsigned int length))
static void FreeByteArrayInternalRep _ANSI_ARGS_ ((Tcl_Obj *objPtr))
static int GetFormatSpec _ANSI_ARGS_ ((char **formatPtr, char *cmdPtr, int *countPtr))
static Tcl_Obj *ScanNumber _ANSI_ARGS_ ((unsigned char *buffer, int type, Tcl_HashTable **numberCachePtr))
static int SetByteArrayFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
static void UpdateStringOfByteArray _ANSI_ARGS_ ((Tcl_Obj *listPtr))
static void DeleteScanNumberCache _ANSI_ARGS_ ((Tcl_HashTable *numberCachePtr))
Tcl_Obj * Tcl_NewByteArrayObj (CONST unsigned char *bytes, int length)
Tcl_Obj * Tcl_DbNewByteArrayObj (CONST unsigned char *bytes, int length, CONST char *file, int line)
void Tcl_SetByteArrayObj (Tcl_Obj *objPtr, CONST unsigned char *bytes, int length)
unsigned char * Tcl_GetByteArrayFromObj (Tcl_Obj *objPtr, int *lengthPtr)
unsigned char * Tcl_SetByteArrayLength (Tcl_Obj *objPtr, int length)
static int SetByteArrayFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr)
static void FreeByteArrayInternalRep (Tcl_Obj *objPtr)
static void DupByteArrayInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
static void UpdateStringOfByteArray (Tcl_Obj *objPtr)
int Tcl_BinaryObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int GetFormatSpec (char **formatPtr, char *cmdPtr, int *countPtr)
static int FormatNumber (Tcl_Interp *interp, int type, Tcl_Obj *src, unsigned char **cursorPtr)
static void CopyNumber (CONST VOID *from, VOID *to, unsigned int length)
static Tcl_Obj * ScanNumber (unsigned char *buffer, int type, Tcl_HashTable **numberCachePtrPtr)
static void DeleteScanNumberCache (Tcl_HashTable *numberCachePtr)
Variables
Tcl_ObjType tclByteArrayType

Define Documentation
#define BINARY_ALL  -1

Definition at line 25 of file tclBinary.c.
Referenced by GetFormatSpec(), and Tcl_BinaryObjCmd().#define BINARY_NOCOUNT  -2

Definition at line 26 of file tclBinary.c.
Referenced by GetFormatSpec(), and Tcl_BinaryObjCmd().#define BINARY_SCAN_MAX_CACHE  260

Definition at line 46 of file tclBinary.c.
Referenced by ScanNumber().#define BYTEARRAY_SIZE(len)  ((unsigned) (sizeof(ByteArray) - 4 + (len)))

Definition at line 119 of file tclBinary.c.
Referenced by DupByteArrayInternalRep(), SetByteArrayFromAny(), Tcl_SetByteArrayLength(), and Tcl_SetByteArrayObj().#define GET_BYTEARRAY(objPtr)  ((ByteArray *) (objPtr)->internalRep.otherValuePtr)

Definition at line 121 of file tclBinary.c.
Referenced by DupByteArrayInternalRep(), FreeByteArrayInternalRep(), Tcl_GetByteArrayFromObj(), Tcl_SetByteArrayLength(), and UpdateStringOfByteArray().#define SET_BYTEARRAY(objPtr, baPtr)  (objPtr)->internalRep.otherValuePtr = (VOID *) (baPtr)

Definition at line 123 of file tclBinary.c.
Referenced by DupByteArrayInternalRep(), SetByteArrayFromAny(), Tcl_SetByteArrayLength(), and Tcl_SetByteArrayObj().
Function Documentation
static void DeleteScanNumberCache _ANSI_ARGS_ ((Tcl_HashTable *numberCachePtr)) [static]
static void UpdateStringOfByteArray _ANSI_ARGS_ ((Tcl_Obj *listPtr)) [static]
static int SetByteArrayFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr)) [static]
static Tcl_Obj* ScanNumber _ANSI_ARGS_ ((unsigned char *buffer, int type, Tcl_HashTable **numberCachePtr)) [static]
static int GetFormatSpec _ANSI_ARGS_ ((char **formatPtr, char *cmdPtr, int *countPtr)) [static]
static void FreeByteArrayInternalRep _ANSI_ARGS_ ((Tcl_Obj *objPtr)) [static]
static void CopyNumber _ANSI_ARGS_ ((CONST VOID *from, VOID *to, unsigned int length)) [static]
static int FormatNumber _ANSI_ARGS_ ((Tcl_Interp *interp, int type, Tcl_Obj *src, unsigned char **cursorPtr)) [static]
static void DupByteArrayInternalRep _ANSI_ARGS_ ((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)) [static]
static void CopyNumber (CONST VOID * from, VOID * to, unsigned int length) [static]

Definition at line 1553 of file tclBinary.c.
Referenced by FormatNumber().1557 {
1558     memcpy(to, from, length);
1559 }
static void DeleteScanNumberCache (Tcl_HashTable * numberCachePtr) [static]

Definition at line 1743 of file tclBinary.c.
References NULL, Tcl_DecrRefCount, Tcl_DeleteHashTable(), Tcl_FirstHashEntry(), Tcl_GetHashValue, and Tcl_NextHashEntry().
Referenced by ScanNumber(), and Tcl_BinaryObjCmd().1747 {
1748     Tcl_HashEntry *hEntry;
1749     Tcl_HashSearch search;
1750 
1751     if (numberCachePtr == NULL) {
1752   return;
1753     }
1754 
1755     hEntry = Tcl_FirstHashEntry(numberCachePtr, &search);
1756     while (hEntry != NULL) {
1757   register Tcl_Obj *value = (Tcl_Obj *) Tcl_GetHashValue(hEntry);
1758 
1759   if (value != NULL) {
1760       Tcl_DecrRefCount(value);
1761   }
1762   hEntry = Tcl_NextHashEntry(&search);
1763     }
1764     Tcl_DeleteHashTable(numberCachePtr);
1765 }
static void DupByteArrayInternalRep (Tcl_Obj * srcPtr, Tcl_Obj * copyPtr) [static]

Definition at line 468 of file tclBinary.c.
References ByteArray::allocated, BYTEARRAY_SIZE, ByteArray::bytes, ckalloc, GET_BYTEARRAY, SET_BYTEARRAY, size_t(), tclByteArrayType, Tcl_Obj::typePtr, ByteArray::used, and VOID.471 {
472     int length;
473     ByteArray *srcArrayPtr, *copyArrayPtr;    
474 
475     srcArrayPtr = GET_BYTEARRAY(srcPtr);
476     length = srcArrayPtr->used;
477 
478     copyArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
479     copyArrayPtr->used = length;
480     copyArrayPtr->allocated = length;
481     memcpy((VOID *) copyArrayPtr->bytes, (VOID *) srcArrayPtr->bytes,
482       (size_t) length);
483     SET_BYTEARRAY(copyPtr, copyArrayPtr);
484 
485     copyPtr->typePtr = &tclByteArrayType;
486 }
static int FormatNumber (Tcl_Interp * interp, int type, Tcl_Obj * src, unsigned char ** cursorPtr) [static]

Definition at line 1447 of file tclBinary.c.
References CopyNumber(), FLT_MAX, TCL_ERROR, Tcl_GetDoubleFromObj(), Tcl_GetLongFromObj(), Tcl_GetWideIntFromObj(), TCL_OK, and VOID.
Referenced by Tcl_BinaryObjCmd().1453 {
1454     long value;
1455     double dvalue;
1456     Tcl_WideInt wvalue;
1457 
1458     switch (type) {
1459     case 'd':
1460     case 'f':
1461   /*
1462    * For floating point types, we need to copy the data using
1463    * memcpy to avoid alignment issues.
1464    */
1465 
1466   if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
1467       return TCL_ERROR;
1468   }
1469   if (type == 'd') {
1470       /*
1471        * Can't just memcpy() here. [Bug 1116542]
1472        */
1473 
1474       CopyNumber(&dvalue, *cursorPtr, sizeof(double));
1475       *cursorPtr += sizeof(double);
1476   } else {
1477       float fvalue;
1478 
1479       /*
1480        * Because some compilers will generate floating point exceptions
1481        * on an overflow cast (e.g. Borland), we restrict the values
1482        * to the valid range for float.
1483        */
1484 
1485       if (fabs(dvalue) > (double)FLT_MAX) {
1486     fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
1487       } else {
1488     fvalue = (float) dvalue;
1489       }
1490       memcpy((VOID *) *cursorPtr, (VOID *) &fvalue, sizeof(float));
1491       *cursorPtr += sizeof(float);
1492   }
1493   return TCL_OK;
1494 
1495   /*
1496    * Next cases separate from other integer cases because we
1497    * need a different API to get a wide.
1498    */
1499     case 'w':
1500     case 'W':
1501   if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) {
1502       return TCL_ERROR;
1503   }
1504   if (type == 'w') {
1505       *(*cursorPtr)++ = (unsigned char) wvalue;
1506       *(*cursorPtr)++ = (unsigned char) (wvalue >> 8);
1507       *(*cursorPtr)++ = (unsigned char) (wvalue >> 16);
1508       *(*cursorPtr)++ = (unsigned char) (wvalue >> 24);
1509       *(*cursorPtr)++ = (unsigned char) (wvalue >> 32);
1510       *(*cursorPtr)++ = (unsigned char) (wvalue >> 40);
1511       *(*cursorPtr)++ = (unsigned char) (wvalue >> 48);
1512       *(*cursorPtr)++ = (unsigned char) (wvalue >> 56);
1513   } else {
1514       *(*cursorPtr)++ = (unsigned char) (wvalue >> 56);
1515       *(*cursorPtr)++ = (unsigned char) (wvalue >> 48);
1516       *(*cursorPtr)++ = (unsigned char) (wvalue >> 40);
1517       *(*cursorPtr)++ = (unsigned char) (wvalue >> 32);
1518       *(*cursorPtr)++ = (unsigned char) (wvalue >> 24);
1519       *(*cursorPtr)++ = (unsigned char) (wvalue >> 16);
1520       *(*cursorPtr)++ = (unsigned char) (wvalue >> 8);
1521       *(*cursorPtr)++ = (unsigned char) wvalue;
1522   }
1523   return TCL_OK;
1524     default:
1525   if (Tcl_GetLongFromObj(interp, src, &value) != TCL_OK) {
1526       return TCL_ERROR;
1527   }
1528   if (type == 'c') {
1529       *(*cursorPtr)++ = (unsigned char) value;
1530   } else if (type == 's') {
1531       *(*cursorPtr)++ = (unsigned char) value;
1532       *(*cursorPtr)++ = (unsigned char) (value >> 8);
1533   } else if (type == 'S') {
1534       *(*cursorPtr)++ = (unsigned char) (value >> 8);
1535       *(*cursorPtr)++ = (unsigned char) value;
1536   } else if (type == 'i') {
1537       *(*cursorPtr)++ = (unsigned char) value;
1538       *(*cursorPtr)++ = (unsigned char) (value >> 8);
1539       *(*cursorPtr)++ = (unsigned char) (value >> 16);
1540       *(*cursorPtr)++ = (unsigned char) (value >> 24);
1541   } else if (type == 'I') {
1542       *(*cursorPtr)++ = (unsigned char) (value >> 24);
1543       *(*cursorPtr)++ = (unsigned char) (value >> 16);
1544       *(*cursorPtr)++ = (unsigned char) (value >> 8);
1545       *(*cursorPtr)++ = (unsigned char) value;
1546   }
1547   return TCL_OK;
1548     }
1549 }
static void FreeByteArrayInternalRep (Tcl_Obj * objPtr) [static]

Definition at line 443 of file tclBinary.c.
References ckfree, and GET_BYTEARRAY.445 {
446     ckfree((char *) GET_BYTEARRAY(objPtr));
447 }
static int GetFormatSpec (char ** formatPtr, char * cmdPtr, int * countPtr) [static]

Definition at line 1391 of file tclBinary.c.
References BINARY_ALL, BINARY_NOCOUNT, strtoul(), and UCHAR.
Referenced by Tcl_BinaryObjCmd().1395 {
1396     /*
1397      * Skip any leading blanks.
1398      */
1399 
1400     while (**formatPtr == ' ') {
1401   (*formatPtr)++;
1402     }
1403 
1404     /*
1405      * The string was empty, except for whitespace, so fail.
1406      */
1407 
1408     if (!(**formatPtr)) {
1409   return 0;
1410     }
1411 
1412     /*
1413      * Extract the command character and any trailing digits or '*'.
1414      */
1415 
1416     *cmdPtr = **formatPtr;
1417     (*formatPtr)++;
1418     if (**formatPtr == '*') {
1419   (*formatPtr)++;
1420   (*countPtr) = BINARY_ALL;
1421     } else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */
1422   (*countPtr) = strtoul(*formatPtr, formatPtr, 10);
1423     } else {
1424   (*countPtr) = BINARY_NOCOUNT;
1425     }
1426     return 1;
1427 }
static Tcl_Obj* ScanNumber (unsigned char * buffer, int type, Tcl_HashTable ** numberCachePtrPtr) [static]

Definition at line 1582 of file tclBinary.c.
References BINARY_SCAN_MAX_CACHE, DeleteScanNumberCache(), NULL, Tcl_HashTable::numEntries, Tcl_CreateHashEntry, Tcl_GetHashValue, Tcl_IncrRefCount, Tcl_NewDoubleObj(), Tcl_NewLongObj(), Tcl_NewWideIntObj(), Tcl_SetHashValue, and VOID.
Referenced by Tcl_BinaryObjCmd().1589 {
1590     long value;
1591     Tcl_WideUInt uwvalue;
1592 
1593     /*
1594      * We cannot rely on the compiler to properly sign extend integer values
1595      * when we cast from smaller values to larger values because we don't know
1596      * the exact size of the integer types.  So, we have to handle sign
1597      * extension explicitly by checking the high bit and padding with 1's as
1598      * needed.
1599      */
1600 
1601     switch (type) {
1602   case 'c':
1603       /*
1604        * Characters need special handling.  We want to produce a
1605        * signed result, but on some platforms (such as AIX) chars
1606        * are unsigned.  To deal with this, check for a value that
1607        * should be negative but isn't.
1608        */
1609 
1610       value = buffer[0];
1611       if (value & 0x80) {
1612     value |= -0x100;
1613       }
1614       goto returnNumericObject;
1615 
1616   case 's':
1617       value = (long) (buffer[0] + (buffer[1] << 8));
1618       goto shortValue;
1619   case 'S':
1620       value = (long) (buffer[1] + (buffer[0] << 8));
1621       shortValue:
1622       if (value & 0x8000) {
1623     value |= -0x10000;
1624       }
1625       goto returnNumericObject;
1626 
1627   case 'i':
1628       value = (long) (buffer[0] 
1629         + (buffer[1] << 8)
1630         + (buffer[2] << 16)
1631         + (buffer[3] << 24));
1632       goto intValue;
1633   case 'I':
1634       value = (long) (buffer[3]
1635         + (buffer[2] << 8)
1636         + (buffer[1] << 16)
1637         + (buffer[0] << 24));
1638       intValue:
1639       /*
1640        * Check to see if the value was sign extended properly on
1641        * systems where an int is more than 32-bits.
1642        */
1643 
1644       if ((value & (((unsigned int)1)<<31)) && (value > 0)) {
1645     value -= (((unsigned int)1)<<31);
1646     value -= (((unsigned int)1)<<31);
1647       }
1648       returnNumericObject:
1649       if (*numberCachePtrPtr == NULL) {
1650     return Tcl_NewLongObj(value);
1651       } else {
1652     register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
1653     register Tcl_HashEntry *hPtr;
1654     int isNew;
1655 
1656     hPtr = Tcl_CreateHashEntry(tablePtr, (char *)value, &isNew);
1657     if (!isNew) {
1658         return (Tcl_Obj *) Tcl_GetHashValue(hPtr);
1659     }
1660     if (tablePtr->numEntries > BINARY_SCAN_MAX_CACHE) {
1661         /*
1662          * We've overflowed the cache!  Someone's parsing
1663          * a LOT of varied binary data in a single call!
1664          * Bail out by switching back to the old behaviour
1665          * for the rest of the scan.
1666          *
1667          * Note that anyone just using the 'c' conversion
1668          * (for bytes) cannot trigger this.
1669          */
1670         DeleteScanNumberCache(tablePtr);
1671         *numberCachePtrPtr = NULL;
1672         return Tcl_NewLongObj(value);
1673     } else {
1674         register Tcl_Obj *objPtr = Tcl_NewLongObj(value);
1675 
1676         Tcl_IncrRefCount(objPtr);
1677         Tcl_SetHashValue(hPtr, (ClientData) objPtr);
1678         return objPtr;
1679     }
1680       }
1681 
1682       /*
1683        * Do not cache wide values; they are already too large to
1684        * use as keys.
1685        */
1686   case 'w':
1687       uwvalue =  ((Tcl_WideUInt) buffer[0])
1688         | (((Tcl_WideUInt) buffer[1]) << 8)
1689         | (((Tcl_WideUInt) buffer[2]) << 16)
1690         | (((Tcl_WideUInt) buffer[3]) << 24)
1691         | (((Tcl_WideUInt) buffer[4]) << 32)
1692         | (((Tcl_WideUInt) buffer[5]) << 40)
1693         | (((Tcl_WideUInt) buffer[6]) << 48)
1694         | (((Tcl_WideUInt) buffer[7]) << 56);
1695       return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);
1696   case 'W':
1697       uwvalue =  ((Tcl_WideUInt) buffer[7])
1698         | (((Tcl_WideUInt) buffer[6]) << 8)
1699         | (((Tcl_WideUInt) buffer[5]) << 16)
1700         | (((Tcl_WideUInt) buffer[4]) << 24)
1701         | (((Tcl_WideUInt) buffer[3]) << 32)
1702         | (((Tcl_WideUInt) buffer[2]) << 40)
1703         | (((Tcl_WideUInt) buffer[1]) << 48)
1704         | (((Tcl_WideUInt) buffer[0]) << 56);
1705       return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);
1706 
1707       /*
1708        * Do not cache double values; they are already too large
1709        * to use as keys and the values stored are utterly
1710        * incompatible too.
1711        */
1712   case 'f': {
1713       float fvalue;
1714       memcpy((VOID *) &fvalue, (VOID *) buffer, sizeof(float));
1715       return Tcl_NewDoubleObj(fvalue);
1716   }
1717   case 'd': {
1718       double dvalue;
1719       memcpy((VOID *) &dvalue, (VOID *) buffer, sizeof(double));
1720       return Tcl_NewDoubleObj(dvalue);
1721   }
1722     }
1723     return NULL;
1724 }
static int SetByteArrayFromAny (Tcl_Interp * interp, Tcl_Obj * objPtr) [static]

Definition at line 391 of file tclBinary.c.
References ByteArray::allocated, BYTEARRAY_SIZE, ByteArray::bytes, ckalloc, Tcl_ObjType::freeIntRepProc, NULL, SET_BYTEARRAY, Tcl_GetStringFromObj(), TCL_OK, Tcl_UtfToUniChar(), tclByteArrayType, Tcl_Obj::typePtr, and ByteArray::used.
Referenced by Tcl_GetByteArrayFromObj(), and Tcl_SetByteArrayLength().394 {
395     Tcl_ObjType *typePtr;
396     int length;
397     char *src, *srcEnd;
398     unsigned char *dst;
399     ByteArray *byteArrayPtr;
400     Tcl_UniChar ch;
401     
402     typePtr = objPtr->typePtr;
403     if (typePtr != &tclByteArrayType) {
404   src = Tcl_GetStringFromObj(objPtr, &length);
405   srcEnd = src + length;
406 
407   byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
408   for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
409       src += Tcl_UtfToUniChar(src, &ch);
410       *dst++ = (unsigned char) ch;
411   }
412 
413   byteArrayPtr->used = dst - byteArrayPtr->bytes;
414   byteArrayPtr->allocated = length;
415 
416   if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) {
417       (*typePtr->freeIntRepProc)(objPtr);
418   }
419   objPtr->typePtr = &tclByteArrayType;
420   SET_BYTEARRAY(objPtr, byteArrayPtr);
421     }
422     return TCL_OK;
423 }
int Tcl_BinaryObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 567 of file tclBinary.c.
References BINARY_ALL, BINARY_NOCOUNT, CONST, DeleteScanNumberCache(), format, FormatNumber(), GetFormatSpec(), NULL, ScanNumber(), size_t(), Tcl_DecrRefCount, TCL_ERROR, Tcl_GetByteArrayFromObj(), Tcl_GetIndexFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_InitHashTable(), TCL_LEAVE_ERR_MSG, Tcl_ListObjAppendElement(), Tcl_ListObjGetElements(), Tcl_NewByteArrayObj(), Tcl_NewObj(), Tcl_ObjSetVar2(), TCL_OK, TCL_ONE_WORD_KEYS, Tcl_ResetResult(), Tcl_SetByteArrayLength(), Tcl_SetLongObj(), Tcl_SetObjLength(), Tcl_UniCharToUtf(), TCL_UTF_MAX, Tcl_UtfToUniChar(), Tcl_WrongNumArgs(), UCHAR, and VOID.572 {
573     int arg;      /* Index of next argument to consume. */
574     int value = 0;    /* Current integer value to be packed.
575          * Initialized to avoid compiler warning. */
576     char cmd;     /* Current format character. */
577     int count;      /* Count associated with current format
578          * character. */
579     char *format;   /* Pointer to current position in format
580          * string. */
581     Tcl_Obj *resultPtr;   /* Object holding result buffer. */
582     unsigned char *buffer;  /* Start of result buffer. */
583     unsigned char *cursor;  /* Current position within result buffer. */
584     unsigned char *maxPos;  /* Greatest position within result buffer that
585          * cursor has visited.*/
586     char *errorString, *errorValue, *str;
587     int offset, size, length, index;
588     static CONST char *options[] = { 
589   "format", "scan",   NULL 
590     };
591     enum options { 
592   BINARY_FORMAT,  BINARY_SCAN
593     };
594 
595     if (objc < 2) {
596       Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
597   return TCL_ERROR;
598     }
599 
600     if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
601       &index) != TCL_OK) {
602       return TCL_ERROR;
603     }
604 
605     switch ((enum options) index) {
606   case BINARY_FORMAT: {
607       if (objc < 3) {
608     Tcl_WrongNumArgs(interp, 2, objv, "formatString ?arg arg ...?");
609     return TCL_ERROR;
610       }
611 
612       /*
613        * To avoid copying the data, we format the string in two passes.
614        * The first pass computes the size of the output buffer.  The
615        * second pass places the formatted data into the buffer.
616        */
617 
618       format = Tcl_GetString(objv[2]);
619       arg = 3;
620       offset = 0;
621       length = 0;
622       while (*format != '\0') {
623     str = format;
624     if (!GetFormatSpec(&format, &cmd, &count)) {
625         break;
626     }
627     switch (cmd) {
628         case 'a':
629         case 'A':
630         case 'b':
631         case 'B':
632         case 'h':
633         case 'H': {
634       /*
635        * For string-type specifiers, the count corresponds
636        * to the number of bytes in a single argument.
637        */
638 
639       if (arg >= objc) {
640           goto badIndex;
641       }
642       if (count == BINARY_ALL) {
643           Tcl_GetByteArrayFromObj(objv[arg], &count);
644       } else if (count == BINARY_NOCOUNT) {
645           count = 1;
646       }
647       arg++;
648       if (cmd == 'a' || cmd == 'A') {
649           offset += count;
650       } else if (cmd == 'b' || cmd == 'B') {
651           offset += (count + 7) / 8;
652       } else {
653           offset += (count + 1) / 2;
654       }
655       break;
656         }
657         case 'c': {
658       size = 1;
659       goto doNumbers;
660         }
661         case 's':
662         case 'S': {
663       size = 2;
664       goto doNumbers;
665         }
666         case 'i':
667         case 'I': {
668       size = 4;
669       goto doNumbers;
670         }
671         case 'w':
672         case 'W': {
673       size = 8;
674       goto doNumbers;
675         }
676         case 'f': {
677       size = sizeof(float);
678       goto doNumbers;
679         }
680         case 'd': {
681       size = sizeof(double);
682       
683       doNumbers:
684       if (arg >= objc) {
685           goto badIndex;
686       }
687 
688       /*
689        * For number-type specifiers, the count corresponds
690        * to the number of elements in the list stored in
691        * a single argument.  If no count is specified, then
692        * the argument is taken as a single non-list value.
693        */
694 
695       if (count == BINARY_NOCOUNT) {
696           arg++;
697           count = 1;
698       } else {
699           int listc;
700           Tcl_Obj **listv;
701           if (Tcl_ListObjGetElements(interp, objv[arg++],
702             &listc, &listv) != TCL_OK) {
703         return TCL_ERROR;
704           }
705           if (count == BINARY_ALL) {
706         count = listc;
707           } else if (count > listc) {
708               Tcl_AppendResult(interp, 
709           "number of elements in list does not match count",
710           (char *) NULL);
711         return TCL_ERROR;
712           }
713       }
714       offset += count*size;
715       break;
716         }
717         case 'x': {
718       if (count == BINARY_ALL) {
719           Tcl_AppendResult(interp, 
720             "cannot use \"*\" in format string with \"x\"",
721             (char *) NULL);
722           return TCL_ERROR;
723       } else if (count == BINARY_NOCOUNT) {
724           count = 1;
725       }
726       offset += count;
727       break;
728         }
729         case 'X': {
730       if (count == BINARY_NOCOUNT) {
731           count = 1;
732       }
733       if ((count > offset) || (count == BINARY_ALL)) {
734           count = offset;
735       }
736       if (offset > length) {
737           length = offset;
738       }
739       offset -= count;
740       break;
741         }
742         case '@': {
743       if (offset > length) {
744           length = offset;
745       }
746       if (count == BINARY_ALL) {
747           offset = length;
748       } else if (count == BINARY_NOCOUNT) {
749           goto badCount;
750       } else {
751           offset = count;
752       }
753       break;
754         }
755         default: {
756       errorString = str;
757       goto badField;
758         }
759     }
760       }
761       if (offset > length) {
762     length = offset;
763       }
764       if (length == 0) {
765     return TCL_OK;
766       }
767 
768       /*
769        * Prepare the result object by preallocating the caclulated
770        * number of bytes and filling with nulls.
771        */
772 
773       resultPtr = Tcl_GetObjResult(interp);
774       buffer = Tcl_SetByteArrayLength(resultPtr, length);
775       memset((VOID *) buffer, 0, (size_t) length);
776 
777       /*
778        * Pack the data into the result object.  Note that we can skip
779        * the error checking during this pass, since we have already
780        * parsed the string once.
781        */
782 
783       arg = 3;
784       format = Tcl_GetString(objv[2]);
785       cursor = buffer;
786       maxPos = cursor;
787       while (*format != 0) {
788     if (!GetFormatSpec(&format, &cmd, &count)) {
789         break;
790     }
791     if ((count == 0) && (cmd != '@')) {
792         arg++;
793         continue;
794     }
795     switch (cmd) {
796         case 'a':
797         case 'A': {
798       char pad = (char) (cmd == 'a' ? '\0' : ' ');
799       unsigned char *bytes;
800 
801       bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length);
802 
803       if (count == BINARY_ALL) {
804           count = length;
805       } else if (count == BINARY_NOCOUNT) {
806           count = 1;
807       }
808       if (length >= count) {
809           memcpy((VOID *) cursor, (VOID *) bytes,
810             (size_t) count);
811       } else {
812           memcpy((VOID *) cursor, (VOID *) bytes,
813             (size_t) length);
814           memset((VOID *) (cursor + length), pad,
815                   (size_t) (count - length));
816       }
817       cursor += count;
818       break;
819         }
820         case 'b':
821         case 'B': {
822       unsigned char *last;
823       
824       str = Tcl_GetStringFromObj(objv[arg++], &length);
825       if (count == BINARY_ALL) {
826           count = length;
827       } else if (count == BINARY_NOCOUNT) {
828           count = 1;
829       }
830       last = cursor + ((count + 7) / 8);
831       if (count > length) {
832           count = length;
833       }
834       value = 0;
835       errorString = "binary";
836       if (cmd == 'B') {
837           for (offset = 0; offset < count; offset++) {
838         value <<= 1;
839         if (str[offset] == '1') {
840             value |= 1;
841         } else if (str[offset] != '0') {
842             errorValue = str;
843             goto badValue;
844         }
845         if (((offset + 1) % 8) == 0) {
846             *cursor++ = (unsigned char) value;
847             value = 0;
848         }
849           }
850       } else {
851           for (offset = 0; offset < count; offset++) {
852         value >>= 1;
853         if (str[offset] == '1') {
854             value |= 128;
855         } else if (str[offset] != '0') {
856             errorValue = str;
857             goto badValue;
858         }
859         if (!((offset + 1) % 8)) {
860             *cursor++ = (unsigned char) value;
861             value = 0;
862         }
863           }
864       }
865       if ((offset % 8) != 0) {
866           if (cmd == 'B') {
867         value <<= 8 - (offset % 8);
868           } else {
869         value >>= 8 - (offset % 8);
870           }
871           *cursor++ = (unsigned char) value;
872       }
873       while (cursor < last) {
874           *cursor++ = '\0';
875       }
876       break;
877         }
878         case 'h':
879         case 'H': {
880       unsigned char *last;
881       int c;
882       
883       str = Tcl_GetStringFromObj(objv[arg++], &length);
884       if (count == BINARY_ALL) {
885           count = length;
886       } else if (count == BINARY_NOCOUNT) {
887           count = 1;
888       }
889       last = cursor + ((count + 1) / 2);
890       if (count > length) {
891           count = length;
892       }
893       value = 0;
894       errorString = "hexadecimal";
895       if (cmd == 'H') {
896           for (offset = 0; offset < count; offset++) {
897         value <<= 4;
898         if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
899             errorValue = str;
900             goto badValue;
901         }
902         c = str[offset] - '0';
903         if (c > 9) {
904             c += ('0' - 'A') + 10;
905         }
906         if (c > 16) {
907             c += ('A' - 'a');
908         }
909         value |= (c & 0xf);
910         if (offset % 2) {
911             *cursor++ = (char) value;
912             value = 0;
913         }
914           }
915       } else {
916           for (offset = 0; offset < count; offset++) {
917         value >>= 4;
918 
919         if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
920             errorValue = str;
921             goto badValue;
922         }
923         c = str[offset] - '0';
924         if (c > 9) {
925             c += ('0' - 'A') + 10;
926         }
927         if (c > 16) {
928             c += ('A' - 'a');
929         }
930         value |= ((c << 4) & 0xf0);
931         if (offset % 2) {
932             *cursor++ = (unsigned char)(value & 0xff);
933             value = 0;
934         }
935           }
936       }
937       if (offset % 2) {
938           if (cmd == 'H') {
939         value <<= 4;
940           } else {
941         value >>= 4;
942           }
943           *cursor++ = (unsigned char) value;
944       }
945 
946       while (cursor < last) {
947           *cursor++ = '\0';
948       }
949       break;
950         }
951         case 'c':
952         case 's':
953         case 'S':
954         case 'i':
955         case 'I':
956         case 'w':
957         case 'W':
958         case 'd':
959         case 'f': {
960       int listc, i;
961       Tcl_Obj **listv;
962 
963       if (count == BINARY_NOCOUNT) {
964           /*
965            * Note that we are casting away the const-ness of
966            * objv, but this is safe since we aren't going to
967            * modify the array.
968            */
969 
970           listv = (Tcl_Obj**)(objv + arg);
971           listc = 1;
972           count = 1;
973       } else {
974           Tcl_ListObjGetElements(interp, objv[arg],
975             &listc, &listv);
976           if (count == BINARY_ALL) {
977         count = listc;
978           }
979       }
980       arg++;
981       for (i = 0; i < count; i++) {
982           if (FormatNumber(interp, cmd, listv[i], &cursor)
983             != TCL_OK) {
984         return TCL_ERROR;
985           }
986       }
987       break;
988         }
989         case 'x': {
990       if (count == BINARY_NOCOUNT) {
991           count = 1;
992       }
993       memset(cursor, 0, (size_t) count);
994       cursor += count;
995       break;
996         }
997         case 'X': {
998       if (cursor > maxPos) {
999           maxPos = cursor;
1000       }
1001       if (count == BINARY_NOCOUNT) {
1002           count = 1;
1003       }
1004       if ((count == BINARY_ALL)
1005         || (count > (cursor - buffer))) {
1006           cursor = buffer;
1007       } else {
1008           cursor -= count;
1009       }
1010       break;
1011         }
1012         case '@': {
1013       if (cursor > maxPos) {
1014           maxPos = cursor;
1015       }
1016       if (count == BINARY_ALL) {
1017           cursor = maxPos;
1018       } else {
1019           cursor = buffer + count;
1020       }
1021       break;
1022         }
1023     }
1024       }
1025       break;
1026   }
1027   case BINARY_SCAN: {
1028       int i;
1029       Tcl_Obj *valuePtr, *elementPtr;
1030       Tcl_HashTable numberCacheHash;
1031       Tcl_HashTable *numberCachePtr;
1032 
1033       if (objc < 4) {
1034     Tcl_WrongNumArgs(interp, 2, objv,
1035       "value formatString ?varName varName ...?");
1036     return TCL_ERROR;
1037       }
1038       numberCachePtr = &numberCacheHash;
1039       Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS);
1040       buffer = Tcl_GetByteArrayFromObj(objv[2], &length);
1041       format = Tcl_GetString(objv[3]);
1042       cursor = buffer;
1043       arg = 4;
1044       offset = 0;
1045       while (*format != '\0') {
1046     str = format;
1047     if (!GetFormatSpec(&format, &cmd, &count)) {
1048         goto done;
1049     }
1050     switch (cmd) {
1051         case 'a':
1052         case 'A': {
1053       unsigned char *src;
1054 
1055       if (arg >= objc) {
1056           DeleteScanNumberCache(numberCachePtr);
1057           goto badIndex;
1058       }
1059       if (count == BINARY_ALL) {
1060           count = length - offset;
1061       } else {
1062           if (count == BINARY_NOCOUNT) {
1063         count = 1;
1064           }
1065           if (count > (length - offset)) {
1066         goto done;
1067           }
1068       }
1069 
1070       src = buffer + offset;
1071       size = count;
1072 
1073       /*
1074        * Trim trailing nulls and spaces, if necessary.
1075        */
1076 
1077       if (cmd == 'A') {
1078           while (size > 0) {
1079         if (src[size-1] != '\0' && src[size-1] != ' ') {
1080             break;
1081         }
1082         size--;
1083           }
1084       }
1085       valuePtr = Tcl_NewByteArrayObj(src, size);
1086       Tcl_IncrRefCount(valuePtr);
1087       resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
1088         NULL, valuePtr, TCL_LEAVE_ERR_MSG);
1089       Tcl_DecrRefCount(valuePtr);
1090       arg++;
1091       if (resultPtr == NULL) {
1092           DeleteScanNumberCache(numberCachePtr);
1093           return TCL_ERROR;
1094       }
1095       offset += count;
1096       break;
1097         }
1098         case 'b':
1099         case 'B': {
1100       unsigned char *src;
1101       char *dest;
1102 
1103       if (arg >= objc) {
1104           DeleteScanNumberCache(numberCachePtr);
1105           goto badIndex;
1106       }
1107       if (count == BINARY_ALL) {
1108           count = (length - offset) * 8;
1109       } else {
1110           if (count == BINARY_NOCOUNT) {
1111         count = 1;
1112           }
1113           if (count > (length - offset) * 8) {
1114         goto done;
1115           }
1116       }
1117       src = buffer + offset;
1118       valuePtr = Tcl_NewObj();
1119       Tcl_SetObjLength(valuePtr, count);
1120       dest = Tcl_GetString(valuePtr);
1121 
1122       if (cmd == 'b') {
1123           for (i = 0; i < count; i++) {
1124         if (i % 8) {
1125             value >>= 1;
1126         } else {
1127             value = *src++;
1128         }
1129         *dest++ = (char) ((value & 1) ? '1' : '0');
1130           }
1131       } else {
1132           for (i = 0; i < count; i++) {
1133         if (i % 8) {
1134             value <<= 1;
1135         } else {
1136             value = *src++;
1137         }
1138         *dest++ = (char) ((value & 0x80) ? '1' : '0');
1139           }
1140       }
1141 
1142       Tcl_IncrRefCount(valuePtr);     
1143       resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
1144         NULL, valuePtr, TCL_LEAVE_ERR_MSG);
1145       Tcl_DecrRefCount(valuePtr);
1146       arg++;
1147       if (resultPtr == NULL) {
1148           DeleteScanNumberCache(numberCachePtr);
1149           return TCL_ERROR;
1150       }
1151       offset += (count + 7 ) / 8;
1152       break;
1153         }
1154         case 'h':
1155         case 'H': {
1156       char *dest;
1157       unsigned char *src;
1158       int i;
1159       static char hexdigit[] = "0123456789abcdef";
1160 
1161       if (arg >= objc) {
1162           DeleteScanNumberCache(numberCachePtr);
1163           goto badIndex;
1164       }
1165       if (count == BINARY_ALL) {
1166           count = (length - offset)*2;
1167       } else {
1168           if (count == BINARY_NOCOUNT) {
1169         count = 1;
1170           }
1171           if (count > (length - offset)*2) {
1172         goto done;
1173           }
1174       }
1175       src = buffer + offset;
1176       valuePtr = Tcl_NewObj();
1177       Tcl_SetObjLength(valuePtr, count);
1178       dest = Tcl_GetString(valuePtr);
1179 
1180       if (cmd == 'h') {
1181           for (i = 0; i < count; i++) {
1182         if (i % 2) {
1183             value >>= 4;
1184         } else {
1185             value = *src++;
1186         }
1187         *dest++ = hexdigit[value & 0xf];
1188           }
1189       } else {
1190           for (i = 0; i < count; i++) {
1191         if (i % 2) {
1192             value <<= 4;
1193         } else {
1194             value = *src++;
1195         }
1196         *dest++ = hexdigit[(value >> 4) & 0xf];
1197           }
1198       }
1199       
1200       Tcl_IncrRefCount(valuePtr);
1201       resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
1202         NULL, valuePtr, TCL_LEAVE_ERR_MSG);
1203       Tcl_DecrRefCount(valuePtr);
1204       arg++;
1205       if (resultPtr == NULL) {
1206           DeleteScanNumberCache(numberCachePtr);
1207           return TCL_ERROR;
1208       }
1209       offset += (count + 1) / 2;
1210       break;
1211         }
1212         case 'c': {
1213       size = 1;
1214       goto scanNumber;
1215         }
1216         case 's':
1217         case 'S': {
1218       size = 2;
1219       goto scanNumber;
1220         }
1221         case 'i':
1222         case 'I': {
1223       size = 4;
1224       goto scanNumber;
1225         }
1226         case 'w':
1227         case 'W': {
1228       size = 8;
1229       goto scanNumber;
1230         }
1231         case 'f': {
1232       size = sizeof(float);
1233       goto scanNumber;
1234         }
1235         case 'd': {
1236       unsigned char *src;
1237 
1238       size = sizeof(double);
1239       /* fall through */
1240       
1241       scanNumber:
1242       if (arg >= objc) {
1243           DeleteScanNumberCache(numberCachePtr);
1244           goto badIndex;
1245       }
1246       if (count == BINARY_NOCOUNT) {
1247           if ((length - offset) < size) {
1248         goto done;
1249           }
1250           valuePtr = ScanNumber(buffer+offset, cmd,
1251             &numberCachePtr);
1252           offset += size;
1253       } else {
1254           if (count == BINARY_ALL) {
1255         count = (length - offset) / size;
1256           }
1257           if ((length - offset) < (count * size)) {
1258         goto done;
1259           }
1260           valuePtr = Tcl_NewObj();
1261           src = buffer+offset;
1262           for (i = 0; i < count; i++) {
1263         elementPtr = ScanNumber(src, cmd,
1264           &numberCachePtr);
1265         src += size;
1266         Tcl_ListObjAppendElement(NULL, valuePtr,
1267           elementPtr);
1268           }
1269           offset += count*size;
1270       }
1271 
1272       Tcl_IncrRefCount(valuePtr); 
1273       resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
1274         NULL, valuePtr, TCL_LEAVE_ERR_MSG);
1275       Tcl_DecrRefCount(valuePtr);
1276       arg++;
1277       if (resultPtr == NULL) {
1278           DeleteScanNumberCache(numberCachePtr);
1279           return TCL_ERROR;
1280       }
1281       break;
1282         }
1283         case 'x': {
1284       if (count == BINARY_NOCOUNT) {
1285           count = 1;
1286       }
1287       if ((count == BINARY_ALL)
1288         || (count > (length - offset))) {
1289           offset = length;
1290       } else {
1291           offset += count;
1292       }
1293       break;
1294         }
1295         case 'X': {
1296       if (count == BINARY_NOCOUNT) {
1297           count = 1;
1298       }
1299       if ((count == BINARY_ALL) || (count > offset)) {
1300           offset = 0;
1301       } else {
1302           offset -= count;
1303       }
1304       break;
1305         }
1306         case '@': {
1307       if (count == BINARY_NOCOUNT) {
1308           DeleteScanNumberCache(numberCachePtr);
1309           goto badCount;
1310       }
1311       if ((count == BINARY_ALL) || (count > length)) {
1312           offset = length;
1313       } else {
1314           offset = count;
1315       }
1316       break;
1317         }
1318         default: {
1319       DeleteScanNumberCache(numberCachePtr);
1320       errorString = str;
1321       goto badField;
1322         }
1323     }
1324       }
1325 
1326       /*
1327        * Set the result to the last position of the cursor.
1328        */
1329 
1330       done:
1331       Tcl_ResetResult(interp);
1332       Tcl_SetLongObj(Tcl_GetObjResult(interp), arg - 4);
1333       DeleteScanNumberCache(numberCachePtr);
1334       break;
1335   }
1336     }
1337     return TCL_OK;
1338 
1339     badValue:
1340     Tcl_ResetResult(interp);
1341     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "expected ", errorString,
1342       " string but got \"", errorValue, "\" instead", NULL);
1343     return TCL_ERROR;
1344 
1345     badCount:
1346     errorString = "missing count for \"@\" field specifier";
1347     goto error;
1348 
1349     badIndex:
1350     errorString = "not enough arguments for all format specifiers";
1351     goto error;
1352 
1353     badField:
1354     {
1355   Tcl_UniChar ch;
1356   char buf[TCL_UTF_MAX + 1];
1357 
1358   Tcl_UtfToUniChar(errorString, &ch);
1359   buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
1360   Tcl_AppendResult(interp, "bad field specifier \"", buf, "\"", NULL);
1361   return TCL_ERROR;
1362     }
1363 
1364     error:
1365     Tcl_AppendResult(interp, errorString, NULL);
1366     return TCL_ERROR;
1367 }
Tcl_Obj* Tcl_DbNewByteArrayObj (CONST unsigned char * bytes, int length, CONST char * file, int line)

Definition at line 226 of file tclBinary.c.
References Tcl_NewByteArrayObj().235 {
236     return Tcl_NewByteArrayObj(bytes, length);
237 }
unsigned char* Tcl_GetByteArrayFromObj (Tcl_Obj * objPtr, int * lengthPtr)

Definition at line 306 of file tclBinary.c.
References ByteArray::bytes, GET_BYTEARRAY, NULL, SetByteArrayFromAny(), and ByteArray::used.
Referenced by DoReadChars(), DoWriteChars(), ExecuteCallback(), ReadBytes(), SetValue(), Tcl_BinaryObjCmd(), Tcl_EncodingObjCmd(), Tcl_ResourceObjCmd(), Tcl_StringObjCmd(), Tcl_WriteObj(), and TclExecuteByteCode().310 {
311     ByteArray *baPtr;
312     
313     SetByteArrayFromAny(NULL, objPtr);
314     baPtr = GET_BYTEARRAY(objPtr);
315 
316     if (lengthPtr != NULL) {
317   *lengthPtr = baPtr->used;
318     }
319     return (unsigned char *) baPtr->bytes;
320 }
Tcl_Obj* Tcl_NewByteArrayObj (CONST unsigned char * bytes, int length)

Definition at line 163 of file tclBinary.c.
References Tcl_SetByteArrayObj(), and TclNewObj.
Referenced by ExecuteCallback(), Tcl_BinaryObjCmd(), Tcl_DbNewByteArrayObj(), Tcl_DdeObjCmd(), Tcl_StringObjCmd(), and TclExecuteByteCode().168 {
169     Tcl_Obj *objPtr;
170 
171     TclNewObj(objPtr);
172     Tcl_SetByteArrayObj(objPtr, bytes, length);
173     return objPtr;
174 }
unsigned char* Tcl_SetByteArrayLength (Tcl_Obj * objPtr, int length)

Definition at line 345 of file tclBinary.c.
References ByteArray::allocated, BYTEARRAY_SIZE, ByteArray::bytes, ckalloc, ckfree, GET_BYTEARRAY, NULL, panic, SET_BYTEARRAY, SetByteArrayFromAny(), size_t(), Tcl_InvalidateStringRep(), Tcl_IsShared, tclByteArrayType, ByteArray::used, and VOID.
Referenced by DoReadChars(), ReadBytes(), and Tcl_BinaryObjCmd().348 {
349     ByteArray *byteArrayPtr, *newByteArrayPtr;
350     
351     if (Tcl_IsShared(objPtr)) {
352   panic("Tcl_SetObjLength called with shared object");
353     }
354     if (objPtr->typePtr != &tclByteArrayType) {
355   SetByteArrayFromAny(NULL, objPtr);
356     }
357 
358     byteArrayPtr = GET_BYTEARRAY(objPtr);
359     if (length > byteArrayPtr->allocated) {
360   newByteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
361   newByteArrayPtr->used = length;
362   newByteArrayPtr->allocated = length;
363   memcpy((VOID *) newByteArrayPtr->bytes,
364     (VOID *) byteArrayPtr->bytes, (size_t) byteArrayPtr->used);
365   ckfree((char *) byteArrayPtr);
366   byteArrayPtr = newByteArrayPtr;
367   SET_BYTEARRAY(objPtr, byteArrayPtr);
368     }
369     Tcl_InvalidateStringRep(objPtr);
370     byteArrayPtr->used = length;
371     return byteArrayPtr->bytes;
372 }
void Tcl_SetByteArrayObj (Tcl_Obj * objPtr, CONST unsigned char * bytes, int length)

Definition at line 259 of file tclBinary.c.
References ByteArray::allocated, BYTEARRAY_SIZE, ByteArray::bytes, ckalloc, Tcl_ObjType::freeIntRepProc, NULL, panic, SET_BYTEARRAY, size_t(), Tcl_InvalidateStringRep(), Tcl_IsShared, tclByteArrayType, ByteArray::used, and VOID.
Referenced by GetValue(), Tcl_EncodingObjCmd(), Tcl_NewByteArrayObj(), Tcl_ResourceObjCmd(), and Tcl_StringObjCmd().265 {
266     Tcl_ObjType *typePtr;
267     ByteArray *byteArrayPtr;
268 
269     if (Tcl_IsShared(objPtr)) {
270   panic("Tcl_SetByteArrayObj called with shared object");
271     }
272     typePtr = objPtr->typePtr;
273     if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
274   (*typePtr->freeIntRepProc)(objPtr);
275     }
276     Tcl_InvalidateStringRep(objPtr);
277 
278     byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
279     byteArrayPtr->used = length;
280     byteArrayPtr->allocated = length;
281     memcpy((VOID *) byteArrayPtr->bytes, (VOID *) bytes, (size_t) length);
282 
283     objPtr->typePtr = &tclByteArrayType;
284     SET_BYTEARRAY(objPtr, byteArrayPtr);
285 }
static void UpdateStringOfByteArray (Tcl_Obj * objPtr) [static]

Definition at line 511 of file tclBinary.c.
References ByteArray::bytes, ckalloc, GET_BYTEARRAY, size_t(), Tcl_UniCharToUtf(), ByteArray::used, and VOID.514 {
515     int i, length, size;
516     unsigned char *src;
517     char *dst;
518     ByteArray *byteArrayPtr;
519 
520     byteArrayPtr = GET_BYTEARRAY(objPtr);
521     src = byteArrayPtr->bytes;
522     length = byteArrayPtr->used;
523 
524     /*
525      * How much space will string rep need?
526      */
527      
528     size = length;
529     for (i = 0; i < length; i++) {
530   if ((src[i] == 0) || (src[i] > 127)) {
531       size++;
532   }
533     }
534 
535     dst = (char *) ckalloc((unsigned) (size + 1));
536     objPtr->bytes = dst;
537     objPtr->length = size;
538 
539     if (size == length) {
540   memcpy((VOID *) dst, (VOID *) src, (size_t) size);
541   dst[size] = '\0';
542     } else {
543   for (i = 0; i < length; i++) {
544       dst += Tcl_UniCharToUtf(src[i], dst);
545   }
546   *dst = '\0';
547     }
548 }

Variable Documentation
Tcl_ObjType tclByteArrayType
Initial value: {
    "bytearray",
    FreeByteArrayInternalRep,
    DupByteArrayInternalRep,
    UpdateStringOfByteArray,
    SetByteArrayFromAny
}
Definition at line 94 of file tclBinary.c.
Referenced by DupByteArrayInternalRep(), SetByteArrayFromAny(), Tcl_SetByteArrayLength(), Tcl_SetByteArrayObj(), Tcl_StringObjCmd(), TclExecuteByteCode(), and TclInitObjSubsystem().

generic/tclCkalloc.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Defines
#define FALSE  0
#define TRUE  1
Functions
char * Tcl_Alloc (unsigned int size)
char * Tcl_DbCkalloc (unsigned int size, CONST char *file, int line)
char * Tcl_AttemptAlloc (unsigned int size)
char * Tcl_AttemptDbCkalloc (unsigned int size, CONST char *file, int line)
char * Tcl_Realloc (char *ptr, unsigned int size)
char * Tcl_DbCkrealloc (char *ptr, unsigned int size, CONST char *file, int line)
char * Tcl_AttemptRealloc (char *ptr, unsigned int size)
char * Tcl_AttemptDbCkrealloc (char *ptr, unsigned int size, CONST char *file, int line)
void Tcl_Free (char *ptr)
int Tcl_DbCkfree (char *ptr, CONST char *file, int line)
void Tcl_InitMemory (Tcl_Interp *interp)
int Tcl_DumpActiveMemory (CONST char *fileName)
void Tcl_ValidateAllMemory (CONST char *file, int line)
void TclDumpMemoryInfo (FILE *outFile)
void TclFinalizeMemorySubsystem ()

Define Documentation
#define FALSE  0

Definition at line 22 of file tclCkalloc.c.#define TRUE  1

Definition at line 23 of file tclCkalloc.c.
Function Documentation
char* Tcl_Alloc (unsigned int size)

Definition at line 997 of file tclCkalloc.c.
References panic, and TclpAlloc().
Referenced by CheckVersion(), setargv(), SetTZIfNecessary(), and Tcl_CreateThread().999 {
1000     char *result;
1001 
1002     result = TclpAlloc(size);
1003     /*
1004      * Most systems will not alloc(0), instead bumping it to one so
1005      * that NULL isn't returned.  Some systems (AIX, Tru64) will alloc(0)
1006      * by returning NULL, so we have to check that the NULL we get is
1007      * not in response to alloc(0).
1008      *
1009      * The ANSI spec actually says that systems either return NULL *or*
1010      * a special pointer on failure, but we only check for NULL
1011      */
1012     if ((result == NULL) && size) {
1013   panic("unable to alloc %u bytes", size);
1014     }
1015     return result;
1016 }
char* Tcl_AttemptAlloc (unsigned int size)

Definition at line 1046 of file tclCkalloc.c.
References TclpAlloc().1048 {
1049     char *result;
1050 
1051     result = TclpAlloc(size);
1052     return result;
1053 }
char* Tcl_AttemptDbCkalloc (unsigned int size, CONST char  * file, int line)

Definition at line 1056 of file tclCkalloc.c.
References TclpAlloc().1060 {
1061     char *result;
1062 
1063     result = (char *) TclpAlloc(size);
1064     return result;
1065 }
char* Tcl_AttemptDbCkrealloc (char        * ptr, unsigned int size, CONST char  * file, int line)

Definition at line 1133 of file tclCkalloc.c.
References TclpRealloc().1138 {
1139     char *result;
1140 
1141     result = (char *) TclpRealloc(ptr, size);
1142     return result;
1143 }
char* Tcl_AttemptRealloc (char * ptr, unsigned int size)

Definition at line 1122 of file tclCkalloc.c.
References TclpRealloc().1125 {
1126     char *result;
1127 
1128     result = TclpRealloc(ptr, size);
1129     return result;
1130 }
char* Tcl_DbCkalloc (unsigned int size, CONST char  * file, int line)

Definition at line 1019 of file tclCkalloc.c.
References panic, and TclpAlloc().1023 {
1024     char *result;
1025 
1026     result = (char *) TclpAlloc(size);
1027 
1028     if ((result == NULL) && size) {
1029         fflush(stdout);
1030         panic("unable to alloc %u bytes, %s line %d", size, file, line);
1031     }
1032     return result;
1033 }
int Tcl_DbCkfree (char       * ptr, CONST char * file, int line)

Definition at line 1164 of file tclCkalloc.c.
References TclpFree().1168 {
1169     TclpFree(ptr);
1170     return 0;
1171 }
char* Tcl_DbCkrealloc (char        * ptr, unsigned int size, CONST char  * file, int line)

Definition at line 1094 of file tclCkalloc.c.
References panic, and TclpRealloc().1099 {
1100     char *result;
1101 
1102     result = (char *) TclpRealloc(ptr, size);
1103 
1104     if ((result == NULL) && size) {
1105         fflush(stdout);
1106         panic("unable to realloc %u bytes, %s line %d", size, file, line);
1107     }
1108     return result;
1109 }
int Tcl_DumpActiveMemory (CONST char * fileName)

Definition at line 1190 of file tclCkalloc.c.
References TCL_OK.1192 {
1193     return TCL_OK;
1194 }
void Tcl_Free (char * ptr)

Definition at line 1157 of file tclCkalloc.c.
References TclpFree().
Referenced by CheckVersion(), CleanupMemory(), ComparePkgVersions(), SetTZIfNecessary(), Tcl_PackageObjCmd(), Tcl_PkgPresentEx(), Tcl_PkgProvideEx(), and Tcl_UpdateObjCmd().1159 {
1160     TclpFree(ptr);
1161 }
void Tcl_InitMemory (Tcl_Interp * interp)

Definition at line 1184 of file tclCkalloc.c.1186 {
1187 }
char* Tcl_Realloc (char * ptr, unsigned int size)

Definition at line 1079 of file tclCkalloc.c.
References panic, and TclpRealloc().1082 {
1083     char *result;
1084 
1085     result = TclpRealloc(ptr, size);
1086 
1087     if ((result == NULL) && size) {
1088   panic("unable to realloc %u bytes", size);
1089     }
1090     return result;
1091 }
void Tcl_ValidateAllMemory (CONST char * file, int line)

Definition at line 1197 of file tclCkalloc.c.1200 {
1201 }
void TclDumpMemoryInfo (FILE * outFile)

Definition at line 1204 of file tclCkalloc.c.1206 {
1207 }
void TclFinalizeMemorySubsystem ()

Definition at line 1232 of file tclCkalloc.c.
References Tcl_DumpActiveMemory, Tcl_MutexLock, Tcl_MutexUnlock, tclMemDumpFileName, and TclpFree().
Referenced by Tcl_Finalize().1233 {
1234 #ifdef TCL_MEM_DEBUG
1235     if (tclMemDumpFileName != NULL) {
1236   Tcl_DumpActiveMemory(tclMemDumpFileName);
1237     } else if (onExitMemDumpFileName != NULL) {
1238   Tcl_DumpActiveMemory(onExitMemDumpFileName);
1239     }
1240     Tcl_MutexLock(ckallocMutexPtr);
1241     if (curTagPtr != NULL) {
1242   TclpFree((char *) curTagPtr);
1243   curTagPtr = NULL;
1244     }
1245     allocHead = NULL;
1246     Tcl_MutexUnlock(ckallocMutexPtr);
1247 #endif
1248 
1249 #if USE_TCLALLOC
1250     TclFinalizeAllocSubsystem(); 
1251 #endif
1252 }

generic/tclClock.c File Reference
#include "tcl.h"
#include "tclInt.h"
#include "tclPort.h"
Functions
TCL_DECLARE_MUTEX (clockMutex)
static int FormatClock (Tcl_Interp *interp, Tcl_WideInt clockVal, int useGMT, char *format)

Function Documentation
static int FormatClock (Tcl_Interp * interp, Tcl_WideInt clockVal, int useGMT, char * format) [static]

Definition at line 256 of file tclClock.c.
References ckalloc, ckfree, CONST, NULL, Tcl_DString::string, Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringSetLength(), Tcl_DStringValue, TCL_ERROR, Tcl_ExternalToUtfDString(), Tcl_GetObjResult(), Tcl_GetVar2(), TCL_GLOBAL_ONLY, Tcl_MutexLock, Tcl_MutexUnlock, TCL_OK, Tcl_SetStringObj(), Tcl_SetVar2(), Tcl_UnsetVar2(), Tcl_UtfToExternalDString(), TclpGetDate(), TclpStrftime(), and tzset.
Referenced by TCL_DECLARE_MUTEX().261 {
262     struct tm *timeDataPtr;
263     Tcl_DString buffer, uniBuffer;
264     int bufSize;
265     char *p;
266     int result;
267     time_t tclockVal;
268 #if !defined(HAVE_TM_ZONE) && !defined(WIN32)
269     int savedTimeZone = 0;  /* lint. */
270     char *savedTZEnv = NULL;  /* lint. */
271 #endif
272 
273 #ifdef HAVE_TZSET
274     /*
275      * Some systems forgot to call tzset in localtime, make sure its done.
276      */
277     static int  calledTzset = 0;
278 
279     Tcl_MutexLock(&clockMutex);
280     if (!calledTzset) {
281         tzset();
282         calledTzset = 1;
283     }
284     Tcl_MutexUnlock(&clockMutex);
285 #endif
286 
287     /*
288      * If the user gave us -format "", just return now
289      */
290     if (*format == '\0') {
291   return TCL_OK;
292     }
293 
294 #if !defined(HAVE_TM_ZONE) && !defined(WIN32)
295     /*
296      * This is a kludge for systems not having the timezone string in
297      * struct tm.  No matter what was specified, they use the local
298      * timezone string.  Since this kludge requires fiddling with the
299      * TZ environment variable, it will mess up if done on multiple
300      * threads at once.  Protect it with a the clock mutex.
301      */
302 
303     Tcl_MutexLock( &clockMutex );
304     if (useGMT) {
305         CONST char *varValue;
306 
307         varValue = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
308         if (varValue != NULL) {
309       savedTZEnv = strcpy(ckalloc(strlen(varValue) + 1), varValue);
310         } else {
311             savedTZEnv = NULL;
312   }
313         Tcl_SetVar2(interp, "env", "TZ", "GMT0", TCL_GLOBAL_ONLY);
314         savedTimeZone = timezone;
315         timezone = 0;
316         tzset();
317     }
318 #endif
319 
320     tclockVal = (time_t) clockVal;
321     timeDataPtr = TclpGetDate((TclpTime_t) &tclockVal, useGMT);
322     
323     /*
324      * Make a guess at the upper limit on the substituted string size
325      * based on the number of percents in the string.
326      */
327 
328     for (bufSize = 1, p = format; *p != '\0'; p++) {
329   if (*p == '%') {
330       bufSize += 40;
331   } else {
332       bufSize++;
333   }
334     }
335     Tcl_DStringInit(&uniBuffer);
336     Tcl_UtfToExternalDString(NULL, format, -1, &uniBuffer);
337     Tcl_DStringInit(&buffer);
338     Tcl_DStringSetLength(&buffer, bufSize);
339 
340     /* If we haven't locked the clock mutex up above, lock it now. */
341 
342 #if defined(HAVE_TM_ZONE) || defined(WIN32)
343     Tcl_MutexLock(&clockMutex);
344 #endif
345     result = TclpStrftime(buffer.string, (unsigned int) bufSize,
346       Tcl_DStringValue(&uniBuffer), timeDataPtr, useGMT);
347 #if defined(HAVE_TM_ZONE) || defined(WIN32)
348     Tcl_MutexUnlock(&clockMutex);
349 #endif
350     Tcl_DStringFree(&uniBuffer);
351 
352 #if !defined(HAVE_TM_ZONE) && !defined(WIN32)
353     if (useGMT) {
354         if (savedTZEnv != NULL) {
355             Tcl_SetVar2(interp, "env", "TZ", savedTZEnv, TCL_GLOBAL_ONLY);
356             ckfree(savedTZEnv);
357         } else {
358             Tcl_UnsetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
359         }
360         timezone = savedTimeZone;
361         tzset();
362     }
363     Tcl_MutexUnlock( &clockMutex );
364 #endif
365 
366     if (result == 0) {
367   /*
368    * A zero return is the error case (can also mean the strftime
369    * didn't get enough space to write into).  We know it doesn't
370    * mean that we wrote zero chars because the check for an empty
371    * format string is above.
372    */
373   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
374     "bad format string \"", format, "\"", (char *) NULL);
375   return TCL_ERROR;
376     }
377 
378     /*
379      * Convert the time to UTF from external encoding [Bug: 3345]
380      */
381     Tcl_DStringInit(&uniBuffer);
382     Tcl_ExternalToUtfDString(NULL, buffer.string, -1, &uniBuffer);
383 
384     Tcl_SetStringObj(Tcl_GetObjResult(interp), uniBuffer.string, -1);
385 
386     Tcl_DStringFree(&uniBuffer);
387     Tcl_DStringFree(&buffer);
388     return TCL_OK;
389 }
TCL_DECLARE_MUTEX (clockMutex)

Definition at line 25 of file tclClock.c.
References CONST, FormatClock(), NULL, Tcl_Time::sec, TCL_ERROR, Tcl_GetBooleanFromObj(), Tcl_GetIndexFromObj(), Tcl_GetObjResult(), Tcl_GetStringFromObj(), Tcl_GetTime(), Tcl_GetWideIntFromObj(), Tcl_MutexLock, Tcl_MutexUnlock, TCL_OK, Tcl_SetLongObj(), Tcl_SetWideIntObj(), Tcl_WrongNumArgs(), TclGetDate(), TclpGetClicks(), TclpGetSeconds(), TclpGetTimeZone(), and Tcl_Time::usec.28                                                         :
29  */
30 
31 static int    FormatClock _ANSI_ARGS_((Tcl_Interp *interp,
32           Tcl_WideInt clockVal, int useGMT,
33           char *format));
34 
35 /*
36  *-------------------------------------------------------------------------
37  *
38  * Tcl_ClockObjCmd --
39  *
40  *  This procedure is invoked to process the "clock" Tcl command.
41  *  See the user documentation for details on what it does.
42  *
43  * Results:
44  *  A standard Tcl result.
45  *
46  * Side effects:
47  *  See the user documentation.
48  *
49  *-------------------------------------------------------------------------
50  */
51 
52 int
53 Tcl_ClockObjCmd (client, interp, objc, objv)
54     ClientData client;      /* Not used. */
55     Tcl_Interp *interp;     /* Current interpreter. */
56     int objc;       /* Number of arguments. */
57     Tcl_Obj *CONST objv[];    /* Argument values. */
58 {
59     Tcl_Obj *resultPtr;
60     int index;
61     Tcl_Obj *CONST *objPtr;
62     int useGMT = 0;
63     char *format = "%a %b %d %X %Z %Y";
64     int dummy;
65     Tcl_WideInt baseClock, clockVal;
66     long zone;
67     Tcl_Obj *baseObjPtr = NULL;
68     char *scanStr;
69     int n;
70     
71     static CONST char *switches[] =
72   {"clicks", "format", "scan", "seconds", (char *) NULL};
73     enum command { COMMAND_CLICKS, COMMAND_FORMAT, COMMAND_SCAN,
74            COMMAND_SECONDS
75     };
76     static CONST char *formatSwitches[] = {"-format", "-gmt", (char *) NULL};
77     static CONST char *scanSwitches[] = {"-base", "-gmt", (char *) NULL};
78 
79     resultPtr = Tcl_GetObjResult(interp);
80     if (objc < 2) {
81   Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
82   return TCL_ERROR;
83     }
84 
85     if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index)
86       != TCL_OK) {
87   return TCL_ERROR;
88     }
89     switch ((enum command) index) {
90   case COMMAND_CLICKS:  {   /* clicks */
91       int forceMilli = 0;
92 
93       if (objc == 3) {
94     format = Tcl_GetStringFromObj(objv[2], &n);
95     if ( ( n >= 2 ) 
96          && ( strncmp( format, "-milliseconds",
97            (unsigned int) n) == 0 ) ) {
98         forceMilli = 1;
99     } else {
100         Tcl_AppendStringsToObj(resultPtr,
101           "bad switch \"", format,
102           "\": must be -milliseconds", (char *) NULL);
103         return TCL_ERROR;
104     }
105       } else if (objc != 2) {
106     Tcl_WrongNumArgs(interp, 2, objv, "?-milliseconds?");
107     return TCL_ERROR;
108       }
109       if (forceMilli) {
110     /*
111      * We can enforce at least millisecond granularity
112      */
113     Tcl_Time time;
114     Tcl_GetTime(&time);
115     Tcl_SetLongObj(resultPtr,
116       (long) (time.sec*1000 + time.usec/1000));
117       } else {
118     Tcl_SetLongObj(resultPtr, (long) TclpGetClicks());
119       }
120       return TCL_OK;
121   }
122 
123   case COMMAND_FORMAT:      /* format */
124       if ((objc < 3) || (objc > 7)) {
125     wrongFmtArgs:
126     Tcl_WrongNumArgs(interp, 2, objv,
127       "clockval ?-format string? ?-gmt boolean?");
128     return TCL_ERROR;
129       }
130 
131       if (Tcl_GetWideIntFromObj(interp, objv[2], &clockVal)
132         != TCL_OK) {
133     return TCL_ERROR;
134       }
135     
136       objPtr = objv+3;
137       objc -= 3;
138       while (objc > 1) {
139     if (Tcl_GetIndexFromObj(interp, objPtr[0], formatSwitches,
140       "switch", 0, &index) != TCL_OK) {
141         return TCL_ERROR;
142     }
143     switch (index) {
144         case 0:   /* -format */
145       format = Tcl_GetStringFromObj(objPtr[1], &dummy);
146       break;
147         case 1:   /* -gmt */
148       if (Tcl_GetBooleanFromObj(interp, objPtr[1],
149         &useGMT) != TCL_OK) {
150           return TCL_ERROR;
151       }
152       break;
153     }
154     objPtr += 2;
155     objc -= 2;
156       }
157       if (objc != 0) {
158     goto wrongFmtArgs;
159       }
160       return FormatClock(interp, clockVal, useGMT,
161         format);
162 
163   case COMMAND_SCAN:      /* scan */
164       if ((objc < 3) || (objc > 7)) {
165     wrongScanArgs:
166     Tcl_WrongNumArgs(interp, 2, objv,
167       "dateString ?-base clockValue? ?-gmt boolean?");
168     return TCL_ERROR;
169       }
170 
171       objPtr = objv+3;
172       objc -= 3;
173       while (objc > 1) {
174     if (Tcl_GetIndexFromObj(interp, objPtr[0], scanSwitches,
175       "switch", 0, &index) != TCL_OK) {
176         return TCL_ERROR;
177     }
178     switch (index) {
179         case 0:   /* -base */
180       baseObjPtr = objPtr[1];
181       break;
182         case 1:   /* -gmt */
183       if (Tcl_GetBooleanFromObj(interp, objPtr[1],
184         &useGMT) != TCL_OK) {
185           return TCL_ERROR;
186       }
187       break;
188     }
189     objPtr += 2;
190     objc -= 2;
191       }
192       if (objc != 0) {
193     goto wrongScanArgs;
194       }
195 
196       if (baseObjPtr != NULL) {
197     if (Tcl_GetWideIntFromObj(interp, baseObjPtr,
198             &baseClock) != TCL_OK) {
199         return TCL_ERROR;
200     }
201       } else {
202     baseClock = TclpGetSeconds();
203       }
204 
205       if (useGMT) {
206     zone = -50000; /* Force GMT */
207       } else {
208     zone = TclpGetTimeZone(baseClock);
209       }
210 
211       scanStr = Tcl_GetStringFromObj(objv[2], &dummy);
212       Tcl_MutexLock(&clockMutex);
213       if (TclGetDate(scanStr, baseClock, zone,
214         &clockVal) < 0) {
215     Tcl_MutexUnlock(&clockMutex);
216     Tcl_AppendStringsToObj(resultPtr,
217       "unable to convert date-time string \"",
218       scanStr, "\"", (char *) NULL);
219     return TCL_ERROR;
220       }
221       Tcl_MutexUnlock(&clockMutex);
222 
223       Tcl_SetWideIntObj(resultPtr, clockVal);
224       return TCL_OK;
225 
226   case COMMAND_SECONDS:     /* seconds */
227       if (objc != 2) {
228     Tcl_WrongNumArgs(interp, 2, objv, NULL);
229     return TCL_ERROR;
230       }
231       Tcl_SetLongObj(resultPtr, (long) TclpGetSeconds());
232       return TCL_OK;
233   default:
234       return TCL_ERROR; /* Should never be reached. */
235     }
236 }


generic/tclCmdAH.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include <locale.h>
Defines
#define STORE_ARY(fieldName, object)
#define NUM_ARGS  9
#define STATIC_LIST_SIZE  4
#define INT_VALUE  0
#define CHAR_VALUE  1
#define PTR_VALUE  2
#define DOUBLE_VALUE  3
#define STRING_VALUE  4
#define WIDE_VALUE  5
#define MAX_FLOAT_SIZE  320
Functions
static int CheckAccess _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int mode))
static int GetStatBuf _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_FSStatProc *statProc, Tcl_StatBuf *statPtr))
static char *GetTypeFromMode _ANSI_ARGS_ ((int mode))
static int StoreStatData _ANSI_ARGS_ ((Tcl_Interp *interp, char *varName, Tcl_StatBuf *statPtr))
int Tcl_BreakObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_CaseObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_CatchObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_CdObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_ConcatObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_ContinueObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_EncodingObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_ErrorObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_EvalObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_ExitObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_ExprObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_FileObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int CheckAccess (Tcl_Interp *interp, Tcl_Obj *objPtr, int mode)
static int GetStatBuf (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_FSStatProc *statProc, Tcl_StatBuf *statPtr)
static int StoreStatData (Tcl_Interp *interp, char *varName, Tcl_StatBuf *statPtr)
static char * GetTypeFromMode (int mode)
int Tcl_ForObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_ForeachObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_FormatObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)

Define Documentation
#define CHAR_VALUE  1

Referenced by Tcl_FormatObjCmd().#define DOUBLE_VALUE  3

Referenced by Tcl_FormatObjCmd().#define INT_VALUE  0

Referenced by Tcl_FormatObjCmd().#define MAX_FLOAT_SIZE  320

Referenced by Tcl_FormatObjCmd().#define NUM_ARGS  9
#define PTR_VALUE  2

Referenced by Tcl_FormatObjCmd().#define STATIC_LIST_SIZE  4

Referenced by Tcl_AppendResultVA(), Tcl_AppendStringsToObjVA(), Tcl_ForeachObjCmd(), and ValidateFormat().#define STORE_ARY(fieldName, object)
Value:Tcl_SetStringObj(field, (fieldName), -1); \
    value = (object); \
    if (Tcl_ObjSetVar2(interp,var,field,value,TCL_LEAVE_ERR_MSG) == NULL) { \
  Tcl_DecrRefCount(var); \
  Tcl_DecrRefCount(field); \
  Tcl_DecrRefCount(value); \
  return TCL_ERROR; \
    }
Referenced by StoreStatData().#define STRING_VALUE  4

Referenced by Tcl_FormatObjCmd().#define WIDE_VALUE  5

Referenced by Tcl_FormatObjCmd().
Function Documentation
static int StoreStatData _ANSI_ARGS_ ((Tcl_Interp *interp, char *varName, Tcl_StatBuf *statPtr)) [static]
static char* GetTypeFromMode _ANSI_ARGS_ ((int mode)) [static]
static int GetStatBuf _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_FSStatProc *statProc, Tcl_StatBuf *statPtr)) [static]
static int CheckAccess _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int mode)) [static]
static int CheckAccess (Tcl_Interp * interp, Tcl_Obj * objPtr, int mode) [static]

Definition at line 1396 of file tclCmdAH.c.
References Tcl_FSAccess(), Tcl_FSConvertToPathType(), Tcl_GetObjResult(), TCL_OK, and Tcl_SetBooleanObj().
Referenced by Tcl_FileObjCmd().1402 {
1403     int value;
1404     
1405     if (Tcl_FSConvertToPathType(interp, objPtr) != TCL_OK) {
1406   value = 0;
1407     } else {
1408   value = (Tcl_FSAccess(objPtr, mode) == 0);
1409     }
1410     Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
1411 
1412     return TCL_OK;
1413 }
static int GetStatBuf (Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_FSStatProc * statProc, Tcl_StatBuf * statPtr) [static]

Definition at line 1436 of file tclCmdAH.c.
References NULL, status, TCL_ERROR, Tcl_FSConvertToPathType(), Tcl_GetString(), TCL_OK, and Tcl_PosixError().
Referenced by Tcl_FileObjCmd().1443 {
1444     int status;
1445     
1446     if (Tcl_FSConvertToPathType(interp, objPtr) != TCL_OK) {
1447   return TCL_ERROR;
1448     }
1449 
1450     status = (*statProc)(objPtr, statPtr);
1451     
1452     if (status < 0) {
1453   if (interp != NULL) {
1454       Tcl_AppendResult(interp, "could not read \"",
1455         Tcl_GetString(objPtr), "\": ",
1456         Tcl_PosixError(interp), (char *) NULL);
1457   }
1458   return TCL_ERROR;
1459     }
1460     return TCL_OK;
1461 }
static char* GetTypeFromMode (int mode) [static]

Definition at line 1554 of file tclCmdAH.c.
References S_ISBLK, S_ISCHR, S_ISDIR, S_ISFIFO, S_ISLNK, S_ISREG, and S_ISSOCK.
Referenced by StoreStatData(), and Tcl_FileObjCmd().1556 {
1557     if (S_ISREG(mode)) {
1558   return "file";
1559     } else if (S_ISDIR(mode)) {
1560   return "directory";
1561     } else if (S_ISCHR(mode)) {
1562   return "characterSpecial";
1563     } else if (S_ISBLK(mode)) {
1564   return "blockSpecial";
1565     } else if (S_ISFIFO(mode)) {
1566   return "fifo";
1567 #ifdef S_ISLNK
1568     } else if (S_ISLNK(mode)) {
1569   return "link";
1570 #endif
1571 #ifdef S_ISSOCK
1572     } else if (S_ISSOCK(mode)) {
1573   return "socket";
1574 #endif
1575     }
1576     return "unknown";
1577 }
static int StoreStatData (Tcl_Interp * interp, char * varName, Tcl_StatBuf * statPtr) [static]

Definition at line 1483 of file tclCmdAH.c.
References GetTypeFromMode(), STORE_ARY, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_NewIntObj(), Tcl_NewLongObj(), Tcl_NewObj(), Tcl_NewStringObj(), Tcl_NewWideIntObj(), and TCL_OK.
Referenced by Tcl_FileObjCmd().1489 {
1490     Tcl_Obj *var = Tcl_NewStringObj(varName, -1);
1491     Tcl_Obj *field = Tcl_NewObj();
1492     Tcl_Obj *value;
1493     register unsigned short mode;
1494 
1495     /*
1496      * Assume Tcl_ObjSetVar2() does not keep a copy of the field name!
1497      */
1498 #define STORE_ARY(fieldName, object) \
1499     Tcl_SetStringObj(field, (fieldName), -1); \
1500     value = (object); \
1501     if (Tcl_ObjSetVar2(interp,var,field,value,TCL_LEAVE_ERR_MSG) == NULL) { \
1502   Tcl_DecrRefCount(var); \
1503   Tcl_DecrRefCount(field); \
1504   Tcl_DecrRefCount(value); \
1505   return TCL_ERROR; \
1506     }
1507 
1508     Tcl_IncrRefCount(var);
1509     Tcl_IncrRefCount(field);
1510     STORE_ARY("dev",   Tcl_NewLongObj((long)statPtr->st_dev));
1511     /*
1512      * Watch out porters; the inode is meant to be an *unsigned* value,
1513      * so the cast might fail when there isn't a real arithmentic 'long
1514      * long' type...
1515      */
1516     STORE_ARY("ino",   Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
1517     STORE_ARY("nlink", Tcl_NewLongObj((long)statPtr->st_nlink));
1518     STORE_ARY("uid",   Tcl_NewLongObj((long)statPtr->st_uid));
1519     STORE_ARY("gid",   Tcl_NewLongObj((long)statPtr->st_gid));
1520     STORE_ARY("size",  Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
1521 #ifdef HAVE_ST_BLOCKS
1522     STORE_ARY("blocks",Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
1523 #endif
1524     STORE_ARY("atime", Tcl_NewLongObj((long)statPtr->st_atime));
1525     STORE_ARY("mtime", Tcl_NewLongObj((long)statPtr->st_mtime));
1526     STORE_ARY("ctime", Tcl_NewLongObj((long)statPtr->st_ctime));
1527     mode = (unsigned short) statPtr->st_mode;
1528     STORE_ARY("mode",  Tcl_NewIntObj(mode));
1529     STORE_ARY("type",  Tcl_NewStringObj(GetTypeFromMode(mode), -1));
1530 #undef STORE_ARY
1531     Tcl_DecrRefCount(var);
1532     Tcl_DecrRefCount(field);
1533     return TCL_OK;
1534 }
int Tcl_BreakObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 57 of file tclCmdAH.c.
References NULL, TCL_BREAK, TCL_ERROR, and Tcl_WrongNumArgs().62 {
63     if (objc != 1) {
64   Tcl_WrongNumArgs(interp, 1, objv, NULL);
65   return TCL_ERROR;
66     }
67     return TCL_BREAK;
68 }
int Tcl_CaseObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 89 of file tclCmdAH.c.
References ckfree, CONST, Tcl_Interp::errorLine, Tcl_AddObjErrorInfo(), Tcl_AppendToObj(), TCL_ERROR, Tcl_EvalObjEx(), Tcl_GetObjResult(), Tcl_GetString(), TCL_INTEGER_SPACE, Tcl_ListObjGetElements(), TCL_OK, Tcl_ResetResult(), Tcl_SplitList(), Tcl_StringMatch(), and Tcl_WrongNumArgs().94 {
95     register int i;
96     int body, result, caseObjc;
97     char *string, *arg;
98     Tcl_Obj *CONST *caseObjv;
99     Tcl_Obj *armPtr;
100 
101     if (objc < 3) {
102   Tcl_WrongNumArgs(interp, 1, objv,
103     "string ?in? patList body ... ?default body?");
104   return TCL_ERROR;
105     }
106 
107     string = Tcl_GetString(objv[1]);
108     body = -1;
109 
110     arg = Tcl_GetString(objv[2]);
111     if (strcmp(arg, "in") == 0) {
112   i = 3;
113     } else {
114   i = 2;
115     }
116     caseObjc = objc - i;
117     caseObjv = objv + i;
118 
119     /*
120      * If all of the pattern/command pairs are lumped into a single
121      * argument, split them out again.
122      */
123 
124     if (caseObjc == 1) {
125   Tcl_Obj **newObjv;
126   
127   Tcl_ListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
128   caseObjv = newObjv;
129     }
130 
131     for (i = 0;  i < caseObjc;  i += 2) {
132   int patObjc, j;
133   CONST char **patObjv;
134   char *pat;
135   unsigned char *p;
136 
137   if (i == (caseObjc - 1)) {
138       Tcl_ResetResult(interp);
139       Tcl_AppendToObj(Tcl_GetObjResult(interp),
140               "extra case pattern with no body", -1);
141       return TCL_ERROR;
142   }
143 
144   /*
145    * Check for special case of single pattern (no list) with
146    * no backslash sequences.
147    */
148 
149   pat = Tcl_GetString(caseObjv[i]);
150   for (p = (unsigned char *) pat; *p != '\0'; p++) {
151       if (isspace(*p) || (*p == '\\')) {  /* INTL: ISO space, UCHAR */
152     break;
153       }
154   }
155   if (*p == '\0') {
156       if ((*pat == 'd') && (strcmp(pat, "default") == 0)) {
157     body = i + 1;
158       }
159       if (Tcl_StringMatch(string, pat)) {
160     body = i + 1;
161     goto match;
162       }
163       continue;
164   }
165 
166 
167   /*
168    * Break up pattern lists, then check each of the patterns
169    * in the list.
170    */
171 
172   result = Tcl_SplitList(interp, pat, &patObjc, &patObjv);
173   if (result != TCL_OK) {
174       return result;
175   }
176   for (j = 0; j < patObjc; j++) {
177       if (Tcl_StringMatch(string, patObjv[j])) {
178     body = i + 1;
179     break;
180       }
181   }
182   ckfree((char *) patObjv);
183   if (j < patObjc) {
184       break;
185   }
186     }
187 
188     match:
189     if (body != -1) {
190   armPtr = caseObjv[body - 1];
191   result = Tcl_EvalObjEx(interp, caseObjv[body], 0);
192   if (result == TCL_ERROR) {
193       char msg[100 + TCL_INTEGER_SPACE];
194       
195       arg = Tcl_GetString(armPtr);
196       sprintf(msg,
197         "\n    (\"%.50s\" arm line %d)", arg,
198               interp->errorLine);
199       Tcl_AddObjErrorInfo(interp, msg, -1);
200   }
201   return result;
202     }
203 
204     /*
205      * Nothing matched: return nothing.
206      */
207 
208     return TCL_OK;
209 }
int Tcl_CatchObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 230 of file tclCmdAH.c.
References NULL, Tcl_AppendToObj(), TCL_ERROR, Tcl_EvalObjEx(), Tcl_GetObjResult(), Tcl_ObjSetVar2(), TCL_OK, Tcl_ResetResult(), Tcl_SetIntObj(), and Tcl_WrongNumArgs().235 {
236     Tcl_Obj *varNamePtr = NULL;
237     int result;
238 
239     if ((objc != 2) && (objc != 3)) {
240   Tcl_WrongNumArgs(interp, 1, objv, "command ?varName?");
241   return TCL_ERROR;
242     }
243 
244     if (objc == 3) {
245   varNamePtr = objv[2];
246     }
247 
248     result = Tcl_EvalObjEx(interp, objv[1], 0);
249     
250     if (objc == 3) {
251   if (Tcl_ObjSetVar2(interp, varNamePtr, NULL,
252     Tcl_GetObjResult(interp), 0) == NULL) {
253       Tcl_ResetResult(interp);
254       Tcl_AppendToObj(Tcl_GetObjResult(interp),  
255               "couldn't save command result in variable", -1);
256       return TCL_ERROR;
257   }
258     }
259 
260     /*
261      * Set the interpreter's object result to an integer object holding the
262      * integer Tcl_EvalObj result. Note that we don't bother generating a
263      * string representation. We reset the interpreter's object result
264      * to an unshared empty object and then set it to be an integer object.
265      */
266 
267     Tcl_ResetResult(interp);
268     Tcl_SetIntObj(Tcl_GetObjResult(interp), result);
269     return TCL_OK;
270 }
int Tcl_CdObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 291 of file tclCmdAH.c.
References NULL, Tcl_DecrRefCount, TCL_ERROR, Tcl_FSChdir(), Tcl_FSConvertToPathType(), Tcl_GetString(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_OK, Tcl_PosixError(), and Tcl_WrongNumArgs().296 {
297     Tcl_Obj *dir;
298     int result;
299 
300     if (objc > 2) {
301   Tcl_WrongNumArgs(interp, 1, objv, "?dirName?");
302   return TCL_ERROR;
303     }
304 
305     if (objc == 2) {
306   dir = objv[1];
307     } else {
308   dir = Tcl_NewStringObj("~",1);
309   Tcl_IncrRefCount(dir);
310     }
311     if (Tcl_FSConvertToPathType(interp, dir) != TCL_OK) {
312   result = TCL_ERROR;
313     } else {
314   result = Tcl_FSChdir(dir);
315   if (result != TCL_OK) {
316       Tcl_AppendResult(interp, "couldn't change working directory to \"",
317         Tcl_GetString(dir), "\": ", Tcl_PosixError(interp), (char *) NULL);
318       result = TCL_ERROR;
319   }
320     }
321     if (objc != 2) {
322   Tcl_DecrRefCount(dir);
323     }
324     return result;
325 }
int Tcl_ConcatObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 346 of file tclCmdAH.c.
References Tcl_ConcatObj(), TCL_OK, and Tcl_SetObjResult().351 {
352     if (objc >= 2) {
353   Tcl_SetObjResult(interp, Tcl_ConcatObj(objc-1, objv+1));
354     }
355     return TCL_OK;
356 }
int Tcl_ContinueObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 381 of file tclCmdAH.c.
References NULL, TCL_CONTINUE, TCL_ERROR, and Tcl_WrongNumArgs().386 {
387     if (objc != 1) {
388   Tcl_WrongNumArgs(interp, 1, objv, NULL);
389   return TCL_ERROR;
390     }
391     return TCL_CONTINUE;
392 }
int Tcl_EncodingObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 411 of file tclCmdAH.c.
References CONST, NULL, Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, TCL_ERROR, Tcl_ExternalToUtfDString(), Tcl_FreeEncoding(), Tcl_GetByteArrayFromObj(), Tcl_GetEncoding(), Tcl_GetEncodingName(), Tcl_GetEncodingNames(), Tcl_GetIndexFromObj(), Tcl_GetObjResult(), Tcl_GetStringFromObj(), TCL_OK, Tcl_SetByteArrayObj(), Tcl_SetStringObj(), Tcl_SetSystemEncoding(), Tcl_UtfToExternalDString(), Tcl_WrongNumArgs(), and TclGetEncodingFromObj().416 {
417     int index, length;
418     Tcl_Encoding encoding;
419     char *string;
420     Tcl_DString ds;
421     Tcl_Obj *resultPtr;
422 
423     static CONST char *optionStrings[] = {
424   "convertfrom", "convertto", "names", "system",
425   NULL
426     };
427     enum options {
428   ENC_CONVERTFROM, ENC_CONVERTTO, ENC_NAMES, ENC_SYSTEM
429     };
430 
431     if (objc < 2) {
432       Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
433         return TCL_ERROR;
434     }
435     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
436       &index) != TCL_OK) {
437   return TCL_ERROR;
438     }
439 
440     switch ((enum options) index) {
441   case ENC_CONVERTTO:
442   case ENC_CONVERTFROM: {
443       Tcl_Obj *data;
444       if (objc == 3) {
445     encoding = Tcl_GetEncoding(interp, NULL);
446     data = objv[2];
447       } else if (objc == 4) {
448     if (TclGetEncodingFromObj(interp, objv[2], &encoding)
449       != TCL_OK) {
450         return TCL_ERROR;
451     }
452     data = objv[3];
453       } else {
454     Tcl_WrongNumArgs(interp, 2, objv, "?encoding? data");
455     return TCL_ERROR;
456       }
457       
458       if ((enum options) index == ENC_CONVERTFROM) {
459     /*
460      * Treat the string as binary data.
461      */
462 
463     string = (char *) Tcl_GetByteArrayFromObj(data, &length);
464     Tcl_ExternalToUtfDString(encoding, string, length, &ds);
465 
466     /*
467      * Note that we cannot use Tcl_DStringResult here because
468      * it will truncate the string at the first null byte.
469      */
470 
471     Tcl_SetStringObj(Tcl_GetObjResult(interp),
472       Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
473     Tcl_DStringFree(&ds);
474       } else {
475     /*
476      * Store the result as binary data.
477      */
478 
479     string = Tcl_GetStringFromObj(data, &length);
480     Tcl_UtfToExternalDString(encoding, string, length, &ds);
481     resultPtr = Tcl_GetObjResult(interp);
482     Tcl_SetByteArrayObj(resultPtr, 
483       (unsigned char *) Tcl_DStringValue(&ds),
484       Tcl_DStringLength(&ds));
485     Tcl_DStringFree(&ds);
486       }
487 
488       Tcl_FreeEncoding(encoding);
489       break;
490   }
491   case ENC_NAMES: {
492       if (objc > 2) {
493     Tcl_WrongNumArgs(interp, 2, objv, NULL);
494     return TCL_ERROR;
495       }
496       Tcl_GetEncodingNames(interp);
497       break;
498   }
499   case ENC_SYSTEM: {
500       if (objc > 3) {
501     Tcl_WrongNumArgs(interp, 2, objv, "?encoding?");
502     return TCL_ERROR;
503       }
504       if (objc == 2) {
505     Tcl_SetStringObj(Tcl_GetObjResult(interp),
506       Tcl_GetEncodingName(NULL), -1);
507       } else {
508           return Tcl_SetSystemEncoding(interp,
509       Tcl_GetStringFromObj(objv[2], NULL));
510       }
511       break;
512   }
513     }
514     return TCL_OK;
515 }
int Tcl_ErrorObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 536 of file tclCmdAH.c.
References ERR_ALREADY_LOGGED, ERROR_CODE_SET, Interp::flags, NULL, Tcl_AddObjErrorInfo(), TCL_ERROR, Tcl_GetStringFromObj(), TCL_GLOBAL_ONLY, Tcl_SetObjResult(), Tcl_SetVar2Ex(), and Tcl_WrongNumArgs().541 {
542     Interp *iPtr = (Interp *) interp;
543     char *info;
544     int infoLen;
545 
546     if ((objc < 2) || (objc > 4)) {
547   Tcl_WrongNumArgs(interp, 1, objv, "message ?errorInfo? ?errorCode?");
548   return TCL_ERROR;
549     }
550     
551     if (objc >= 3) {    /* process the optional info argument */
552   info = Tcl_GetStringFromObj(objv[2], &infoLen);
553   if (infoLen > 0) {
554       Tcl_AddObjErrorInfo(interp, info, infoLen);
555       iPtr->flags |= ERR_ALREADY_LOGGED;
556   }
557     }
558     
559     if (objc == 4) {
560   Tcl_SetVar2Ex(interp, "errorCode", NULL, objv[3], TCL_GLOBAL_ONLY);
561   iPtr->flags |= ERROR_CODE_SET;
562     }
563     
564     Tcl_SetObjResult(interp, objv[1]);
565     return TCL_ERROR;
566 }
int Tcl_EvalObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 587 of file tclCmdAH.c.
References Tcl_Interp::errorLine, Tcl_AddObjErrorInfo(), Tcl_ConcatObj(), TCL_ERROR, TCL_EVAL_DIRECT, Tcl_EvalObjEx(), TCL_INTEGER_SPACE, and Tcl_WrongNumArgs().592 {
593     int result;
594     register Tcl_Obj *objPtr;
595 
596     if (objc < 2) {
597   Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
598   return TCL_ERROR;
599     }
600     
601     if (objc == 2) {
602   result = Tcl_EvalObjEx(interp, objv[1], TCL_EVAL_DIRECT);
603     } else {
604   /*
605    * More than one argument: concatenate them together with spaces
606    * between, then evaluate the result.  Tcl_EvalObjEx will delete
607    * the object when it decrements its refcount after eval'ing it.
608    */
609       objPtr = Tcl_ConcatObj(objc-1, objv+1);
610   result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
611     }
612     if (result == TCL_ERROR) {
613   char msg[32 + TCL_INTEGER_SPACE];
614 
615   sprintf(msg, "\n    (\"eval\" body line %d)", interp->errorLine);
616   Tcl_AddObjErrorInfo(interp, msg, -1);
617     }
618     return result;
619 }
int Tcl_ExitObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 640 of file tclCmdAH.c.
References TCL_ERROR, Tcl_Exit(), Tcl_GetIntFromObj(), TCL_OK, and Tcl_WrongNumArgs().645 {
646     int value;
647 
648     if ((objc != 1) && (objc != 2)) {
649   Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
650   return TCL_ERROR;
651     }
652     
653     if (objc == 1) {
654   value = 0;
655     } else if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) {
656   return TCL_ERROR;
657     }
658     Tcl_Exit(value);
659     /*NOTREACHED*/
660     return TCL_OK;      /* Better not ever reach this! */
661 }
int Tcl_ExprObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 689 of file tclCmdAH.c.
References Tcl_AppendToObj(), Tcl_DecrRefCount, TCL_ERROR, Tcl_ExprObj(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_OK, Tcl_SetObjResult(), and Tcl_WrongNumArgs().694 {  
695     register Tcl_Obj *objPtr;
696     Tcl_Obj *resultPtr;
697     register char *bytes;
698     int length, i, result;
699 
700     if (objc < 2) {
701   Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
702   return TCL_ERROR;
703     }
704 
705     if (objc == 2) {
706   result = Tcl_ExprObj(interp, objv[1], &resultPtr);
707   if (result == TCL_OK) {
708       Tcl_SetObjResult(interp, resultPtr);
709       Tcl_DecrRefCount(resultPtr);  /* done with the result object */
710   }
711   return result;
712     }
713 
714     /*
715      * Create a new object holding the concatenated argument strings.
716      */
717 
718     /*** QUESTION: Do we need to copy the slow way? ***/
719     bytes = Tcl_GetStringFromObj(objv[1], &length);
720     objPtr = Tcl_NewStringObj(bytes, length);
721     Tcl_IncrRefCount(objPtr);
722     for (i = 2;  i < objc;  i++) {
723   Tcl_AppendToObj(objPtr, " ", 1);
724   bytes = Tcl_GetStringFromObj(objv[i], &length);
725   Tcl_AppendToObj(objPtr, bytes, length);
726     }
727 
728     /*
729      * Evaluate the concatenated string object.
730      */
731 
732     result = Tcl_ExprObj(interp, objPtr, &resultPtr);
733     if (result == TCL_OK) {
734   Tcl_SetObjResult(interp, resultPtr);
735   Tcl_DecrRefCount(resultPtr);  /* done with the result object */
736     }
737 
738     /*
739      * Free allocated resources.
740      */
741     
742     Tcl_DecrRefCount(objPtr);
743     return result;
744 }
int Tcl_FileObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 769 of file tclCmdAH.c.
References CheckAccess(), CONST, EEXIST, ENOENT, errno, F_OK, geteuid, GetStatBuf(), GetTypeFromMode(), NULL, R_OK, S_ISDIR, S_ISREG, StoreStatData(), TCL_CREATE_HARD_LINK, TCL_CREATE_SYMBOLIC_LINK, Tcl_DecrRefCount, Tcl_DStringFree(), Tcl_DStringLength, TCL_ERROR, Tcl_FSConvertToPathType(), Tcl_FSFileSystemInfo(), Tcl_FSGetNormalizedPath(), Tcl_FSGetPathType(), Tcl_FSJoinToPath(), Tcl_FSLink(), Tcl_FSListVolumes(), Tcl_FSLstat(), Tcl_FSPathSeparator(), Tcl_FSSplitPath(), Tcl_FSStat(), Tcl_FSUtime(), Tcl_GetChannelNamesEx(), Tcl_GetIndexFromObj(), Tcl_GetLongFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_ListObjIndex(), Tcl_NewStringObj(), TCL_OK, TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, TCL_PATH_VOLUME_RELATIVE, TCL_PLATFORM_MAC, TCL_PLATFORM_UNIX, TCL_PLATFORM_WINDOWS, Tcl_PosixError(), Tcl_SetBooleanObj(), Tcl_SetLongObj(), Tcl_SetObjResult(), Tcl_SetStringObj(), Tcl_SetWideIntObj(), Tcl_TranslateFileName(), Tcl_WrongNumArgs(), TclFileAttrsCmd(), TclFileCopyCmd(), TclFileDeleteCmd(), TclFileDirname(), TclFileMakeDirsCmd(), TclFileRenameCmd(), TclGetExtension(), tclPlatform, W_OK, and X_OK.774 {
775     int index;
776 
777 /*
778  * This list of constants should match the fileOption string array below.
779  */
780 
781     static CONST char *fileOptions[] = {
782   "atime",  "attributes", "channels", "copy",
783   "delete",
784   "dirname",  "executable", "exists", "extension",
785   "isdirectory",  "isfile", "join",   "link",
786   "lstat",        "mtime",  "mkdir",  "nativename", 
787   "normalize",    "owned",
788   "pathtype", "readable", "readlink", "rename",
789   "rootname", "separator",    "size",   "split",  
790   "stat",         "system", 
791   "tail",   "type",   "volumes",  "writable",
792   (char *) NULL
793     };
794     enum options {
795   FCMD_ATIME, FCMD_ATTRIBUTES, FCMD_CHANNELS, FCMD_COPY,
796   FCMD_DELETE,
797   FCMD_DIRNAME, FCMD_EXECUTABLE, FCMD_EXISTS, FCMD_EXTENSION,
798   FCMD_ISDIRECTORY, FCMD_ISFILE,  FCMD_JOIN,  FCMD_LINK, 
799   FCMD_LSTAT,     FCMD_MTIME, FCMD_MKDIR, FCMD_NATIVENAME, 
800   FCMD_NORMALIZE, FCMD_OWNED,
801   FCMD_PATHTYPE,  FCMD_READABLE,  FCMD_READLINK,  FCMD_RENAME,
802   FCMD_ROOTNAME,  FCMD_SEPARATOR, FCMD_SIZE,  FCMD_SPLIT, 
803   FCMD_STAT,      FCMD_SYSTEM, 
804   FCMD_TAIL,  FCMD_TYPE,  FCMD_VOLUMES, FCMD_WRITABLE
805     };
806 
807     if (objc < 2) {
808       Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
809         return TCL_ERROR;
810     }
811     if (Tcl_GetIndexFromObj(interp, objv[1], fileOptions, "option", 0,
812       &index) != TCL_OK) {
813       return TCL_ERROR;
814     }
815 
816     switch ((enum options) index) {
817       case FCMD_ATIME: {
818       Tcl_StatBuf buf;
819       struct utimbuf tval;
820 
821       if ((objc < 3) || (objc > 4)) {
822     Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
823     return TCL_ERROR;
824       }
825       if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
826     return TCL_ERROR;
827       }
828       if (objc == 4) {
829     long newTime;
830 
831     if (Tcl_GetLongFromObj(interp, objv[3], &newTime) != TCL_OK) {
832         return TCL_ERROR;
833     }
834     tval.actime = newTime;
835     tval.modtime = buf.st_mtime;
836     if (Tcl_FSUtime(objv[2], &tval) != 0) {
837         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
838           "could not set access time for file \"",
839           Tcl_GetString(objv[2]), "\": ",
840           Tcl_PosixError(interp), (char *) NULL);
841         return TCL_ERROR;
842     }
843     /*
844      * Do another stat to ensure that the we return the
845      * new recognized atime - hopefully the same as the
846      * one we sent in.  However, fs's like FAT don't
847      * even know what atime is.
848      */
849     if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
850         return TCL_ERROR;
851     }
852       }
853       Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_atime);
854       return TCL_OK;
855   }
856   case FCMD_ATTRIBUTES: {
857             return TclFileAttrsCmd(interp, objc, objv);
858   }
859   case FCMD_CHANNELS: {
860       if ((objc < 2) || (objc > 3)) {
861     Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
862     return TCL_ERROR;
863       }
864       return Tcl_GetChannelNamesEx(interp,
865         ((objc == 2) ? NULL : Tcl_GetString(objv[2])));
866   }
867   case FCMD_COPY: {
868       return TclFileCopyCmd(interp, objc, objv);
869   }     
870   case FCMD_DELETE: {
871       return TclFileDeleteCmd(interp, objc, objv);
872   }
873       case FCMD_DIRNAME: {
874       Tcl_Obj *dirPtr;
875       if (objc != 3) {
876     goto only3Args;
877       }
878       dirPtr = TclFileDirname(interp, objv[2]);
879       if (dirPtr == NULL) {
880           return TCL_ERROR;
881       } else {
882     Tcl_SetObjResult(interp, dirPtr);
883     Tcl_DecrRefCount(dirPtr);
884     return TCL_OK;
885       }
886   }
887   case FCMD_EXECUTABLE: {
888       if (objc != 3) {
889     goto only3Args;
890       }
891       return CheckAccess(interp, objv[2], X_OK);
892   }
893   case FCMD_EXISTS: {
894       if (objc != 3) {
895     goto only3Args;
896       }
897       return CheckAccess(interp, objv[2], F_OK);
898   }
899   case FCMD_EXTENSION: {
900       char *fileName, *extension;
901       if (objc != 3) {
902         goto only3Args;
903       }
904       fileName = Tcl_GetString(objv[2]);
905       extension = TclGetExtension(fileName);
906       if (extension != NULL) {
907         Tcl_SetStringObj(Tcl_GetObjResult(interp), extension, -1);
908       }
909       return TCL_OK;
910   }
911       case FCMD_ISDIRECTORY: {
912       int value;
913       Tcl_StatBuf buf;
914 
915       if (objc != 3) {
916     goto only3Args;
917       }
918       value = 0;
919       if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
920     value = S_ISDIR(buf.st_mode);
921       }
922       Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
923       return TCL_OK;
924   }
925       case FCMD_ISFILE: {
926       int value;
927       Tcl_StatBuf buf;
928       
929           if (objc != 3) {
930             goto only3Args;
931           }
932       value = 0;
933       if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
934     value = S_ISREG(buf.st_mode);
935       }
936       Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
937       return TCL_OK;
938   }
939   case FCMD_JOIN: {
940       Tcl_Obj *resObj;
941 
942       if (objc < 3) {
943     Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
944     return TCL_ERROR;
945       }
946       resObj = Tcl_FSJoinToPath(NULL, objc - 2, objv + 2);
947       Tcl_SetObjResult(interp, resObj);
948       return TCL_OK;
949   }
950   case FCMD_LINK: {
951       Tcl_Obj *contents;
952       int index;
953       
954       if (objc < 3 || objc > 5) {
955     Tcl_WrongNumArgs(interp, 2, objv, 
956          "?-linktype? linkname ?target?");
957     return TCL_ERROR;
958       }
959       
960       /* Index of the 'source' argument */
961       if (objc == 5) {
962     index = 3;
963       } else {
964     index = 2;
965       }
966       
967       if (objc > 3) {
968     int linkAction;
969     if (objc == 5) {
970         /* We have a '-linktype' argument */
971         static CONST char *linkTypes[] = {
972       "-symbolic", "-hard", NULL
973         };
974         if (Tcl_GetIndexFromObj(interp, objv[2], linkTypes, 
975              "switch", 0, &linkAction) != TCL_OK) {
976       return TCL_ERROR;
977         }
978         if (linkAction == 0) {
979             linkAction = TCL_CREATE_SYMBOLIC_LINK;
980         } else {
981       linkAction = TCL_CREATE_HARD_LINK;
982         }
983     } else {
984         linkAction = TCL_CREATE_SYMBOLIC_LINK|TCL_CREATE_HARD_LINK;
985     }
986     if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
987         return TCL_ERROR;
988     }
989     /* Create link from source to target */
990     contents = Tcl_FSLink(objv[index], objv[index+1], linkAction);
991     if (contents == NULL) {
992         /* 
993          * We handle two common error cases specially, and
994          * for all other errors, we use the standard posix
995          * error message.
996          */
997         if (errno == EEXIST) {
998       Tcl_AppendResult(interp, "could not create new link \"", 
999         Tcl_GetString(objv[index]), 
1000         "\": that path already exists", (char *) NULL);
1001         } else if (errno == ENOENT) {
1002       Tcl_AppendResult(interp, "could not create new link \"", 
1003         Tcl_GetString(objv[index]), 
1004         "\" since target \"", 
1005         Tcl_GetString(objv[index+1]), 
1006         "\" doesn't exist", 
1007         (char *) NULL);
1008         } else {
1009       Tcl_AppendResult(interp, "could not create new link \"", 
1010         Tcl_GetString(objv[index]), "\" pointing to \"", 
1011         Tcl_GetString(objv[index+1]), "\": ", 
1012         Tcl_PosixError(interp), (char *) NULL);
1013         }
1014         return TCL_ERROR;
1015     }
1016       } else {
1017     if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
1018         return TCL_ERROR;
1019     }
1020     /* Read link */
1021     contents = Tcl_FSLink(objv[index], NULL, 0);
1022     if (contents == NULL) {
1023         Tcl_AppendResult(interp, "could not read link \"", 
1024           Tcl_GetString(objv[index]), "\": ", 
1025           Tcl_PosixError(interp), (char *) NULL);
1026         return TCL_ERROR;
1027     }
1028       }
1029       Tcl_SetObjResult(interp, contents);
1030       if (objc == 3) {
1031     /* 
1032      * If we are reading a link, we need to free this
1033      * result refCount.  If we are creating a link, this
1034      * will just be objv[index+1], and so we don't own it.
1035      */
1036     Tcl_DecrRefCount(contents);
1037       }
1038       return TCL_OK;
1039   }
1040       case FCMD_LSTAT: {
1041       char *varName;
1042       Tcl_StatBuf buf;
1043 
1044           if (objc != 4) {
1045             Tcl_WrongNumArgs(interp, 2, objv, "name varName");
1046             return TCL_ERROR;
1047           }
1048       if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
1049     return TCL_ERROR;
1050       }
1051       varName = Tcl_GetString(objv[3]);
1052       return StoreStatData(interp, varName, &buf);
1053   }
1054   case FCMD_MTIME: {
1055       Tcl_StatBuf buf;
1056       struct utimbuf tval;
1057 
1058       if ((objc < 3) || (objc > 4)) {
1059     Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
1060     return TCL_ERROR;
1061       }
1062       if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
1063     return TCL_ERROR;
1064       }
1065       if (objc == 4) {
1066     long newTime;
1067 
1068     if (Tcl_GetLongFromObj(interp, objv[3], &newTime) != TCL_OK) {
1069         return TCL_ERROR;
1070     }
1071     tval.actime = buf.st_atime;
1072     tval.modtime = newTime;
1073     if (Tcl_FSUtime(objv[2], &tval) != 0) {
1074         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1075           "could not set modification time for file \"",
1076           Tcl_GetString(objv[2]), "\": ",
1077           Tcl_PosixError(interp), (char *) NULL);
1078         return TCL_ERROR;
1079     }
1080     /*
1081      * Do another stat to ensure that the we return the
1082      * new recognized atime - hopefully the same as the
1083      * one we sent in.  However, fs's like FAT don't
1084      * even know what atime is.
1085      */
1086     if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
1087         return TCL_ERROR;
1088     }
1089       }
1090       Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_mtime);
1091       return TCL_OK;
1092   }
1093   case FCMD_MKDIR: {
1094       if (objc < 3) {
1095     Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
1096     return TCL_ERROR;
1097       }
1098       return TclFileMakeDirsCmd(interp, objc, objv);
1099   }
1100   case FCMD_NATIVENAME: {
1101       CONST char *fileName;
1102       Tcl_DString ds;
1103 
1104       if (objc != 3) {
1105     goto only3Args;
1106       }
1107       fileName = Tcl_GetString(objv[2]);
1108       fileName = Tcl_TranslateFileName(interp, fileName, &ds);
1109       if (fileName == NULL) {
1110     return TCL_ERROR;
1111       }
1112       Tcl_SetStringObj(Tcl_GetObjResult(interp), fileName, 
1113            Tcl_DStringLength(&ds));
1114       Tcl_DStringFree(&ds);
1115       return TCL_OK;
1116   }
1117   case FCMD_NORMALIZE: {
1118       Tcl_Obj *fileName;
1119 
1120       if (objc != 3) {
1121     Tcl_WrongNumArgs(interp, 2, objv, "filename");
1122     return TCL_ERROR;
1123       }
1124 
1125       fileName = Tcl_FSGetNormalizedPath(interp, objv[2]);
1126       if (fileName == NULL) {
1127     return TCL_ERROR;
1128       }
1129       Tcl_SetObjResult(interp, fileName);
1130       return TCL_OK;
1131   }
1132   case FCMD_OWNED: {
1133       int value;
1134       Tcl_StatBuf buf;
1135       
1136       if (objc != 3) {
1137     goto only3Args;
1138       }
1139       value = 0;
1140       if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
1141     /*
1142      * For Windows and Macintosh, there are no user ids 
1143      * associated with a file, so we always return 1.
1144      */
1145 
1146 #if (defined(__WIN32__) || defined(MAC_TCL))
1147     value = 1;
1148 #else
1149     value = (geteuid() == buf.st_uid);
1150 #endif
1151       }     
1152       Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
1153       return TCL_OK;
1154   }
1155   case FCMD_PATHTYPE: {
1156       if (objc != 3) {
1157     goto only3Args;
1158       }
1159       switch (Tcl_FSGetPathType(objv[2])) {
1160         case TCL_PATH_ABSOLUTE:
1161             Tcl_SetStringObj(Tcl_GetObjResult(interp), "absolute", -1);
1162         break;
1163         case TCL_PATH_RELATIVE:
1164             Tcl_SetStringObj(Tcl_GetObjResult(interp), "relative", -1);
1165             break;
1166         case TCL_PATH_VOLUME_RELATIVE:
1167         Tcl_SetStringObj(Tcl_GetObjResult(interp), 
1168              "volumerelative", -1);
1169         break;
1170       }
1171       return TCL_OK;
1172   }
1173       case FCMD_READABLE: {
1174       if (objc != 3) {
1175     goto only3Args;
1176       }
1177       return CheckAccess(interp, objv[2], R_OK);
1178   }
1179   case FCMD_READLINK: {
1180       Tcl_Obj *contents;
1181     
1182       if (objc != 3) {
1183     goto only3Args;
1184       }
1185       
1186       if (Tcl_FSConvertToPathType(interp, objv[2]) != TCL_OK) {
1187     return TCL_ERROR;
1188       }
1189 
1190       contents = Tcl_FSLink(objv[2], NULL, 0);
1191 
1192       if (contents == NULL) {
1193         Tcl_AppendResult(interp, "could not readlink \"", 
1194           Tcl_GetString(objv[2]), "\": ", 
1195           Tcl_PosixError(interp), (char *) NULL);
1196         return TCL_ERROR;
1197       }
1198       Tcl_SetObjResult(interp, contents);
1199       Tcl_DecrRefCount(contents);
1200       return TCL_OK;
1201   }
1202   case FCMD_RENAME: {
1203       return TclFileRenameCmd(interp, objc, objv);
1204   }
1205   case FCMD_ROOTNAME: {
1206       int length;
1207       char *fileName, *extension;
1208       
1209       if (objc != 3) {
1210     goto only3Args;
1211       }
1212       fileName = Tcl_GetStringFromObj(objv[2], &length);
1213       extension = TclGetExtension(fileName);
1214       if (extension == NULL) {
1215         Tcl_SetObjResult(interp, objv[2]);
1216       } else {
1217           Tcl_SetStringObj(Tcl_GetObjResult(interp), fileName,
1218       (int) (length - strlen(extension)));
1219       }
1220       return TCL_OK;
1221   }
1222   case FCMD_SEPARATOR: {
1223       if ((objc < 2) || (objc > 3)) {
1224     Tcl_WrongNumArgs(interp, 2, objv, "?name?");
1225     return TCL_ERROR;
1226       }
1227       if (objc == 2) {
1228           char *separator = NULL; /* lint */
1229     switch (tclPlatform) {
1230         case TCL_PLATFORM_UNIX:
1231       separator = "/";
1232       break;
1233         case TCL_PLATFORM_WINDOWS:
1234       separator = "\\";
1235       break;
1236         case TCL_PLATFORM_MAC:
1237       separator = ":";
1238       break;
1239     }
1240     Tcl_SetObjResult(interp, Tcl_NewStringObj(separator,1));
1241       } else {
1242     Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[2]);
1243     if (separatorObj != NULL) {
1244         Tcl_SetObjResult(interp, separatorObj);
1245     } else {
1246         Tcl_SetObjResult(interp, 
1247           Tcl_NewStringObj("Unrecognised path",-1));
1248         return TCL_ERROR;
1249     }
1250       }
1251       return TCL_OK;
1252   }
1253   case FCMD_SIZE: {
1254       Tcl_StatBuf buf;
1255       
1256       if (objc != 3) {
1257     goto only3Args;
1258       }
1259       if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
1260     return TCL_ERROR;
1261       }
1262       Tcl_SetWideIntObj(Tcl_GetObjResult(interp),
1263         (Tcl_WideInt) buf.st_size);
1264       return TCL_OK;
1265   }
1266   case FCMD_SPLIT: {
1267       if (objc != 3) {
1268     goto only3Args;
1269       }
1270       Tcl_SetObjResult(interp, Tcl_FSSplitPath(objv[2], NULL));
1271       return TCL_OK;
1272   }
1273   case FCMD_STAT: {
1274       char *varName;
1275       Tcl_StatBuf buf;
1276       
1277       if (objc != 4) {
1278         Tcl_WrongNumArgs(interp, 1, objv, "stat name varName");
1279     return TCL_ERROR;
1280       }
1281       if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
1282     return TCL_ERROR;
1283       }
1284       varName = Tcl_GetString(objv[3]);
1285       return StoreStatData(interp, varName, &buf);
1286   }
1287   case FCMD_SYSTEM: {
1288       Tcl_Obj* fsInfo;
1289       if (objc != 3) {
1290     goto only3Args;
1291       }
1292       fsInfo = Tcl_FSFileSystemInfo(objv[2]);
1293       if (fsInfo != NULL) {
1294     Tcl_SetObjResult(interp, fsInfo);
1295     return TCL_OK;
1296       } else {
1297     Tcl_SetObjResult(interp, 
1298          Tcl_NewStringObj("Unrecognised path",-1));
1299     return TCL_ERROR;
1300       }
1301   }
1302       case FCMD_TAIL: {
1303       int splitElements;
1304       Tcl_Obj *splitPtr;
1305 
1306       if (objc != 3) {
1307     goto only3Args;
1308       }
1309       /* 
1310        * The behaviour we want here is slightly different to
1311        * the standard Tcl_FSSplitPath in the handling of home
1312        * directories; Tcl_FSSplitPath preserves the "~" while 
1313        * this code computes the actual full path name, if we
1314        * had just a single component.
1315        */     
1316       splitPtr = Tcl_FSSplitPath(objv[2], &splitElements);
1317       if ((splitElements == 1) && (Tcl_GetString(objv[2])[0] == '~')) {
1318     Tcl_DecrRefCount(splitPtr);
1319     splitPtr = Tcl_FSGetNormalizedPath(interp, objv[2]);
1320     if (splitPtr == NULL) {
1321         return TCL_ERROR;
1322     }
1323     splitPtr = Tcl_FSSplitPath(splitPtr, &splitElements);
1324       }
1325 
1326       /*
1327        * Return the last component, unless it is the only component,
1328        * and it is the root of an absolute path.
1329        */
1330 
1331       if (splitElements > 0) {
1332         if ((splitElements > 1)
1333       || (Tcl_FSGetPathType(objv[2]) == TCL_PATH_RELATIVE)) {
1334         
1335         Tcl_Obj *tail = NULL;
1336         Tcl_ListObjIndex(NULL, splitPtr, splitElements-1, &tail);
1337         Tcl_SetObjResult(interp, tail);
1338         }
1339       }
1340       Tcl_DecrRefCount(splitPtr);
1341       return TCL_OK;
1342   }
1343   case FCMD_TYPE: {
1344       Tcl_StatBuf buf;
1345 
1346       if (objc != 3) {
1347         goto only3Args;
1348       }
1349       if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
1350     return TCL_ERROR;
1351       }
1352       Tcl_SetStringObj(Tcl_GetObjResult(interp), 
1353         GetTypeFromMode((unsigned short) buf.st_mode), -1);
1354       return TCL_OK;
1355   }
1356   case FCMD_VOLUMES: {
1357       if (objc != 2) {
1358     Tcl_WrongNumArgs(interp, 2, objv, NULL);
1359     return TCL_ERROR;
1360       }
1361       Tcl_SetObjResult(interp, Tcl_FSListVolumes());
1362       return TCL_OK;
1363   }
1364   case FCMD_WRITABLE: {
1365       if (objc != 3) {
1366         goto only3Args;
1367       }
1368       return CheckAccess(interp, objv[2], W_OK);
1369   }
1370     }
1371 
1372     only3Args:
1373     Tcl_WrongNumArgs(interp, 2, objv, "name");
1374     return TCL_ERROR;
1375 }
int Tcl_ForeachObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 1686 of file tclCmdAH.c.
References ckalloc, ckfree, Tcl_Interp::errorLine, NULL, NUM_ARGS, panic, STATIC_LIST_SIZE, Tcl_AddObjErrorInfo(), Tcl_AppendToObj(), TCL_BREAK, TCL_CONTINUE, Tcl_DecrRefCount, TCL_ERROR, Tcl_EvalObjEx(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_IncrRefCount, TCL_INTEGER_SPACE, Tcl_ListObjGetElements(), Tcl_NewObj(), Tcl_ObjSetVar2(), TCL_OK, Tcl_ResetResult(), and Tcl_WrongNumArgs().1691 {
1692     int result = TCL_OK;
1693     int i;      /* i selects a value list */
1694     int j, maxj;    /* Number of loop iterations */
1695     int v;      /* v selects a loop variable */
1696     int numLists;   /* Count of value lists */
1697     Tcl_Obj *bodyPtr;
1698 
1699     /*
1700      * We copy the argument object pointers into a local array to avoid
1701      * the problem that "objv" might become invalid. It is a pointer into
1702      * the evaluation stack and that stack might be grown and reallocated
1703      * if the loop body requires a large amount of stack space.
1704      */
1705     
1706 #define NUM_ARGS 9
1707     Tcl_Obj *(argObjStorage[NUM_ARGS]);
1708     Tcl_Obj **argObjv = argObjStorage;
1709     
1710 #define STATIC_LIST_SIZE 4
1711     int indexArray[STATIC_LIST_SIZE];
1712     int varcListArray[STATIC_LIST_SIZE];
1713     Tcl_Obj **varvListArray[STATIC_LIST_SIZE];
1714     int argcListArray[STATIC_LIST_SIZE];
1715     Tcl_Obj **argvListArray[STATIC_LIST_SIZE];
1716 
1717     int *index = indexArray;       /* Array of value list indices */
1718     int *varcList = varcListArray;     /* # loop variables per list */
1719     Tcl_Obj ***varvList = varvListArray;   /* Array of var name lists */
1720     int *argcList = argcListArray;     /* Array of value list sizes */
1721     Tcl_Obj ***argvList = argvListArray;   /* Array of value lists */
1722 
1723     if (objc < 4 || (objc%2 != 0)) {
1724   Tcl_WrongNumArgs(interp, 1, objv,
1725     "varList list ?varList list ...? command");
1726   return TCL_ERROR;
1727     }
1728 
1729     /*
1730      * Create the object argument array "argObjv". Make sure argObjv is
1731      * large enough to hold the objc arguments.
1732      */
1733 
1734     if (objc > NUM_ARGS) {
1735   argObjv = (Tcl_Obj **) ckalloc(objc * sizeof(Tcl_Obj *));
1736     }
1737     for (i = 0;  i < objc;  i++) {
1738   argObjv[i] = objv[i];
1739     }
1740 
1741     /*
1742      * Manage numList parallel value lists.
1743      * argvList[i] is a value list counted by argcList[i]
1744      * varvList[i] is the list of variables associated with the value list
1745      * varcList[i] is the number of variables associated with the value list
1746      * index[i] is the current pointer into the value list argvList[i]
1747      */
1748 
1749     numLists = (objc-2)/2;
1750     if (numLists > STATIC_LIST_SIZE) {
1751   index = (int *) ckalloc(numLists * sizeof(int));
1752   varcList = (int *) ckalloc(numLists * sizeof(int));
1753   varvList = (Tcl_Obj ***) ckalloc(numLists * sizeof(Tcl_Obj **));
1754   argcList = (int *) ckalloc(numLists * sizeof(int));
1755   argvList = (Tcl_Obj ***) ckalloc(numLists * sizeof(Tcl_Obj **));
1756     }
1757     for (i = 0;  i < numLists;  i++) {
1758   index[i] = 0;
1759   varcList[i] = 0;
1760   varvList[i] = (Tcl_Obj **) NULL;
1761   argcList[i] = 0;
1762   argvList[i] = (Tcl_Obj **) NULL;
1763     }
1764 
1765     /*
1766      * Break up the value lists and variable lists into elements
1767      */
1768 
1769     maxj = 0;
1770     for (i = 0;  i < numLists;  i++) {
1771   result = Tcl_ListObjGetElements(interp, argObjv[1+i*2],
1772           &varcList[i], &varvList[i]);
1773   if (result != TCL_OK) {
1774       goto done;
1775   }
1776   if (varcList[i] < 1) {
1777       Tcl_AppendToObj(Tcl_GetObjResult(interp),
1778               "foreach varlist is empty", -1);
1779       result = TCL_ERROR;
1780       goto done;
1781   }
1782   
1783   result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
1784           &argcList[i], &argvList[i]);
1785   if (result != TCL_OK) {
1786       goto done;
1787   }
1788   
1789   j = argcList[i] / varcList[i];
1790   if ((argcList[i] % varcList[i]) != 0) {
1791       j++;
1792   }
1793   if (j > maxj) {
1794       maxj = j;
1795   }
1796     }
1797 
1798     /*
1799      * Iterate maxj times through the lists in parallel
1800      * If some value lists run out of values, set loop vars to ""
1801      */
1802     
1803     bodyPtr = argObjv[objc-1];
1804     for (j = 0;  j < maxj;  j++) {
1805   for (i = 0;  i < numLists;  i++) {
1806       /*
1807        * Refetch the list members; we assume that the sizes are
1808        * the same, but the array of elements might be different
1809        * if the internal rep of the objects has been lost and
1810        * recreated (it is too difficult to accurately tell when
1811        * this happens, which can lead to some wierd crashes,
1812        * like Bug #494348...)
1813        */
1814 
1815       result = Tcl_ListObjGetElements(interp, argObjv[1+i*2],
1816         &varcList[i], &varvList[i]);
1817       if (result != TCL_OK) {
1818     panic("Tcl_ForeachObjCmd: could not reconvert variable list %d to a list object\n", i);
1819       }
1820       result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
1821         &argcList[i], &argvList[i]);
1822       if (result != TCL_OK) {
1823     panic("Tcl_ForeachObjCmd: could not reconvert value list %d to a list object\n", i);
1824       }
1825       
1826       for (v = 0;  v < varcList[i];  v++) {
1827     int k = index[i]++;
1828     Tcl_Obj *valuePtr, *varValuePtr;
1829     
1830     if (k < argcList[i]) {
1831         valuePtr = argvList[i][k];
1832     } else {
1833         valuePtr = Tcl_NewObj(); /* empty string */
1834     }
1835     Tcl_IncrRefCount(valuePtr);
1836     varValuePtr = Tcl_ObjSetVar2(interp, varvList[i][v],
1837       NULL, valuePtr, 0);
1838     Tcl_DecrRefCount(valuePtr);
1839     if (varValuePtr == NULL) {
1840         Tcl_ResetResult(interp);
1841         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1842       "couldn't set loop variable: \"",
1843       Tcl_GetString(varvList[i][v]), "\"", (char *) NULL);
1844         result = TCL_ERROR;
1845         goto done;
1846     }
1847 
1848       }
1849   }
1850 
1851   result = Tcl_EvalObjEx(interp, bodyPtr, 0);
1852   if (result != TCL_OK) {
1853       if (result == TCL_CONTINUE) {
1854     result = TCL_OK;
1855       } else if (result == TCL_BREAK) {
1856     result = TCL_OK;
1857     break;
1858       } else if (result == TCL_ERROR) {
1859                 char msg[32 + TCL_INTEGER_SPACE];
1860 
1861     sprintf(msg, "\n    (\"foreach\" body line %d)",
1862       interp->errorLine);
1863     Tcl_AddObjErrorInfo(interp, msg, -1);
1864     break;
1865       } else {
1866     break;
1867       }
1868   }
1869     }
1870     if (result == TCL_OK) {
1871   Tcl_ResetResult(interp);
1872     }
1873 
1874     done:
1875     if (numLists > STATIC_LIST_SIZE) {
1876   ckfree((char *) index);
1877   ckfree((char *) varcList);
1878   ckfree((char *) argcList);
1879   ckfree((char *) varvList);
1880   ckfree((char *) argvList);
1881     }
1882     if (argObjv != argObjStorage) {
1883   ckfree((char *) argObjv);
1884     }
1885     return result;
1886 #undef STATIC_LIST_SIZE
1887 #undef NUM_ARGS
1888 }
int Tcl_FormatObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 1909 of file tclCmdAH.c.
References CHAR_VALUE, ckalloc, ckfree, DOUBLE_VALUE, format, INT_VALUE, MAX_FLOAT_SIZE, NULL, PTR_VALUE, size_t(), STRING_VALUE, strtoul(), Tcl_AppendToObj(), Tcl_DecrRefCount, TCL_ERROR, Tcl_GetDoubleFromObj(), Tcl_GetIntFromObj(), Tcl_GetLongFromObj(), Tcl_GetStringFromObj(), Tcl_GetWideIntFromObj(), TCL_LL_MODIFIER, TCL_LL_MODIFIER_SIZE, Tcl_NewObj(), Tcl_NumUtfChars(), TCL_OK, Tcl_SetObjResult(), Tcl_SetResult(), TCL_STATIC, Tcl_UniCharToUtf(), TCL_UTF_MAX, Tcl_UtfAtIndex(), TCL_VOLATILE, Tcl_WideAsLong, Tcl_WrongNumArgs(), TclFormatInt(), UCHAR, and WIDE_VALUE.1914 {
1915     char *format;   /* Used to read characters from the format
1916          * string. */
1917     int formatLen;    /* The length of the format string */
1918     char *endPtr;   /* Points to the last char in format array */
1919     char newFormat[43];   /* A new format specifier is generated here. */
1920     int width;      /* Field width from field specifier, or 0 if
1921          * no width given. */
1922     int precision;    /* Field precision from field specifier, or 0
1923          * if no precision given. */
1924     int size;     /* Number of bytes needed for result of
1925          * conversion, based on type of conversion
1926          * ("e", "s", etc.), width, and precision. */
1927     long intValue;    /* Used to hold value to pass to sprintf, if
1928          * it's a one-word integer or char value */
1929     char *ptrValue = NULL;  /* Used to hold value to pass to sprintf, if
1930          * it's a one-word value. */
1931     double doubleValue;   /* Used to hold value to pass to sprintf if
1932          * it's a double value. */
1933     Tcl_WideInt wideValue;  /* Used to hold value to pass to sprintf if
1934          * it's a 'long long' value. */
1935     int whichValue;   /* Indicates which of intValue, ptrValue,
1936          * or doubleValue has the value to pass to
1937          * sprintf, according to the following
1938          * definitions: */
1939 #   define INT_VALUE 0
1940 #   define CHAR_VALUE 1
1941 #   define PTR_VALUE 2
1942 #   define DOUBLE_VALUE 3
1943 #   define STRING_VALUE 4
1944 #   define WIDE_VALUE 5
1945 #   define MAX_FLOAT_SIZE 320
1946 
1947     Tcl_Obj *resultPtr;   /* Where result is stored finally. */
1948     char staticBuf[MAX_FLOAT_SIZE + 1];
1949         /* A static buffer to copy the format results 
1950          * into */
1951     char *dst = staticBuf;      /* The buffer that sprintf writes into each
1952          * time the format processes a specifier */
1953     int dstSize = MAX_FLOAT_SIZE;
1954         /* The size of the dst buffer */
1955     int noPercent;    /* Special case for speed:  indicates there's
1956          * no field specifier, just a string to copy.*/
1957     int objIndex;   /* Index of argument to substitute next. */
1958     int gotXpg = 0;   /* Non-zero means that an XPG3 %n$-style
1959          * specifier has been seen. */
1960     int gotSequential = 0;  /* Non-zero means that a regular sequential
1961          * (non-XPG3) conversion specifier has been
1962          * seen. */
1963     int useShort;   /* Value to be printed is short (half word). */
1964     char *end;      /* Used to locate end of numerical fields. */
1965     int stringLen = 0;    /* Length of string in characters rather
1966          * than bytes.  Used for %s substitution. */
1967     int gotMinus;   /* Non-zero indicates that a minus flag has
1968          * been seen in the current field. */
1969     int gotPrecision;   /* Non-zero indicates that a precision has
1970          * been set for the current field. */
1971     int gotZero;    /* Non-zero indicates that a zero flag has
1972          * been seen in the current field. */
1973     int useWide;    /* Value to be printed is Tcl_WideInt. */
1974 
1975     /*
1976      * This procedure is a bit nasty.  The goal is to use sprintf to
1977      * do most of the dirty work.  There are several problems:
1978      * 1. this procedure can't trust its arguments.
1979      * 2. we must be able to provide a large enough result area to hold
1980      *    whatever's generated.  This is hard to estimate.
1981      * 3. there's no way to move the arguments from objv to the call
1982      *    to sprintf in a reasonable way.  This is particularly nasty
1983      *    because some of the arguments may be two-word values (doubles
1984      *    and wide-ints).
1985      * So, what happens here is to scan the format string one % group
1986      * at a time, making many individual calls to sprintf.
1987      */
1988 
1989     if (objc < 2) {
1990   Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg arg ...?");
1991   return TCL_ERROR;
1992     }
1993 
1994     format = Tcl_GetStringFromObj(objv[1], &formatLen);
1995     endPtr = format + formatLen;
1996     resultPtr = Tcl_NewObj();
1997     objIndex = 2;
1998 
1999     while (format < endPtr) {
2000   register char *newPtr = newFormat;
2001 
2002   width = precision = noPercent = useShort = 0;
2003   gotZero = gotMinus = gotPrecision = 0;
2004   useWide = 0;
2005   whichValue = PTR_VALUE;
2006 
2007   /*
2008    * Get rid of any characters before the next field specifier.
2009    */
2010   if (*format != '%') {
2011       ptrValue = format;
2012       while ((*format != '%') && (format < endPtr)) {
2013     format++;
2014       }
2015       size = format - ptrValue;
2016       noPercent = 1;
2017       goto doField;
2018   }
2019 
2020   if (format[1] == '%') {
2021       ptrValue = format;
2022       size = 1;
2023       noPercent = 1;
2024       format += 2;
2025       goto doField;
2026   }
2027 
2028   /*
2029    * Parse off a field specifier, compute how many characters
2030    * will be needed to store the result, and substitute for
2031    * "*" size specifiers.
2032    */
2033   *newPtr = '%';
2034   newPtr++;
2035   format++;
2036   if (isdigit(UCHAR(*format))) { /* INTL: Tcl source. */
2037       int tmp;
2038 
2039       /*
2040        * Check for an XPG3-style %n$ specification.  Note: there
2041        * must not be a mixture of XPG3 specs and non-XPG3 specs
2042        * in the same format string.
2043        */
2044 
2045       tmp = strtoul(format, &end, 10);  /* INTL: "C" locale. */
2046       if (*end != '$') {
2047     goto notXpg;
2048       }
2049       format = end+1;
2050       gotXpg = 1;
2051       if (gotSequential) {
2052     goto mixedXPG;
2053       }
2054       objIndex = tmp+1;
2055       if ((objIndex < 2) || (objIndex >= objc)) {
2056     goto badIndex;
2057       }
2058       goto xpgCheckDone;
2059   }
2060 
2061   notXpg:
2062   gotSequential = 1;
2063   if (gotXpg) {
2064       goto mixedXPG;
2065   }
2066 
2067   xpgCheckDone:
2068   while ((*format == '-') || (*format == '#') || (*format == '0')
2069     || (*format == ' ') || (*format == '+')) {
2070       if (*format == '-') {
2071     gotMinus = 1;
2072       }
2073       if (*format == '0') {
2074     /*
2075      * This will be handled by sprintf for numbers, but we
2076      * need to do the char/string ones ourselves
2077      */
2078     gotZero = 1;
2079       }
2080       *newPtr = *format;
2081       newPtr++;
2082       format++;
2083   }
2084   if (isdigit(UCHAR(*format))) {    /* INTL: Tcl source. */
2085       width = strtoul(format, &end, 10);  /* INTL: Tcl source. */
2086       format = end;
2087   } else if (*format == '*') {
2088       if (objIndex >= objc) {
2089     goto badIndex;
2090       }
2091       if (Tcl_GetIntFromObj(interp, /* INTL: Tcl source. */
2092         objv[objIndex], &width) != TCL_OK) {
2093     goto fmtError;
2094       }
2095       if (width < 0) {
2096     width = -width;
2097     *newPtr = '-';
2098     gotMinus = 1;
2099     newPtr++;
2100       }
2101       objIndex++;
2102       format++;
2103   }
2104   if (width > 100000) {
2105       /*
2106        * Don't allow arbitrarily large widths:  could cause core
2107        * dump when we try to allocate a zillion bytes of memory
2108        * below.
2109        */
2110 
2111       width = 100000;
2112   } else if (width < 0) {
2113       width = 0;
2114   }
2115   if (width != 0) {
2116       TclFormatInt(newPtr, width);  /* INTL: printf format. */
2117       while (*newPtr != 0) {
2118     newPtr++;
2119       }
2120   }
2121   if (*format == '.') {
2122       *newPtr = '.';
2123       newPtr++;
2124       format++;
2125       gotPrecision = 1;
2126   }
2127   if (isdigit(UCHAR(*format))) {    /* INTL: Tcl source. */
2128       precision = strtoul(format, &end, 10);  /* INTL: "C" locale. */
2129       format = end;
2130   } else if (*format == '*') {
2131       if (objIndex >= objc) {
2132     goto badIndex;
2133       }
2134       if (Tcl_GetIntFromObj(interp, /* INTL: Tcl source. */
2135         objv[objIndex], &precision) != TCL_OK) {
2136     goto fmtError;
2137       }
2138       objIndex++;
2139       format++;
2140   }
2141   if (gotPrecision) {
2142       TclFormatInt(newPtr, precision);  /* INTL: printf format. */
2143       while (*newPtr != 0) {
2144     newPtr++;
2145       }
2146   }
2147   if (*format == 'l') {
2148       useWide = 1;
2149       /*
2150        * Only add a 'll' modifier for integer values as it makes
2151        * some libc's go into spasm otherwise.  [Bug #702622]
2152        */
2153       switch (format[1]) {
2154       case 'i':
2155       case 'd':
2156       case 'o':
2157       case 'u':
2158       case 'x':
2159       case 'X':
2160     strcpy(newPtr, TCL_LL_MODIFIER);
2161     newPtr += TCL_LL_MODIFIER_SIZE;
2162       }
2163       format++;
2164   } else if (*format == 'h') {
2165       useShort = 1;
2166       *newPtr = 'h';
2167       newPtr++;
2168       format++;
2169   }
2170   *newPtr = *format;
2171   newPtr++;
2172   *newPtr = 0;
2173   if (objIndex >= objc) {
2174       goto badIndex;
2175   }
2176   switch (*format) {
2177   case 'i':
2178       newPtr[-1] = 'd';
2179   case 'd':
2180   case 'o':
2181   case 'u':
2182   case 'x':
2183   case 'X':
2184       if (useWide) {
2185     if (Tcl_GetWideIntFromObj(interp, /* INTL: Tcl source. */
2186       objv[objIndex], &wideValue) != TCL_OK) {
2187         goto fmtError;
2188     }
2189     whichValue = WIDE_VALUE;
2190     size = 40 + precision;
2191     break;
2192       }
2193       if (Tcl_GetLongFromObj(interp,    /* INTL: Tcl source. */
2194         objv[objIndex], &intValue) != TCL_OK) {
2195     if (Tcl_GetWideIntFromObj(interp, /* INTL: Tcl source. */
2196       objv[objIndex], &wideValue) != TCL_OK) {
2197         goto fmtError;
2198     }
2199     intValue = Tcl_WideAsLong(wideValue);
2200       }
2201 
2202 #if (LONG_MAX > INT_MAX)
2203       if (!useShort) {
2204     /*
2205      * Add the 'l' for long format type because we are on an
2206      * LP64 archtecture and we are really going to pass a long
2207      * argument to sprintf.
2208      *
2209      * Do not add this if we're going to pass in a short (i.e.
2210      * if we've got an 'h' modifier already in the string); some
2211      * libc implementations of sprintf() do not like it at all.
2212      * [Bug 1154163]
2213      */
2214     newPtr++;
2215     *newPtr = 0;
2216     newPtr[-1] = newPtr[-2];
2217     newPtr[-2] = 'l';
2218       }
2219 #endif /* LONG_MAX > INT_MAX */
2220       whichValue = INT_VALUE;
2221       size = 40 + precision;
2222       break;
2223   case 's':
2224       /*
2225        * Compute the length of the string in characters and add
2226        * any additional space required by the field width.  All
2227        * of the extra characters will be spaces, so one byte per
2228        * character is adequate.
2229        */
2230 
2231       whichValue = STRING_VALUE;
2232       ptrValue = Tcl_GetStringFromObj(objv[objIndex], &size);
2233       stringLen = Tcl_NumUtfChars(ptrValue, size);
2234       if (gotPrecision && (precision < stringLen)) {
2235     stringLen = precision;
2236       }
2237       size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue;
2238       if (width > stringLen) {
2239     size += (width - stringLen);
2240       }
2241       break;
2242   case 'c':
2243       if (Tcl_GetLongFromObj(interp,  /* INTL: Tcl source. */
2244         objv[objIndex], &intValue) != TCL_OK) {
2245     goto fmtError;
2246       }
2247       whichValue = CHAR_VALUE;
2248       size = width + TCL_UTF_MAX;
2249       break;
2250   case 'e':
2251   case 'E':
2252   case 'f':
2253   case 'g':
2254   case 'G':
2255       if (Tcl_GetDoubleFromObj(interp, /* INTL: Tcl source. */
2256         objv[objIndex], &doubleValue) != TCL_OK) {
2257     goto fmtError;
2258       }
2259       whichValue = DOUBLE_VALUE;
2260       size = MAX_FLOAT_SIZE;
2261       if (precision > 10) {
2262     size += precision;
2263       }
2264       break;
2265   case 0:
2266       Tcl_SetResult(interp,
2267         "format string ended in middle of field specifier",
2268         TCL_STATIC);
2269       goto fmtError;
2270   default:
2271   {
2272       char buf[40];
2273 
2274       sprintf(buf, "bad field specifier \"%c\"", *format);
2275       Tcl_SetResult(interp, buf, TCL_VOLATILE);
2276       goto fmtError;
2277   }
2278   }
2279   objIndex++;
2280   format++;
2281 
2282   /*
2283    * Make sure that there's enough space to hold the formatted
2284    * result, then format it.
2285    */
2286 
2287   doField:
2288   if (width > size) {
2289       size = width;
2290   }
2291   if (noPercent) {
2292       Tcl_AppendToObj(resultPtr, ptrValue, size);
2293   } else {
2294       if (size > dstSize) {
2295           if (dst != staticBuf) {
2296         ckfree(dst);
2297     }
2298     dst = (char *) ckalloc((unsigned) (size + 1));
2299     dstSize = size;
2300       }
2301       switch (whichValue) {
2302       case DOUBLE_VALUE:
2303     sprintf(dst, newFormat, doubleValue); /* INTL: user locale. */
2304     break;
2305       case WIDE_VALUE:
2306     sprintf(dst, newFormat, wideValue);
2307     break;
2308       case INT_VALUE:
2309     if (useShort) {
2310         sprintf(dst, newFormat, (short) intValue);
2311     } else {
2312         sprintf(dst, newFormat, intValue);
2313     }
2314     break;
2315       case CHAR_VALUE: {
2316     char *ptr;
2317     char padChar = (gotZero ? '0' : ' ');
2318     ptr = dst;
2319     if (!gotMinus) {
2320         for ( ; --width > 0; ptr++) {
2321       *ptr = padChar;
2322         }
2323     }
2324     ptr += Tcl_UniCharToUtf(intValue, ptr);
2325     for ( ; --width > 0; ptr++) {
2326         *ptr = padChar;
2327     }
2328     *ptr = '\0';
2329     break;
2330       }
2331       case STRING_VALUE: {
2332     char *ptr;
2333     char padChar = (gotZero ? '0' : ' ');
2334     int pad;
2335 
2336     ptr = dst;
2337     if (width > stringLen) {
2338         pad = width - stringLen;
2339     } else {
2340         pad = 0;
2341     }
2342 
2343     if (!gotMinus) {
2344         while (pad > 0) {
2345       *ptr++ = padChar;
2346       pad--;
2347         }
2348     }
2349 
2350     size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue; 
2351     if (size) {
2352         memcpy(ptr, ptrValue, (size_t) size);
2353         ptr += size;
2354     }
2355     while (pad > 0) {
2356         *ptr++ = padChar;
2357         pad--;
2358     }
2359     *ptr = '\0';
2360     break;
2361       }
2362       default:
2363     sprintf(dst, newFormat, ptrValue);
2364     break;
2365       }
2366       Tcl_AppendToObj(resultPtr, dst, -1);
2367   }
2368     }
2369 
2370     Tcl_SetObjResult(interp, resultPtr);
2371     if (dst != staticBuf) {
2372   ckfree(dst);
2373     }
2374     return TCL_OK;
2375 
2376     mixedXPG:
2377     Tcl_SetResult(interp, 
2378       "cannot mix \"%\" and \"%n$\" conversion specifiers", TCL_STATIC);
2379     goto fmtError;
2380 
2381     badIndex:
2382     if (gotXpg) {
2383   Tcl_SetResult(interp, 
2384     "\"%n$\" argument index out of range", TCL_STATIC);
2385     } else {
2386   Tcl_SetResult(interp, 
2387     "not enough arguments for all format specifiers", TCL_STATIC);
2388     }
2389 
2390     fmtError:
2391     if (dst != staticBuf) {
2392   ckfree(dst);
2393     }
2394     Tcl_DecrRefCount(resultPtr);
2395     return TCL_ERROR;
2396 }
int Tcl_ForObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 1603 of file tclCmdAH.c.
References Tcl_Interp::errorLine, Tcl_AddErrorInfo(), TCL_BREAK, TCL_CONTINUE, TCL_ERROR, Tcl_EvalObjEx(), Tcl_ExprBooleanObj(), TCL_INTEGER_SPACE, TCL_OK, Tcl_ResetResult(), and Tcl_WrongNumArgs().1608 {
1609     int result, value;
1610 
1611     if (objc != 5) {
1612         Tcl_WrongNumArgs(interp, 1, objv, "start test next command");
1613         return TCL_ERROR;
1614     }
1615 
1616     result = Tcl_EvalObjEx(interp, objv[1], 0);
1617     if (result != TCL_OK) {
1618         if (result == TCL_ERROR) {
1619             Tcl_AddErrorInfo(interp, "\n    (\"for\" initial command)");
1620         }
1621         return result;
1622     }
1623     while (1) {
1624   /*
1625    * We need to reset the result before passing it off to
1626    * Tcl_ExprBooleanObj.  Otherwise, any error message will be appended
1627    * to the result of the last evaluation.
1628    */
1629 
1630   Tcl_ResetResult(interp);
1631         result = Tcl_ExprBooleanObj(interp, objv[2], &value);
1632         if (result != TCL_OK) {
1633             return result;
1634         }
1635         if (!value) {
1636             break;
1637         }
1638         result = Tcl_EvalObjEx(interp, objv[4], 0);
1639         if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
1640             if (result == TCL_ERROR) {
1641                 char msg[32 + TCL_INTEGER_SPACE];
1642 
1643                 sprintf(msg, "\n    (\"for\" body line %d)",interp->errorLine);
1644                 Tcl_AddErrorInfo(interp, msg);
1645             }
1646             break;
1647         }
1648         result = Tcl_EvalObjEx(interp, objv[3], 0);
1649   if (result == TCL_BREAK) {
1650             break;
1651         } else if (result != TCL_OK) {
1652             if (result == TCL_ERROR) {
1653                 Tcl_AddErrorInfo(interp, "\n    (\"for\" loop-end command)");
1654             }
1655             return result;
1656         }
1657     }
1658     if (result == TCL_BREAK) {
1659         result = TCL_OK;
1660     }
1661     if (result == TCL_OK) {
1662         Tcl_ResetResult(interp);
1663     }
1664     return result;
1665 }

generic/tclCmdIL.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"
Classes
struct SortElement
struct SortInfo
Defines
#define SORTMODE_ASCII  0
#define SORTMODE_INTEGER  1
#define SORTMODE_REAL  2
#define SORTMODE_COMMAND  3
#define SORTMODE_DICTIONARY  4
#define SORTIDX_NONE  -1
#define SORTIDX_END  -2
#define NUM_LISTS  30
Functions
static void AppendLocals _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, CONST char *pattern, int includeLinks))
static int DictionaryCompare _ANSI_ARGS_ ((char *left, char *right))
static int InfoArgsCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
static SortElement *MergeSort _ANSI_ARGS_ ((SortElement *headPt, SortInfo *infoPtr))
static SortElement *MergeLists _ANSI_ARGS_ ((SortElement *leftPtr, SortElement *rightPtr, SortInfo *infoPtr))
static int SortCompare _ANSI_ARGS_ ((Tcl_Obj *firstPtr, Tcl_Obj *second, SortInfo *infoPtr))
int Tcl_IfObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_IncrObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_InfoObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static int InfoArgsCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoBodyCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoCmdCountCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoCommandsCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoCompleteCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoDefaultCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoExistsCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoFunctionsCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoGlobalsCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoHostnameCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoLevelCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoLibraryCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoLoadedCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoLocalsCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static void AppendLocals (Tcl_Interp *interp, Tcl_Obj *listPtr, CONST char *pattern, int includeLinks)
static int InfoNameOfExecutableCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoPatchLevelCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoProcsCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoScriptCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoSharedlibCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoTclVersionCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int InfoVarsCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_JoinObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_LindexObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
Tcl_Obj * TclLindexList (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *argPtr)
Tcl_Obj * TclLindexFlat (Tcl_Interp *interp, Tcl_Obj *listPtr, int indexCount, indexArray)
int Tcl_LinsertObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_ListObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_LlengthObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_LrangeObjCmd (ClientData notUsed, Tcl_Interp *interp, int objc, objv)
int Tcl_LreplaceObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_LsearchObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
int Tcl_LsetObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
int Tcl_LsortObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static SortElement * MergeSort (SortElement *headPtr, SortInfo *infoPtr)
static SortElement * MergeLists (SortElement *leftPtr, SortElement *rightPtr, SortInfo *infoPtr)
static int SortCompare (Tcl_Obj *objPtr1, Tcl_Obj *objPtr2, SortInfo *infoPtr)
static int DictionaryCompare (char *left, char *right)

Define Documentation
#define NUM_LISTS  30

Referenced by MergeSort().#define SORTIDX_END  -2

Definition at line 80 of file tclCmdIL.c.
Referenced by Tcl_LsortObjCmd().#define SORTIDX_NONE  -1

Definition at line 79 of file tclCmdIL.c.
Referenced by SortCompare(), and Tcl_LsortObjCmd().#define SORTMODE_ASCII  0

Definition at line 69 of file tclCmdIL.c.
Referenced by SortCompare(), and Tcl_LsortObjCmd().#define SORTMODE_COMMAND  3

Definition at line 72 of file tclCmdIL.c.
Referenced by Tcl_LsortObjCmd().#define SORTMODE_DICTIONARY  4

Definition at line 73 of file tclCmdIL.c.
Referenced by SortCompare(), and Tcl_LsortObjCmd().#define SORTMODE_INTEGER  1

Definition at line 70 of file tclCmdIL.c.
Referenced by SortCompare(), and Tcl_LsortObjCmd().#define SORTMODE_REAL  2

Definition at line 71 of file tclCmdIL.c.
Referenced by SortCompare(), and Tcl_LsortObjCmd().
Function Documentation
static int SortCompare _ANSI_ARGS_ ((Tcl_Obj *firstPtr, Tcl_Obj *second, SortInfo *infoPtr)) [static]
static SortElement* MergeLists _ANSI_ARGS_ ((SortElement *leftPtr, SortElement *rightPtr, SortInfo *infoPtr)) [static]
static SortElement* MergeSort _ANSI_ARGS_ ((SortElement *headPt, SortInfo *infoPtr)) [static]
static int InfoArgsCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])) [static]
static int DictionaryCompare _ANSI_ARGS_ ((char *left, char *right)) [static]
static void AppendLocals _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, CONST char *pattern, int includeLinks)) [static]
static void AppendLocals (Tcl_Interp * interp, Tcl_Obj * listPtr, CONST char * pattern, int includeLinks) [static]

Definition at line 1416 of file tclCmdIL.c.
References CallFrame::compiledLocals, Proc::firstLocalPtr, CompiledLocal::nextPtr, NULL, CallFrame::numCompiledLocals, CallFrame::procPtr, Tcl_FirstHashEntry(), Tcl_GetHashKey, Tcl_GetHashValue, Tcl_ListObjAppendElement(), Tcl_NewStringObj(), Tcl_NextHashEntry(), Tcl_StringMatch(), TclIsVarLink, TclIsVarTemporary, TclIsVarUndefined, Interp::varFramePtr, varPtr, and CallFrame::varTablePtr.
Referenced by InfoLocalsCmd(), and InfoVarsCmd().1421 {
1422     Interp *iPtr = (Interp *) interp;
1423     CompiledLocal *localPtr;
1424     Var *varPtr;
1425     int i, localVarCt;
1426     char *varName;
1427     Tcl_HashTable *localVarTablePtr;
1428     register Tcl_HashEntry *entryPtr;
1429     Tcl_HashSearch search;
1430 
1431     localPtr = iPtr->varFramePtr->procPtr->firstLocalPtr;
1432     localVarCt = iPtr->varFramePtr->numCompiledLocals;
1433     varPtr = iPtr->varFramePtr->compiledLocals;
1434     localVarTablePtr = iPtr->varFramePtr->varTablePtr;
1435 
1436     for (i = 0; i < localVarCt; i++) {
1437   /*
1438    * Skip nameless (temporary) variables and undefined variables
1439    */
1440 
1441   if (!TclIsVarTemporary(localPtr) && !TclIsVarUndefined(varPtr)
1442           && (includeLinks || !TclIsVarLink(varPtr))) {
1443       varName = varPtr->name;
1444       if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
1445     Tcl_ListObjAppendElement(interp, listPtr,
1446             Tcl_NewStringObj(varName, -1));
1447       }
1448         }
1449   varPtr++;
1450   localPtr = localPtr->nextPtr;
1451     }
1452     
1453     if (localVarTablePtr != NULL) {
1454   for (entryPtr = Tcl_FirstHashEntry(localVarTablePtr, &search);
1455           entryPtr != NULL;
1456                 entryPtr = Tcl_NextHashEntry(&search)) {
1457       varPtr = (Var *) Tcl_GetHashValue(entryPtr);
1458       if (!TclIsVarUndefined(varPtr)
1459         && (includeLinks || !TclIsVarLink(varPtr))) {
1460     varName = Tcl_GetHashKey(localVarTablePtr, entryPtr);
1461     if ((pattern == NULL)
1462             || Tcl_StringMatch(varName, pattern)) {
1463         Tcl_ListObjAppendElement(interp, listPtr,
1464           Tcl_NewStringObj(varName, -1));
1465     }
1466       }
1467   }
1468     }
1469 }
static int DictionaryCompare (char * left, char * right) [static]

Definition at line 3890 of file tclCmdIL.c.
References Tcl_UniCharIsLower(), Tcl_UniCharIsUpper(), Tcl_UniCharToLower(), Tcl_UtfToUniChar(), and UCHAR.
Referenced by SortCompare(), and Tcl_LsearchObjCmd().3892 {
3893     Tcl_UniChar uniLeft, uniRight, uniLeftLower, uniRightLower;
3894     int diff, zeros;
3895     int secondaryDiff = 0;
3896 
3897     while (1) {
3898   if (isdigit(UCHAR(*right)) /* INTL: digit */
3899     && isdigit(UCHAR(*left))) { /* INTL: digit */
3900       /*
3901        * There are decimal numbers embedded in the two
3902        * strings.  Compare them as numbers, rather than
3903        * strings.  If one number has more leading zeros than
3904        * the other, the number with more leading zeros sorts
3905        * later, but only as a secondary choice.
3906        */
3907 
3908       zeros = 0;
3909       while ((*right == '0') && (isdigit(UCHAR(right[1])))) {
3910     right++;
3911     zeros--;
3912       }
3913       while ((*left == '0') && (isdigit(UCHAR(left[1])))) {
3914     left++;
3915     zeros++;
3916       }
3917       if (secondaryDiff == 0) {
3918     secondaryDiff = zeros;
3919       }
3920 
3921       /*
3922        * The code below compares the numbers in the two
3923        * strings without ever converting them to integers.  It
3924        * does this by first comparing the lengths of the
3925        * numbers and then comparing the digit values.
3926        */
3927 
3928       diff = 0;
3929       while (1) {
3930     if (diff == 0) {
3931         diff = UCHAR(*left) - UCHAR(*right);
3932     }
3933     right++;
3934     left++;
3935     if (!isdigit(UCHAR(*right))) { /* INTL: digit */
3936         if (isdigit(UCHAR(*left))) { /* INTL: digit */
3937       return 1;
3938         } else {
3939       /*
3940        * The two numbers have the same length. See
3941        * if their values are different.
3942        */
3943 
3944       if (diff != 0) {
3945           return diff;
3946       }
3947       break;
3948         }
3949     } else if (!isdigit(UCHAR(*left))) { /* INTL: digit */
3950         return -1;
3951     }
3952       }
3953       continue;
3954   }
3955 
3956   /*
3957    * Convert character to Unicode for comparison purposes.  If either
3958    * string is at the terminating null, do a byte-wise comparison and
3959    * bail out immediately.
3960    */
3961 
3962   if ((*left != '\0') && (*right != '\0')) {
3963       left += Tcl_UtfToUniChar(left, &uniLeft);
3964       right += Tcl_UtfToUniChar(right, &uniRight);
3965       /*
3966        * Convert both chars to lower for the comparison, because
3967        * dictionary sorts are case insensitve.  Covert to lower, not
3968        * upper, so chars between Z and a will sort before A (where most
3969        * other interesting punctuations occur)
3970        */
3971       uniLeftLower = Tcl_UniCharToLower(uniLeft);
3972       uniRightLower = Tcl_UniCharToLower(uniRight);
3973   } else {
3974       diff = UCHAR(*left) - UCHAR(*right);
3975       break;
3976   }
3977 
3978         diff = uniLeftLower - uniRightLower;
3979         if (diff) {
3980       return diff;
3981   } else if (secondaryDiff == 0) {
3982       if (Tcl_UniCharIsUpper(uniLeft) &&
3983         Tcl_UniCharIsLower(uniRight)) {
3984     secondaryDiff = -1;
3985       } else if (Tcl_UniCharIsUpper(uniRight)
3986         && Tcl_UniCharIsLower(uniLeft)) {
3987     secondaryDiff = 1;
3988       }
3989         }
3990     }
3991     if (diff == 0) {
3992   diff = secondaryDiff;
3993     }
3994     return diff;
3995 }
static int InfoArgsCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 515 of file tclCmdIL.c.
References Proc::firstLocalPtr, CompiledLocal::name, CompiledLocal::nextPtr, NULL, TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), Tcl_ListObjAppendElement(), Tcl_NewListObj(), Tcl_NewStringObj(), TCL_OK, Tcl_SetObjResult(), Tcl_WrongNumArgs(), TclFindProc(), and TclIsVarArgument.
Referenced by Tcl_InfoObjCmd().520 {
521     register Interp *iPtr = (Interp *) interp;
522     char *name;
523     Proc *procPtr;
524     CompiledLocal *localPtr;
525     Tcl_Obj *listObjPtr;
526 
527     if (objc != 3) {
528         Tcl_WrongNumArgs(interp, 2, objv, "procname");
529         return TCL_ERROR;
530     }
531 
532     name = Tcl_GetString(objv[2]);
533     procPtr = TclFindProc(iPtr, name);
534     if (procPtr == NULL) {
535         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
536                 "\"", name, "\" isn't a procedure", (char *) NULL);
537         return TCL_ERROR;
538     }
539 
540     /*
541      * Build a return list containing the arguments.
542      */
543     
544     listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
545     for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
546             localPtr = localPtr->nextPtr) {
547         if (TclIsVarArgument(localPtr)) {
548             Tcl_ListObjAppendElement(interp, listObjPtr,
549         Tcl_NewStringObj(localPtr->name, -1));
550         }
551     }
552     Tcl_SetObjResult(interp, listObjPtr);
553     return TCL_OK;
554 }
static int InfoBodyCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 577 of file tclCmdIL.c.
References Proc::bodyPtr, Tcl_Obj::bytes, Tcl_Obj::length, NULL, TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), Tcl_NewStringObj(), TCL_OK, Tcl_SetObjResult(), Tcl_WrongNumArgs(), TclFindProc(), and void().
Referenced by Tcl_InfoObjCmd().582 {
583     register Interp *iPtr = (Interp *) interp;
584     char *name;
585     Proc *procPtr;
586     Tcl_Obj *bodyPtr, *resultPtr;
587     
588     if (objc != 3) {
589         Tcl_WrongNumArgs(interp, 2, objv, "procname");
590         return TCL_ERROR;
591     }
592 
593     name = Tcl_GetString(objv[2]);
594     procPtr = TclFindProc(iPtr, name);
595     if (procPtr == NULL) {
596         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
597     "\"", name, "\" isn't a procedure", (char *) NULL);
598         return TCL_ERROR;
599     }
600 
601     /* 
602      * Here we used to return procPtr->bodyPtr, except when the body was
603      * bytecompiled - in that case, the return was a copy of the body's
604      * string rep. In order to better isolate the implementation details
605      * of the compiler/engine subsystem, we now always return a copy of 
606      * the string rep. It is important to return a copy so that later 
607      * manipulations of the object do not invalidate the internal rep.
608      */
609 
610     bodyPtr = procPtr->bodyPtr;
611     if (bodyPtr->bytes == NULL) {
612   /*
613    * The string rep might not be valid if the procedure has
614    * never been run before.  [Bug #545644]
615    */
616   (void) Tcl_GetString(bodyPtr);
617     }
618     resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
619     
620     Tcl_SetObjResult(interp, resultPtr);
621     return TCL_OK;
622 }
static int InfoCmdCountCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 646 of file tclCmdIL.c.
References Interp::cmdCount, NULL, TCL_ERROR, Tcl_GetObjResult(), TCL_OK, Tcl_SetIntObj(), and Tcl_WrongNumArgs().
Referenced by Tcl_InfoObjCmd().651 {
652     Interp *iPtr = (Interp *) interp;
653     
654     if (objc != 2) {
655         Tcl_WrongNumArgs(interp, 2, objv, NULL);
656         return TCL_ERROR;
657     }
658 
659     Tcl_SetIntObj(Tcl_GetObjResult(interp), iPtr->cmdCount);
660     return TCL_OK;
661 }
static int InfoCommandsCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 688 of file tclCmdIL.c.
References Namespace::cmdTable, CONST, NULL, TCL_ERROR, Tcl_FindHashEntry, Tcl_FirstHashEntry(), Tcl_GetCommandFullName(), Tcl_GetCurrentNamespace(), Tcl_GetGlobalNamespace(), Tcl_GetHashKey, Tcl_GetHashValue, Tcl_GetString(), Tcl_ListObjAppendElement(), Tcl_NewListObj(), Tcl_NewObj(), Tcl_NewStringObj(), Tcl_NextHashEntry(), TCL_OK, Tcl_SetObjResult(), Tcl_StringMatch(), Tcl_WrongNumArgs(), TclGetNamespaceForQualName(), and TclMatchIsTrivial().
Referenced by Tcl_InfoObjCmd().693 {
694     char *cmdName, *pattern;
695     CONST char *simplePattern;
696     register Tcl_HashEntry *entryPtr;
697     Tcl_HashSearch search;
698     Namespace *nsPtr;
699     Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
700     Namespace *currNsPtr   = (Namespace *) Tcl_GetCurrentNamespace(interp);
701     Tcl_Obj *listPtr, *elemObjPtr;
702     int specificNsInPattern = 0;  /* Init. to avoid compiler warning. */
703     Tcl_Command cmd;
704 
705     /*
706      * Get the pattern and find the "effective namespace" in which to
707      * list commands.
708      */
709 
710     if (objc == 2) {
711         simplePattern = NULL;
712   nsPtr = currNsPtr;
713   specificNsInPattern = 0;
714     } else if (objc == 3) {
715   /*
716    * From the pattern, get the effective namespace and the simple
717    * pattern (no namespace qualifiers or ::'s) at the end. If an
718    * error was found while parsing the pattern, return it. Otherwise,
719    * if the namespace wasn't found, just leave nsPtr NULL: we will
720    * return an empty list since no commands there can be found.
721    */
722 
723   Namespace *dummy1NsPtr, *dummy2NsPtr;
724   
725 
726   pattern = Tcl_GetString(objv[2]);
727   TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
728            /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
729 
730   if (nsPtr != NULL) {  /* we successfully found the pattern's ns */
731       specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
732   }
733     } else {
734         Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
735         return TCL_ERROR;
736     }
737 
738     /*
739      * Exit as quickly as possible if we couldn't find the namespace.
740      */
741 
742     if (nsPtr == NULL) {
743   return TCL_OK;
744     }
745 
746     /*
747      * Scan through the effective namespace's command table and create a
748      * list with all commands that match the pattern. If a specific
749      * namespace was requested in the pattern, qualify the command names
750      * with the namespace name.
751      */
752 
753     listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
754 
755     if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
756   /*
757    * Special case for when the pattern doesn't include any of
758    * glob's special characters. This lets us avoid scans of any
759    * hash tables.
760    */
761   entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
762   if (entryPtr != NULL) {
763       if (specificNsInPattern) {
764     cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
765     elemObjPtr = Tcl_NewObj();
766     Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
767       } else {
768     cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
769     elemObjPtr = Tcl_NewStringObj(cmdName, -1);
770       }
771       Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
772   } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
773       entryPtr = Tcl_FindHashEntry(&globalNsPtr->cmdTable,
774         simplePattern);
775       if (entryPtr != NULL) {
776     cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
777     Tcl_ListObjAppendElement(interp, listPtr,
778       Tcl_NewStringObj(cmdName, -1));
779       }
780   }
781     } else {
782   entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
783   while (entryPtr != NULL) {
784       cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
785       if ((simplePattern == NULL)
786               || Tcl_StringMatch(cmdName, simplePattern)) {
787     if (specificNsInPattern) {
788         cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
789         elemObjPtr = Tcl_NewObj();
790         Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
791     } else {
792         elemObjPtr = Tcl_NewStringObj(cmdName, -1);
793     }
794     Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
795       }
796       entryPtr = Tcl_NextHashEntry(&search);
797   }
798 
799   /*
800    * If the effective namespace isn't the global :: namespace, and a
801    * specific namespace wasn't requested in the pattern, then add in
802    * all global :: commands that match the simple pattern. Of course,
803    * we add in only those commands that aren't hidden by a command in
804    * the effective namespace.
805    */
806   
807   if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
808       entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
809       while (entryPtr != NULL) {
810     cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
811     if ((simplePattern == NULL)
812                   || Tcl_StringMatch(cmdName, simplePattern)) {
813         if (Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) {
814       Tcl_ListObjAppendElement(interp, listPtr,
815         Tcl_NewStringObj(cmdName, -1));
816         }
817     }
818     entryPtr = Tcl_NextHashEntry(&search);
819       }
820   }
821     }
822     
823     Tcl_SetObjResult(interp, listPtr);
824     return TCL_OK;
825 }
static int InfoCompleteCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 849 of file tclCmdIL.c.
References TCL_ERROR, Tcl_GetObjResult(), TCL_OK, Tcl_SetIntObj(), Tcl_WrongNumArgs(), and TclObjCommandComplete().
Referenced by Tcl_InfoObjCmd().854 {
855     if (objc != 3) {
856         Tcl_WrongNumArgs(interp, 2, objv, "command");
857         return TCL_ERROR;
858     }
859 
860     if (TclObjCommandComplete(objv[2])) {
861   Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
862     } else {
863   Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
864     }
865 
866     return TCL_OK;
867 }
static int InfoDefaultCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 891 of file tclCmdIL.c.
References CompiledLocal::defValuePtr, Proc::firstLocalPtr, CompiledLocal::name, CompiledLocal::nextPtr, NULL, Tcl_DecrRefCount, TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), Tcl_IncrRefCount, Tcl_NewObj(), Tcl_ObjSetVar2(), TCL_OK, Tcl_SetIntObj(), Tcl_WrongNumArgs(), TclFindProc(), and TclIsVarArgument.
Referenced by Tcl_InfoObjCmd().896 {
897     Interp *iPtr = (Interp *) interp;
898     char *procName, *argName, *varName;
899     Proc *procPtr;
900     CompiledLocal *localPtr;
901     Tcl_Obj *valueObjPtr;
902 
903     if (objc != 5) {
904         Tcl_WrongNumArgs(interp, 2, objv, "procname arg varname");
905         return TCL_ERROR;
906     }
907 
908     procName = Tcl_GetString(objv[2]);
909     argName = Tcl_GetString(objv[3]);
910 
911     procPtr = TclFindProc(iPtr, procName);
912     if (procPtr == NULL) {
913   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
914     "\"", procName, "\" isn't a procedure", (char *) NULL);
915         return TCL_ERROR;
916     }
917 
918     for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
919             localPtr = localPtr->nextPtr) {
920         if (TclIsVarArgument(localPtr)
921     && (strcmp(argName, localPtr->name) == 0)) {
922             if (localPtr->defValuePtr != NULL) {
923     valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
924       localPtr->defValuePtr, 0);
925                 if (valueObjPtr == NULL) {
926                     defStoreError:
927         varName = Tcl_GetString(objv[4]);
928         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
929                       "couldn't store default value in variable \"",
930           varName, "\"", (char *) NULL);
931                     return TCL_ERROR;
932                 }
933     Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
934             } else {
935                 Tcl_Obj *nullObjPtr = Tcl_NewObj();
936     Tcl_IncrRefCount(nullObjPtr);
937                 valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
938       nullObjPtr, 0);
939     Tcl_DecrRefCount(nullObjPtr); /* free unneeded obj */
940                 if (valueObjPtr == NULL) {
941                     goto defStoreError;
942                 }
943     Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
944             }
945             return TCL_OK;
946         }
947     }
948 
949     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
950       "procedure \"", procName, "\" doesn't have an argument \"",
951       argName, "\"", (char *) NULL);
952     return TCL_ERROR;
953 }
static int InfoExistsCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 976 of file tclCmdIL.c.
References NULL, TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), TCL_OK, Tcl_SetIntObj(), Tcl_WrongNumArgs(), TclIsVarUndefined, TclVarTraceExists(), and varPtr.
Referenced by Tcl_InfoObjCmd().981 {
982     char *varName;
983     Var *varPtr;
984 
985     if (objc != 3) {
986         Tcl_WrongNumArgs(interp, 2, objv, "varName");
987         return TCL_ERROR;
988     }
989 
990     varName = Tcl_GetString(objv[2]);
991     varPtr = TclVarTraceExists(interp, varName);
992     if ((varPtr != NULL) && !TclIsVarUndefined(varPtr)) {
993         Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
994     } else {
995         Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
996     }
997     return TCL_OK;
998 }
static int InfoFunctionsCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1022 of file tclCmdIL.c.
References NULL, TCL_ERROR, Tcl_GetString(), Tcl_ListMathFuncs(), TCL_OK, Tcl_SetObjResult(), and Tcl_WrongNumArgs().
Referenced by Tcl_InfoObjCmd().1027 {
1028     char *pattern;
1029     Tcl_Obj *listPtr;
1030 
1031     if (objc == 2) {
1032         pattern = NULL;
1033     } else if (objc == 3) {
1034         pattern = Tcl_GetString(objv[2]);
1035     } else {
1036         Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
1037         return TCL_ERROR;
1038     }
1039 
1040     listPtr = Tcl_ListMathFuncs(interp, pattern);
1041     if (listPtr == NULL) {
1042   return TCL_ERROR;
1043     }
1044     Tcl_SetObjResult(interp, listPtr);
1045     return TCL_OK;
1046 }
static int InfoGlobalsCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1070 of file tclCmdIL.c.
References NULL, TCL_ERROR, Tcl_FindHashEntry, Tcl_FirstHashEntry(), Tcl_GetGlobalNamespace(), Tcl_GetHashKey, Tcl_GetHashValue, Tcl_GetString(), Tcl_ListObjAppendElement(), Tcl_NewListObj(), Tcl_NewStringObj(), Tcl_NextHashEntry(), TCL_OK, Tcl_SetObjResult(), Tcl_StringMatch(), Tcl_WrongNumArgs(), TclIsVarUndefined, TclMatchIsTrivial(), varPtr, and Namespace::varTable.
Referenced by Tcl_InfoObjCmd().1075 {
1076     char *varName, *pattern;
1077     Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
1078     register Tcl_HashEntry *entryPtr;
1079     Tcl_HashSearch search;
1080     Var *varPtr;
1081     Tcl_Obj *listPtr;
1082 
1083     if (objc == 2) {
1084         pattern = NULL;
1085     } else if (objc == 3) {
1086   pattern = Tcl_GetString(objv[2]);
1087   /*
1088    * Strip leading global-namespace qualifiers. [Bug 1057461]
1089    */
1090   if (pattern[0] == ':' && pattern[1] == ':') {
1091       while (*pattern == ':') {
1092     pattern++;
1093       }
1094   }
1095     } else {
1096         Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
1097         return TCL_ERROR;
1098     }
1099 
1100     /*
1101      * Scan through the global :: namespace's variable table and create a
1102      * list of all global variables that match the pattern.
1103      */
1104     
1105     listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
1106     if (pattern != NULL && TclMatchIsTrivial(pattern)) {
1107   entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable, pattern);
1108   if (entryPtr != NULL) {
1109       varPtr = (Var *) Tcl_GetHashValue(entryPtr);
1110       if (!TclIsVarUndefined(varPtr)) {
1111     Tcl_ListObjAppendElement(interp, listPtr,
1112       Tcl_NewStringObj(pattern, -1));
1113       }
1114   }
1115     } else {
1116   for (entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);
1117     entryPtr != NULL;
1118     entryPtr = Tcl_NextHashEntry(&search)) {
1119       varPtr = (Var *) Tcl_GetHashValue(entryPtr);
1120       if (TclIsVarUndefined(varPtr)) {
1121     continue;
1122       }
1123       varName = Tcl_GetHashKey(&globalNsPtr->varTable, entryPtr);
1124       if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
1125     Tcl_ListObjAppendElement(interp, listPtr,
1126       Tcl_NewStringObj(varName, -1));
1127       }
1128   }
1129     }
1130     Tcl_SetObjResult(interp, listPtr);
1131     return TCL_OK;
1132 }
static int InfoHostnameCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1155 of file tclCmdIL.c.
References CONST, NULL, TCL_ERROR, Tcl_GetHostName(), Tcl_GetObjResult(), TCL_OK, Tcl_SetStringObj(), and Tcl_WrongNumArgs().
Referenced by Tcl_InfoObjCmd().1160 {
1161     CONST char *name;
1162     if (objc != 2) {
1163         Tcl_WrongNumArgs(interp, 2, objv, NULL);
1164         return TCL_ERROR;
1165     }
1166 
1167     name = Tcl_GetHostName();
1168     if (name) {
1169   Tcl_SetStringObj(Tcl_GetObjResult(interp), name, -1);
1170   return TCL_OK;
1171     } else {
1172   Tcl_SetStringObj(Tcl_GetObjResult(interp),
1173     "unable to determine name of host", -1);
1174   return TCL_ERROR;
1175     }
1176 }
static int InfoLevelCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1199 of file tclCmdIL.c.
References CallFrame::callerVarPtr, CallFrame::level, NULL, CallFrame::objc, CallFrame::objv, TCL_ERROR, Tcl_GetIntFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_NewListObj(), TCL_OK, Tcl_SetIntObj(), Tcl_SetObjResult(), Tcl_WrongNumArgs(), and Interp::varFramePtr.
Referenced by Tcl_InfoObjCmd().1204 {
1205     Interp *iPtr = (Interp *) interp;
1206     int level;
1207     CallFrame *framePtr;
1208     Tcl_Obj *listPtr;
1209 
1210     if (objc == 2) {    /* just "info level" */
1211         if (iPtr->varFramePtr == NULL) {
1212             Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
1213         } else {
1214             Tcl_SetIntObj(Tcl_GetObjResult(interp), iPtr->varFramePtr->level);
1215         }
1216         return TCL_OK;
1217     } else if (objc == 3) {
1218         if (Tcl_GetIntFromObj(interp, objv[2], &level) != TCL_OK) {
1219             return TCL_ERROR;
1220         }
1221         if (level <= 0) {
1222             if (iPtr->varFramePtr == NULL) {
1223                 levelError:
1224     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1225       "bad level \"",
1226       Tcl_GetString(objv[2]),
1227       "\"", (char *) NULL);
1228                 return TCL_ERROR;
1229             }
1230             level += iPtr->varFramePtr->level;
1231         }
1232         for (framePtr = iPtr->varFramePtr;  framePtr != NULL;
1233                 framePtr = framePtr->callerVarPtr) {
1234             if (framePtr->level == level) {
1235                 break;
1236             }
1237         }
1238         if (framePtr == NULL) {
1239             goto levelError;
1240         }
1241 
1242         listPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
1243         Tcl_SetObjResult(interp, listPtr);
1244         return TCL_OK;
1245     }
1246 
1247     Tcl_WrongNumArgs(interp, 2, objv, "?number?");
1248     return TCL_ERROR;
1249 }
static int InfoLibraryCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1273 of file tclCmdIL.c.
References CONST, NULL, TCL_ERROR, Tcl_GetObjResult(), Tcl_GetVar(), TCL_GLOBAL_ONLY, TCL_OK, Tcl_SetStringObj(), and Tcl_WrongNumArgs().
Referenced by Tcl_InfoObjCmd().1278 {
1279     CONST char *libDirName;
1280 
1281     if (objc != 2) {
1282         Tcl_WrongNumArgs(interp, 2, objv, NULL);
1283         return TCL_ERROR;
1284     }
1285 
1286     libDirName = Tcl_GetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
1287     if (libDirName != NULL) {
1288         Tcl_SetStringObj(Tcl_GetObjResult(interp), libDirName, -1);
1289         return TCL_OK;
1290     }
1291     Tcl_SetStringObj(Tcl_GetObjResult(interp), 
1292             "no library has been specified for Tcl", -1);
1293     return TCL_ERROR;
1294 }
static int InfoLoadedCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1318 of file tclCmdIL.c.
References NULL, TCL_ERROR, Tcl_GetString(), Tcl_WrongNumArgs(), and TclGetLoadedPackages().
Referenced by Tcl_InfoObjCmd().1323 {
1324     char *interpName;
1325     int result;
1326 
1327     if ((objc != 2) && (objc != 3)) {
1328         Tcl_WrongNumArgs(interp, 2, objv, "?interp?");
1329         return TCL_ERROR;
1330     }
1331 
1332     if (objc == 2) {    /* get loaded pkgs in all interpreters */
1333   interpName = NULL;
1334     } else {      /* get pkgs just in specified interp */
1335   interpName = Tcl_GetString(objv[2]);
1336     }
1337     result = TclGetLoadedPackages(interp, interpName);
1338     return result;
1339 }
static int InfoLocalsCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1363 of file tclCmdIL.c.
References AppendLocals(), CallFrame::isProcCallFrame, NULL, TCL_ERROR, Tcl_GetString(), Tcl_NewListObj(), TCL_OK, Tcl_SetObjResult(), Tcl_WrongNumArgs(), and Interp::varFramePtr.
Referenced by Tcl_InfoObjCmd().1368 {
1369     Interp *iPtr = (Interp *) interp;
1370     char *pattern;
1371     Tcl_Obj *listPtr;
1372 
1373     if (objc == 2) {
1374         pattern = NULL;
1375     } else if (objc == 3) {
1376         pattern = Tcl_GetString(objv[2]);
1377     } else {
1378         Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
1379         return TCL_ERROR;
1380     }
1381     
1382     if (iPtr->varFramePtr == NULL || !iPtr->varFramePtr->isProcCallFrame) {
1383         return TCL_OK;
1384     }
1385 
1386     /*
1387      * Return a list containing names of first the compiled locals (i.e. the
1388      * ones stored in the call frame), then the variables in the local hash
1389      * table (if one exists).
1390      */
1391     
1392     listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
1393     AppendLocals(interp, listPtr, pattern, 0);
1394     Tcl_SetObjResult(interp, listPtr);
1395     return TCL_OK;
1396 }
static int InfoNameOfExecutableCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1493 of file tclCmdIL.c.
References CONST, NULL, TCL_ERROR, Tcl_GetNameOfExecutable(), Tcl_GetObjResult(), TCL_OK, Tcl_SetStringObj(), and Tcl_WrongNumArgs().
Referenced by Tcl_InfoObjCmd().1498 {
1499     CONST char *nameOfExecutable;
1500 
1501     if (objc != 2) {
1502         Tcl_WrongNumArgs(interp, 2, objv, NULL);
1503         return TCL_ERROR;
1504     }
1505 
1506     nameOfExecutable = Tcl_GetNameOfExecutable();
1507     
1508     if (nameOfExecutable != NULL) {
1509   Tcl_SetStringObj(Tcl_GetObjResult(interp), nameOfExecutable, -1);
1510     }
1511     return TCL_OK;
1512 }
static int InfoPatchLevelCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1536 of file tclCmdIL.c.
References CONST, NULL, TCL_ERROR, Tcl_GetObjResult(), Tcl_GetVar(), TCL_GLOBAL_ONLY, TCL_LEAVE_ERR_MSG, TCL_OK, Tcl_SetStringObj(), and Tcl_WrongNumArgs().
Referenced by Tcl_InfoObjCmd().1541 {
1542     CONST char *patchlevel;
1543 
1544     if (objc != 2) {
1545         Tcl_WrongNumArgs(interp, 2, objv, NULL);
1546         return TCL_ERROR;
1547     }
1548 
1549     patchlevel = Tcl_GetVar(interp, "tcl_patchLevel",
1550             (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
1551     if (patchlevel != NULL) {
1552         Tcl_SetStringObj(Tcl_GetObjResult(interp), patchlevel, -1);
1553         return TCL_OK;
1554     }
1555     return TCL_ERROR;
1556 }
static int InfoProcsCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1583 of file tclCmdIL.c.
References Namespace::cmdTable, CONST, NULL, TCL_ERROR, Tcl_FindHashEntry, Tcl_FirstHashEntry(), Tcl_GetCommandFullName(), Tcl_GetCurrentNamespace(), Tcl_GetGlobalNamespace(), Tcl_GetHashKey, Tcl_GetHashValue, Tcl_GetString(), Tcl_ListObjAppendElement(), Tcl_NewListObj(), Tcl_NewObj(), Tcl_NewStringObj(), Tcl_NextHashEntry(), TCL_OK, Tcl_SetObjResult(), Tcl_StringMatch(), Tcl_WrongNumArgs(), TclGetNamespaceForQualName(), TclGetOriginalCommand(), TclIsProc(), and TclMatchIsTrivial().
Referenced by Tcl_InfoObjCmd().1588 {
1589     char *cmdName, *pattern;
1590     CONST char *simplePattern;
1591     Namespace *nsPtr;
1592 #ifdef INFO_PROCS_SEARCH_GLOBAL_NS
1593     Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
1594 #endif
1595     Namespace *currNsPtr   = (Namespace *) Tcl_GetCurrentNamespace(interp);
1596     Tcl_Obj *listPtr, *elemObjPtr;
1597     int specificNsInPattern = 0;  /* Init. to avoid compiler warning. */
1598     register Tcl_HashEntry *entryPtr;
1599     Tcl_HashSearch search;
1600     Command *cmdPtr, *realCmdPtr;
1601 
1602     /*
1603      * Get the pattern and find the "effective namespace" in which to
1604      * list procs.
1605      */
1606 
1607     if (objc == 2) {
1608   simplePattern = NULL;
1609   nsPtr = currNsPtr;
1610   specificNsInPattern = 0;
1611     } else if (objc == 3) {
1612   /*
1613    * From the pattern, get the effective namespace and the simple
1614    * pattern (no namespace qualifiers or ::'s) at the end. If an
1615    * error was found while parsing the pattern, return it. Otherwise,
1616    * if the namespace wasn't found, just leave nsPtr NULL: we will
1617    * return an empty list since no commands there can be found.
1618    */
1619 
1620   Namespace *dummy1NsPtr, *dummy2NsPtr;
1621 
1622   pattern = Tcl_GetString(objv[2]);
1623   TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
1624     /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
1625     &simplePattern);
1626 
1627   if (nsPtr != NULL) {  /* we successfully found the pattern's ns */
1628       specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
1629   }
1630     } else {
1631         Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
1632         return TCL_ERROR;
1633     }
1634 
1635     if (nsPtr == NULL) {
1636   return TCL_OK;
1637     }
1638 
1639     /*
1640      * Scan through the effective namespace's command table and create a
1641      * list with all procs that match the pattern. If a specific
1642      * namespace was requested in the pattern, qualify the command names
1643      * with the namespace name.
1644      */
1645 
1646     listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
1647 #ifndef INFO_PROCS_SEARCH_GLOBAL_NS
1648     if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
1649   entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
1650   if (entryPtr != NULL) {
1651       cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
1652 
1653       if (!TclIsProc(cmdPtr)) {
1654     realCmdPtr = (Command *)
1655       TclGetOriginalCommand((Tcl_Command) cmdPtr);
1656     if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
1657         goto simpleProcOK;
1658     }
1659       } else {
1660         simpleProcOK:
1661     if (specificNsInPattern) {
1662         elemObjPtr = Tcl_NewObj();
1663         Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
1664           elemObjPtr);
1665     } else {
1666         elemObjPtr = Tcl_NewStringObj(simplePattern, -1);
1667     }
1668     Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
1669       }
1670   }
1671     } else
1672 #endif /* !INFO_PROCS_SEARCH_GLOBAL_NS */
1673     {
1674   entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
1675   while (entryPtr != NULL) {
1676       cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
1677       if ((simplePattern == NULL)
1678               || Tcl_StringMatch(cmdName, simplePattern)) {
1679     cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
1680 
1681     if (!TclIsProc(cmdPtr)) {
1682         realCmdPtr = (Command *)
1683           TclGetOriginalCommand((Tcl_Command) cmdPtr);
1684         if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
1685       goto procOK;
1686         }
1687     } else {
1688       procOK:
1689         if (specificNsInPattern) {
1690       elemObjPtr = Tcl_NewObj();
1691       Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
1692         elemObjPtr);
1693         } else {
1694       elemObjPtr = Tcl_NewStringObj(cmdName, -1);
1695         }
1696         Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
1697     }
1698       }
1699       entryPtr = Tcl_NextHashEntry(&search);
1700   }
1701 
1702   /*
1703    * If the effective namespace isn't the global :: namespace, and a
1704    * specific namespace wasn't requested in the pattern, then add in
1705    * all global :: procs that match the simple pattern. Of course,
1706    * we add in only those procs that aren't hidden by a proc in
1707    * the effective namespace.
1708    */
1709 
1710 #ifdef INFO_PROCS_SEARCH_GLOBAL_NS
1711   /*
1712    * If "info procs" worked like "info commands", returning the
1713    * commands also seen in the global namespace, then you would
1714    * include this code.  As this could break backwards compatibilty
1715    * with 8.0-8.2, we decided not to "fix" it in 8.3, leaving the
1716    * behavior slightly different.
1717    */
1718   if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
1719       entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
1720       while (entryPtr != NULL) {
1721     cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
1722     if ((simplePattern == NULL)
1723                   || Tcl_StringMatch(cmdName, simplePattern)) {
1724         if (Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) {
1725       cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
1726       realCmdPtr = (Command *) TclGetOriginalCommand(
1727               (Tcl_Command) cmdPtr);
1728 
1729       if (TclIsProc(cmdPtr) || ((realCmdPtr != NULL)
1730         && TclIsProc(realCmdPtr))) {
1731           Tcl_ListObjAppendElement(interp, listPtr,
1732                   Tcl_NewStringObj(cmdName, -1));
1733       }
1734         }
1735     }
1736     entryPtr = Tcl_NextHashEntry(&search);
1737       }
1738   }
1739 #endif
1740     }
1741 
1742     Tcl_SetObjResult(interp, listPtr);
1743     return TCL_OK;
1744 }
static int InfoScriptCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1771 of file tclCmdIL.c.
References NULL, Interp::scriptFile, Tcl_DecrRefCount, TCL_ERROR, Tcl_IncrRefCount, TCL_OK, Tcl_SetObjResult(), and Tcl_WrongNumArgs().
Referenced by Tcl_InfoObjCmd().1776 {
1777     Interp *iPtr = (Interp *) interp;
1778     if ((objc != 2) && (objc != 3)) {
1779         Tcl_WrongNumArgs(interp, 2, objv, "?filename?");
1780         return TCL_ERROR;
1781     }
1782 
1783     if (objc == 3) {
1784   if (iPtr->scriptFile != NULL) {
1785       Tcl_DecrRefCount(iPtr->scriptFile);
1786   }
1787   iPtr->scriptFile = objv[2];
1788   Tcl_IncrRefCount(iPtr->scriptFile);
1789     }
1790     if (iPtr->scriptFile != NULL) {
1791         Tcl_SetObjResult(interp, iPtr->scriptFile);
1792     }
1793     return TCL_OK;
1794 }
static int InfoSharedlibCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1818 of file tclCmdIL.c.
References NULL, TCL_ERROR, Tcl_GetObjResult(), TCL_OK, Tcl_SetStringObj(), TCL_SHLIB_EXT, and Tcl_WrongNumArgs().
Referenced by Tcl_InfoObjCmd().1823 {
1824     if (objc != 2) {
1825         Tcl_WrongNumArgs(interp, 2, objv, NULL);
1826         return TCL_ERROR;
1827     }
1828     
1829 #ifdef TCL_SHLIB_EXT
1830     Tcl_SetStringObj(Tcl_GetObjResult(interp), TCL_SHLIB_EXT, -1);
1831 #endif
1832     return TCL_OK;
1833 }
static int InfoTclVersionCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1856 of file tclCmdIL.c.
References CONST, NULL, TCL_ERROR, Tcl_GetObjResult(), Tcl_GetVar(), TCL_GLOBAL_ONLY, TCL_LEAVE_ERR_MSG, TCL_OK, Tcl_SetStringObj(), and Tcl_WrongNumArgs().
Referenced by Tcl_InfoObjCmd().1861 {
1862     CONST char *version;
1863 
1864     if (objc != 2) {
1865         Tcl_WrongNumArgs(interp, 2, objv, NULL);
1866         return TCL_ERROR;
1867     }
1868 
1869     version = Tcl_GetVar(interp, "tcl_version",
1870         (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
1871     if (version != NULL) {
1872         Tcl_SetStringObj(Tcl_GetObjResult(interp), version, -1);
1873         return TCL_OK;
1874     }
1875     return TCL_ERROR;
1876 }
static int InfoVarsCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1903 of file tclCmdIL.c.
References AppendLocals(), CONST, CallFrame::isProcCallFrame, NULL, TCL_ERROR, Tcl_FindHashEntry, Tcl_FirstHashEntry(), Tcl_GetCurrentNamespace(), Tcl_GetGlobalNamespace(), Tcl_GetHashKey, Tcl_GetHashValue, Tcl_GetString(), Tcl_GetVariableFullName(), Tcl_ListObjAppendElement(), Tcl_NewListObj(), Tcl_NewObj(), Tcl_NewStringObj(), Tcl_NextHashEntry(), TCL_OK, Tcl_SetObjResult(), Tcl_StringMatch(), Tcl_WrongNumArgs(), TclGetNamespaceForQualName(), TclIsVarUndefined, TclMatchIsTrivial(), VAR_NAMESPACE_VAR, Interp::varFramePtr, varPtr, and Namespace::varTable.
Referenced by Tcl_InfoObjCmd().1908 {
1909     Interp *iPtr = (Interp *) interp;
1910     char *varName, *pattern;
1911     CONST char *simplePattern;
1912     register Tcl_HashEntry *entryPtr;
1913     Tcl_HashSearch search;
1914     Var *varPtr;
1915     Namespace *nsPtr;
1916     Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
1917     Namespace *currNsPtr   = (Namespace *) Tcl_GetCurrentNamespace(interp);
1918     Tcl_Obj *listPtr, *elemObjPtr;
1919     int specificNsInPattern = 0;  /* Init. to avoid compiler warning. */
1920 
1921     /*
1922      * Get the pattern and find the "effective namespace" in which to
1923      * list variables. We only use this effective namespace if there's
1924      * no active Tcl procedure frame.
1925      */
1926 
1927     if (objc == 2) {
1928         simplePattern = NULL;
1929   nsPtr = currNsPtr;
1930   specificNsInPattern = 0;
1931     } else if (objc == 3) {
1932   /*
1933    * From the pattern, get the effective namespace and the simple
1934    * pattern (no namespace qualifiers or ::'s) at the end. If an
1935    * error was found while parsing the pattern, return it. Otherwise,
1936    * if the namespace wasn't found, just leave nsPtr NULL: we will
1937    * return an empty list since no variables there can be found.
1938    */
1939 
1940   Namespace *dummy1NsPtr, *dummy2NsPtr;
1941 
1942         pattern = Tcl_GetString(objv[2]);
1943   TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
1944     /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
1945     &simplePattern);
1946 
1947   if (nsPtr != NULL) {  /* we successfully found the pattern's ns */
1948       specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
1949   }
1950     } else {
1951         Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
1952         return TCL_ERROR;
1953     }
1954 
1955     /*
1956      * If the namespace specified in the pattern wasn't found, just return.
1957      */
1958 
1959     if (nsPtr == NULL) {
1960   return TCL_OK;
1961     }
1962     
1963     listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
1964     
1965     if ((iPtr->varFramePtr == NULL)
1966       || !iPtr->varFramePtr->isProcCallFrame
1967       || specificNsInPattern) {
1968   /*
1969    * There is no frame pointer, the frame pointer was pushed only
1970    * to activate a namespace, or we are in a procedure call frame
1971    * but a specific namespace was specified. Create a list containing
1972    * only the variables in the effective namespace's variable table.
1973    */
1974   
1975   if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
1976       /*
1977        * If we can just do hash lookups, that simplifies things
1978        * a lot.
1979        */
1980 
1981       entryPtr = Tcl_FindHashEntry(&nsPtr->varTable, simplePattern);
1982       if (entryPtr != NULL) {
1983     varPtr = (Var *) Tcl_GetHashValue(entryPtr);
1984     if (!TclIsVarUndefined(varPtr)
1985       || (varPtr->flags & VAR_NAMESPACE_VAR)) {
1986         if (specificNsInPattern) {
1987       elemObjPtr = Tcl_NewObj();
1988       Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
1989             elemObjPtr);
1990         } else {
1991       elemObjPtr = Tcl_NewStringObj(simplePattern, -1);
1992         }
1993         Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
1994     }
1995       } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
1996     entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable,
1997       simplePattern);
1998     if (entryPtr != NULL) {
1999         varPtr = (Var *) Tcl_GetHashValue(entryPtr);
2000         if (!TclIsVarUndefined(varPtr)
2001           || (varPtr->flags & VAR_NAMESPACE_VAR)) {
2002       Tcl_ListObjAppendElement(interp, listPtr,
2003         Tcl_NewStringObj(simplePattern, -1));
2004         }
2005     }
2006       }
2007   } else {
2008       /*
2009        * Have to scan the tables of variables.
2010        */
2011 
2012       entryPtr = Tcl_FirstHashEntry(&nsPtr->varTable, &search);
2013       while (entryPtr != NULL) {
2014     varPtr = (Var *) Tcl_GetHashValue(entryPtr);
2015     if (!TclIsVarUndefined(varPtr)
2016       || (varPtr->flags & VAR_NAMESPACE_VAR)) {
2017         varName = Tcl_GetHashKey(&nsPtr->varTable, entryPtr);
2018         if ((simplePattern == NULL)
2019           || Tcl_StringMatch(varName, simplePattern)) {
2020       if (specificNsInPattern) {
2021           elemObjPtr = Tcl_NewObj();
2022           Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
2023             elemObjPtr);
2024       } else {
2025           elemObjPtr = Tcl_NewStringObj(varName, -1);
2026       }
2027       Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
2028         }
2029     }
2030     entryPtr = Tcl_NextHashEntry(&search);
2031       }
2032 
2033       /*
2034        * If the effective namespace isn't the global ::
2035        * namespace, and a specific namespace wasn't requested in
2036        * the pattern (i.e., the pattern only specifies variable
2037        * names), then add in all global :: variables that match
2038        * the simple pattern. Of course, add in only those
2039        * variables that aren't hidden by a variable in the
2040        * effective namespace.
2041        */
2042 
2043       if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
2044     entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);
2045     while (entryPtr != NULL) {
2046         varPtr = (Var *) Tcl_GetHashValue(entryPtr);
2047         if (!TclIsVarUndefined(varPtr)
2048           || (varPtr->flags & VAR_NAMESPACE_VAR)) {
2049       varName = Tcl_GetHashKey(&globalNsPtr->varTable,
2050         entryPtr);
2051       if ((simplePattern == NULL)
2052         || Tcl_StringMatch(varName, simplePattern)) {
2053           if (Tcl_FindHashEntry(&nsPtr->varTable,
2054             varName) == NULL) {
2055         Tcl_ListObjAppendElement(interp, listPtr,
2056           Tcl_NewStringObj(varName, -1));
2057           }
2058       }
2059         }
2060         entryPtr = Tcl_NextHashEntry(&search);
2061     }
2062       }
2063   }
2064     } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) {
2065   AppendLocals(interp, listPtr, simplePattern, 1);
2066     }
2067     
2068     Tcl_SetObjResult(interp, listPtr);
2069     return TCL_OK;
2070 }
static SortElement* MergeLists (SortElement * leftPtr, SortElement * rightPtr, SortInfo * infoPtr) [static]

Definition at line 3638 of file tclCmdIL.c.
References cmp(), SortElement::count, SortElement::nextPtr, NULL, SortElement::objPtr, and SortCompare().
Referenced by MergeSort().3645 {
3646     SortElement *headPtr;
3647     SortElement *tailPtr;
3648     int cmp;
3649 
3650     if (leftPtr == NULL) {
3651         return rightPtr;
3652     }
3653     if (rightPtr == NULL) {
3654         return leftPtr;
3655     }
3656     cmp = SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr);
3657     if (cmp > 0) {
3658   tailPtr = rightPtr;
3659   rightPtr = rightPtr->nextPtr;
3660     } else {
3661   if (cmp == 0) {
3662       leftPtr->count++;
3663   }
3664   tailPtr = leftPtr;
3665   leftPtr = leftPtr->nextPtr;
3666     }
3667     headPtr = tailPtr;
3668     while ((leftPtr != NULL) && (rightPtr != NULL)) {
3669   cmp = SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr);
3670   if (cmp > 0) {
3671       tailPtr->nextPtr = rightPtr;
3672       tailPtr = rightPtr;
3673       rightPtr = rightPtr->nextPtr;
3674   } else {
3675       if (cmp == 0) {
3676     leftPtr->count++;
3677       }
3678       tailPtr->nextPtr = leftPtr;
3679       tailPtr = leftPtr;
3680       leftPtr = leftPtr->nextPtr;
3681   }
3682     }
3683     if (leftPtr != NULL) {
3684        tailPtr->nextPtr = leftPtr;
3685     } else {
3686        tailPtr->nextPtr = rightPtr;
3687     }
3688     return headPtr;
3689 }
static SortElement* MergeSort (SortElement * headPtr, SortInfo * infoPtr) [static]

Definition at line 3580 of file tclCmdIL.c.
References MergeLists(), SortElement::nextPtr, NULL, and NUM_LISTS.3584 {
3585     /*
3586      * The subList array below holds pointers to temporary lists built
3587      * during the merge sort.  Element i of the array holds a list of
3588      * length 2**i.
3589      */
3590 
3591 #   define NUM_LISTS 30
3592     SortElement *subList[NUM_LISTS];
3593     SortElement *elementPtr;
3594     int i;
3595 
3596     for(i = 0; i < NUM_LISTS; i++){
3597         subList[i] = NULL;
3598     }
3599     while (headPtr != NULL) {
3600   elementPtr = headPtr;
3601   headPtr = headPtr->nextPtr;
3602   elementPtr->nextPtr = 0;
3603   for (i = 0; (i < NUM_LISTS) && (subList[i] != NULL); i++){
3604       elementPtr = MergeLists(subList[i], elementPtr, infoPtr);
3605       subList[i] = NULL;
3606   }
3607   if (i >= NUM_LISTS) {
3608       i = NUM_LISTS-1;
3609   }
3610   subList[i] = elementPtr;
3611     }
3612     elementPtr = NULL;
3613     for (i = 0; i < NUM_LISTS; i++){
3614         elementPtr = MergeLists(subList[i], elementPtr, infoPtr);
3615     }
3616     return elementPtr;
3617 }
static int SortCompare (Tcl_Obj * objPtr1, Tcl_Obj * objPtr2, SortInfo * infoPtr) [static]

Definition at line 3713 of file tclCmdIL.c.
References SortInfo::compareCmdPtr, DictionaryCompare(), SortInfo::index, SortInfo::interp, SortInfo::isIncreasing, NULL, SortInfo::resultCode, SORTIDX_NONE, SortInfo::sortMode, SORTMODE_ASCII, SORTMODE_DICTIONARY, SORTMODE_INTEGER, SORTMODE_REAL, Tcl_AddErrorInfo(), Tcl_AppendToObj(), TCL_ERROR, Tcl_EvalObjv(), Tcl_GetDoubleFromObj(), Tcl_GetIntFromObj(), Tcl_GetLongFromObj(), Tcl_GetObjResult(), Tcl_GetString(), TCL_INTEGER_SPACE, Tcl_ListObjGetElements(), Tcl_ListObjIndex(), Tcl_ListObjLength(), Tcl_ListObjReplace(), TCL_OK, Tcl_ResetResult(), and TclFormatInt().
Referenced by MergeLists().3717 {
3718     int order, listLen, index;
3719     Tcl_Obj *objPtr;
3720     char buffer[TCL_INTEGER_SPACE];
3721 
3722     order = 0;
3723     if (infoPtr->resultCode != TCL_OK) {
3724   /*
3725    * Once an error has occurred, skip any future comparisons
3726    * so as to preserve the error message in sortInterp->result.
3727    */
3728 
3729   return order;
3730     }
3731     if (infoPtr->index != SORTIDX_NONE) {
3732   /*
3733    * The "-index" option was specified.  Treat each object as a
3734    * list, extract the requested element from each list, and
3735    * compare the elements, not the lists.  "end"-relative indices
3736    * are signaled here with large negative values.
3737    */
3738 
3739   if (Tcl_ListObjLength(infoPtr->interp, objPtr1, &listLen) != TCL_OK) {
3740       infoPtr->resultCode = TCL_ERROR;
3741       return order;
3742   }
3743   if (infoPtr->index < SORTIDX_NONE) {
3744       index = listLen + infoPtr->index + 1;
3745   } else {
3746       index = infoPtr->index;
3747   }
3748 
3749   if (Tcl_ListObjIndex(infoPtr->interp, objPtr1, index, &objPtr)
3750     != TCL_OK) {
3751       infoPtr->resultCode = TCL_ERROR;
3752       return order;
3753   }
3754   if (objPtr == NULL) {
3755       objPtr = objPtr1;
3756       missingElement:
3757       TclFormatInt(buffer, infoPtr->index);
3758       Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),
3759       "element ", buffer, " missing from sublist \"",
3760       Tcl_GetString(objPtr), "\"", (char *) NULL);
3761       infoPtr->resultCode = TCL_ERROR;
3762       return order;
3763   }
3764   objPtr1 = objPtr;
3765 
3766   if (Tcl_ListObjLength(infoPtr->interp, objPtr2, &listLen) != TCL_OK) {
3767       infoPtr->resultCode = TCL_ERROR;
3768       return order;
3769   }
3770   if (infoPtr->index < SORTIDX_NONE) {
3771       index = listLen + infoPtr->index + 1;
3772   } else {
3773       index = infoPtr->index;
3774   }
3775 
3776   if (Tcl_ListObjIndex(infoPtr->interp, objPtr2, index, &objPtr)
3777     != TCL_OK) {
3778       infoPtr->resultCode = TCL_ERROR;
3779       return order;
3780   }
3781   if (objPtr == NULL) {
3782       objPtr = objPtr2;
3783       goto missingElement;
3784   }
3785   objPtr2 = objPtr;
3786     }
3787     if (infoPtr->sortMode == SORTMODE_ASCII) {
3788   order = strcmp(Tcl_GetString(objPtr1), Tcl_GetString(objPtr2));
3789     } else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
3790   order = DictionaryCompare(
3791     Tcl_GetString(objPtr1), Tcl_GetString(objPtr2));
3792     } else if (infoPtr->sortMode == SORTMODE_INTEGER) {
3793   long a, b;
3794 
3795   if ((Tcl_GetLongFromObj(infoPtr->interp, objPtr1, &a) != TCL_OK)
3796     || (Tcl_GetLongFromObj(infoPtr->interp, objPtr2, &b)
3797     != TCL_OK)) {
3798       infoPtr->resultCode = TCL_ERROR;
3799       return order;
3800   }
3801   if (a > b) {
3802       order = 1;
3803   } else if (b > a) {
3804       order = -1;
3805   }
3806     } else if (infoPtr->sortMode == SORTMODE_REAL) {
3807   double a, b;
3808 
3809   if ((Tcl_GetDoubleFromObj(infoPtr->interp, objPtr1, &a) != TCL_OK)
3810         || (Tcl_GetDoubleFromObj(infoPtr->interp, objPtr2, &b)
3811           != TCL_OK)) {
3812       infoPtr->resultCode = TCL_ERROR;
3813       return order;
3814   }
3815   if (a > b) {
3816       order = 1;
3817   } else if (b > a) {
3818       order = -1;
3819   }
3820     } else {
3821   Tcl_Obj **objv, *paramObjv[2];
3822   int objc;
3823 
3824   paramObjv[0] = objPtr1;
3825   paramObjv[1] = objPtr2;
3826 
3827     /*
3828    * We made space in the command list for the two things to
3829    * compare. Replace them and evaluate the result.
3830    */
3831 
3832   Tcl_ListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc);
3833   Tcl_ListObjReplace(infoPtr->interp, infoPtr->compareCmdPtr, objc - 2,
3834     2, 2, paramObjv);
3835     Tcl_ListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr,
3836     &objc, &objv);
3837 
3838   infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0);
3839   
3840     if (infoPtr->resultCode != TCL_OK) {
3841       Tcl_AddErrorInfo(infoPtr->interp,
3842         "\n    (-compare command)");
3843       return order;
3844   }
3845 
3846   /*
3847    * Parse the result of the command.
3848    */
3849 
3850   if (Tcl_GetIntFromObj(infoPtr->interp,
3851     Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) {
3852       Tcl_ResetResult(infoPtr->interp);
3853       Tcl_AppendToObj(Tcl_GetObjResult(infoPtr->interp),
3854         "-compare command returned non-integer result", -1);
3855       infoPtr->resultCode = TCL_ERROR;
3856       return order;
3857   }
3858     }
3859     if (!infoPtr->isIncreasing) {
3860   order = -order;
3861     }
3862     return order;
3863 }
int Tcl_IfObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 184 of file tclCmdIL.c.
References NULL, TCL_ERROR, Tcl_EvalObjEx(), Tcl_ExprBooleanObj(), Tcl_GetString(), and TCL_OK.189 {
190     int thenScriptIndex = 0;  /* then script to be evaled after syntax check */
191     int i, result, value;
192     char *clause;
193     i = 1;
194     while (1) {
195   /*
196    * At this point in the loop, objv and objc refer to an expression
197    * to test, either for the main expression or an expression
198    * following an "elseif".  The arguments after the expression must
199    * be "then" (optional) and a script to execute if the expression is
200    * true.
201    */
202 
203   if (i >= objc) {
204       clause = Tcl_GetString(objv[i-1]);
205       Tcl_AppendResult(interp, "wrong # args: no expression after \"",
206         clause, "\" argument", (char *) NULL);
207       return TCL_ERROR;
208   }
209   if (!thenScriptIndex) {
210       result = Tcl_ExprBooleanObj(interp, objv[i], &value);
211       if (result != TCL_OK) {
212     return result;
213       }
214   }
215   i++;
216   if (i >= objc) {
217       missingScript:
218       clause = Tcl_GetString(objv[i-1]);
219       Tcl_AppendResult(interp, "wrong # args: no script following \"",
220         clause, "\" argument", (char *) NULL);
221       return TCL_ERROR;
222   }
223   clause = Tcl_GetString(objv[i]);
224   if ((i < objc) && (strcmp(clause, "then") == 0)) {
225       i++;
226   }
227   if (i >= objc) {
228       goto missingScript;
229   }
230   if (value) {
231       thenScriptIndex = i;
232       value = 0;
233   }
234   
235   /*
236    * The expression evaluated to false.  Skip the command, then
237    * see if there is an "else" or "elseif" clause.
238    */
239 
240   i++;
241   if (i >= objc) {
242       if (thenScriptIndex) {
243     return Tcl_EvalObjEx(interp, objv[thenScriptIndex], 0);
244       }
245       return TCL_OK;
246   }
247   clause = Tcl_GetString(objv[i]);
248   if ((clause[0] == 'e') && (strcmp(clause, "elseif") == 0)) {
249       i++;
250       continue;
251   }
252   break;
253     }
254 
255     /*
256      * Couldn't find a "then" or "elseif" clause to execute.  Check now
257      * for an "else" clause.  We know that there's at least one more
258      * argument when we get here.
259      */
260 
261     if (strcmp(clause, "else") == 0) {
262   i++;
263   if (i >= objc) {
264       Tcl_AppendResult(interp,
265         "wrong # args: no script following \"else\" argument",
266         (char *) NULL);
267       return TCL_ERROR;
268   }
269     }
270     if (i < objc - 1) {
271   Tcl_AppendResult(interp,
272     "wrong # args: extra words after \"else\" clause in \"if\" command",
273     (char *) NULL);
274   return TCL_ERROR;
275     }
276     if (thenScriptIndex) {
277   return Tcl_EvalObjEx(interp, objv[thenScriptIndex], 0);
278     }
279     return Tcl_EvalObjEx(interp, objv[i], 0);
280 }
int Tcl_IncrObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 305 of file tclCmdIL.c.
References LONG_MAX, LONG_MIN, NULL, Tcl_AddErrorInfo(), TCL_ERROR, Tcl_GetLongFromObj(), Tcl_GetWideIntFromObj(), TCL_LEAVE_ERR_MSG, Tcl_LongAsWide, TCL_OK, Tcl_SetObjResult(), Tcl_WideAsLong, Tcl_WrongNumArgs(), TclGetLongFromWide, TclIncrVar2(), tclIntType, and tclWideIntType.310 {
311     long incrAmount;
312     Tcl_Obj *newValuePtr;
313     
314     if ((objc != 2) && (objc != 3)) {
315         Tcl_WrongNumArgs(interp, 1, objv, "varName ?increment?");
316   return TCL_ERROR;
317     }
318 
319     /*
320      * Calculate the amount to increment by.
321      */
322     
323     if (objc == 2) {
324   incrAmount = 1;
325     } else {
326   if (Tcl_GetLongFromObj(interp, objv[2], &incrAmount) != TCL_OK) {
327       Tcl_AddErrorInfo(interp, "\n    (reading increment)");
328       return TCL_ERROR;
329   }
330   /*
331    * Need to be a bit cautious to ensure that [expr]-like rules
332    * are enforced for interpretation of wide integers, despite
333    * the fact that the underlying API itself is a 'long' only one.
334    */
335   if (objv[2]->typePtr == &tclIntType) {
336       incrAmount = objv[2]->internalRep.longValue;
337   } else if (objv[2]->typePtr == &tclWideIntType) {
338       TclGetLongFromWide(incrAmount,objv[2]);
339   } else {
340       Tcl_WideInt wide;
341 
342       if (Tcl_GetWideIntFromObj(interp, objv[2], &wide) != TCL_OK) {
343     Tcl_AddErrorInfo(interp, "\n    (reading increment)");
344     return TCL_ERROR;
345       }
346       incrAmount = Tcl_WideAsLong(wide);
347       if ((wide <= Tcl_LongAsWide(LONG_MAX))
348         && (wide >= Tcl_LongAsWide(LONG_MIN))) {
349     objv[2]->typePtr = &tclIntType;
350     objv[2]->internalRep.longValue = incrAmount;
351       }
352   }
353     }
354     
355     /*
356      * Increment the variable's value.
357      */
358 
359     newValuePtr = TclIncrVar2(interp, objv[1], (Tcl_Obj *) NULL, incrAmount,
360       TCL_LEAVE_ERR_MSG);
361     if (newValuePtr == NULL) {
362   return TCL_ERROR;
363     }
364 
365     /*
366      * Set the interpreter's object result to refer to the variable's new
367      * value object.
368      */
369 
370     Tcl_SetObjResult(interp, newValuePtr);
371     return TCL_OK; 
372 }
int Tcl_InfoObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv)

Definition at line 393 of file tclCmdIL.c.
References CONST, InfoArgsCmd(), InfoBodyCmd(), InfoCmdCountCmd(), InfoCommandsCmd(), InfoCompleteCmd(), InfoDefaultCmd(), InfoExistsCmd(), InfoFunctionsCmd(), InfoGlobalsCmd(), InfoHostnameCmd(), InfoLevelCmd(), InfoLibraryCmd(), InfoLoadedCmd(), InfoLocalsCmd(), InfoNameOfExecutableCmd(), InfoPatchLevelCmd(), InfoProcsCmd(), InfoScriptCmd(), InfoSharedlibCmd(), InfoTclVersionCmd(), InfoVarsCmd(), NULL, TCL_ERROR, Tcl_GetIndexFromObj(), TCL_OK, and Tcl_WrongNumArgs().398 {
399     static CONST char *subCmds[] = {
400             "args", "body", "cmdcount", "commands",
401        "complete", "default", "exists", "functions", "globals",
402        "hostname", "level", "library", "loaded",
403        "locals", "nameofexecutable", "patchlevel", "procs",
404        "script", "sharedlibextension", "tclversion", "vars",
405        (char *) NULL};
406     enum ISubCmdIdx {
407       IArgsIdx, IBodyIdx, ICmdCountIdx, ICommandsIdx,
408       ICompleteIdx, IDefaultIdx, IExistsIdx, IFunctionsIdx, IGlobalsIdx,
409       IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx,
410       ILocalsIdx, INameOfExecutableIdx, IPatchLevelIdx, IProcsIdx,
411       IScriptIdx, ISharedLibExtensionIdx, ITclVersionIdx, IVarsIdx
412     };
413     int index, result;
414 
415     if (objc < 2) {
416         Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
417         return TCL_ERROR;
418     }
419     
420     result = Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option", 0,
421       (int *) &index);
422     if (result != TCL_OK) {
423   return result;
424     }
425 
426     switch (index) {
427         case IArgsIdx:
428       result = InfoArgsCmd(clientData, interp, objc, objv);
429             break;
430   case IBodyIdx:
431       result = InfoBodyCmd(clientData, interp, objc, objv);
432       break;
433   case ICmdCountIdx:
434       result = InfoCmdCountCmd(clientData, interp, objc, objv);
435       break;
436         case ICommandsIdx:
437       result = InfoCommandsCmd(clientData, interp, objc, objv);
438       break;
439         case ICompleteIdx:
440       result = InfoCompleteCmd(clientData, interp, objc, objv);
441       break;
442   case IDefaultIdx:
443       result = InfoDefaultCmd(clientData, interp, objc, objv);
444       break;
445   case IExistsIdx:
446       result = InfoExistsCmd(clientData, interp, objc, objv);
447       break;
448   case IFunctionsIdx:
449       result = InfoFunctionsCmd(clientData, interp, objc, objv);
450       break;
451         case IGlobalsIdx:
452       result = InfoGlobalsCmd(clientData, interp, objc, objv);
453       break;
454         case IHostnameIdx:
455       result = InfoHostnameCmd(clientData, interp, objc, objv);
456       break;
457   case ILevelIdx:
458       result = InfoLevelCmd(clientData, interp, objc, objv);
459       break;
460   case ILibraryIdx:
461       result = InfoLibraryCmd(clientData, interp, objc, objv);
462       break;
463         case ILoadedIdx:
464       result = InfoLoadedCmd(clientData, interp, objc, objv);
465       break;
466         case ILocalsIdx:
467       result = InfoLocalsCmd(clientData, interp, objc, objv);
468       break;
469   case INameOfExecutableIdx:
470       result = InfoNameOfExecutableCmd(clientData, interp, objc, objv);
471       break;
472   case IPatchLevelIdx:
473       result = InfoPatchLevelCmd(clientData, interp, objc, objv);
474       break;
475         case IProcsIdx:
476       result = InfoProcsCmd(clientData, interp, objc, objv);
477       break;
478         case IScriptIdx:
479       result = InfoScriptCmd(clientData, interp, objc, objv);
480       break;
481   case ISharedLibExtensionIdx:
482       result = InfoSharedlibCmd(clientData, interp, objc, objv);
483       break;
484   case ITclVersionIdx:
485       result = InfoTclVersionCmd(clientData, interp, objc, objv);
486       break;
487   case IVarsIdx:
488       result = InfoVarsCmd(clientData, interp, objc, objv);
489       break;
490     }
491     return result;
492 }
int Tcl_JoinObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 2091 of file tclCmdIL.c.
References Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), Tcl_GetStringFromObj(), Tcl_ListObjGetElements(), TCL_OK, and Tcl_WrongNumArgs().2096 {
2097     char *joinString, *bytes;
2098     int joinLength, listLen, length, i, result;
2099     Tcl_Obj **elemPtrs;
2100     Tcl_Obj *resObjPtr;
2101 
2102     if (objc == 2) {
2103   joinString = " ";
2104   joinLength = 1;
2105     } else if (objc == 3) {
2106   joinString = Tcl_GetStringFromObj(objv[2], &joinLength);
2107     } else {
2108   Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
2109   return TCL_ERROR;
2110     }
2111 
2112     /*
2113      * Make sure the list argument is a list object and get its length and
2114      * a pointer to its array of element pointers.
2115      */
2116 
2117     result = Tcl_ListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
2118     if (result != TCL_OK) {
2119   return result;
2120     }
2121 
2122     /*
2123      * Now concatenate strings to form the "joined" result. We append
2124      * directly into the interpreter's result object.
2125      */
2126 
2127     resObjPtr = Tcl_GetObjResult(interp);
2128 
2129     for (i = 0;  i < listLen;  i++) {
2130   bytes = Tcl_GetStringFromObj(elemPtrs[i], &length);
2131   if (i > 0) {
2132       Tcl_AppendToObj(resObjPtr, joinString, joinLength);
2133   }
2134   Tcl_AppendToObj(resObjPtr, bytes, length);
2135     }
2136     return TCL_OK;
2137 }
int Tcl_LindexObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 2158 of file tclCmdIL.c.
References NULL, Tcl_DecrRefCount, TCL_ERROR, TCL_OK, Tcl_SetObjResult(), Tcl_WrongNumArgs(), TclLindexFlat(), and TclLindexList().2163 {
2164 
2165     Tcl_Obj *elemPtr;   /* Pointer to the element being extracted */
2166 
2167     if (objc < 2) {
2168   Tcl_WrongNumArgs(interp, 1, objv, "list ?index...?");
2169   return TCL_ERROR;
2170     }
2171 
2172     /*
2173      * If objc == 3, then objv[ 2 ] may be either a single index or
2174      * a list of indices: go to TclLindexList to determine which.
2175      * If objc >= 4, or objc == 2, then objv[ 2 .. objc-2 ] are all
2176      * single indices and processed as such in TclLindexFlat.
2177      */
2178 
2179     if ( objc == 3 ) {
2180 
2181   elemPtr = TclLindexList( interp, objv[ 1 ], objv[ 2 ] );
2182 
2183     } else {
2184 
2185   elemPtr = TclLindexFlat( interp, objv[ 1 ], objc-2, objv+2 );
2186 
2187     }
2188   
2189     /*
2190      * Set the interpreter's object result to the last element extracted
2191      */
2192 
2193     if ( elemPtr == NULL ) {
2194   return TCL_ERROR;
2195     } else {
2196   Tcl_SetObjResult(interp, elemPtr);
2197   Tcl_DecrRefCount( elemPtr );
2198   return TCL_OK;
2199     }
2200 }
int Tcl_LinsertObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 2514 of file tclCmdIL.c.
References Tcl_DecrRefCount, Tcl_DuplicateObj(), TCL_ERROR, Tcl_IsShared, Tcl_ListObjAppendElement(), Tcl_ListObjLength(), Tcl_ListObjReplace(), TCL_OK, Tcl_SetObjResult(), Tcl_WrongNumArgs(), and TclGetIntForIndex().2519 {
2520     Tcl_Obj *listPtr;
2521     int index, isDuplicate, len, result;
2522 
2523     if (objc < 4) {
2524   Tcl_WrongNumArgs(interp, 1, objv, "list index element ?element ...?");
2525   return TCL_ERROR;
2526     }
2527 
2528     result = Tcl_ListObjLength(interp, objv[1], &len);
2529     if (result != TCL_OK) {
2530   return result;
2531     }
2532 
2533     /*
2534      * Get the index.  "end" is interpreted to be the index after the last
2535      * element, such that using it will cause any inserted elements to be
2536      * appended to the list.
2537      */
2538 
2539     result = TclGetIntForIndex(interp, objv[2], /*end*/ len, &index);
2540     if (result != TCL_OK) {
2541   return result;
2542     }
2543     if (index > len) {
2544   index = len;
2545     }
2546 
2547     /*
2548      * If the list object is unshared we can modify it directly. Otherwise
2549      * we create a copy to modify: this is "copy on write".
2550      */
2551 
2552     listPtr = objv[1];
2553     isDuplicate = 0;
2554     if (Tcl_IsShared(listPtr)) {
2555   listPtr = Tcl_DuplicateObj(listPtr);
2556   isDuplicate = 1;
2557     }
2558 
2559     if ((objc == 4) && (index == len)) {
2560   /*
2561    * Special case: insert one element at the end of the list.
2562    */
2563   result = Tcl_ListObjAppendElement(interp, listPtr, objv[3]);
2564     } else if (objc > 3) {
2565   result = Tcl_ListObjReplace(interp, listPtr, index, 0,
2566             (objc-3), &(objv[3]));
2567     }
2568     if (result != TCL_OK) {
2569   if (isDuplicate) {
2570       Tcl_DecrRefCount(listPtr); /* free unneeded obj */
2571   }
2572   return result;
2573     }
2574     
2575     /*
2576      * Set the interpreter's object result.
2577      */
2578 
2579     Tcl_SetObjResult(interp, listPtr);
2580     return TCL_OK;
2581 }
int Tcl_ListObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 2602 of file tclCmdIL.c.
References Tcl_GetObjResult(), TCL_OK, and Tcl_SetListObj().2607 {
2608     /*
2609      * If there are no list elements, the result is an empty object.
2610      * Otherwise modify the interpreter's result object to be a list object.
2611      */
2612     
2613     if (objc > 1) {
2614   Tcl_SetListObj(Tcl_GetObjResult(interp), (objc-1), &(objv[1]));
2615     }
2616     return TCL_OK;
2617 }
int Tcl_LlengthObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 2638 of file tclCmdIL.c.
References TCL_ERROR, Tcl_GetObjResult(), Tcl_ListObjLength(), TCL_OK, Tcl_SetIntObj(), and Tcl_WrongNumArgs().2643 {
2644     int listLen, result;
2645 
2646     if (objc != 2) {
2647   Tcl_WrongNumArgs(interp, 1, objv, "list");
2648   return TCL_ERROR;
2649     }
2650 
2651     result = Tcl_ListObjLength(interp, objv[1], &listLen);
2652     if (result != TCL_OK) {
2653   return result;
2654     }
2655 
2656     /*
2657      * Set the interpreter's object result to an integer object holding the
2658      * length. 
2659      */
2660 
2661     Tcl_SetIntObj(Tcl_GetObjResult(interp), listLen);
2662     return TCL_OK;
2663 }
int Tcl_LrangeObjCmd (ClientData notUsed, Tcl_Interp * interp, int objc, objv)

Definition at line 2684 of file tclCmdIL.c.
References TCL_ERROR, Tcl_GetObjResult(), Tcl_ListObjGetElements(), TCL_OK, Tcl_SetListObj(), Tcl_WrongNumArgs(), TclGetIntForIndex(), tclListType, and Tcl_Obj::typePtr.2689 {
2690     Tcl_Obj *listPtr;
2691     Tcl_Obj **elemPtrs;
2692     int listLen, first, last, numElems, result;
2693 
2694     if (objc != 4) {
2695   Tcl_WrongNumArgs(interp, 1, objv, "list first last");
2696   return TCL_ERROR;
2697     }
2698 
2699     /*
2700      * Make sure the list argument is a list object and get its length and
2701      * a pointer to its array of element pointers.
2702      */
2703 
2704     listPtr = objv[1];
2705     result = Tcl_ListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
2706     if (result != TCL_OK) {
2707   return result;
2708     }
2709 
2710     /*
2711      * Get the first and last indexes.
2712      */
2713 
2714     result = TclGetIntForIndex(interp, objv[2], /*endValue*/ (listLen - 1),
2715       &first);
2716     if (result != TCL_OK) {
2717   return result;
2718     }
2719     if (first < 0) {
2720   first = 0;
2721     }
2722 
2723     result = TclGetIntForIndex(interp, objv[3], /*endValue*/ (listLen - 1),
2724       &last);
2725     if (result != TCL_OK) {
2726   return result;
2727     }
2728     if (last >= listLen) {
2729   last = (listLen - 1);
2730     }
2731     
2732     if (first > last) {
2733   return TCL_OK;    /* the result is an empty object */
2734     }
2735 
2736     /*
2737      * Make sure listPtr still refers to a list object. It might have been
2738      * converted to an int above if the argument objects were shared.
2739      */  
2740 
2741     if (listPtr->typePtr != &tclListType) {
2742         result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
2743                 &elemPtrs);
2744         if (result != TCL_OK) {
2745             return result;
2746         }
2747     }
2748 
2749     /*
2750      * Extract a range of fields. We modify the interpreter's result object
2751      * to be a list object containing the specified elements.
2752      */
2753 
2754     numElems = (last - first + 1);
2755     Tcl_SetListObj(Tcl_GetObjResult(interp), numElems, &(elemPtrs[first]));
2756     return TCL_OK;
2757 }
int Tcl_LreplaceObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 2779 of file tclCmdIL.c.
References NULL, Tcl_DecrRefCount, Tcl_DuplicateObj(), TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), Tcl_IsShared, Tcl_ListObjLength(), Tcl_ListObjReplace(), TCL_OK, Tcl_SetObjResult(), Tcl_WrongNumArgs(), and TclGetIntForIndex().2784 {
2785     register Tcl_Obj *listPtr;
2786     int isDuplicate, first, last, listLen, numToDelete, result;
2787 
2788     if (objc < 4) {
2789   Tcl_WrongNumArgs(interp, 1, objv,
2790     "list first last ?element element ...?");
2791   return TCL_ERROR;
2792     }
2793 
2794     result = Tcl_ListObjLength(interp, objv[1], &listLen);
2795     if (result != TCL_OK) {
2796   return result;
2797     }
2798 
2799     /*
2800      * Get the first and last indexes.  "end" is interpreted to be the index
2801      * for the last element, such that using it will cause that element to
2802      * be included for deletion.
2803      */
2804 
2805     result = TclGetIntForIndex(interp, objv[2], /*end*/ (listLen - 1), &first);
2806     if (result != TCL_OK) {
2807   return result;
2808     }
2809 
2810     result = TclGetIntForIndex(interp, objv[3], /*end*/ (listLen - 1), &last);
2811     if (result != TCL_OK) {
2812   return result;
2813     }
2814 
2815     if (first < 0)  {
2816       first = 0;
2817     }
2818 
2819     /*
2820      * Complain if the user asked for a start element that is greater than the
2821      * list length.  This won't ever trigger for the "end*" case as that will
2822      * be properly constrained by TclGetIntForIndex because we use listLen-1
2823      * (to allow for replacing the last elem).
2824      */
2825 
2826     if ((first >= listLen) && (listLen > 0)) {
2827   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
2828     "list doesn't contain element ",
2829     Tcl_GetString(objv[2]), (int *) NULL);
2830   return TCL_ERROR;
2831     }
2832     if (last >= listLen) {
2833       last = (listLen - 1);
2834     }
2835     if (first <= last) {
2836   numToDelete = (last - first + 1);
2837     } else {
2838   numToDelete = 0;
2839     }
2840 
2841     /*
2842      * If the list object is unshared we can modify it directly, otherwise
2843      * we create a copy to modify: this is "copy on write".
2844      */
2845 
2846     listPtr = objv[1];
2847     isDuplicate = 0;
2848     if (Tcl_IsShared(listPtr)) {
2849   listPtr = Tcl_DuplicateObj(listPtr);
2850   isDuplicate = 1;
2851     }
2852     if (objc > 4) {
2853   result = Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
2854           (objc-4), &(objv[4]));
2855     } else {
2856   result = Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
2857     0, NULL);
2858     }
2859     if (result != TCL_OK) {
2860   if (isDuplicate) {
2861       Tcl_DecrRefCount(listPtr); /* free unneeded obj */
2862   }
2863   return result;
2864     }
2865 
2866     /*
2867      * Set the interpreter's object result. 
2868      */
2869 
2870     Tcl_SetObjResult(interp, listPtr);
2871     return TCL_OK;
2872 }
int Tcl_LsearchObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv)

Definition at line 2892 of file tclCmdIL.c.
References CONST, DictionaryCompare(), memcmp(), NULL, size_t(), Tcl_DecrRefCount, Tcl_DuplicateObj(), TCL_ERROR, Tcl_GetDoubleFromObj(), Tcl_GetIndexFromObj(), Tcl_GetIntFromObj(), Tcl_GetObjResult(), Tcl_GetRegExpFromObj(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_ListObjAppendElement(), Tcl_ListObjGetElements(), Tcl_NewIntObj(), Tcl_NewListObj(), Tcl_NewObj(), TCL_OK, TCL_REG_ADVANCED, TCL_REG_NOSUB, Tcl_RegExpExecObj(), Tcl_ResetResult(), Tcl_SetIntObj(), Tcl_SetObjResult(), Tcl_StringMatch(), Tcl_WrongNumArgs(), and TclGetIntForIndex().2897 {
2898     char *bytes, *patternBytes;
2899     int i, match, mode, index, result, listc, length, elemLen;
2900     int dataType, isIncreasing, lower, upper, patInt, objInt;
2901     int offset, allMatches, inlineReturn, negatedMatch;
2902     double patDouble, objDouble;
2903     Tcl_Obj *patObj, **listv, *listPtr, *startPtr;
2904     Tcl_RegExp regexp = NULL;
2905     static CONST char *options[] = {
2906   "-all",     "-ascii", "-decreasing", "-dictionary",
2907   "-exact",   "-glob",  "-increasing", "-inline",
2908   "-integer", "-not",   "-real",       "-regexp",
2909   "-sorted",  "-start", NULL
2910     };
2911     enum options {
2912   LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_DECREASING, LSEARCH_DICTIONARY,
2913   LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING, LSEARCH_INLINE,
2914   LSEARCH_INTEGER, LSEARCH_NOT, LSEARCH_REAL, LSEARCH_REGEXP,
2915   LSEARCH_SORTED, LSEARCH_START
2916     };
2917     enum datatypes {
2918   ASCII, DICTIONARY, INTEGER, REAL
2919     };
2920     enum modes {
2921   EXACT, GLOB, REGEXP, SORTED
2922     };
2923 
2924     mode = GLOB;
2925     dataType = ASCII;
2926     isIncreasing = 1;
2927     allMatches = 0;
2928     inlineReturn = 0;
2929     negatedMatch = 0;
2930     listPtr = NULL;
2931     startPtr = NULL;
2932     offset = 0;
2933 
2934     if (objc < 3) {
2935   Tcl_WrongNumArgs(interp, 1, objv, "?options? list pattern");
2936   return TCL_ERROR;
2937     }
2938 
2939     for (i = 1; i < objc-2; i++) {
2940   if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
2941     != TCL_OK) {
2942       if (startPtr) {
2943     Tcl_DecrRefCount(startPtr);
2944       }
2945       return TCL_ERROR;
2946   }
2947   switch ((enum options) index) {
2948   case LSEARCH_ALL:   /* -all */
2949       allMatches = 1;
2950       break;
2951   case LSEARCH_ASCII:   /* -ascii */
2952       dataType = ASCII;
2953       break;
2954   case LSEARCH_DECREASING:  /* -decreasing */
2955       isIncreasing = 0;
2956       break;
2957   case LSEARCH_DICTIONARY:  /* -dictionary */
2958       dataType = DICTIONARY;
2959       break;
2960   case LSEARCH_EXACT:   /* -increasing */
2961       mode = EXACT;
2962       break;
2963   case LSEARCH_GLOB:    /* -glob */
2964       mode = GLOB;
2965       break;
2966   case LSEARCH_INCREASING:  /* -increasing */
2967       isIncreasing = 1;
2968       break;
2969   case LSEARCH_INLINE:    /* -inline */
2970       inlineReturn = 1;
2971       break;
2972   case LSEARCH_INTEGER:   /* -integer */
2973       dataType = INTEGER;
2974       break;
2975   case LSEARCH_NOT:   /* -not */
2976       negatedMatch = 1;
2977       break;
2978   case LSEARCH_REAL:    /* -real */
2979       dataType = REAL;
2980       break;
2981   case LSEARCH_REGEXP:    /* -regexp */
2982       mode = REGEXP;
2983       break;
2984   case LSEARCH_SORTED:    /* -sorted */
2985       mode = SORTED;
2986       break;
2987   case LSEARCH_START:   /* -start */
2988       /*
2989        * If there was a previous -start option, release its saved
2990        * index because it will either be replaced or there will be
2991        * an error.
2992        */
2993       if (startPtr) {
2994     Tcl_DecrRefCount(startPtr);
2995       }
2996       if (i > objc-4) {
2997     Tcl_AppendResult(interp, "missing starting index", NULL);
2998     return TCL_ERROR;
2999       }
3000       i++;
3001       if (objv[i] == objv[objc - 2]) {
3002     /*
3003      * Take copy to prevent shimmering problems.  Note
3004      * that it does not matter if the index obj is also a
3005      * component of the list being searched.  We only need
3006      * to copy where the list and the index are
3007      * one-and-the-same.
3008      */
3009     startPtr = Tcl_DuplicateObj(objv[i]);
3010       } else {
3011     startPtr = objv[i];
3012     Tcl_IncrRefCount(startPtr);
3013       }
3014   }
3015     }
3016 
3017     if ((enum modes) mode == REGEXP) {
3018   /*
3019    * We can shimmer regexp/list if listv[i] == pattern, so get the
3020    * regexp rep before the list rep. First time round, omit the interp
3021          * and hope that the compilation will succeed. If it fails, we'll
3022          * recompile in "expensive" mode with a place to put error messages.
3023    */
3024 
3025   regexp = Tcl_GetRegExpFromObj(NULL, objv[objc - 1],
3026     TCL_REG_ADVANCED | TCL_REG_NOSUB);
3027   if (regexp == NULL) {
3028             /*
3029              * Failed to compile the RE. Try again without the TCL_REG_NOSUB
3030              * flag in case the RE had sub-expressions in it [Bug 1366683].
3031              * If this fails, an error message will be left in the
3032              * interpreter.
3033              */
3034 
3035             regexp = Tcl_GetRegExpFromObj(interp, objv[objc - 1],
3036         TCL_REG_ADVANCED);
3037   }
3038 
3039   if (regexp == NULL) {
3040       if (startPtr) {
3041     Tcl_DecrRefCount(startPtr);
3042       }
3043       return TCL_ERROR;
3044   }
3045     }
3046 
3047     /*
3048      * Make sure the list argument is a list object and get its length and
3049      * a pointer to its array of element pointers.
3050      */
3051 
3052     result = Tcl_ListObjGetElements(interp, objv[objc - 2], &listc, &listv);
3053     if (result != TCL_OK) {
3054   if (startPtr) {
3055       Tcl_DecrRefCount(startPtr);
3056   }
3057   return result;
3058     }
3059 
3060     /*
3061      * Get the user-specified start offset.
3062      */
3063     if (startPtr) {
3064   result = TclGetIntForIndex(interp, startPtr, listc-1, &offset);
3065   Tcl_DecrRefCount(startPtr);
3066   if (result != TCL_OK) {
3067       return result;
3068   }
3069 
3070   /*
3071    * If the search started past the end of the list, we just return a
3072    * "did not match anything at all" result straight away. [Bug 1374778]
3073    */
3074 
3075   if (offset > listc-1) {
3076       if (allMatches || inlineReturn) {
3077     Tcl_ResetResult(interp);
3078       } else {
3079     Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
3080       }
3081       return TCL_OK;
3082   }
3083   if (offset < 0) {
3084       offset = 0;
3085   }
3086     }
3087 
3088     patObj = objv[objc - 1];
3089     patternBytes = NULL;
3090     if ((enum modes) mode == EXACT || (enum modes) mode == SORTED) {
3091   switch ((enum datatypes) dataType) {
3092   case ASCII:
3093   case DICTIONARY:
3094       patternBytes = Tcl_GetStringFromObj(patObj, &length);
3095       break;
3096   case INTEGER:
3097       result = Tcl_GetIntFromObj(interp, patObj, &patInt);
3098       if (result != TCL_OK) {
3099     return result;
3100       }
3101       break;
3102   case REAL:
3103       result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble);
3104       if (result != TCL_OK) {
3105     return result;
3106       }
3107       break;
3108   }
3109     } else {
3110   patternBytes = Tcl_GetStringFromObj(patObj, &length);
3111     }
3112 
3113     /*
3114      * Set default index value to -1, indicating failure; if we find the
3115      * item in the course of our search, index will be set to the correct
3116      * value.
3117      */
3118     index = -1;
3119     match = 0;
3120 
3121     if ((enum modes) mode == SORTED && !allMatches && !negatedMatch) {
3122   /*
3123    * If the data is sorted, we can do a more intelligent search.
3124    * Note that there is no point in being smart when -all was
3125    * specified; in that case, we have to look at all items anyway,
3126    * and there is no sense in doing this when the match sense is
3127    * inverted.
3128    */
3129   lower = offset - 1;
3130   upper = listc;
3131   while (lower + 1 != upper) {
3132       i = (lower + upper)/2;
3133       switch ((enum datatypes) dataType) {
3134       case ASCII:
3135     bytes = Tcl_GetString(listv[i]);
3136     match = strcmp(patternBytes, bytes);
3137     break;
3138       case DICTIONARY:
3139     bytes = Tcl_GetString(listv[i]);
3140     match = DictionaryCompare(patternBytes, bytes);
3141     break;
3142       case INTEGER:
3143     result = Tcl_GetIntFromObj(interp, listv[i], &objInt);
3144     if (result != TCL_OK) {
3145         return result;
3146     }
3147     if (patInt == objInt) {
3148         match = 0;
3149     } else if (patInt < objInt) {
3150         match = -1;
3151     } else {
3152         match = 1;
3153     }
3154     break;
3155       case REAL:
3156     result = Tcl_GetDoubleFromObj(interp, listv[i], &objDouble);
3157     if (result != TCL_OK) {
3158         return result;
3159     }
3160     if (patDouble == objDouble) {
3161         match = 0;
3162     } else if (patDouble < objDouble) {
3163         match = -1;
3164     } else {
3165         match = 1;
3166     }
3167     break;
3168       }
3169       if (match == 0) {
3170     /*
3171      * Normally, binary search is written to stop when it
3172      * finds a match.  If there are duplicates of an element in
3173      * the list, our first match might not be the first occurance.
3174      * Consider:  0 0 0 1 1 1 2 2 2
3175      * To maintain consistancy with standard lsearch semantics,
3176      * we must find the leftmost occurance of the pattern in the
3177      * list.  Thus we don't just stop searching here.  This
3178      * variation means that a search always makes log n
3179      * comparisons (normal binary search might "get lucky" with
3180      * an early comparison).
3181      */
3182     index = i;
3183     upper = i;
3184       } else if (match > 0) {
3185     if (isIncreasing) {
3186         lower = i;
3187     } else {
3188         upper = i;
3189     }
3190       } else {
3191     if (isIncreasing) {
3192         upper = i;
3193     } else {
3194         lower = i;
3195     }
3196       }
3197   }
3198 
3199     } else {
3200   /*
3201    * We need to do a linear search, because (at least one) of:
3202    *   - our matcher can only tell equal vs. not equal
3203    *   - our matching sense is negated
3204    *   - we're building a list of all matched items
3205    */
3206   if (allMatches) {
3207       listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
3208   }
3209   for (i = offset; i < listc; i++) {
3210       match = 0;
3211       switch ((enum modes) mode) {
3212       case SORTED:
3213       case EXACT:
3214     switch ((enum datatypes) dataType) {
3215     case ASCII:
3216         bytes = Tcl_GetStringFromObj(listv[i], &elemLen);
3217         if (length == elemLen) {
3218       match = (memcmp(bytes, patternBytes,
3219         (size_t) length) == 0);
3220         }
3221         break;
3222     case DICTIONARY:
3223         bytes = Tcl_GetString(listv[i]);
3224         match = (DictionaryCompare(bytes, patternBytes) == 0);
3225         break;
3226     case INTEGER:
3227         result = Tcl_GetIntFromObj(interp, listv[i], &objInt);
3228         if (result != TCL_OK) {
3229       if (listPtr) {
3230           Tcl_DecrRefCount(listPtr);
3231       }
3232       return result;
3233         }
3234         match = (objInt == patInt);
3235         break;
3236     case REAL:
3237         result = Tcl_GetDoubleFromObj(interp, listv[i],
3238           &objDouble);
3239         if (result != TCL_OK) {
3240       if (listPtr) {
3241           Tcl_DecrRefCount(listPtr);
3242       }
3243       return result;
3244         }
3245         match = (objDouble == patDouble);
3246         break;
3247     }
3248     break;
3249       case GLOB:
3250     match = Tcl_StringMatch(Tcl_GetString(listv[i]),
3251       patternBytes);
3252     break;
3253       case REGEXP:
3254     match = Tcl_RegExpExecObj(interp, regexp, listv[i], 0, 0, 0);
3255     if (match < 0) {
3256         Tcl_DecrRefCount(patObj);
3257         if (listPtr) {
3258       Tcl_DecrRefCount(listPtr);
3259         }
3260         return TCL_ERROR;
3261     }
3262     break;
3263       }
3264       /*
3265        * Invert match condition for -not
3266        */
3267       if (negatedMatch) {
3268     match = !match;
3269       }
3270       if (match != 0) {
3271     if (!allMatches) {
3272         index = i;
3273         break;
3274     } else if (inlineReturn) {
3275         /*
3276          * Note that these appends are not expected to fail.
3277          */
3278         Tcl_ListObjAppendElement(interp, listPtr, listv[i]);
3279     } else {
3280         Tcl_ListObjAppendElement(interp, listPtr,
3281           Tcl_NewIntObj(i));
3282     }
3283       }
3284   }
3285     }
3286 
3287     /*
3288      * Return everything or a single value.
3289      */
3290     if (allMatches) {
3291   Tcl_SetObjResult(interp, listPtr);
3292     } else if (!inlineReturn) {
3293   Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
3294     } else if (index < 0) {
3295   /*
3296    * Is this superfluous?  The result should be a blank object
3297    * by default...
3298    */
3299   Tcl_SetObjResult(interp, Tcl_NewObj());
3300     } else {
3301   Tcl_SetObjResult(interp, listv[index]);
3302     }
3303     return TCL_OK;
3304 }
int Tcl_LsetObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv)

Definition at line 3324 of file tclCmdIL.c.
References NULL, Tcl_DecrRefCount, TCL_ERROR, TCL_LEAVE_ERR_MSG, Tcl_ObjGetVar2(), Tcl_ObjSetVar2(), TCL_OK, Tcl_SetObjResult(), Tcl_WrongNumArgs(), TclLsetFlat(), and TclLsetList().3329 {
3330 
3331     Tcl_Obj* listPtr;   /* Pointer to the list being altered. */
3332     Tcl_Obj* finalValuePtr; /* Value finally assigned to the variable */
3333 
3334     /* Check parameter count */
3335 
3336     if ( objc < 3 ) {
3337   Tcl_WrongNumArgs( interp, 1, objv, "listVar index ?index...? value" );
3338   return TCL_ERROR;
3339     }
3340 
3341     /* Look up the list variable's value */
3342 
3343     listPtr = Tcl_ObjGetVar2( interp, objv[ 1 ], (Tcl_Obj*) NULL,
3344             TCL_LEAVE_ERR_MSG );
3345     if ( listPtr == NULL ) {
3346   return TCL_ERROR;
3347     }
3348 
3349     /* 
3350      * Substitute the value in the value.  Return either the value or
3351      * else an unshared copy of it.
3352      */
3353 
3354     if ( objc == 4 ) {
3355   finalValuePtr = TclLsetList( interp, listPtr,
3356              objv[ 2 ], objv[ 3 ] );
3357     } else {
3358   finalValuePtr = TclLsetFlat( interp, listPtr,
3359              objc-3, objv+2, objv[ objc-1 ] );
3360     }
3361 
3362     /*
3363      * If substitution has failed, bail out.
3364      */
3365 
3366     if ( finalValuePtr == NULL ) {
3367   return TCL_ERROR;
3368     }
3369 
3370     /* Finally, update the variable so that traces fire. */
3371 
3372     listPtr = Tcl_ObjSetVar2( interp, objv[1], NULL, finalValuePtr,
3373             TCL_LEAVE_ERR_MSG );
3374     Tcl_DecrRefCount( finalValuePtr );
3375     if ( listPtr == NULL ) {
3376   return TCL_ERROR;
3377     }
3378 
3379     /* Return the new value of the variable as the interpreter result. */
3380 
3381     Tcl_SetObjResult( interp, listPtr );
3382     return TCL_OK;
3383 
3384 }
int Tcl_LsortObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv)

Definition at line 3404 of file tclCmdIL.c.
References SortInfo::compareCmdPtr, CONST, SortInfo::index, SortInfo::interp, SortInfo::isIncreasing, NULL, SortInfo::resultCode, SORTIDX_END, SORTIDX_NONE, SortInfo::sortMode, SORTMODE_ASCII, SORTMODE_COMMAND, SORTMODE_DICTIONARY, SORTMODE_INTEGER, SORTMODE_REAL, Tcl_AppendToObj(), Tcl_DecrRefCount, Tcl_DuplicateObj(), TCL_ERROR, Tcl_GetIndexFromObj(), Tcl_GetObjResult(), Tcl_IncrRefCount, Tcl_ListObjAppendElement(), Tcl_NewObj(), TCL_OK, Tcl_WrongNumArgs(), and TclGetIntForIndex().3409 {
3410     int i, index, unique;
3411     Tcl_Obj *resultPtr;
3412     int length;
3413     Tcl_Obj *cmdPtr, **listObjPtrs;
3414     SortElement *elementArray;
3415     SortElement *elementPtr;        
3416     SortInfo sortInfo;                  /* Information about this sort that
3417                                          * needs to be passed to the 
3418                                          * comparison function */
3419     static CONST char *switches[] = {
3420   "-ascii", "-command", "-decreasing", "-dictionary", "-increasing",
3421   "-index", "-integer", "-real", "-unique", (char *) NULL
3422     };
3423 
3424     resultPtr = Tcl_GetObjResult(interp);
3425     if (objc < 2) {
3426   Tcl_WrongNumArgs(interp, 1, objv, "?options? list");
3427   return TCL_ERROR;
3428     }
3429 
3430     /*
3431      * Parse arguments to set up the mode for the sort.
3432      */
3433 
3434     sortInfo.isIncreasing = 1;
3435     sortInfo.sortMode = SORTMODE_ASCII;
3436     sortInfo.index = SORTIDX_NONE;
3437     sortInfo.interp = interp;
3438     sortInfo.resultCode = TCL_OK;
3439     cmdPtr = NULL;
3440     unique = 0;
3441     for (i = 1; i < objc-1; i++) {
3442   if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index)
3443     != TCL_OK) {
3444       return TCL_ERROR;
3445   }
3446   switch (index) {
3447       case 0:     /* -ascii */
3448     sortInfo.sortMode = SORTMODE_ASCII;
3449     break;
3450       case 1:     /* -command */
3451     if (i == (objc-2)) {
3452         Tcl_AppendToObj(resultPtr,
3453           "\"-command\" option must be followed by comparison command",
3454           -1);
3455         return TCL_ERROR;
3456     }
3457     sortInfo.sortMode = SORTMODE_COMMAND;
3458     cmdPtr = objv[i+1];
3459     i++;
3460     break;
3461       case 2:     /* -decreasing */
3462     sortInfo.isIncreasing = 0;
3463     break;
3464       case 3:     /* -dictionary */
3465     sortInfo.sortMode = SORTMODE_DICTIONARY;
3466     break;
3467       case 4:     /* -increasing */
3468     sortInfo.isIncreasing = 1;
3469     break;
3470       case 5:     /* -index */
3471     if (i == (objc-2)) {
3472         Tcl_AppendToObj(resultPtr,
3473           "\"-index\" option must be followed by list index",
3474           -1);
3475         return TCL_ERROR;
3476     }
3477     if (TclGetIntForIndex(interp, objv[i+1], SORTIDX_END,
3478       &sortInfo.index) != TCL_OK) {
3479         return TCL_ERROR;
3480     }
3481     i++;
3482     break;
3483       case 6:     /* -integer */
3484     sortInfo.sortMode = SORTMODE_INTEGER;
3485     break;
3486       case 7:     /* -real */
3487     sortInfo.sortMode = SORTMODE_REAL;
3488     break;
3489       case 8:     /* -unique */
3490     unique = 1;
3491     break;
3492   }
3493     }
3494     if (sortInfo.sortMode == SORTMODE_COMMAND) {
3495   /*
3496    * The existing command is a list. We want to flatten it, append
3497    * two dummy arguments on the end, and replace these arguments
3498    * later.
3499    */
3500 
3501         Tcl_Obj *newCommandPtr = Tcl_DuplicateObj(cmdPtr);
3502   Tcl_Obj *newObjPtr = Tcl_NewObj();
3503 
3504   Tcl_IncrRefCount(newCommandPtr);
3505   if (Tcl_ListObjAppendElement(interp, newCommandPtr, newObjPtr)
3506     != TCL_OK) {
3507       Tcl_DecrRefCount(newCommandPtr);
3508       Tcl_IncrRefCount(newObjPtr);
3509       Tcl_DecrRefCount(newObjPtr);
3510       return TCL_ERROR;
3511   }
3512   Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
3513   sortInfo.compareCmdPtr = newCommandPtr;
3514     }
3515 
3516     sortInfo.resultCode = Tcl_ListObjGetElements(interp, objv[objc-1],
3517       &length, &listObjPtrs);
3518     if (sortInfo.resultCode != TCL_OK || length <= 0) {
3519   goto done;
3520     }
3521     elementArray = (SortElement *) ckalloc(length * sizeof(SortElement));
3522     for (i=0; i < length; i++){
3523   elementArray[i].objPtr = listObjPtrs[i];
3524   elementArray[i].count = 0;
3525   elementArray[i].nextPtr = &elementArray[i+1];
3526     }
3527     elementArray[length-1].nextPtr = NULL;
3528     elementPtr = MergeSort(elementArray, &sortInfo);
3529     if (sortInfo.resultCode == TCL_OK) {
3530   /*
3531    * Note: must clear the interpreter's result object: it could
3532    * have been set by the -command script.
3533    */
3534 
3535   Tcl_ResetResult(interp);
3536   resultPtr = Tcl_GetObjResult(interp);
3537   if (unique) {
3538       for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
3539     if (elementPtr->count == 0) {
3540         Tcl_ListObjAppendElement(interp, resultPtr,
3541           elementPtr->objPtr);
3542     }
3543       }
3544   } else {
3545       for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
3546     Tcl_ListObjAppendElement(interp, resultPtr,
3547       elementPtr->objPtr);
3548       }
3549   }
3550     }
3551     ckfree((char*) elementArray);
3552 
3553     done:
3554     if (sortInfo.sortMode == SORTMODE_COMMAND) {
3555   Tcl_DecrRefCount(sortInfo.compareCmdPtr);
3556   sortInfo.compareCmdPtr = NULL;
3557     }
3558     return sortInfo.resultCode;
3559 }
Tcl_Obj* TclLindexFlat (Tcl_Interp* interp, Tcl_Obj* listPtr, int indexCount, indexArray)

Definition at line 2396 of file tclCmdIL.c.
References NULL, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_ListObjGetElements(), Tcl_NewObj(), TCL_OK, TclGetIntForIndex(), tclListType, and Tcl_Obj::typePtr.
Referenced by Tcl_LindexObjCmd(), TclExecuteByteCode(), and TclLindexList().2404 {
2405 
2406     int i;      /* Current list index */
2407     int result;     /* Result of Tcl library calls */
2408     int listLen;    /* Length of the current list being 
2409          * processed */
2410     Tcl_Obj** elemPtrs;   /* Array of pointers to the elements
2411          * of the current list */
2412     int index;      /* Parsed version of the current element
2413          * of indexArray  */
2414     Tcl_Obj* oldListPtr;  /* Temporary to hold listPtr so that
2415          * its ref count can be decremented. */
2416 
2417     /*
2418      * Record the reference to the 'listPtr' object that we are
2419      * maintaining in the C activation record.
2420      */
2421 
2422     Tcl_IncrRefCount( listPtr );
2423 
2424     for ( i = 0; i < indexCount; ++i ) {
2425 
2426   /*
2427    * Convert the current listPtr to a list if necessary.
2428    */
2429   
2430   result = Tcl_ListObjGetElements(interp, listPtr,
2431           &listLen, &elemPtrs);
2432   if (result != TCL_OK) {
2433       Tcl_DecrRefCount( listPtr );
2434       return NULL;
2435   }
2436   
2437   /*
2438    * Get the index from objv[i]
2439    */
2440   
2441   result = TclGetIntForIndex( interp, indexArray[ i ],
2442             /*endValue*/ (listLen - 1),
2443             &index );
2444   if ( result != TCL_OK ) {
2445 
2446       /* Index could not be parsed */
2447 
2448       Tcl_DecrRefCount( listPtr );
2449       return NULL;
2450 
2451   } else if ( index < 0
2452         || index >= listLen ) {
2453       
2454       /*
2455        * Index is out of range
2456        */
2457     
2458       Tcl_DecrRefCount( listPtr );
2459       listPtr = Tcl_NewObj();
2460       Tcl_IncrRefCount( listPtr );
2461       return listPtr;
2462   }
2463       
2464   /*
2465    * Make sure listPtr still refers to a list object.
2466    * It might have been converted to something else above
2467    * if objv[1] overlaps with one of the other parameters.
2468    */
2469   
2470   if (listPtr->typePtr != &tclListType) {
2471       result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
2472               &elemPtrs);
2473       if (result != TCL_OK) {
2474     Tcl_DecrRefCount( listPtr );
2475     return NULL;
2476       }
2477   }
2478   
2479   /*
2480    * Extract the pointer to the appropriate element
2481    */
2482   
2483   oldListPtr = listPtr;
2484   listPtr = elemPtrs[ index ];
2485   Tcl_IncrRefCount( listPtr );
2486   Tcl_DecrRefCount( oldListPtr );
2487   
2488     }
2489 
2490     return listPtr;
2491 
2492 }
Tcl_Obj* TclLindexList (Tcl_Interp* interp, Tcl_Obj* listPtr, Tcl_Obj* argPtr)

Definition at line 2230 of file tclCmdIL.c.
References NULL, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_ListObjGetElements(), Tcl_NewObj(), TCL_OK, TclGetIntForIndex(), TclLindexFlat(), tclListType, and Tcl_Obj::typePtr.
Referenced by Tcl_LindexObjCmd(), and TclExecuteByteCode().2234 {
2235 
2236     Tcl_Obj **elemPtrs;   /* Elements of the list being manipulated. */
2237     int listLen;    /* Length of the list being manipulated. */
2238     int index;      /* Index into the list */
2239     int result;     /* Result returned from a Tcl library call */
2240     int i;      /* Current index number */
2241     Tcl_Obj** indices;    /* Array of list indices */
2242     int indexCount;   /* Size of the array of list indices */
2243     Tcl_Obj* oldListPtr;  /* Temp location to preserve the list
2244          * pointer when replacing it with a sublist */
2245 
2246     /*
2247      * Determine whether argPtr designates a list or a single index.
2248      * We have to be careful about the order of the checks to avoid
2249      * repeated shimmering; see TIP#22 and TIP#33 for the details.
2250      */
2251 
2252     if ( argPtr->typePtr != &tclListType 
2253    && TclGetIntForIndex( NULL , argPtr, 0, &index ) == TCL_OK ) {
2254 
2255   /*
2256    * argPtr designates a single index.
2257    */
2258 
2259   return TclLindexFlat( interp, listPtr, 1, &argPtr );
2260 
2261     } else if ( Tcl_ListObjGetElements( NULL, argPtr, &indexCount, &indices )
2262     != TCL_OK ) {
2263 
2264   /*
2265    * argPtr designates something that is neither an index nor a
2266    * well-formed list.  Report the error via TclLindexFlat.
2267    */
2268   
2269   return TclLindexFlat( interp, listPtr, 1, &argPtr );
2270     }
2271 
2272     /*
2273      * Record the reference to the list that we are maintaining in
2274      * the activation record.
2275      */
2276 
2277     Tcl_IncrRefCount( listPtr );
2278 
2279     /*
2280      * argPtr designates a list, and the 'else if' above has parsed it
2281      * into indexCount and indices.
2282      */
2283 
2284     for ( i = 0; i < indexCount; ++i ) {
2285 
2286   /*
2287    * Convert the current listPtr to a list if necessary.
2288    */
2289       
2290   result = Tcl_ListObjGetElements( interp, listPtr,
2291            &listLen, &elemPtrs);
2292   if (result != TCL_OK) {
2293       Tcl_DecrRefCount( listPtr );
2294       return NULL;
2295   }
2296       
2297   /*
2298    * Get the index from indices[ i ]
2299    */
2300   
2301   result = TclGetIntForIndex( interp, indices[ i ],
2302             /*endValue*/ (listLen - 1),
2303             &index );
2304   if ( result != TCL_OK ) {
2305       /*
2306        * Index could not be parsed
2307        */
2308 
2309       Tcl_DecrRefCount( listPtr );
2310       return NULL;
2311 
2312   } else if ( index < 0
2313         || index >= listLen ) {
2314       /*
2315        * Index is out of range
2316        */
2317       Tcl_DecrRefCount( listPtr );
2318       listPtr = Tcl_NewObj();
2319       Tcl_IncrRefCount( listPtr );
2320       return listPtr;
2321   }
2322   
2323   /*
2324    * Make sure listPtr still refers to a list object.
2325    * If it shared a Tcl_Obj structure with the arguments, then
2326    * it might have just been converted to something else.
2327    */
2328   
2329   if (listPtr->typePtr != &tclListType) {
2330       result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
2331               &elemPtrs);
2332       if (result != TCL_OK) {
2333     Tcl_DecrRefCount( listPtr );
2334     return NULL;
2335       }
2336   }
2337   
2338   /*
2339    * Extract the pointer to the appropriate element
2340    */
2341   
2342   oldListPtr = listPtr;
2343   listPtr = elemPtrs[ index ];
2344   Tcl_IncrRefCount( listPtr );
2345   Tcl_DecrRefCount( oldListPtr );
2346   
2347   /*
2348    * The work we did above may have caused the internal rep
2349    * of *argPtr to change to something else.  Get it back.
2350    */
2351   
2352   result = Tcl_ListObjGetElements( interp, argPtr,
2353            &indexCount, &indices );
2354   if ( result != TCL_OK ) {
2355       /* 
2356        * This can't happen unless some extension corrupted a Tcl_Obj.
2357        */
2358       Tcl_DecrRefCount( listPtr );
2359       return NULL;
2360   }
2361   
2362     } /* end for */
2363 
2364     /*
2365      * Return the last object extracted.  Its reference count will include
2366      * the reference being returned.
2367      */
2368 
2369     return listPtr;
2370 }

generic/tclCmdMZ.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"
#include "tclCompile.h"
Classes
struct TraceVarInfo
struct CompoundVarTrace
struct TraceCommandInfo
Defines
#define TCL_TRACE_ENTER_DURING_EXEC  4
#define TCL_TRACE_LEAVE_DURING_EXEC  8
#define TCL_TRACE_ANY_EXEC  15
#define TCL_TRACE_EXEC_IN_PROGRESS  0x10
#define TCL_TRACE_EXEC_DIRECT  0x20
Functions
typedef int (Tcl_TraceTypeObjCmd)
static int CallTraceProcedure _ANSI_ARGS_ ((Tcl_Interp *interp, Trace *tracePtr, Command *cmdPtr, CONST char *command, int numChars, int objc, Tcl_Obj *CONST objv[]))
static char *TraceVarProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags))
static void TraceCommandProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, CONST char *oldName, CONST char *newName, int flags))
int Tcl_PwdObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_RegexpObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_RegsubObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_RenameObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_ReturnObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_SourceObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_SplitObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_StringObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_SubstObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
Tcl_Obj * Tcl_SubstObj (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
int Tcl_SwitchObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_TimeObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_TraceObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int TclTraceExecutionObjCmd (Tcl_Interp *interp, int optionIndex, int objc, objv)
int TclTraceCommandObjCmd (Tcl_Interp *interp, int optionIndex, int objc, objv)
int TclTraceVariableObjCmd (Tcl_Interp *interp, int optionIndex, int objc, objv)
ClientData Tcl_CommandTraceInfo (Tcl_Interp *interp, CONST char *cmdName, int flags, Tcl_CommandTraceProc *proc, ClientData prevClientData)
int Tcl_TraceCommand (Tcl_Interp *interp, CONST char *cmdName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData)
void Tcl_UntraceCommand (Tcl_Interp *interp, CONST char *cmdName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData)
static void TraceCommandProc (ClientData clientData, Tcl_Interp *interp, CONST char *oldName, CONST char *newName, int flags)
int TclCheckExecutionTraces (Tcl_Interp *interp, CONST char *command, int numChars, Command *cmdPtr, int code, int traceFlags, int objc, objv)
int TclCheckInterpTraces (Tcl_Interp *interp, CONST char *command, int numChars, Command *cmdPtr, int code, int traceFlags, int objc, objv)
static int CallTraceProcedure (Tcl_Interp *interp, Trace *tracePtr, Command *cmdPtr, CONST char *command, int numChars, int objc, objv)
static void CommandObjTraceDeleted (ClientData clientData)
static int TraceExecutionProc (ClientData clientData, Tcl_Interp *interp, int level, CONST char *command, Tcl_Command cmdInfo, int objc, struct Tcl_Obj *CONST objv[])
static char * TraceVarProc (ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags)
int Tcl_WhileObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
Variables
static Tcl_TraceTypeObjCmd * traceSubCmds []
static Tcl_CmdObjTraceProc TraceExecutionProc

Define Documentation
#define TCL_TRACE_ANY_EXEC  15

Definition at line 95 of file tclCmdMZ.c.
Referenced by Tcl_TraceCommand(), Tcl_UntraceCommand(), TclTraceExecutionObjCmd(), TraceCommandProc(), and TraceExecutionProc().#define TCL_TRACE_ENTER_DURING_EXEC  4

Definition at line 93 of file tclCmdMZ.c.
Referenced by TclTraceExecutionObjCmd(), TraceCommandProc(), and TraceExecutionProc().#define TCL_TRACE_EXEC_DIRECT  0x20

Definition at line 97 of file tclCmdMZ.c.
Referenced by TclCheckExecutionTraces(), and TraceExecutionProc().#define TCL_TRACE_EXEC_IN_PROGRESS  0x10

Definition at line 96 of file tclCmdMZ.c.
Referenced by TclCheckInterpTraces(), TclTraceExecutionObjCmd(), TraceCommandProc(), and TraceExecutionProc().#define TCL_TRACE_LEAVE_DURING_EXEC  8

Definition at line 94 of file tclCmdMZ.c.
Referenced by TclTraceExecutionObjCmd(), TraceCommandProc(), and TraceExecutionProc().
Function Documentation
static void TraceCommandProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, CONST char *oldName, CONST char *newName, int flags)) [static]
static char* TraceVarProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags)) [static]
static int CallTraceProcedure _ANSI_ARGS_ ((Tcl_Interp *interp, Trace *tracePtr, Command *cmdPtr, CONST char *command, int numChars, int objc, Tcl_Obj *CONST objv[])) [static]
static int CallTraceProcedure (Tcl_Interp * interp, Trace * tracePtr, Command * cmdPtr, CONST char * command, int numChars, int objc, objv) [static]

Definition at line 4438 of file tclCmdMZ.c.
References ckalloc, ckfree, size_t(), and VOID.
Referenced by TclCheckInterpTraces().4448 {
4449     Interp *iPtr = (Interp *) interp;
4450     char *commandCopy;
4451     int traceCode;
4452 
4453    /*
4454      * Copy the command characters into a new string.
4455      */
4456 
4457     commandCopy = (char *) ckalloc((unsigned) (numChars + 1));
4458     memcpy((VOID *) commandCopy, (VOID *) command, (size_t) numChars);
4459     commandCopy[numChars] = '\0';
4460     
4461     /*
4462      * Call the trace procedure then free allocated storage.
4463      */
4464     
4465     traceCode = (tracePtr->proc)( tracePtr->clientData, (Tcl_Interp*) iPtr,
4466                               iPtr->numLevels, commandCopy,
4467                               (Tcl_Command) cmdPtr, objc, objv );
4468 
4469     ckfree((char *) commandCopy);
4470     return(traceCode);
4471 }
static void CommandObjTraceDeleted (ClientData clientData) [static]

Definition at line 4490 of file tclCmdMZ.c.
References ckfree, and TraceCommandInfo::refCount.
Referenced by TraceExecutionProc().4490                                               {
4491     TraceCommandInfo* tcmdPtr = (TraceCommandInfo*)clientData;
4492     tcmdPtr->refCount--;
4493     if (tcmdPtr->refCount < 0) {
4494   Tcl_Panic("CommandObjTraceDeleted: negative TraceCommandInfo refCount");
4495     }
4496     if (tcmdPtr->refCount == 0) {
4497         ckfree((char*)tcmdPtr);
4498     }
4499 }
typedef int (Tcl_TraceTypeObjCmd)

Definition at line 103 of file tclCmdMZ.c.
References NULL.117                                         {
118     "execution", "command", "variable", (char*) NULL
119 };
ClientData Tcl_CommandTraceInfo (Tcl_Interp * interp, CONST char * cmdName, int flags, Tcl_CommandTraceProc * proc, ClientData prevClientData)

Definition at line 3841 of file tclCmdMZ.c.
References CommandTrace::clientData, CommandTrace::nextPtr, NULL, Tcl_FindCommand(), TCL_LEAVE_ERR_MSG, CommandTrace::traceProc, and Command::tracePtr.
Referenced by TclTraceCommandObjCmd(), and TclTraceExecutionObjCmd().3852 {
3853     Command *cmdPtr;
3854     register CommandTrace *tracePtr;
3855 
3856     cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName, 
3857     NULL, TCL_LEAVE_ERR_MSG);
3858     if (cmdPtr == NULL) {
3859   return NULL;
3860     }
3861 
3862     /*
3863      * Find the relevant trace, if any, and return its clientData.
3864      */
3865 
3866     tracePtr = cmdPtr->tracePtr;
3867     if (prevClientData != NULL) {
3868   for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
3869       if ((tracePtr->clientData == prevClientData)
3870         && (tracePtr->traceProc == proc)) {
3871     tracePtr = tracePtr->nextPtr;
3872     break;
3873       }
3874   }
3875     }
3876     for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
3877   if (tracePtr->traceProc == proc) {
3878       return tracePtr->clientData;
3879   }
3880     }
3881     return NULL;
3882 }
int Tcl_PwdObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 160 of file tclCmdMZ.c.
References NULL, Tcl_DecrRefCount, TCL_ERROR, Tcl_FSGetCwd(), TCL_OK, Tcl_SetObjResult(), and Tcl_WrongNumArgs().165 {
166     Tcl_Obj *retVal;
167 
168     if (objc != 1) {
169   Tcl_WrongNumArgs(interp, 1, objv, NULL);
170   return TCL_ERROR;
171     }
172 
173     retVal = Tcl_FSGetCwd(interp);
174     if (retVal == NULL) {
175   return TCL_ERROR;
176     }
177     Tcl_SetObjResult(interp, retVal);
178     Tcl_DecrRefCount(retVal);
179     return TCL_OK;
180 }
int Tcl_RegexpObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 201 of file tclCmdMZ.c.
References CONST, Tcl_RegExpIndices::end, Tcl_RegExpInfo::matches, Tcl_RegExpInfo::nsubs, NULL, Tcl_RegExpIndices::start, Tcl_DecrRefCount, TCL_ERROR, TCL_EXACT, Tcl_GetCharLength(), Tcl_GetIndexFromObj(), Tcl_GetIntFromObj(), Tcl_GetObjResult(), Tcl_GetRange(), Tcl_GetRegExpFromObj(), Tcl_GetString(), Tcl_GetUniChar(), Tcl_IncrRefCount, Tcl_ListObjAppendElement(), Tcl_NewListObj(), Tcl_NewLongObj(), Tcl_NewObj(), Tcl_ObjSetVar2(), TCL_OK, TCL_REG_ADVANCED, TCL_REG_EXPANDED, TCL_REG_NEWLINE, TCL_REG_NLANCH, TCL_REG_NLSTOP, TCL_REG_NOCASE, TCL_REG_NOTBOL, Tcl_RegExpExecObj(), Tcl_RegExpGetInfo(), Tcl_SetIntObj(), Tcl_SetListObj(), Tcl_WrongNumArgs(), and TclRegAbout().206 {
207     int i, indices, match, about, offset, all, doinline, numMatchesSaved;
208     int cflags, eflags, stringLength;
209     Tcl_RegExp regExpr;
210     Tcl_Obj *objPtr, *resultPtr;
211     Tcl_RegExpInfo info;
212     static CONST char *options[] = {
213   "-all",   "-about", "-indices", "-inline",
214   "-expanded",  "-line",  "-linestop",  "-lineanchor",
215   "-nocase",  "-start", "--",   (char *) NULL
216     };
217     enum options {
218   REGEXP_ALL, REGEXP_ABOUT, REGEXP_INDICES, REGEXP_INLINE,
219   REGEXP_EXPANDED,REGEXP_LINE,  REGEXP_LINESTOP,REGEXP_LINEANCHOR,
220   REGEXP_NOCASE,  REGEXP_START, REGEXP_LAST
221     };
222 
223     indices = 0;
224     about = 0;
225     cflags  = TCL_REG_ADVANCED;
226     eflags  = 0;
227     offset  = 0;
228     all   = 0;
229     doinline  = 0;
230     
231     for (i = 1; i < objc; i++) {
232   char *name;
233   int index;
234 
235   name = Tcl_GetString(objv[i]);
236   if (name[0] != '-') {
237       break;
238   }
239   if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
240     &index) != TCL_OK) {
241       return TCL_ERROR;
242   }
243   switch ((enum options) index) {
244       case REGEXP_ALL: {
245     all = 1;
246     break;
247       }
248       case REGEXP_INDICES: {
249     indices = 1;
250     break;
251       }
252       case REGEXP_INLINE: {
253     doinline = 1;
254     break;
255       }
256       case REGEXP_NOCASE: {
257     cflags |= TCL_REG_NOCASE;
258     break;
259       }
260       case REGEXP_ABOUT: {
261     about = 1;
262     break;
263       }
264       case REGEXP_EXPANDED: {
265     cflags |= TCL_REG_EXPANDED;
266     break;
267       }
268       case REGEXP_LINE: {
269     cflags |= TCL_REG_NEWLINE;
270     break;
271       }
272       case REGEXP_LINESTOP: {
273     cflags |= TCL_REG_NLSTOP;
274     break;
275       }
276       case REGEXP_LINEANCHOR: {
277     cflags |= TCL_REG_NLANCH;
278     break;
279       }
280       case REGEXP_START: {
281     if (++i >= objc) {
282         goto endOfForLoop;
283     }
284     if (Tcl_GetIntFromObj(interp, objv[i], &offset) != TCL_OK) {
285         return TCL_ERROR;
286     }
287     if (offset < 0) {
288         offset = 0;
289     }
290     break;
291       }
292       case REGEXP_LAST: {
293     i++;
294     goto endOfForLoop;
295       }
296   }
297     }
298 
299     endOfForLoop:
300     if ((objc - i) < (2 - about)) {
301   Tcl_WrongNumArgs(interp, 1, objv, 
302     "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
303   return TCL_ERROR;
304     }
305     objc -= i;
306     objv += i;
307 
308     if (doinline && ((objc - 2) != 0)) {
309   /*
310    * User requested -inline, but specified match variables - a no-no.
311    */
312   Tcl_AppendResult(interp, "regexp match variables not allowed",
313     " when using -inline", (char *) NULL);
314   return TCL_ERROR;
315     }
316 
317     /*
318      * Handle the odd about case separately.
319      */
320     if (about) {
321   regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
322   if ((regExpr == NULL) || (TclRegAbout(interp, regExpr) < 0)) {
323       return TCL_ERROR;
324   }
325   return TCL_OK;
326     }
327 
328     /*
329      * Get the length of the string that we are matching against so
330      * we can do the termination test for -all matches.  Do this before
331      * getting the regexp to avoid shimmering problems.
332      */
333     objPtr = objv[1];
334     stringLength = Tcl_GetCharLength(objPtr);
335 
336     regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
337     if (regExpr == NULL) {
338   return TCL_ERROR;
339     }
340 
341     if (offset > 0) {
342   /*
343    * Add flag if using offset (string is part of a larger string),
344    * so that "^" won't match.
345    */
346   eflags |= TCL_REG_NOTBOL;
347     }
348 
349     objc -= 2;
350     objv += 2;
351     resultPtr = Tcl_GetObjResult(interp);
352 
353     if (doinline) {
354   /*
355    * Save all the subexpressions, as we will return them as a list
356    */
357   numMatchesSaved = -1;
358     } else {
359   /*
360    * Save only enough subexpressions for matches we want to keep,
361    * expect in the case of -all, where we need to keep at least
362    * one to know where to move the offset.
363    */
364   numMatchesSaved = (objc == 0) ? all : objc;
365     }
366 
367     /*
368      * The following loop is to handle multiple matches within the
369      * same source string;  each iteration handles one match.  If "-all"
370      * hasn't been specified then the loop body only gets executed once.
371      * We terminate the loop when the starting offset is past the end of the
372      * string.
373      */
374 
375     while (1) {
376   match = Tcl_RegExpExecObj(interp, regExpr, objPtr,
377     offset /* offset */, numMatchesSaved, eflags 
378     | ((offset > 0 &&
379        (Tcl_GetUniChar(objPtr,offset-1) != (Tcl_UniChar)'\n'))
380        ? TCL_REG_NOTBOL : 0));
381 
382   if (match < 0) {
383       return TCL_ERROR;
384   }
385 
386   if (match == 0) {
387       /*
388        * We want to set the value of the intepreter result only when
389        * this is the first time through the loop.
390        */
391       if (all <= 1) {
392     /*
393      * If inlining, set the interpreter's object result to an
394      * empty list, otherwise set it to an integer object w/
395      * value 0.
396      */
397     if (doinline) {
398         Tcl_SetListObj(resultPtr, 0, NULL);
399     } else {
400         Tcl_SetIntObj(resultPtr, 0);
401     }
402     return TCL_OK;
403       }
404       break;
405   }
406 
407   /*
408    * If additional variable names have been specified, return
409    * index information in those variables.
410    */
411 
412   Tcl_RegExpGetInfo(regExpr, &info);
413   if (doinline) {
414       /*
415        * It's the number of substitutions, plus one for the matchVar
416        * at index 0
417        */
418       objc = info.nsubs + 1;
419   }
420   for (i = 0; i < objc; i++) {
421       Tcl_Obj *newPtr;
422 
423       if (indices) {
424     int start, end;
425     Tcl_Obj *objs[2];
426 
427     /*
428      * Only adjust the match area if there was a match for
429      * that area.  (Scriptics Bug 4391/SF Bug #219232)
430      */
431     if (i <= info.nsubs && info.matches[i].start >= 0) {
432         start = offset + info.matches[i].start;
433         end   = offset + info.matches[i].end;
434 
435         /*
436          * Adjust index so it refers to the last character in the
437          * match instead of the first character after the match.
438          */
439 
440         if (end >= offset) {
441       end--;
442         }
443     } else {
444         start = -1;
445         end   = -1;
446     }
447 
448     objs[0] = Tcl_NewLongObj(start);
449     objs[1] = Tcl_NewLongObj(end);
450 
451     newPtr = Tcl_NewListObj(2, objs);
452       } else {
453     if (i <= info.nsubs) {
454         newPtr = Tcl_GetRange(objPtr,
455           offset + info.matches[i].start,
456           offset + info.matches[i].end - 1);
457     } else {
458         newPtr = Tcl_NewObj();
459     }
460       }
461       if (doinline) {
462     if (Tcl_ListObjAppendElement(interp, resultPtr, newPtr)
463       != TCL_OK) {
464         Tcl_DecrRefCount(newPtr);
465         return TCL_ERROR;
466     }
467       } else {
468     Tcl_Obj *valuePtr;
469     Tcl_IncrRefCount(newPtr);
470     valuePtr = Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr, 0);
471     Tcl_DecrRefCount(newPtr);
472     if (valuePtr == NULL) {
473         Tcl_AppendResult(interp, "couldn't set variable \"",
474           Tcl_GetString(objv[i]), "\"", (char *) NULL);
475         return TCL_ERROR;
476     }
477       }
478   }
479 
480   if (all == 0) {
481       break;
482   }
483   /*
484    * Adjust the offset to the character just after the last one
485    * in the matchVar and increment all to count how many times
486    * we are making a match.  We always increment the offset by at least
487    * one to prevent endless looping (as in the case:
488    * regexp -all {a*} a).  Otherwise, when we match the NULL string at
489    * the end of the input string, we will loop indefinately (because the
490    * length of the match is 0, so offset never changes).
491    */
492   if (info.matches[0].end == 0) {
493       offset++;
494   }
495   offset += info.matches[0].end;
496   all++;
497   eflags |= TCL_REG_NOTBOL;
498   if (offset >= stringLength) {
499       break;
500   }
501     }
502 
503     /*
504      * Set the interpreter's object result to an integer object
505      * with value 1 if -all wasn't specified, otherwise it's all-1
506      * (the number of times through the while - 1).
507      * Get the resultPtr again as the Tcl_ObjSetVar2 above may have
508      * cause the result to change. [Patch #558324] (watson).
509      */
510 
511     if (!doinline) {
512   resultPtr = Tcl_GetObjResult(interp);
513   Tcl_SetIntObj(resultPtr, (all ? all-1 : 1));
514     }
515     return TCL_OK;
516 }
int Tcl_RegsubObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 537 of file tclCmdMZ.c.
References _ANSI_ARGS_, CONST, Tcl_RegExpIndices::end, Tcl_RegExpInfo::matches, Tcl_RegExpInfo::nsubs, NULL, Tcl_RegExpIndices::start, Tcl_AppendUnicodeToObj(), Tcl_DecrRefCount, Tcl_DuplicateObj(), TCL_ERROR, TCL_EXACT, Tcl_GetIndexFromObj(), Tcl_GetIntFromObj(), Tcl_GetObjResult(), Tcl_GetRegExpFromObj(), Tcl_GetString(), Tcl_GetUnicodeFromObj(), Tcl_IncrRefCount, Tcl_NewUnicodeObj(), Tcl_ObjSetVar2(), TCL_OK, TCL_REG_ADVANCED, TCL_REG_EXPANDED, TCL_REG_NEWLINE, TCL_REG_NLANCH, TCL_REG_NLSTOP, TCL_REG_NOCASE, TCL_REG_NOTBOL, Tcl_RegExpExecObj(), Tcl_RegExpGetInfo(), Tcl_SetIntObj(), Tcl_SetObjResult(), Tcl_UniCharNcasecmp(), Tcl_UniCharNcmp(), Tcl_UniCharToLower(), and Tcl_WrongNumArgs().542 {
543     int idx, result, cflags, all, wlen, wsublen, numMatches, offset;
544     int start, end, subStart, subEnd, match;
545     Tcl_RegExp regExpr;
546     Tcl_RegExpInfo info;
547     Tcl_Obj *resultPtr, *subPtr, *objPtr;
548     Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend;
549 
550     static CONST char *options[] = {
551   "-all",   "-nocase",  "-expanded",
552   "-line",  "-linestop",  "-lineanchor",  "-start",
553   "--",   NULL
554     };
555     enum options {
556   REGSUB_ALL, REGSUB_NOCASE,  REGSUB_EXPANDED,
557   REGSUB_LINE,  REGSUB_LINESTOP, REGSUB_LINEANCHOR, REGSUB_START,
558   REGSUB_LAST
559     };
560 
561     cflags = TCL_REG_ADVANCED;
562     all = 0;
563     offset = 0;
564     resultPtr = NULL;
565 
566     for (idx = 1; idx < objc; idx++) {
567   char *name;
568   int index;
569   
570   name = Tcl_GetString(objv[idx]);
571   if (name[0] != '-') {
572       break;
573   }
574   if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch",
575     TCL_EXACT, &index) != TCL_OK) {
576       return TCL_ERROR;
577   }
578   switch ((enum options) index) {
579       case REGSUB_ALL: {
580     all = 1;
581     break;
582       }
583       case REGSUB_NOCASE: {
584     cflags |= TCL_REG_NOCASE;
585     break;
586       }
587       case REGSUB_EXPANDED: {
588     cflags |= TCL_REG_EXPANDED;
589     break;
590       }
591       case REGSUB_LINE: {
592     cflags |= TCL_REG_NEWLINE;
593     break;
594       }
595       case REGSUB_LINESTOP: {
596     cflags |= TCL_REG_NLSTOP;
597     break;
598       }
599       case REGSUB_LINEANCHOR: {
600     cflags |= TCL_REG_NLANCH;
601     break;
602       }
603       case REGSUB_START: {
604     if (++idx >= objc) {
605         goto endOfForLoop;
606     }
607     if (Tcl_GetIntFromObj(interp, objv[idx], &offset) != TCL_OK) {
608         return TCL_ERROR;
609     }
610     if (offset < 0) {
611         offset = 0;
612     }
613     break;
614       }
615       case REGSUB_LAST: {
616     idx++;
617     goto endOfForLoop;
618       }
619   }
620     }
621     endOfForLoop:
622     if (objc-idx < 3 || objc-idx > 4) {
623   Tcl_WrongNumArgs(interp, 1, objv,
624     "?switches? exp string subSpec ?varName?");
625   return TCL_ERROR;
626     }
627 
628     objc -= idx;
629     objv += idx;
630 
631     if (all && (offset == 0)
632       && (strpbrk(Tcl_GetString(objv[2]), "&\\") == NULL)
633       && (strpbrk(Tcl_GetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) {
634   /*
635    * This is a simple one pair string map situation.  We make use of
636    * a slightly modified version of the one pair STR_MAP code.
637    */
638   int slen, nocase;
639   int (*strCmpFn)_ANSI_ARGS_((CONST Tcl_UniChar *, CONST Tcl_UniChar *,
640     unsigned long));
641   Tcl_UniChar *p, wsrclc;
642 
643   numMatches = 0;
644   nocase     = (cflags & TCL_REG_NOCASE);
645   strCmpFn   = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;
646 
647   wsrc     = Tcl_GetUnicodeFromObj(objv[0], &slen);
648   wstring  = Tcl_GetUnicodeFromObj(objv[1], &wlen);
649   wsubspec = Tcl_GetUnicodeFromObj(objv[2], &wsublen);
650   wend     = wstring + wlen - (slen ? slen - 1 : 0);
651   result   = TCL_OK;
652 
653   if (slen == 0) {
654       /*
655        * regsub behavior for "" matches between each character.
656        * 'string map' skips the "" case.
657        */
658       if (wstring < wend) {
659     resultPtr = Tcl_NewUnicodeObj(wstring, 0);
660     Tcl_IncrRefCount(resultPtr);
661     for (; wstring < wend; wstring++) {
662         Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen);
663         Tcl_AppendUnicodeToObj(resultPtr, wstring, 1);
664         numMatches++;
665     }
666     wlen = 0;
667       }
668   } else {
669       wsrclc = Tcl_UniCharToLower(*wsrc);
670       for (p = wfirstChar = wstring; wstring < wend; wstring++) {
671     if (((*wstring == *wsrc) ||
672       (nocase && (Tcl_UniCharToLower(*wstring) ==
673         wsrclc))) &&
674       ((slen == 1) || (strCmpFn(wstring, wsrc,
675         (unsigned long) slen) == 0))) {
676         if (numMatches == 0) {
677       resultPtr = Tcl_NewUnicodeObj(wstring, 0);
678       Tcl_IncrRefCount(resultPtr);
679         }
680         if (p != wstring) {
681       Tcl_AppendUnicodeToObj(resultPtr, p, wstring - p);
682       p = wstring + slen;
683         } else {
684       p += slen;
685         }
686         wstring = p - 1;
687 
688         Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen);
689         numMatches++;
690     }
691       }
692       if (numMatches) {
693     wlen    = wfirstChar + wlen - p;
694     wstring = p;
695       }
696   }
697   objPtr = NULL;
698   subPtr = NULL;
699   goto regsubDone;
700     }
701 
702     regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
703     if (regExpr == NULL) {
704   return TCL_ERROR;
705     }
706 
707     /*
708      * Make sure to avoid problems where the objects are shared.  This
709      * can cause RegExpObj <> UnicodeObj shimmering that causes data
710      * corruption.  [Bug #461322]
711      */
712 
713     if (objv[1] == objv[0]) {
714   objPtr = Tcl_DuplicateObj(objv[1]);
715     } else {
716   objPtr = objv[1];
717     }
718     wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen);
719     if (objv[2] == objv[0]) {
720   subPtr = Tcl_DuplicateObj(objv[2]);
721     } else {
722   subPtr = objv[2];
723     }
724     wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen);
725 
726     result = TCL_OK;
727 
728     /*
729      * The following loop is to handle multiple matches within the
730      * same source string;  each iteration handles one match and its
731      * corresponding substitution.  If "-all" hasn't been specified
732      * then the loop body only gets executed once.  We must use
733      * 'offset <= wlen' in particular for the case where the regexp
734      * pattern can match the empty string - this is useful when
735      * doing, say, 'regsub -- ^ $str ...' when $str might be empty.
736      */
737 
738     numMatches = 0;
739     for ( ; offset <= wlen; ) {
740 
741   /*
742    * The flags argument is set if string is part of a larger string,
743    * so that "^" won't match.
744    */
745 
746   match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset,
747     10 /* matches */, ((offset > 0 &&
748        (wstring[offset-1] != (Tcl_UniChar)'\n'))
749        ? TCL_REG_NOTBOL : 0));
750 
751   if (match < 0) {
752       result = TCL_ERROR;
753       goto done;
754   }
755   if (match == 0) {
756       break;
757   }
758   if (numMatches == 0) {
759       resultPtr = Tcl_NewUnicodeObj(wstring, 0);
760       Tcl_IncrRefCount(resultPtr);
761       if (offset > 0) {
762     /*
763      * Copy the initial portion of the string in if an offset
764      * was specified.
765      */
766     Tcl_AppendUnicodeToObj(resultPtr, wstring, offset);
767       }
768   }
769   numMatches++;
770 
771   /*
772    * Copy the portion of the source string before the match to the
773    * result variable.
774    */
775 
776   Tcl_RegExpGetInfo(regExpr, &info);
777   start = info.matches[0].start;
778   end = info.matches[0].end;
779   Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, start);
780 
781   /*
782    * Append the subSpec argument to the variable, making appropriate
783    * substitutions.  This code is a bit hairy because of the backslash
784    * conventions and because the code saves up ranges of characters in
785    * subSpec to reduce the number of calls to Tcl_SetVar.
786    */
787 
788   wsrc = wfirstChar = wsubspec;
789   wend = wsubspec + wsublen;
790   for (ch = *wsrc; wsrc != wend; wsrc++, ch = *wsrc) {
791       if (ch == '&') {
792     idx = 0;
793       } else if (ch == '\\') {
794     ch = wsrc[1];
795     if ((ch >= '0') && (ch <= '9')) {
796         idx = ch - '0';
797     } else if ((ch == '\\') || (ch == '&')) {
798         *wsrc = ch;
799         Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
800           wsrc - wfirstChar + 1);
801         *wsrc = '\\';
802         wfirstChar = wsrc + 2;
803         wsrc++;
804         continue;
805     } else {
806         continue;
807     }
808       } else {
809     continue;
810       }
811       if (wfirstChar != wsrc) {
812     Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
813       wsrc - wfirstChar);
814       }
815       if (idx <= info.nsubs) {
816     subStart = info.matches[idx].start;
817     subEnd = info.matches[idx].end;
818     if ((subStart >= 0) && (subEnd >= 0)) {
819         Tcl_AppendUnicodeToObj(resultPtr,
820           wstring + offset + subStart, subEnd - subStart);
821     }
822       }
823       if (*wsrc == '\\') {
824     wsrc++;
825       }
826       wfirstChar = wsrc + 1;
827   }
828   if (wfirstChar != wsrc) {
829       Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar);
830   }
831   if (end == 0) {
832       /*
833        * Always consume at least one character of the input string
834        * in order to prevent infinite loops.
835        */
836 
837       if (offset < wlen) {
838     Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
839       }
840       offset++;
841   } else {
842       offset += end;
843       if (start == end) {
844     /*
845      * We matched an empty string, which means we must go 
846      * forward one more step so we don't match again at the
847      * same spot.
848      */
849     if (offset < wlen) {
850         Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
851     }
852     offset++;
853       }
854   }
855   if (!all) {
856       break;
857   }
858     }
859 
860     /*
861      * Copy the portion of the source string after the last match to the
862      * result variable.
863      */
864     regsubDone:
865     if (numMatches == 0) {
866   /*
867    * On zero matches, just ignore the offset, since it shouldn't
868    * matter to us in this case, and the user may have skewed it.
869    */
870   resultPtr = objv[1];
871   Tcl_IncrRefCount(resultPtr);
872     } else if (offset < wlen) {
873   Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
874     }
875     if (objc == 4) {
876   if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, 0) == NULL) {
877       Tcl_AppendResult(interp, "couldn't set variable \"",
878         Tcl_GetString(objv[3]), "\"", (char *) NULL);
879       result = TCL_ERROR;
880   } else {
881       /*
882        * Set the interpreter's object result to an integer object
883        * holding the number of matches. 
884        */
885 
886       Tcl_SetIntObj(Tcl_GetObjResult(interp), numMatches);
887   }
888     } else {
889   /*
890    * No varname supplied, so just return the modified string.
891    */
892   Tcl_SetObjResult(interp, resultPtr);
893     }
894 
895     done:
896     if (objPtr && (objv[1] == objv[0])) { Tcl_DecrRefCount(objPtr); }
897     if (subPtr && (objv[2] == objv[0])) { Tcl_DecrRefCount(subPtr); }
898     if (resultPtr) { Tcl_DecrRefCount(resultPtr); }
899     return result;
900 }
int Tcl_RenameObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 921 of file tclCmdMZ.c.
References TCL_ERROR, Tcl_GetString(), Tcl_WrongNumArgs(), and TclRenameCommand().926 {
927     char *oldName, *newName;
928     
929     if (objc != 3) {
930   Tcl_WrongNumArgs(interp, 1, objv, "oldName newName");
931   return TCL_ERROR;
932     }
933 
934     oldName = Tcl_GetString(objv[1]);
935     newName = Tcl_GetString(objv[2]);
936     return TclRenameCommand(interp, oldName, newName);
937 }
int Tcl_ReturnObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 958 of file tclCmdMZ.c.
References ckalloc, ckfree, Interp::errorCode, Interp::errorInfo, NULL, Interp::returnCode, TCL_BREAK, TCL_CONTINUE, TCL_ERROR, Tcl_GetIntFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), TCL_OK, Tcl_ResetResult(), TCL_RETURN, and Tcl_SetObjResult().963 {
964     Interp *iPtr = (Interp *) interp;
965     int optionLen, argLen, code, result;
966 
967     if (iPtr->errorInfo != NULL) {
968   ckfree(iPtr->errorInfo);
969   iPtr->errorInfo = NULL;
970     }
971     if (iPtr->errorCode != NULL) {
972   ckfree(iPtr->errorCode);
973   iPtr->errorCode = NULL;
974     }
975     code = TCL_OK;
976     
977     for (objv++, objc--;  objc > 1;  objv += 2, objc -= 2) {
978   char *option = Tcl_GetStringFromObj(objv[0], &optionLen);
979   char *arg = Tcl_GetStringFromObj(objv[1], &argLen);
980       
981   if (strcmp(option, "-code") == 0) {
982       register int c = arg[0];
983       if ((c == 'o') && (strcmp(arg, "ok") == 0)) {
984     code = TCL_OK;
985       } else if ((c == 'e') && (strcmp(arg, "error") == 0)) {
986     code = TCL_ERROR;
987       } else if ((c == 'r') && (strcmp(arg, "return") == 0)) {
988     code = TCL_RETURN;
989       } else if ((c == 'b') && (strcmp(arg, "break") == 0)) {
990     code = TCL_BREAK;
991       } else if ((c == 'c') && (strcmp(arg, "continue") == 0)) {
992     code = TCL_CONTINUE;
993       } else {
994     result = Tcl_GetIntFromObj((Tcl_Interp *) NULL, objv[1],
995             &code);
996     if (result != TCL_OK) {
997         Tcl_ResetResult(interp);
998         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
999           "bad completion code \"",
1000           Tcl_GetString(objv[1]),
1001           "\": must be ok, error, return, break, ",
1002           "continue, or an integer", (char *) NULL);
1003         return result;
1004     }
1005       }
1006   } else if (strcmp(option, "-errorinfo") == 0) {
1007       iPtr->errorInfo =
1008     (char *) ckalloc((unsigned) (strlen(arg) + 1));
1009       strcpy(iPtr->errorInfo, arg);
1010   } else if (strcmp(option, "-errorcode") == 0) {
1011       iPtr->errorCode =
1012     (char *) ckalloc((unsigned) (strlen(arg) + 1));
1013       strcpy(iPtr->errorCode, arg);
1014   } else {
1015       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1016         "bad option \"", option,
1017         "\": must be -code, -errorcode, or -errorinfo",
1018         (char *) NULL);
1019       return TCL_ERROR;
1020   }
1021     }
1022     
1023     if (objc == 1) {
1024   /*
1025    * Set the interpreter's object result. An inline version of
1026    * Tcl_SetObjResult.
1027    */
1028 
1029   Tcl_SetObjResult(interp, objv[0]);
1030     }
1031     iPtr->returnCode = code;
1032     return TCL_RETURN;
1033 }
int Tcl_SourceObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 1054 of file tclCmdMZ.c.
References TCL_ERROR, Tcl_FSEvalFile(), and Tcl_WrongNumArgs().1059 {
1060     if (objc != 2) {
1061   Tcl_WrongNumArgs(interp, 1, objv, "fileName");
1062   return TCL_ERROR;
1063     }
1064 
1065     return Tcl_FSEvalFile(interp, objv[1]);
1066 }
int Tcl_SplitObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 1087 of file tclCmdMZ.c.
References element(), NULL, Tcl_CreateHashEntry, Tcl_DeleteHashTable(), TCL_ERROR, Tcl_GetHashValue, Tcl_GetObjResult(), Tcl_GetStringFromObj(), Tcl_InitHashTable(), Tcl_ListObjAppendElement(), Tcl_NewStringObj(), TCL_OK, TCL_ONE_WORD_KEYS, Tcl_SetHashValue, Tcl_WrongNumArgs(), and TclUtfToUniChar.1092 {
1093     Tcl_UniChar ch;
1094     int len;
1095     char *splitChars, *string, *end;
1096     int splitCharLen, stringLen;
1097     Tcl_Obj *listPtr, *objPtr;
1098 
1099     if (objc == 2) {
1100   splitChars = " \n\t\r";
1101   splitCharLen = 4;
1102     } else if (objc == 3) {
1103   splitChars = Tcl_GetStringFromObj(objv[2], &splitCharLen);
1104     } else {
1105   Tcl_WrongNumArgs(interp, 1, objv, "string ?splitChars?");
1106   return TCL_ERROR;
1107     }
1108 
1109     string = Tcl_GetStringFromObj(objv[1], &stringLen);
1110     end = string + stringLen;
1111     listPtr = Tcl_GetObjResult(interp);
1112     
1113     if (stringLen == 0) {
1114   /*
1115    * Do nothing.
1116    */
1117     } else if (splitCharLen == 0) {
1118   Tcl_HashTable charReuseTable;
1119   Tcl_HashEntry *hPtr;
1120   int isNew;
1121 
1122   /*
1123    * Handle the special case of splitting on every character.
1124    *
1125    * Uses a hash table to ensure that each kind of character has
1126    * only one Tcl_Obj instance (multiply-referenced) in the
1127    * final list.  This is a *major* win when splitting on a long
1128    * string (especially in the megabyte range!) - DKF
1129    */
1130 
1131   Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS);
1132   for ( ; string < end; string += len) {
1133       len = TclUtfToUniChar(string, &ch);
1134       /* Assume Tcl_UniChar is an integral type... */
1135       hPtr = Tcl_CreateHashEntry(&charReuseTable, (char*)0 + ch, &isNew);
1136       if (isNew) {
1137     objPtr = Tcl_NewStringObj(string, len);
1138     /* Don't need to fiddle with refcount... */
1139     Tcl_SetHashValue(hPtr, (ClientData) objPtr);
1140       } else {
1141     objPtr = (Tcl_Obj*) Tcl_GetHashValue(hPtr);
1142       }
1143       Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
1144   }
1145   Tcl_DeleteHashTable(&charReuseTable);
1146     } else if (splitCharLen == 1) {
1147   char *p;
1148 
1149   /*
1150    * Handle the special case of splitting on a single character.
1151    * This is only true for the one-char ASCII case, as one unicode
1152    * char is > 1 byte in length.
1153    */
1154 
1155   while (*string && (p = strchr(string, (int) *splitChars)) != NULL) {
1156       objPtr = Tcl_NewStringObj(string, p - string);
1157       Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
1158       string = p + 1;
1159   }
1160   objPtr = Tcl_NewStringObj(string, end - string);
1161   Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
1162     } else {
1163   char *element, *p, *splitEnd;
1164   int splitLen;
1165   Tcl_UniChar splitChar;
1166   
1167   /*
1168    * Normal case: split on any of a given set of characters.
1169    * Discard instances of the split characters.
1170    */
1171 
1172   splitEnd = splitChars + splitCharLen;
1173 
1174   for (element = string; string < end; string += len) {
1175       len = TclUtfToUniChar(string, &ch);
1176       for (p = splitChars; p < splitEnd; p += splitLen) {
1177     splitLen = TclUtfToUniChar(p, &splitChar);
1178     if (ch == splitChar) {
1179         objPtr = Tcl_NewStringObj(element, string - element);
1180         Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
1181         element = string + len;
1182         break;
1183     }
1184       }
1185   }
1186   objPtr = Tcl_NewStringObj(element, string - element);
1187   Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
1188     }
1189     return TCL_OK;
1190 }
int Tcl_StringObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 1218 of file tclCmdMZ.c.
References _ANSI_ARGS_, ckalloc, ckfree, CONST, ERANGE, errno, INT_MAX, INT_MIN, memcmp(), NULL, size_t(), strtod(), strtol(), strtoul(), strtoull(), Tcl_AppendObjToObj(), Tcl_AppendToObj(), Tcl_AppendUnicodeToObj(), Tcl_DecrRefCount, Tcl_DuplicateObj(), TCL_ERROR, Tcl_GetBoolean(), Tcl_GetByteArrayFromObj(), Tcl_GetCharLength(), Tcl_GetIndexFromObj(), Tcl_GetIntFromObj(), Tcl_GetObjResult(), Tcl_GetRange(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_GetUniChar(), Tcl_GetUnicodeFromObj(), Tcl_IncrRefCount, TCL_INTEGER_SPACE, TCL_LEAVE_ERR_MSG, Tcl_ListObjGetElements(), Tcl_NewByteArrayObj(), Tcl_NewIntObj(), Tcl_NewObj(), Tcl_NumUtfChars(), Tcl_ObjSetVar2(), TCL_OK, Tcl_SetBooleanObj(), Tcl_SetByteArrayObj(), Tcl_SetIntObj(), Tcl_SetObjLength(), Tcl_SetObjResult(), Tcl_SetStringObj(), Tcl_SetUnicodeObj(), Tcl_UniCharIsAlnum(), Tcl_UniCharIsAlpha(), Tcl_UniCharIsControl(), Tcl_UniCharIsDigit(), Tcl_UniCharIsGraph(), Tcl_UniCharIsLower(), Tcl_UniCharIsPrint(), Tcl_UniCharIsPunct(), Tcl_UniCharIsSpace(), Tcl_UniCharIsUpper(), Tcl_UniCharIsWordChar(), Tcl_UniCharNcasecmp(), Tcl_UniCharNcmp(), Tcl_UniCharToLower(), Tcl_UniCharToUtf(), TCL_UTF_MAX, Tcl_UtfAtIndex(), Tcl_UtfNcasecmp(), Tcl_UtfNcmp(), Tcl_UtfPrev(), Tcl_UtfToLower(), Tcl_UtfToTitle(), Tcl_UtfToUpper(), Tcl_WrongNumArgs(), tclByteArrayType, tclDoubleType, TclGetIntForIndex(), tclIntType, TclLooksLikeInt(), TclpUtfNcmp2(), tclStringType, TclUniCharMatch(), TclUniCharNcmp, TclUtfToUniChar, Tcl_Obj::typePtr, and void().1223 {
1224     int index, left, right;
1225     Tcl_Obj *resultPtr;
1226     char *string1, *string2;
1227     int length1, length2;
1228     static CONST char *options[] = {
1229   "bytelength", "compare",  "equal",  "first",
1230   "index",  "is",   "last",   "length",
1231   "map",    "match",  "range",  "repeat",
1232   "replace",  "tolower",  "toupper",  "totitle",
1233   "trim",   "trimleft", "trimright",
1234   "wordend",  "wordstart",  (char *) NULL
1235     };
1236     enum options {
1237   STR_BYTELENGTH, STR_COMPARE,  STR_EQUAL,  STR_FIRST,
1238   STR_INDEX,  STR_IS,   STR_LAST, STR_LENGTH,
1239   STR_MAP,  STR_MATCH,  STR_RANGE,  STR_REPEAT,
1240   STR_REPLACE,  STR_TOLOWER,  STR_TOUPPER,  STR_TOTITLE,
1241   STR_TRIM, STR_TRIMLEFT, STR_TRIMRIGHT,
1242   STR_WORDEND,  STR_WORDSTART
1243     };    
1244 
1245     if (objc < 2) {
1246         Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
1247   return TCL_ERROR;
1248     }
1249     
1250     if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
1251       &index) != TCL_OK) {
1252   return TCL_ERROR;
1253     }
1254 
1255     resultPtr = Tcl_GetObjResult(interp);
1256     switch ((enum options) index) {
1257   case STR_EQUAL:
1258   case STR_COMPARE: {
1259       /*
1260        * Remember to keep code here in some sync with the
1261        * byte-compiled versions in tclExecute.c (INST_STR_EQ,
1262        * INST_STR_NEQ and INST_STR_CMP as well as the expr string
1263        * comparison in INST_EQ/INST_NEQ/INST_LT/...).
1264        */
1265       int i, match, length, nocase = 0, reqlength = -1;
1266       int (*strCmpFn)();
1267 
1268       if (objc < 4 || objc > 7) {
1269       str_cmp_args:
1270           Tcl_WrongNumArgs(interp, 2, objv,
1271          "?-nocase? ?-length int? string1 string2");
1272     return TCL_ERROR;
1273       }
1274 
1275       for (i = 2; i < objc-2; i++) {
1276     string2 = Tcl_GetStringFromObj(objv[i], &length2);
1277     if ((length2 > 1)
1278       && strncmp(string2, "-nocase", (size_t)length2) == 0) {
1279         nocase = 1;
1280     } else if ((length2 > 1)
1281       && strncmp(string2, "-length", (size_t)length2) == 0) {
1282         if (i+1 >= objc-2) {
1283       goto str_cmp_args;
1284         }
1285         if (Tcl_GetIntFromObj(interp, objv[++i],
1286           &reqlength) != TCL_OK) {
1287       return TCL_ERROR;
1288         }
1289     } else {
1290         Tcl_AppendStringsToObj(resultPtr, "bad option \"",
1291           string2, "\": must be -nocase or -length",
1292           (char *) NULL);
1293         return TCL_ERROR;
1294     }
1295       }
1296 
1297       /*
1298        * From now on, we only access the two objects at the end
1299        * of the argument array.
1300        */
1301       objv += objc-2;
1302 
1303       if ((reqlength == 0) || (objv[0] == objv[1])) {
1304     /*
1305      * Alway match at 0 chars of if it is the same obj.
1306      */
1307 
1308     Tcl_SetBooleanObj(resultPtr,
1309       ((enum options) index == STR_EQUAL));
1310     break;
1311       } else if (!nocase && objv[0]->typePtr == &tclByteArrayType &&
1312         objv[1]->typePtr == &tclByteArrayType) {
1313     /*
1314      * Use binary versions of comparisons since that won't
1315      * cause undue type conversions and it is much faster.
1316      * Only do this if we're case-sensitive (which is all
1317      * that really makes sense with byte arrays anyway, and
1318      * we have no memcasecmp() for some reason... :^)
1319      */
1320     string1 = (char*) Tcl_GetByteArrayFromObj(objv[0], &length1);
1321     string2 = (char*) Tcl_GetByteArrayFromObj(objv[1], &length2);
1322     strCmpFn = memcmp;
1323       } else if ((objv[0]->typePtr == &tclStringType)
1324         && (objv[1]->typePtr == &tclStringType)) {
1325     /*
1326      * Do a unicode-specific comparison if both of the args
1327      * are of String type.  In benchmark testing this proved
1328      * the most efficient check between the unicode and
1329      * string comparison operations.
1330      */
1331     string1 = (char*) Tcl_GetUnicodeFromObj(objv[0], &length1);
1332     string2 = (char*) Tcl_GetUnicodeFromObj(objv[1], &length2);
1333     strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;
1334       } else {
1335     /*
1336      * As a catch-all we will work with UTF-8.  We cannot use
1337      * memcmp() as that is unsafe with any string containing
1338      * NULL (\xC0\x80 in Tcl's utf rep).  We can use the more
1339      * efficient TclpUtfNcmp2 if we are case-sensitive and no
1340      * specific length was requested.
1341      */
1342     string1 = (char*) Tcl_GetStringFromObj(objv[0], &length1);
1343     string2 = (char*) Tcl_GetStringFromObj(objv[1], &length2);
1344     if ((reqlength < 0) && !nocase) {
1345         strCmpFn = TclpUtfNcmp2;
1346     } else {
1347         length1 = Tcl_NumUtfChars(string1, length1);
1348         length2 = Tcl_NumUtfChars(string2, length2);
1349         strCmpFn = nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp;
1350     }
1351       }
1352 
1353       if (((enum options) index == STR_EQUAL)
1354         && (reqlength < 0) && (length1 != length2)) {
1355     match = 1; /* this will be reversed below */
1356       } else {
1357     length = (length1 < length2) ? length1 : length2;
1358     if (reqlength > 0 && reqlength < length) {
1359         length = reqlength;
1360     } else if (reqlength < 0) {
1361         /*
1362          * The requested length is negative, so we ignore it by
1363          * setting it to length + 1 so we correct the match var.
1364          */
1365         reqlength = length + 1;
1366     }
1367     match = strCmpFn(string1, string2, (unsigned) length);
1368     if ((match == 0) && (reqlength > length)) {
1369         match = length1 - length2;
1370     }
1371       }
1372 
1373       if ((enum options) index == STR_EQUAL) {
1374     Tcl_SetBooleanObj(resultPtr, (match) ? 0 : 1);
1375       } else {
1376     Tcl_SetIntObj(resultPtr, ((match > 0) ? 1 :
1377             (match < 0) ? -1 : 0));
1378       }
1379       break;
1380   }
1381   case STR_FIRST: {
1382       Tcl_UniChar *ustring1, *ustring2;
1383       int match, start;
1384 
1385       if (objc < 4 || objc > 5) {
1386           Tcl_WrongNumArgs(interp, 2, objv,
1387          "subString string ?startIndex?");
1388     return TCL_ERROR;
1389       }
1390 
1391       /*
1392        * We are searching string2 for the sequence string1.
1393        */
1394 
1395       match = -1;
1396       start = 0;
1397       length2 = -1;
1398 
1399       ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1);
1400       ustring2 = Tcl_GetUnicodeFromObj(objv[3], &length2);
1401 
1402       if (objc == 5) {
1403     /*
1404      * If a startIndex is specified, we will need to fast
1405      * forward to that point in the string before we think
1406      * about a match
1407      */
1408     if (TclGetIntForIndex(interp, objv[4], length2 - 1,
1409       &start) != TCL_OK) {
1410         return TCL_ERROR;
1411     }
1412     if (start >= length2) {
1413         goto str_first_done;
1414     } else if (start > 0) {
1415         ustring2 += start;
1416         length2  -= start;
1417     } else if (start < 0) {
1418         /*
1419          * Invalid start index mapped to string start;
1420          * Bug #423581
1421          */
1422         start = 0;
1423     }
1424       }
1425 
1426       if (length1 > 0) {
1427     register Tcl_UniChar *p, *end;
1428 
1429     end = ustring2 + length2 - length1 + 1;
1430     for (p = ustring2;  p < end;  p++) {
1431         /*
1432          * Scan forward to find the first character.
1433          */
1434         if ((*p == *ustring1) &&
1435           (TclUniCharNcmp(ustring1, p,
1436             (unsigned long) length1) == 0)) {
1437       match = p - ustring2;
1438       break;
1439         }
1440     }
1441       }
1442       /*
1443        * Compute the character index of the matching string by
1444        * counting the number of characters before the match.
1445        */
1446       if ((match != -1) && (objc == 5)) {
1447     match += start;
1448       }
1449 
1450       str_first_done:
1451       Tcl_SetIntObj(resultPtr, match);
1452       break;
1453   }
1454   case STR_INDEX: {
1455       if (objc != 4) {
1456           Tcl_WrongNumArgs(interp, 2, objv, "string charIndex");
1457     return TCL_ERROR;
1458       }
1459 
1460       /*
1461        * If we have a ByteArray object, avoid indexing in the
1462        * Utf string since the byte array contains one byte per
1463        * character.  Otherwise, use the Unicode string rep to
1464        * get the index'th char.
1465        */
1466 
1467       if (objv[2]->typePtr == &tclByteArrayType) {
1468     string1 = (char *) Tcl_GetByteArrayFromObj(objv[2], &length1);
1469 
1470     if (TclGetIntForIndex(interp, objv[3], length1 - 1,
1471       &index) != TCL_OK) {
1472         return TCL_ERROR;
1473     }
1474     if ((index >= 0) && (index < length1)) {
1475         Tcl_SetByteArrayObj(resultPtr,
1476           (unsigned char *)(&string1[index]), 1);
1477     }
1478       } else {
1479     /*
1480      * Get Unicode char length to calulate what 'end' means.
1481      */
1482     length1 = Tcl_GetCharLength(objv[2]);
1483 
1484     if (TclGetIntForIndex(interp, objv[3], length1 - 1,
1485       &index) != TCL_OK) {
1486         return TCL_ERROR;
1487     }
1488     if ((index >= 0) && (index < length1)) {
1489         char buf[TCL_UTF_MAX];
1490         Tcl_UniChar ch;
1491 
1492         ch      = Tcl_GetUniChar(objv[2], index);
1493         length1 = Tcl_UniCharToUtf(ch, buf);
1494         Tcl_SetStringObj(resultPtr, buf, length1);
1495     }
1496       }
1497       break;
1498   }
1499   case STR_IS: {
1500       char *end;
1501       Tcl_UniChar ch;
1502 
1503             /*
1504        * The UniChar comparison function
1505        */
1506 
1507       int (*chcomp)_ANSI_ARGS_((int)) = NULL; 
1508       int i, failat = 0, result = 1, strict = 0;
1509       Tcl_Obj *objPtr, *failVarObj = NULL;
1510 
1511       static CONST char *isOptions[] = {
1512     "alnum",  "alpha",  "ascii",  "control",
1513     "boolean",  "digit",  "double", "false",
1514     "graph",  "integer",  "lower",  "print",
1515     "punct",  "space",  "true",   "upper",
1516     "wordchar", "xdigit", (char *) NULL
1517       };
1518       enum isOptions {
1519     STR_IS_ALNUM, STR_IS_ALPHA, STR_IS_ASCII, STR_IS_CONTROL,
1520     STR_IS_BOOL,  STR_IS_DIGIT, STR_IS_DOUBLE,  STR_IS_FALSE,
1521     STR_IS_GRAPH, STR_IS_INT, STR_IS_LOWER, STR_IS_PRINT,
1522     STR_IS_PUNCT, STR_IS_SPACE, STR_IS_TRUE,  STR_IS_UPPER,
1523     STR_IS_WORD,  STR_IS_XDIGIT
1524       };
1525 
1526       if (objc < 4 || objc > 7) {
1527     Tcl_WrongNumArgs(interp, 2, objv,
1528          "class ?-strict? ?-failindex var? str");
1529     return TCL_ERROR;
1530       }
1531       if (Tcl_GetIndexFromObj(interp, objv[2], isOptions, "class", 0,
1532             &index) != TCL_OK) {
1533     return TCL_ERROR;
1534       }
1535       if (objc != 4) {
1536     for (i = 3; i < objc-1; i++) {
1537         string2 = Tcl_GetStringFromObj(objv[i], &length2);
1538         if ((length2 > 1) &&
1539       strncmp(string2, "-strict", (size_t) length2) == 0) {
1540       strict = 1;
1541         } else if ((length2 > 1) &&
1542           strncmp(string2, "-failindex",
1543             (size_t) length2) == 0) {
1544       if (i+1 >= objc-1) {
1545           Tcl_WrongNumArgs(interp, 3, objv,
1546                "?-strict? ?-failindex var? str");
1547           return TCL_ERROR;
1548       }
1549       failVarObj = objv[++i];
1550         } else {
1551       Tcl_AppendStringsToObj(resultPtr, "bad option \"",
1552         string2, "\": must be -strict or -failindex",
1553         (char *) NULL);
1554       return TCL_ERROR;
1555         }
1556     }
1557       }
1558 
1559       /*
1560        * We get the objPtr so that we can short-cut for some classes
1561        * by checking the object type (int and double), but we need
1562        * the string otherwise, because we don't want any conversion
1563        * of type occuring (as, for example, Tcl_Get*FromObj would do
1564        */
1565       objPtr = objv[objc-1];
1566       string1 = Tcl_GetStringFromObj(objPtr, &length1);
1567       if (length1 == 0) {
1568     if (strict) {
1569         result = 0;
1570     }
1571     goto str_is_done;
1572       }
1573       end = string1 + length1;
1574 
1575       /*
1576        * When entering here, result == 1 and failat == 0
1577        */
1578       switch ((enum isOptions) index) {
1579     case STR_IS_ALNUM:
1580         chcomp = Tcl_UniCharIsAlnum;
1581         break;
1582     case STR_IS_ALPHA:
1583         chcomp = Tcl_UniCharIsAlpha;
1584         break;
1585     case STR_IS_ASCII:
1586         for (; string1 < end; string1++, failat++) {
1587       /*
1588        * This is a valid check in unicode, because all
1589        * bytes < 0xC0 are single byte chars (but isascii
1590        * limits that def'n to 0x80).
1591        */
1592       if (*((unsigned char *)string1) >= 0x80) {
1593           result = 0;
1594           break;
1595       }
1596         }
1597         break;
1598     case STR_IS_BOOL:
1599     case STR_IS_TRUE:
1600     case STR_IS_FALSE:
1601         /* Optimizers, beware Bug 1187123 ! */
1602         if ((Tcl_GetBoolean(NULL, string1, &i)
1603         == TCL_ERROR) ||
1604              (((enum isOptions) index == STR_IS_TRUE) &&
1605         i == 0) ||
1606              (((enum isOptions) index == STR_IS_FALSE) &&
1607         i != 0)) {
1608       result = 0;
1609         }
1610         break;
1611     case STR_IS_CONTROL:
1612         chcomp = Tcl_UniCharIsControl;
1613         break;
1614     case STR_IS_DIGIT:
1615         chcomp = Tcl_UniCharIsDigit;
1616         break;
1617     case STR_IS_DOUBLE: {
1618         char *stop;
1619 
1620         if ((objPtr->typePtr == &tclDoubleType) ||
1621       (objPtr->typePtr == &tclIntType)) {
1622       break;
1623         }
1624         /*
1625          * This is adapted from Tcl_GetDouble
1626          *
1627          * The danger in this function is that
1628          * "12345678901234567890" is an acceptable 'double',
1629          * but will later be interp'd as an int by something
1630          * like [expr].  Therefore, we check to see if it looks
1631          * like an int, and if so we do a range check on it.
1632          * If strtoul gets to the end, we know we either
1633          * received an acceptable int, or over/underflow
1634          */
1635         if (TclLooksLikeInt(string1, length1)) {
1636       errno = 0;
1637 #ifdef TCL_WIDE_INT_IS_LONG
1638       strtoul(string1, &stop, 0); /* INTL: Tcl source. */
1639 #else
1640       strtoull(string1, &stop, 0); /* INTL: Tcl source. */
1641 #endif
1642       if (stop == end) {
1643           if (errno == ERANGE) {
1644         result = 0;
1645         failat = -1;
1646           }
1647           break;
1648       }
1649         }
1650         errno = 0;
1651         strtod(string1, &stop); /* INTL: Tcl source. */
1652         if (errno == ERANGE) {
1653       /*
1654        * if (errno == ERANGE), then it was an over/underflow
1655        * problem, but in this method, we only want to know
1656        * yes or no, so bad flow returns 0 (false) and sets
1657        * the failVarObj to the string length.
1658        */
1659       result = 0;
1660       failat = -1;
1661         } else if (stop == string1) {
1662       /*
1663        * In this case, nothing like a number was found
1664        */
1665       result = 0;
1666       failat = 0;
1667         } else {
1668       /*
1669        * Assume we sucked up one char per byte
1670        * and then we go onto SPACE, since we are
1671        * allowed trailing whitespace
1672        */
1673       failat = stop - string1;
1674       string1 = stop;
1675       chcomp = Tcl_UniCharIsSpace;
1676         }
1677         break;
1678     }
1679     case STR_IS_GRAPH:
1680         chcomp = Tcl_UniCharIsGraph;
1681         break;
1682     case STR_IS_INT: {
1683         char *stop;
1684         long int l = 0;
1685 
1686         if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &i)) {
1687       break;
1688         }
1689         /*
1690          * Like STR_IS_DOUBLE, but we use strtoul.
1691          * Since Tcl_GetIntFromObj already failed,
1692          * we set result to 0.
1693          */
1694         result = 0;
1695         errno = 0;
1696         l = strtol(string1, &stop, 0); /* INTL: Tcl source. */
1697         if ((errno == ERANGE) || (l > INT_MAX) || (l < INT_MIN)) {
1698       /*
1699        * if (errno == ERANGE), then it was an over/underflow
1700        * problem, but in this method, we only want to know
1701        * yes or no, so bad flow returns 0 (false) and sets
1702        * the failVarObj to the string length.
1703        */
1704       failat = -1;
1705 
1706         } else if (stop == string1) {
1707       /*
1708        * In this case, nothing like a number was found
1709        */
1710       failat = 0;
1711         } else {
1712       /*
1713        * Assume we sucked up one char per byte
1714        * and then we go onto SPACE, since we are
1715        * allowed trailing whitespace
1716        */
1717       failat = stop - string1;
1718       string1 = stop;
1719       chcomp = Tcl_UniCharIsSpace;
1720         }
1721         break;
1722     }
1723     case STR_IS_LOWER:
1724         chcomp = Tcl_UniCharIsLower;
1725         break;
1726     case STR_IS_PRINT:
1727         chcomp = Tcl_UniCharIsPrint;
1728         break;
1729     case STR_IS_PUNCT:
1730         chcomp = Tcl_UniCharIsPunct;
1731         break;
1732     case STR_IS_SPACE:
1733         chcomp = Tcl_UniCharIsSpace;
1734         break;
1735     case STR_IS_UPPER:
1736         chcomp = Tcl_UniCharIsUpper;
1737         break;
1738     case STR_IS_WORD:
1739         chcomp = Tcl_UniCharIsWordChar;
1740         break;
1741     case STR_IS_XDIGIT: {
1742         for (; string1 < end; string1++, failat++) {
1743       /* INTL: We assume unicode is bad for this class */
1744       if ((*((unsigned char *)string1) >= 0xC0) ||
1745           !isxdigit(*(unsigned char *)string1)) {
1746           result = 0;
1747           break;
1748       }
1749         }
1750         break;
1751     }
1752       }
1753       if (chcomp != NULL) {
1754     for (; string1 < end; string1 += length2, failat++) {
1755         length2 = TclUtfToUniChar(string1, &ch);
1756         if (!chcomp(ch)) {
1757       result = 0;
1758       break;
1759         }
1760     }
1761       }
1762   str_is_done:
1763       /*
1764        * Only set the failVarObj when we will return 0
1765        * and we have indicated a valid fail index (>= 0)
1766        */
1767       if ((result == 0) && (failVarObj != NULL)) {
1768     Tcl_Obj *resPtr, *tmpPtr = Tcl_NewIntObj(failat);
1769 
1770     Tcl_IncrRefCount(tmpPtr);
1771     resPtr = Tcl_ObjSetVar2(interp, failVarObj, NULL, tmpPtr,
1772       TCL_LEAVE_ERR_MSG);
1773     Tcl_DecrRefCount(tmpPtr);
1774     if (resPtr == NULL) {
1775         return TCL_ERROR;
1776     }
1777       }
1778       Tcl_SetBooleanObj(resultPtr, result);
1779       break;
1780   }
1781   case STR_LAST: {
1782       Tcl_UniChar *ustring1, *ustring2, *p;
1783       int match, start;
1784 
1785       if (objc < 4 || objc > 5) {
1786           Tcl_WrongNumArgs(interp, 2, objv,
1787          "subString string ?startIndex?");
1788     return TCL_ERROR;
1789       }
1790 
1791       /*
1792        * We are searching string2 for the sequence string1.
1793        */
1794 
1795       match = -1;
1796       start = 0;
1797       length2 = -1;
1798 
1799       ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1);
1800       ustring2 = Tcl_GetUnicodeFromObj(objv[3], &length2);
1801 
1802       if (objc == 5) {
1803     /*
1804      * If a startIndex is specified, we will need to restrict
1805      * the string range to that char index in the string
1806      */
1807     if (TclGetIntForIndex(interp, objv[4], length2 - 1,
1808       &start) != TCL_OK) {
1809         return TCL_ERROR;
1810     }
1811     if (start < 0) {
1812         goto str_last_done;
1813     } else if (start < length2) {
1814         p = ustring2 + start + 1 - length1;
1815     } else {
1816         p = ustring2 + length2 - length1;
1817     }
1818       } else {
1819     p = ustring2 + length2 - length1;
1820       }
1821 
1822       if (length1 > 0) {
1823     for (; p >= ustring2;  p--) {
1824         /*
1825          * Scan backwards to find the first character.
1826          */
1827         if ((*p == *ustring1) &&
1828           (memcmp((char *) ustring1, (char *) p, (size_t)
1829             (length1 * sizeof(Tcl_UniChar))) == 0)) {
1830       match = p - ustring2;
1831       break;
1832         }
1833     }
1834       }
1835 
1836       str_last_done:
1837       Tcl_SetIntObj(resultPtr, match);
1838       break;
1839   }
1840   case STR_BYTELENGTH:
1841   case STR_LENGTH: {
1842       if (objc != 3) {
1843           Tcl_WrongNumArgs(interp, 2, objv, "string");
1844     return TCL_ERROR;
1845       }
1846 
1847       if ((enum options) index == STR_BYTELENGTH) {
1848     (void) Tcl_GetStringFromObj(objv[2], &length1);
1849       } else {
1850     /*
1851      * If we have a ByteArray object, avoid recomputing the
1852      * string since the byte array contains one byte per
1853      * character.  Otherwise, use the Unicode string rep to
1854      * calculate the length.
1855      */
1856 
1857     if (objv[2]->typePtr == &tclByteArrayType) {
1858         (void) Tcl_GetByteArrayFromObj(objv[2], &length1);
1859     } else {
1860         length1 = Tcl_GetCharLength(objv[2]);
1861     }
1862       }
1863       Tcl_SetIntObj(resultPtr, length1);
1864       break;
1865   }
1866   case STR_MAP: {
1867       int mapElemc, nocase = 0, copySource = 0;
1868       Tcl_Obj **mapElemv, *sourceObj;
1869       Tcl_UniChar *ustring1, *ustring2, *p, *end;
1870       int (*strCmpFn)_ANSI_ARGS_((CONST Tcl_UniChar*,
1871           CONST Tcl_UniChar*, unsigned long));
1872 
1873       if (objc < 4 || objc > 5) {
1874           Tcl_WrongNumArgs(interp, 2, objv, "?-nocase? charMap string");
1875     return TCL_ERROR;
1876       }
1877 
1878       if (objc == 5) {
1879     string2 = Tcl_GetStringFromObj(objv[2], &length2);
1880     if ((length2 > 1) &&
1881         strncmp(string2, "-nocase", (size_t) length2) == 0) {
1882         nocase = 1;
1883     } else {
1884         Tcl_AppendStringsToObj(resultPtr, "bad option \"",
1885              string2, "\": must be -nocase",
1886              (char *) NULL);
1887         return TCL_ERROR;
1888     }
1889       }
1890 
1891       if (Tcl_ListObjGetElements(interp, objv[objc-2], &mapElemc,
1892                &mapElemv) != TCL_OK) {
1893     return TCL_ERROR;
1894       }
1895       if (mapElemc == 0) {
1896     /*
1897      * empty charMap, just return whatever string was given
1898      */
1899     Tcl_SetObjResult(interp, objv[objc-1]);
1900     return TCL_OK;
1901       } else if (mapElemc & 1) {
1902     /*
1903      * The charMap must be an even number of key/value items
1904      */
1905     Tcl_SetStringObj(resultPtr, "char map list unbalanced", -1);
1906     return TCL_ERROR;
1907       }
1908 
1909       /*
1910        * Take a copy of the source string object if it is the
1911        * same as the map string to cut out nasty sharing
1912        * crashes. [Bug 1018562]
1913        */
1914       if (objv[objc-2] == objv[objc-1]) {
1915     sourceObj = Tcl_DuplicateObj(objv[objc-1]);
1916     copySource = 1;
1917       } else {
1918     sourceObj = objv[objc-1];
1919       }
1920       ustring1 = Tcl_GetUnicodeFromObj(sourceObj, &length1);
1921       if (length1 == 0) {
1922     /*
1923      * Empty input string, just stop now
1924      */
1925     if (copySource) {
1926         Tcl_DecrRefCount(sourceObj);
1927     }
1928     break;
1929       }
1930       end = ustring1 + length1;
1931 
1932       strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;
1933 
1934       /*
1935        * Force result to be Unicode
1936        */
1937       Tcl_SetUnicodeObj(resultPtr, ustring1, 0);
1938 
1939       if (mapElemc == 2) {
1940     /*
1941      * Special case for one map pair which avoids the extra
1942      * for loop and extra calls to get Unicode data.  The
1943      * algorithm is otherwise identical to the multi-pair case.
1944      * This will be >30% faster on larger strings.
1945      */
1946     int mapLen;
1947     Tcl_UniChar *mapString, u2lc;
1948 
1949     ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
1950     p = ustring1;
1951     if ((length2 > length1) || (length2 == 0)) {
1952         /* match string is either longer than input or empty */
1953         ustring1 = end;
1954     } else {
1955         mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen);
1956         u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0);
1957         for (; ustring1 < end; ustring1++) {
1958       if (((*ustring1 == *ustring2) ||
1959         (nocase && (Tcl_UniCharToLower(*ustring1) ==
1960           u2lc))) &&
1961         ((length2 == 1) || strCmpFn(ustring1, ustring2,
1962           (unsigned long) length2) == 0)) {
1963           if (p != ustring1) {
1964         Tcl_AppendUnicodeToObj(resultPtr, p,
1965           ustring1 - p);
1966         p = ustring1 + length2;
1967           } else {
1968         p += length2;
1969           }
1970           ustring1 = p - 1;
1971 
1972           Tcl_AppendUnicodeToObj(resultPtr, mapString,
1973             mapLen);
1974       }
1975         }
1976     }
1977       } else {
1978     Tcl_UniChar **mapStrings, *u2lc = NULL;
1979     int *mapLens;
1980     /*
1981      * Precompute pointers to the unicode string and length.
1982      * This saves us repeated function calls later,
1983      * significantly speeding up the algorithm.  We only need
1984      * the lowercase first char in the nocase case.
1985      */
1986     mapStrings = (Tcl_UniChar **) ckalloc((mapElemc * 2)
1987       * sizeof(Tcl_UniChar *));
1988     mapLens = (int *) ckalloc((mapElemc * 2) * sizeof(int));
1989     if (nocase) {
1990         u2lc = (Tcl_UniChar *)
1991       ckalloc((mapElemc) * sizeof(Tcl_UniChar));
1992     }
1993     for (index = 0; index < mapElemc; index++) {
1994         mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
1995           &(mapLens[index]));
1996         if (nocase && ((index % 2) == 0)) {
1997       u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]);
1998         }
1999     }
2000     for (p = ustring1; ustring1 < end; ustring1++) {
2001         for (index = 0; index < mapElemc; index += 2) {
2002       /*
2003        * Get the key string to match on.
2004        */
2005       ustring2 = mapStrings[index];
2006       length2  = mapLens[index];
2007       if ((length2 > 0) && ((*ustring1 == *ustring2) ||
2008         (nocase && (Tcl_UniCharToLower(*ustring1) ==
2009           u2lc[index/2]))) &&
2010         /* restrict max compare length */
2011         ((end - ustring1) >= length2) &&
2012         ((length2 == 1) || strCmpFn(ustring2, ustring1,
2013           (unsigned long) length2) == 0)) {
2014           if (p != ustring1) {
2015         /*
2016          * Put the skipped chars onto the result first
2017          */
2018         Tcl_AppendUnicodeToObj(resultPtr, p,
2019           ustring1 - p);
2020         p = ustring1 + length2;
2021           } else {
2022         p += length2;
2023           }
2024           /*
2025            * Adjust len to be full length of matched string
2026            */
2027           ustring1 = p - 1;
2028 
2029           /*
2030            * Append the map value to the unicode string
2031            */
2032           Tcl_AppendUnicodeToObj(resultPtr,
2033             mapStrings[index+1], mapLens[index+1]);
2034           break;
2035       }
2036         }
2037     }
2038     ckfree((char *) mapStrings);
2039     ckfree((char *) mapLens);
2040     if (nocase) {
2041         ckfree((char *) u2lc);
2042     }
2043       }
2044       if (p != ustring1) {
2045     /*
2046      * Put the rest of the unmapped chars onto result
2047      */
2048     Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
2049       }
2050       if (copySource) {
2051     Tcl_DecrRefCount(sourceObj);
2052       }
2053       break;
2054   }
2055   case STR_MATCH: {
2056       Tcl_UniChar *ustring1, *ustring2;
2057       int nocase = 0;
2058 
2059       if (objc < 4 || objc > 5) {
2060           Tcl_WrongNumArgs(interp, 2, objv, "?-nocase? pattern string");
2061     return TCL_ERROR;
2062       }
2063 
2064       if (objc == 5) {
2065     string2 = Tcl_GetStringFromObj(objv[2], &length2);
2066     if ((length2 > 1) &&
2067         strncmp(string2, "-nocase", (size_t) length2) == 0) {
2068         nocase = 1;
2069     } else {
2070         Tcl_AppendStringsToObj(resultPtr, "bad option \"",
2071              string2, "\": must be -nocase",
2072              (char *) NULL);
2073         return TCL_ERROR;
2074     }
2075       }
2076       ustring1 = Tcl_GetUnicodeFromObj(objv[objc-1], &length1);
2077       ustring2 = Tcl_GetUnicodeFromObj(objv[objc-2], &length2);
2078       Tcl_SetBooleanObj(resultPtr, TclUniCharMatch(ustring1, length1,
2079         ustring2, length2, nocase));
2080       break;
2081   }
2082   case STR_RANGE: {
2083       int first, last;
2084 
2085       if (objc != 5) {
2086           Tcl_WrongNumArgs(interp, 2, objv, "string first last");
2087     return TCL_ERROR;
2088       }
2089 
2090       /*
2091        * If we have a ByteArray object, avoid indexing in the
2092        * Utf string since the byte array contains one byte per
2093        * character.  Otherwise, use the Unicode string rep to
2094        * get the range.
2095        */
2096 
2097       if (objv[2]->typePtr == &tclByteArrayType) {
2098     string1 = (char *)Tcl_GetByteArrayFromObj(objv[2], &length1);
2099     length1--;
2100       } else {
2101     /*
2102      * Get the length in actual characters.
2103      */
2104     string1 = NULL;
2105     length1 = Tcl_GetCharLength(objv[2]) - 1;
2106       }
2107 
2108       if ((TclGetIntForIndex(interp, objv[3], length1, &first) != TCL_OK)
2109         || (TclGetIntForIndex(interp, objv[4], length1,
2110           &last) != TCL_OK)) {
2111     return TCL_ERROR;
2112       }
2113 
2114       if (first < 0) {
2115     first = 0;
2116       }
2117       if (last >= length1) {
2118     last = length1;
2119       }
2120       if (last >= first) {
2121     if (string1 != NULL) {
2122         int numBytes = last - first + 1;
2123         resultPtr = Tcl_NewByteArrayObj(
2124       (unsigned char *) &string1[first], numBytes);
2125         Tcl_SetObjResult(interp, resultPtr);
2126     } else {
2127         Tcl_SetObjResult(interp,
2128           Tcl_GetRange(objv[2], first, last));
2129     }
2130       }
2131       break;
2132   }
2133   case STR_REPEAT: {
2134       int count;
2135 
2136       if (objc != 4) {
2137     Tcl_WrongNumArgs(interp, 2, objv, "string count");
2138     return TCL_ERROR;
2139       }
2140 
2141       if (Tcl_GetIntFromObj(interp, objv[3], &count) != TCL_OK) {
2142     return TCL_ERROR;
2143       }
2144 
2145       if (count == 1) {
2146     Tcl_SetObjResult(interp, objv[2]);
2147       } else if (count > 1) {
2148     string1 = Tcl_GetStringFromObj(objv[2], &length1);
2149     if (length1 > 0) {
2150         /*
2151          * Only build up a string that has data.  Instead of
2152          * building it up with repeated appends, we just allocate
2153          * the necessary space once and copy the string value in.
2154          * Check for overflow with back-division. [Bug #714106]
2155          */
2156         length2   = length1 * count;
2157         if ((length2 / count) != length1) {
2158       char buf[TCL_INTEGER_SPACE+1];
2159       sprintf(buf, "%d", INT_MAX);
2160       Tcl_AppendStringsToObj(resultPtr,
2161         "string size overflow, must be less than ",
2162         buf, (char *) NULL);
2163       return TCL_ERROR;
2164         }
2165         /*
2166          * Include space for the NULL
2167          */
2168         string2   = (char *) ckalloc((size_t) length2+1);
2169         for (index = 0; index < count; index++) {
2170       memcpy(string2 + (length1 * index), string1,
2171         (size_t) length1);
2172         }
2173         string2[length2]  = '\0';
2174         /*
2175          * We have to directly assign this instead of using
2176          * Tcl_SetStringObj (and indirectly TclInitStringRep)
2177          * because that makes another copy of the data.
2178          */
2179         resultPtr   = Tcl_NewObj();
2180         resultPtr->bytes  = string2;
2181         resultPtr->length = length2;
2182         Tcl_SetObjResult(interp, resultPtr);
2183     }
2184       }
2185       break;
2186   }
2187   case STR_REPLACE: {
2188       Tcl_UniChar *ustring1;
2189       int first, last;
2190 
2191       if (objc < 5 || objc > 6) {
2192           Tcl_WrongNumArgs(interp, 2, objv,
2193          "string first last ?string?");
2194     return TCL_ERROR;
2195       }
2196 
2197       ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1);
2198       length1--;
2199 
2200       if ((TclGetIntForIndex(interp, objv[3], length1, &first) != TCL_OK)
2201         || (TclGetIntForIndex(interp, objv[4], length1,
2202           &last) != TCL_OK)) {
2203     return TCL_ERROR;
2204       }
2205 
2206       if ((last < first) || (last < 0) || (first > length1)) {
2207     Tcl_SetObjResult(interp, objv[2]);
2208       } else {
2209     if (first < 0) {
2210         first = 0;
2211     }
2212 
2213     Tcl_SetUnicodeObj(resultPtr, ustring1, first);
2214     if (objc == 6) {
2215         Tcl_AppendObjToObj(resultPtr, objv[5]);
2216     }
2217     if (last < length1) {
2218         Tcl_AppendUnicodeToObj(resultPtr, ustring1 + last + 1,
2219           length1 - last);
2220     }
2221       }
2222       break;
2223   }
2224   case STR_TOLOWER:
2225   case STR_TOUPPER:
2226   case STR_TOTITLE:
2227       if (objc < 3 || objc > 5) {
2228           Tcl_WrongNumArgs(interp, 2, objv, "string ?first? ?last?");
2229     return TCL_ERROR;
2230       }
2231 
2232       string1 = Tcl_GetStringFromObj(objv[2], &length1);
2233 
2234       if (objc == 3) {
2235     /*
2236      * Since the result object is not a shared object, it is
2237      * safe to copy the string into the result and do the
2238      * conversion in place.  The conversion may change the length
2239      * of the string, so reset the length after conversion.
2240      */
2241 
2242     Tcl_SetStringObj(resultPtr, string1, length1);
2243     if ((enum options) index == STR_TOLOWER) {
2244         length1 = Tcl_UtfToLower(Tcl_GetString(resultPtr));
2245     } else if ((enum options) index == STR_TOUPPER) {
2246         length1 = Tcl_UtfToUpper(Tcl_GetString(resultPtr));
2247     } else {
2248         length1 = Tcl_UtfToTitle(Tcl_GetString(resultPtr));
2249     }
2250     Tcl_SetObjLength(resultPtr, length1);
2251       } else {
2252     int first, last;
2253     CONST char *start, *end;
2254 
2255     length1 = Tcl_NumUtfChars(string1, length1) - 1;
2256     if (TclGetIntForIndex(interp, objv[3], length1,
2257               &first) != TCL_OK) {
2258         return TCL_ERROR;
2259     }
2260     if (first < 0) {
2261         first = 0;
2262     }
2263     last = first;
2264     if ((objc == 5) && (TclGetIntForIndex(interp, objv[4], length1,
2265                   &last) != TCL_OK)) {
2266         return TCL_ERROR;
2267     }
2268     if (last >= length1) {
2269         last = length1;
2270     }
2271     if (last < first) {
2272         Tcl_SetObjResult(interp, objv[2]);
2273         break;
2274     }
2275     start = Tcl_UtfAtIndex(string1, first);
2276     end = Tcl_UtfAtIndex(start, last - first + 1);
2277     length2 = end-start;
2278     string2 = ckalloc((size_t) length2+1);
2279     memcpy(string2, start, (size_t) length2);
2280     string2[length2] = '\0';
2281     if ((enum options) index == STR_TOLOWER) {
2282         length2 = Tcl_UtfToLower(string2);
2283     } else if ((enum options) index == STR_TOUPPER) {
2284         length2 = Tcl_UtfToUpper(string2);
2285     } else {
2286         length2 = Tcl_UtfToTitle(string2);
2287     }
2288     Tcl_SetStringObj(resultPtr, string1, start - string1);
2289     Tcl_AppendToObj(resultPtr, string2, length2);
2290     Tcl_AppendToObj(resultPtr, end, -1);
2291     ckfree(string2);
2292       }
2293       break;
2294 
2295   case STR_TRIM: {
2296       Tcl_UniChar ch, trim;
2297       register CONST char *p, *end;
2298       char *check, *checkEnd;
2299       int offset;
2300 
2301       left = 1;
2302       right = 1;
2303 
2304       dotrim:
2305       if (objc == 4) {
2306     string2 = Tcl_GetStringFromObj(objv[3], &length2);
2307       } else if (objc == 3) {
2308     string2 = " \t\n\r";
2309     length2 = strlen(string2);
2310       } else {
2311           Tcl_WrongNumArgs(interp, 2, objv, "string ?chars?");
2312     return TCL_ERROR;
2313       }
2314       string1 = Tcl_GetStringFromObj(objv[2], &length1);
2315       checkEnd = string2 + length2;
2316 
2317       if (left) {
2318     end = string1 + length1;
2319     /*
2320      * The outer loop iterates over the string.  The inner
2321      * loop iterates over the trim characters.  The loops
2322      * terminate as soon as a non-trim character is discovered
2323      * and string1 is left pointing at the first non-trim
2324      * character.
2325      */
2326 
2327     for (p = string1; p < end; p += offset) {
2328         offset = TclUtfToUniChar(p, &ch);
2329         
2330         for (check = string2; ; ) {
2331       if (check >= checkEnd) {
2332           p = end;
2333           break;
2334       }
2335       check += TclUtfToUniChar(check, &trim);
2336       if (ch == trim) {
2337           length1 -= offset;
2338           string1 += offset;
2339           break;
2340       }
2341         }
2342     }
2343       }
2344       if (right) {
2345           end = string1;
2346 
2347     /*
2348      * The outer loop iterates over the string.  The inner
2349      * loop iterates over the trim characters.  The loops
2350      * terminate as soon as a non-trim character is discovered
2351      * and length1 marks the last non-trim character.
2352      */
2353 
2354     for (p = string1 + length1; p > end; ) {
2355         p = Tcl_UtfPrev(p, string1);
2356         offset = TclUtfToUniChar(p, &ch);
2357         for (check = string2; ; ) {
2358             if (check >= checkEnd) {
2359           p = end;
2360           break;
2361       }
2362       check += TclUtfToUniChar(check, &trim);
2363       if (ch == trim) {
2364           length1 -= offset;
2365           break;
2366       }
2367         }
2368     }
2369       }
2370       Tcl_SetStringObj(resultPtr, string1, length1);
2371       break;
2372   }
2373   case STR_TRIMLEFT: {
2374       left = 1;
2375       right = 0;
2376       goto dotrim;
2377   }
2378   case STR_TRIMRIGHT: {
2379       left = 0;
2380       right = 1;
2381       goto dotrim;
2382   }
2383   case STR_WORDEND: {
2384       int cur;
2385       Tcl_UniChar ch;
2386       CONST char *p, *end;
2387       int numChars;
2388       
2389       if (objc != 4) {
2390           Tcl_WrongNumArgs(interp, 2, objv, "string index");
2391     return TCL_ERROR;
2392       }
2393 
2394       string1 = Tcl_GetStringFromObj(objv[2], &length1);
2395       numChars = Tcl_NumUtfChars(string1, length1);
2396       if (TclGetIntForIndex(interp, objv[3], numChars-1,
2397           &index) != TCL_OK) {
2398     return TCL_ERROR;
2399       }
2400       if (index < 0) {
2401     index = 0;
2402       }
2403       if (index < numChars) {
2404     p = Tcl_UtfAtIndex(string1, index);
2405     end = string1+length1;
2406     for (cur = index; p < end; cur++) {
2407         p += TclUtfToUniChar(p, &ch);
2408         if (!Tcl_UniCharIsWordChar(ch)) {
2409       break;
2410         }
2411     }
2412     if (cur == index) {
2413         cur++;
2414     }
2415       } else {
2416     cur = numChars;
2417       }
2418       Tcl_SetIntObj(resultPtr, cur);
2419       break;
2420   }
2421   case STR_WORDSTART: {
2422       int cur;
2423       Tcl_UniChar ch;
2424       CONST char *p;
2425       int numChars;
2426       
2427       if (objc != 4) {
2428           Tcl_WrongNumArgs(interp, 2, objv, "string index");
2429     return TCL_ERROR;
2430       }
2431 
2432       string1 = Tcl_GetStringFromObj(objv[2], &length1);
2433       numChars = Tcl_NumUtfChars(string1, length1);
2434       if (TclGetIntForIndex(interp, objv[3], numChars-1,
2435           &index) != TCL_OK) {
2436     return TCL_ERROR;
2437       }
2438       if (index >= numChars) {
2439     index = numChars - 1;
2440       }
2441       cur = 0;
2442       if (index > 0) {
2443     p = Tcl_UtfAtIndex(string1, index);
2444           for (cur = index; cur >= 0; cur--) {
2445         TclUtfToUniChar(p, &ch);
2446         if (!Tcl_UniCharIsWordChar(ch)) {
2447       break;
2448         }
2449         p = Tcl_UtfPrev(p, string1);
2450     }
2451     if (cur != index) {
2452         cur += 1;
2453     }
2454       }
2455       Tcl_SetIntObj(resultPtr, cur);
2456       break;
2457   }
2458     }
2459     return TCL_OK;
2460 }
Tcl_Obj* Tcl_SubstObj (Tcl_Interp * interp, Tcl_Obj * objPtr, int flags)

Definition at line 2576 of file tclCmdMZ.c.
References Interp::evalFlags, NULL, Interp::numLevels, parse(), Tcl_AppendObjToObj(), Tcl_AppendToObj(), TCL_BRACKET_TERM, TCL_BREAK, TCL_CONTINUE, Tcl_DecrRefCount, TCL_ERROR, Tcl_EvalEx(), Tcl_EvalTokensStandard(), Tcl_GetObjResult(), Tcl_GetStringFromObj(), Tcl_NewStringObj(), TCL_OK, Tcl_ParseVarName(), Tcl_ResetResult(), TCL_SUBST_BACKSLASHES, TCL_SUBST_COMMANDS, TCL_SUBST_VARIABLES, TCL_UTF_MAX, Tcl_UtfBackslash(), TclInterpReady(), and Interp::termOffset.
Referenced by Tcl_SubstObjCmd().2580 {
2581     Tcl_Obj *resultObj;
2582     char *p, *old;
2583     int length;
2584 
2585     old = p = Tcl_GetStringFromObj(objPtr, &length);
2586     resultObj = Tcl_NewStringObj("", 0);
2587     while (length) {
2588   switch (*p) {
2589   case '\\':
2590       if (flags & TCL_SUBST_BACKSLASHES) {
2591     char buf[TCL_UTF_MAX];
2592     int count;
2593 
2594     if (p != old) {
2595         Tcl_AppendToObj(resultObj, old, p-old);
2596     }
2597     Tcl_AppendToObj(resultObj, buf,
2598         Tcl_UtfBackslash(p, &count, buf));
2599     p += count; length -= count;
2600     old = p;
2601       } else {
2602     p++; length--;
2603       }
2604       break;
2605 
2606   case '$':
2607       if (flags & TCL_SUBST_VARIABLES) {
2608     Tcl_Parse parse;
2609     int code;
2610 
2611     /*
2612      * Code is simpler overall if we (effectively) inline
2613      * Tcl_ParseVar, particularly as that allows us to use
2614      * a non-string interface when we come to appending
2615      * the variable contents to the result object.  There
2616      * are a few other optimisations that doing this
2617      * enables (like being able to continue the run of
2618      * unsubstituted characters straight through if a '$'
2619      * does not precede a variable name.)
2620      */
2621     if (Tcl_ParseVarName(interp, p, -1, &parse, 0) != TCL_OK) {
2622         goto errorResult;
2623     }
2624     if (parse.numTokens == 1) {
2625         /*
2626          * There isn't a variable name after all: the $ is
2627          * just a $.
2628          */
2629         p++; length--;
2630         break;
2631     }
2632     if (p != old) {
2633         Tcl_AppendToObj(resultObj, old, p-old);
2634     }
2635     p += parse.tokenPtr->size;
2636     length -= parse.tokenPtr->size;
2637     code = Tcl_EvalTokensStandard(interp, parse.tokenPtr,
2638             parse.numTokens);
2639     if (code == TCL_ERROR) {
2640         goto errorResult;
2641     }
2642     if (code == TCL_BREAK) {
2643         Tcl_ResetResult(interp);
2644         return resultObj;
2645     }
2646     if (code != TCL_CONTINUE) {
2647         Tcl_AppendObjToObj(resultObj, Tcl_GetObjResult(interp));
2648     }
2649     Tcl_ResetResult(interp);
2650     old = p;
2651       } else {
2652     p++; length--;
2653       }
2654       break;
2655 
2656   case '[':
2657       if (flags & TCL_SUBST_COMMANDS) {
2658     Interp *iPtr = (Interp *) interp;
2659     int code;
2660 
2661     if (p != old) {
2662         Tcl_AppendToObj(resultObj, old, p-old);
2663     }
2664     iPtr->evalFlags = TCL_BRACKET_TERM;
2665     iPtr->numLevels++;
2666     code = TclInterpReady(interp);
2667     if (code == TCL_OK) {
2668         code = Tcl_EvalEx(interp, p+1, -1, 0);
2669     }
2670     iPtr->numLevels--;
2671     switch (code) {
2672     case TCL_ERROR:
2673         goto errorResult;
2674     case TCL_BREAK:
2675         Tcl_ResetResult(interp);
2676         return resultObj;
2677     default:
2678         Tcl_AppendObjToObj(resultObj, Tcl_GetObjResult(interp));
2679     case TCL_CONTINUE:
2680         Tcl_ResetResult(interp);
2681         old = p = (p+1 + iPtr->termOffset + 1);
2682         length -= (iPtr->termOffset + 2);
2683     }
2684       } else {
2685     p++; length--;
2686       }
2687       break;
2688   default:
2689       p++; length--;
2690       break;
2691   }
2692     }
2693     if (p != old) {
2694   Tcl_AppendToObj(resultObj, old, p-old);
2695     }
2696     return resultObj;
2697 
2698  errorResult:
2699     Tcl_DecrRefCount(resultObj);
2700     return NULL;
2701 }
int Tcl_SubstObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 2482 of file tclCmdMZ.c.
References CONST, NULL, panic, TCL_ERROR, Tcl_GetIndexFromObj(), TCL_OK, Tcl_SetObjResult(), TCL_SUBST_ALL, TCL_SUBST_BACKSLASHES, TCL_SUBST_COMMANDS, TCL_SUBST_VARIABLES, Tcl_SubstObj(), and Tcl_WrongNumArgs().2487 {
2488     static CONST char *substOptions[] = {
2489   "-nobackslashes", "-nocommands", "-novariables", (char *) NULL
2490     };
2491     enum substOptions {
2492   SUBST_NOBACKSLASHES,      SUBST_NOCOMMANDS,       SUBST_NOVARS
2493     };
2494     Tcl_Obj *resultPtr;
2495     int optionIndex, flags, i;
2496 
2497     /*
2498      * Parse command-line options.
2499      */
2500 
2501     flags = TCL_SUBST_ALL;
2502     for (i = 1; i < (objc-1); i++) {
2503   if (Tcl_GetIndexFromObj(interp, objv[i], substOptions,
2504     "switch", 0, &optionIndex) != TCL_OK) {
2505 
2506       return TCL_ERROR;
2507   }
2508   switch (optionIndex) {
2509       case SUBST_NOBACKSLASHES: {
2510     flags &= ~TCL_SUBST_BACKSLASHES;
2511     break;
2512       }
2513       case SUBST_NOCOMMANDS: {
2514     flags &= ~TCL_SUBST_COMMANDS;
2515     break;
2516       }
2517       case SUBST_NOVARS: {
2518     flags &= ~TCL_SUBST_VARIABLES;
2519     break;
2520       }
2521       default: {
2522     panic("Tcl_SubstObjCmd: bad option index to SubstOptions");
2523       }
2524   }
2525     }
2526     if (i != (objc-1)) {
2527   Tcl_WrongNumArgs(interp, 1, objv,
2528     "?-nobackslashes? ?-nocommands? ?-novariables? string");
2529   return TCL_ERROR;
2530     }
2531 
2532     /*
2533      * Perform the substitution.
2534      */
2535     resultPtr = Tcl_SubstObj(interp, objv[i], flags);
2536 
2537     if (resultPtr == NULL) {
2538   return TCL_ERROR;
2539     }
2540     Tcl_SetObjResult(interp, resultPtr);
2541     return TCL_OK;
2542 }
int Tcl_SwitchObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 2722 of file tclCmdMZ.c.
References CONST, Tcl_Interp::errorLine, NULL, panic, Tcl_AddObjErrorInfo(), TCL_ERROR, Tcl_EvalObjEx(), Tcl_GetIndexFromObj(), Tcl_GetString(), TCL_INTEGER_SPACE, Tcl_ListObjGetElements(), TCL_OK, Tcl_RegExpMatchObj(), Tcl_ResetResult(), Tcl_StringMatch(), and Tcl_WrongNumArgs().2727 {
2728     int i, j, index, mode, matched, result, splitObjs;
2729     char *string, *pattern;
2730     Tcl_Obj *stringObj;
2731     Tcl_Obj *CONST *savedObjv = objv;
2732     static CONST char *options[] = {
2733   "-exact", "-glob",  "-regexp",  "--", 
2734   NULL
2735     };
2736     enum options {
2737   OPT_EXACT,  OPT_GLOB, OPT_REGEXP, OPT_LAST
2738     };
2739 
2740     mode = OPT_EXACT;
2741     for (i = 1; i < objc; i++) {
2742   string = Tcl_GetString(objv[i]);
2743   if (string[0] != '-') {
2744       break;
2745   }
2746   if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, 
2747     &index) != TCL_OK) {
2748       return TCL_ERROR;
2749   }
2750   if (index == OPT_LAST) {
2751       i++;
2752       break;
2753   }
2754   mode = index;
2755     }
2756 
2757     if (objc - i < 2) {
2758   Tcl_WrongNumArgs(interp, 1, objv,
2759     "?switches? string pattern body ... ?default body?");
2760   return TCL_ERROR;
2761     }
2762 
2763     stringObj = objv[i];
2764     objc -= i + 1;
2765     objv += i + 1;
2766 
2767     /*
2768      * If all of the pattern/command pairs are lumped into a single
2769      * argument, split them out again.
2770      */
2771 
2772     splitObjs = 0;
2773     if (objc == 1) {
2774   Tcl_Obj **listv;
2775 
2776   if (Tcl_ListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK) {
2777       return TCL_ERROR;
2778   }
2779 
2780   /*
2781    * Ensure that the list is non-empty.
2782    */
2783 
2784   if (objc < 1) {
2785       Tcl_WrongNumArgs(interp, 1, savedObjv,
2786         "?switches? string {pattern body ... ?default body?}");
2787       return TCL_ERROR;
2788   }
2789   objv = listv;
2790   splitObjs = 1;
2791     }
2792 
2793     /*
2794      * Complain if there is an odd number of words in the list of
2795      * patterns and bodies.
2796      */
2797 
2798     if (objc % 2) {
2799   Tcl_ResetResult(interp);
2800   Tcl_AppendResult(interp, "extra switch pattern with no body", NULL);
2801 
2802   /*
2803    * Check if this can be due to a badly placed comment
2804    * in the switch block.
2805    *
2806    * The following is an heuristic to detect the infamous
2807    * "comment in switch" error: just check if a pattern
2808    * begins with '#'.
2809    */
2810 
2811   if (splitObjs) {
2812       for (i=0 ; i<objc ; i+=2) {
2813     if (Tcl_GetString(objv[i])[0] == '#') {
2814         Tcl_AppendResult(interp, ", this may be due to a ",
2815           "comment incorrectly placed outside of a ",
2816           "switch body - see the \"switch\" ",
2817           "documentation", NULL);
2818         break;
2819     }
2820       }
2821   }
2822 
2823   return TCL_ERROR;
2824     }
2825 
2826     /*
2827      * Complain if the last body is a continuation.  Note that this
2828      * check assumes that the list is non-empty!
2829      */
2830 
2831     if (strcmp(Tcl_GetString(objv[objc-1]), "-") == 0) {
2832   Tcl_ResetResult(interp);
2833   Tcl_AppendResult(interp, "no body specified for pattern \"",
2834     Tcl_GetString(objv[objc-2]), "\"", NULL);
2835   return TCL_ERROR;
2836     }
2837 
2838     for (i = 0; i < objc; i += 2) {
2839   /*
2840    * See if the pattern matches the string.
2841    */
2842 
2843   pattern = Tcl_GetString(objv[i]);
2844 
2845   matched = 0;
2846   if ((i == objc - 2) 
2847     && (*pattern == 'd') 
2848     && (strcmp(pattern, "default") == 0)) {
2849       matched = 1;
2850   } else {
2851       switch (mode) {
2852     case OPT_EXACT:
2853         matched = (strcmp(Tcl_GetString(stringObj), pattern) == 0);
2854         break;
2855     case OPT_GLOB:
2856         matched = Tcl_StringMatch(Tcl_GetString(stringObj),
2857           pattern);
2858         break;
2859     case OPT_REGEXP:
2860         matched = Tcl_RegExpMatchObj(interp, stringObj, objv[i]);
2861         if (matched < 0) {
2862       return TCL_ERROR;
2863         }
2864         break;
2865       }
2866   }
2867   if (matched == 0) {
2868       continue;
2869   }
2870 
2871   /*
2872    * We've got a match. Find a body to execute, skipping bodies
2873    * that are "-".
2874    */
2875 
2876   for (j = i + 1; ; j += 2) {
2877       if (j >= objc) {
2878     /*
2879      * This shouldn't happen since we've checked that the
2880      * last body is not a continuation...
2881      */
2882     panic("fall-out when searching for body to match pattern");
2883       }
2884       if (strcmp(Tcl_GetString(objv[j]), "-") != 0) {
2885     break;
2886       }
2887   }
2888   result = Tcl_EvalObjEx(interp, objv[j], 0);
2889   if (result == TCL_ERROR) {
2890       char msg[100 + TCL_INTEGER_SPACE];
2891 
2892       sprintf(msg, "\n    (\"%.50s\" arm line %d)", pattern,
2893         interp->errorLine);
2894       Tcl_AddObjErrorInfo(interp, msg, -1);
2895   }
2896   return result;
2897     }
2898     return TCL_OK;
2899 }
int Tcl_TimeObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 2920 of file tclCmdMZ.c.
References Tcl_Time::sec, TCL_ERROR, Tcl_EvalObjEx(), Tcl_GetIntFromObj(), Tcl_GetTime(), Tcl_NewDoubleObj(), Tcl_NewIntObj(), Tcl_NewListObj(), Tcl_NewStringObj(), TCL_OK, Tcl_SetObjResult(), Tcl_WrongNumArgs(), and Tcl_Time::usec.2925 {
2926     register Tcl_Obj *objPtr;
2927     Tcl_Obj *objs[4];
2928     register int i, result;
2929     int count;
2930     double totalMicroSec;
2931     Tcl_Time start, stop;
2932 
2933     if (objc == 2) {
2934   count = 1;
2935     } else if (objc == 3) {
2936   result = Tcl_GetIntFromObj(interp, objv[2], &count);
2937   if (result != TCL_OK) {
2938       return result;
2939   }
2940     } else {
2941   Tcl_WrongNumArgs(interp, 1, objv, "command ?count?");
2942   return TCL_ERROR;
2943     }
2944     
2945     objPtr = objv[1];
2946     i = count;
2947     Tcl_GetTime(&start);
2948     while (i-- > 0) {
2949   result = Tcl_EvalObjEx(interp, objPtr, 0);
2950   if (result != TCL_OK) {
2951       return result;
2952   }
2953     }
2954     Tcl_GetTime(&stop);
2955     
2956     totalMicroSec = ( ( (double) ( stop.sec - start.sec ) ) * 1.0e6
2957           + ( stop.usec - start.usec ) );
2958     if (count <= 1) {
2959   /* Use int obj since we know time is not fractional [Bug 1202178] */
2960   objs[0] = Tcl_NewIntObj((count <= 0) ? 0 : (int) totalMicroSec);
2961     } else {
2962   objs[0] = Tcl_NewDoubleObj(totalMicroSec/count);
2963     }
2964     objs[1] = Tcl_NewStringObj("microseconds", -1);
2965     objs[2] = Tcl_NewStringObj("per", -1);
2966     objs[3] = Tcl_NewStringObj("iteration", -1);
2967     Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs));
2968     return TCL_OK;
2969 }
int Tcl_TraceCommand (Tcl_Interp * interp, CONST char * cmdName, int flags, Tcl_CommandTraceProc * proc, ClientData clientData)

Definition at line 3908 of file tclCmdMZ.c.
References ckalloc, CommandTrace::clientData, CMD_HAS_EXEC_TRACES, Command::flags, CommandTrace::flags, CommandTrace::nextPtr, NULL, CommandTrace::refCount, TCL_ERROR, Tcl_FindCommand(), TCL_LEAVE_ERR_MSG, TCL_OK, TCL_TRACE_ANY_EXEC, TCL_TRACE_DELETE, TCL_TRACE_RENAME, CommandTrace::traceProc, and Command::tracePtr.
Referenced by TclTraceCommandObjCmd(), and TclTraceExecutionObjCmd().3918 {
3919     Command *cmdPtr;
3920     register CommandTrace *tracePtr;
3921 
3922     cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName,
3923       NULL, TCL_LEAVE_ERR_MSG);
3924     if (cmdPtr == NULL) {
3925   return TCL_ERROR;
3926     }
3927 
3928     /*
3929      * Set up trace information.
3930      */
3931 
3932     tracePtr = (CommandTrace *) ckalloc(sizeof(CommandTrace));
3933     tracePtr->traceProc = proc;
3934     tracePtr->clientData = clientData;
3935     tracePtr->flags = flags & (TCL_TRACE_RENAME | TCL_TRACE_DELETE
3936              | TCL_TRACE_ANY_EXEC);
3937     tracePtr->nextPtr = cmdPtr->tracePtr;
3938     tracePtr->refCount = 1;
3939     cmdPtr->tracePtr = tracePtr;
3940     if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
3941         cmdPtr->flags |= CMD_HAS_EXEC_TRACES;
3942     }
3943     return TCL_OK;
3944 }
int Tcl_TraceObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 2994 of file tclCmdMZ.c.
References TraceVarInfo::command, CONST, TraceVarInfo::flags, NULL, Tcl_DecrRefCount, TCL_ERROR, Tcl_GetIndexFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_ListObjAppendElement(), Tcl_NewListObj(), Tcl_NewObj(), Tcl_NewStringObj(), TCL_OK, Tcl_SetObjResult(), TCL_TRACE_ARRAY, TCL_TRACE_READS, TCL_TRACE_UNSETS, TCL_TRACE_WRITES, Tcl_VarTraceInfo(), Tcl_WrongNumArgs(), and TraceVarProc().2999 {
3000     int optionIndex;
3001     char *name, *flagOps, *p;
3002     /* Main sub commands to 'trace' */
3003     static CONST char *traceOptions[] = {
3004   "add", "info", "remove", 
3005 #ifndef TCL_REMOVE_OBSOLETE_TRACES
3006   "variable", "vdelete", "vinfo", 
3007 #endif
3008   (char *) NULL
3009     };
3010     /* 'OLD' options are pre-Tcl-8.4 style */
3011     enum traceOptions {
3012   TRACE_ADD, TRACE_INFO, TRACE_REMOVE, 
3013 #ifndef TCL_REMOVE_OBSOLETE_TRACES
3014   TRACE_OLD_VARIABLE, TRACE_OLD_VDELETE, TRACE_OLD_VINFO
3015 #endif
3016     };
3017 
3018     if (objc < 2) {
3019   Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
3020   return TCL_ERROR;
3021     }
3022 
3023     if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions,
3024     "option", 0, &optionIndex) != TCL_OK) {
3025   return TCL_ERROR;
3026     }
3027     switch ((enum traceOptions) optionIndex) {
3028   case TRACE_ADD: 
3029   case TRACE_REMOVE:
3030   case TRACE_INFO: {
3031       /* 
3032        * All sub commands of trace add/remove must take at least
3033        * one more argument.  Beyond that we let the subcommand itself
3034        * control the argument structure.
3035        */
3036       int typeIndex;
3037       if (objc < 3) {
3038     Tcl_WrongNumArgs(interp, 2, objv, "type ?arg arg ...?");
3039     return TCL_ERROR;
3040       }
3041       if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions,
3042       "option", 0, &typeIndex) != TCL_OK) {
3043     return TCL_ERROR;
3044       }
3045       return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv);
3046   }
3047 #ifndef TCL_REMOVE_OBSOLETE_TRACES
3048         case TRACE_OLD_VARIABLE:
3049   case TRACE_OLD_VDELETE: {
3050       Tcl_Obj *copyObjv[6];
3051       Tcl_Obj *opsList;
3052       int code, numFlags;
3053 
3054       if (objc != 5) {
3055     Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
3056     return TCL_ERROR;
3057       }
3058 
3059       opsList = Tcl_NewObj();
3060       Tcl_IncrRefCount(opsList);
3061       flagOps = Tcl_GetStringFromObj(objv[3], &numFlags);
3062       if (numFlags == 0) {
3063     Tcl_DecrRefCount(opsList);
3064     goto badVarOps;
3065       }
3066       for (p = flagOps; *p != 0; p++) {
3067     if (*p == 'r') {
3068         Tcl_ListObjAppendElement(NULL, opsList,
3069           Tcl_NewStringObj("read", -1));
3070     } else if (*p == 'w') {
3071         Tcl_ListObjAppendElement(NULL, opsList,
3072           Tcl_NewStringObj("write", -1));
3073     } else if (*p == 'u') {
3074         Tcl_ListObjAppendElement(NULL, opsList,
3075           Tcl_NewStringObj("unset", -1));
3076     } else if (*p == 'a') {
3077         Tcl_ListObjAppendElement(NULL, opsList,
3078           Tcl_NewStringObj("array", -1));
3079     } else {
3080         Tcl_DecrRefCount(opsList);
3081         goto badVarOps;
3082     }
3083       }
3084       copyObjv[0] = NULL;
3085       memcpy(copyObjv+1, objv, objc*sizeof(Tcl_Obj *));
3086       copyObjv[4] = opsList;
3087       if  (optionIndex == TRACE_OLD_VARIABLE) {
3088     code = (traceSubCmds[2])(interp,TRACE_ADD,objc+1,copyObjv);
3089       } else {
3090     code = (traceSubCmds[2])(interp,TRACE_REMOVE,objc+1,copyObjv);
3091       }
3092       Tcl_DecrRefCount(opsList);
3093       return code;
3094   }
3095   case TRACE_OLD_VINFO: {
3096       ClientData clientData;
3097       char ops[5];
3098       Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr;
3099 
3100       if (objc != 3) {
3101     Tcl_WrongNumArgs(interp, 2, objv, "name");
3102     return TCL_ERROR;
3103       }
3104       resultListPtr = Tcl_GetObjResult(interp);
3105       clientData = 0;
3106       name = Tcl_GetString(objv[2]);
3107       while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
3108         TraceVarProc, clientData)) != 0) {
3109 
3110     TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
3111 
3112     pairObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
3113     p = ops;
3114     if (tvarPtr->flags & TCL_TRACE_READS) {
3115         *p = 'r';
3116         p++;
3117     }
3118     if (tvarPtr->flags & TCL_TRACE_WRITES) {
3119         *p = 'w';
3120         p++;
3121     }
3122     if (tvarPtr->flags & TCL_TRACE_UNSETS) {
3123         *p = 'u';
3124         p++;
3125     }
3126     if (tvarPtr->flags & TCL_TRACE_ARRAY) {
3127         *p = 'a';
3128         p++;
3129     }
3130     *p = '\0';
3131 
3132     /*
3133      * Build a pair (2-item list) with the ops string as
3134      * the first obj element and the tvarPtr->command string
3135      * as the second obj element.  Append the pair (as an
3136      * element) to the end of the result object list.
3137      */
3138 
3139     elemObjPtr = Tcl_NewStringObj(ops, -1);
3140     Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
3141     elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
3142     Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
3143     Tcl_ListObjAppendElement(interp, resultListPtr, pairObjPtr);
3144       }
3145       Tcl_SetObjResult(interp, resultListPtr);
3146       break;
3147   }
3148 #endif /* TCL_REMOVE_OBSOLETE_TRACES */
3149     }
3150     return TCL_OK;
3151 
3152     badVarOps:
3153     Tcl_AppendResult(interp, "bad operations \"", flagOps,
3154       "\": should be one or more of rwua", (char *) NULL);
3155     return TCL_ERROR;
3156 }
void Tcl_UntraceCommand (Tcl_Interp * interp, CONST char * cmdName, int flags, Tcl_CommandTraceProc * proc, ClientData clientData)

Definition at line 3965 of file tclCmdMZ.c.
References Interp::activeCmdTracePtr, ckfree, CommandTrace::clientData, CMD_HAS_EXEC_TRACES, Command::flags, CommandTrace::flags, ActiveCommandTrace::nextPtr, CommandTrace::nextPtr, ActiveCommandTrace::nextTracePtr, NULL, CommandTrace::refCount, ActiveCommandTrace::reverseScan, Tcl_FindCommand(), TCL_LEAVE_ERR_MSG, TCL_TRACE_ANY_EXEC, TCL_TRACE_DELETE, TCL_TRACE_RENAME, CommandTrace::traceProc, and Command::tracePtr.
Referenced by TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), and TraceCommandProc().3973 {
3974     register CommandTrace *tracePtr;
3975     CommandTrace *prevPtr;
3976     Command *cmdPtr;
3977     Interp *iPtr = (Interp *) interp;
3978     ActiveCommandTrace *activePtr;
3979     int hasExecTraces = 0;
3980     
3981     cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName, 
3982     NULL, TCL_LEAVE_ERR_MSG);
3983     if (cmdPtr == NULL) {
3984   return;
3985     }
3986 
3987     flags &= (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC);
3988 
3989     for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL;  ;
3990    prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
3991   if (tracePtr == NULL) {
3992       return;
3993   }
3994   if ((tracePtr->traceProc == proc) 
3995       && ((tracePtr->flags & (TCL_TRACE_RENAME | TCL_TRACE_DELETE | 
3996             TCL_TRACE_ANY_EXEC)) == flags)
3997     && (tracePtr->clientData == clientData)) {
3998       if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
3999     hasExecTraces = 1;
4000       }
4001       break;
4002   }
4003     }
4004     
4005     /*
4006      * The code below makes it possible to delete traces while traces
4007      * are active: it makes sure that the deleted trace won't be
4008      * processed by CallCommandTraces.
4009      */
4010 
4011     for (activePtr = iPtr->activeCmdTracePtr;  activePtr != NULL;
4012    activePtr = activePtr->nextPtr) {
4013   if (activePtr->nextTracePtr == tracePtr) {
4014       if (activePtr->reverseScan) {
4015     activePtr->nextTracePtr = prevPtr;
4016       } else {
4017     activePtr->nextTracePtr = tracePtr->nextPtr;
4018       }
4019   }
4020     }
4021     if (prevPtr == NULL) {
4022   cmdPtr->tracePtr = tracePtr->nextPtr;
4023     } else {
4024   prevPtr->nextPtr = tracePtr->nextPtr;
4025     }
4026     tracePtr->flags = 0;
4027     
4028     if ((--tracePtr->refCount) <= 0) {
4029   ckfree((char*)tracePtr);
4030     }
4031     
4032     if (hasExecTraces) {
4033   for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; tracePtr != NULL ;
4034        prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
4035       if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
4036           return;
4037       }
4038   }
4039   /* 
4040    * None of the remaining traces on this command are execution
4041    * traces.  We therefore remove this flag:
4042    */
4043   cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES;
4044     }
4045 }
int Tcl_WhileObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 4856 of file tclCmdMZ.c.
References Tcl_Interp::errorLine, Tcl_AddErrorInfo(), TCL_BREAK, TCL_CONTINUE, TCL_ERROR, Tcl_EvalObjEx(), Tcl_ExprBooleanObj(), TCL_INTEGER_SPACE, TCL_OK, Tcl_ResetResult(), and Tcl_WrongNumArgs().4861 {
4862     int result, value;
4863 
4864     if (objc != 3) {
4865   Tcl_WrongNumArgs(interp, 1, objv, "test command");
4866         return TCL_ERROR;
4867     }
4868 
4869     while (1) {
4870         result = Tcl_ExprBooleanObj(interp, objv[1], &value);
4871         if (result != TCL_OK) {
4872             return result;
4873         }
4874         if (!value) {
4875             break;
4876         }
4877         result = Tcl_EvalObjEx(interp, objv[2], 0);
4878         if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
4879             if (result == TCL_ERROR) {
4880                 char msg[32 + TCL_INTEGER_SPACE];
4881 
4882                 sprintf(msg, "\n    (\"while\" body line %d)",
4883                         interp->errorLine);
4884                 Tcl_AddErrorInfo(interp, msg);
4885             }
4886             break;
4887         }
4888     }
4889     if (result == TCL_BREAK) {
4890         result = TCL_OK;
4891     }
4892     if (result == TCL_OK) {
4893         Tcl_ResetResult(interp);
4894     }
4895     return result;
4896 }
int TclCheckExecutionTraces (Tcl_Interp * interp, CONST char * command, int numChars, Command * cmdPtr, int code, int traceFlags, int objc, objv)

Definition at line 4220 of file tclCmdMZ.c.
References Interp::activeCmdTracePtr, ckfree, CommandTrace::clientData, ActiveCommandTrace::cmdPtr, TraceCommandInfo::curCode, TraceCommandInfo::curFlags, TraceCommandInfo::flags, CallFrame::level, CommandTrace::nextPtr, ActiveCommandTrace::nextPtr, ActiveCommandTrace::nextTracePtr, NULL, TraceCommandInfo::refCount, ActiveCommandTrace::reverseScan, TCL_OK, TCL_TRACE_EXEC_DIRECT, TCL_TRACE_LEAVE_EXEC, TraceCommandProc(), TraceExecutionProc, CommandTrace::traceProc, Command::tracePtr, and Interp::varFramePtr.
Referenced by TclEvalObjvInternal().4232 {
4233     Interp *iPtr = (Interp *) interp;
4234     CommandTrace *tracePtr, *lastTracePtr;
4235     ActiveCommandTrace active;
4236     int curLevel;
4237     int traceCode = TCL_OK;
4238     TraceCommandInfo* tcmdPtr;
4239     
4240     if (command == NULL || cmdPtr->tracePtr == NULL) {
4241   return traceCode;
4242     }
4243     
4244     curLevel = ((iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level);
4245     
4246     active.nextPtr = iPtr->activeCmdTracePtr;
4247     iPtr->activeCmdTracePtr = &active;
4248 
4249     active.cmdPtr = cmdPtr;
4250     lastTracePtr = NULL;
4251     for (tracePtr = cmdPtr->tracePtr; 
4252    (traceCode == TCL_OK) && (tracePtr != NULL);
4253    tracePtr = active.nextTracePtr) {
4254         if (traceFlags & TCL_TRACE_LEAVE_EXEC) {
4255             /* execute the trace command in order of creation for "leave" */
4256       active.reverseScan = 1;
4257       active.nextTracePtr = NULL;
4258             tracePtr = cmdPtr->tracePtr;
4259             while (tracePtr->nextPtr != lastTracePtr) {
4260           active.nextTracePtr = tracePtr;
4261           tracePtr = tracePtr->nextPtr;
4262             }
4263         } else {
4264       active.reverseScan = 0;
4265       active.nextTracePtr = tracePtr->nextPtr;
4266         }
4267   if (tracePtr->traceProc == TraceCommandProc) {
4268       tcmdPtr = (TraceCommandInfo*)tracePtr->clientData;
4269       if (tcmdPtr->flags != 0) {
4270           tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT;
4271           tcmdPtr->curCode  = code;
4272     tcmdPtr->refCount++;
4273     traceCode = TraceExecutionProc((ClientData)tcmdPtr, interp, 
4274       curLevel, command, (Tcl_Command)cmdPtr, objc, objv);
4275     tcmdPtr->refCount--;
4276     if (tcmdPtr->refCount < 0) {
4277         Tcl_Panic("TclCheckExecutionTraces: negative TraceCommandInfo refCount");
4278     }
4279     if (tcmdPtr->refCount == 0) {
4280         ckfree((char*)tcmdPtr);
4281     }
4282       }
4283   }
4284   if (active.nextTracePtr) {
4285       lastTracePtr = active.nextTracePtr->nextPtr;
4286   }
4287     }
4288     iPtr->activeCmdTracePtr = active.nextPtr;
4289     return(traceCode);
4290 }
int TclCheckInterpTraces (Tcl_Interp * interp, CONST char * command, int numChars, Command * cmdPtr, int code, int traceFlags, int objc, objv)

Definition at line 4315 of file tclCmdMZ.c.
References Interp::activeInterpTracePtr, CallTraceProcedure(), TraceCommandInfo::curCode, TraceCommandInfo::curFlags, Trace::flags, Interp::flags, INTERP_TRACE_IN_PROGRESS, Trace::level, Trace::nextPtr, ActiveInterpTrace::nextPtr, ActiveInterpTrace::nextTracePtr, NULL, Interp::numLevels, ActiveInterpTrace::reverseScan, TCL_OK, Tcl_Preserve(), Tcl_Release(), TCL_TRACE_ENTER_EXEC, TCL_TRACE_EXEC_IN_PROGRESS, TCL_TRACE_LEAVE_EXEC, and Interp::tracePtr.
Referenced by TclEvalObjvInternal().4327 {
4328     Interp *iPtr = (Interp *) interp;
4329     Trace *tracePtr, *lastTracePtr;
4330     ActiveInterpTrace active;
4331     int curLevel;
4332     int traceCode = TCL_OK;
4333     
4334     if (command == NULL || iPtr->tracePtr == NULL ||
4335            (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) {
4336   return(traceCode);
4337     }
4338     
4339     curLevel = iPtr->numLevels;
4340     
4341     active.nextPtr = iPtr->activeInterpTracePtr;
4342     iPtr->activeInterpTracePtr = &active;
4343 
4344     lastTracePtr = NULL;
4345     for ( tracePtr = iPtr->tracePtr;
4346           (traceCode == TCL_OK) && (tracePtr != NULL);
4347     tracePtr = active.nextTracePtr) {
4348         if (traceFlags & TCL_TRACE_ENTER_EXEC) {
4349             /* 
4350              * Execute the trace command in reverse order of creation
4351              * for "enterstep" operation. The order is changed for
4352              * "enterstep" instead of for "leavestep" as was done in 
4353              * TclCheckExecutionTraces because for step traces,
4354              * Tcl_CreateObjTrace creates one more linked list of traces
4355              * which results in one more reversal of trace invocation.
4356              */
4357       active.reverseScan = 1;
4358       active.nextTracePtr = NULL;
4359             tracePtr = iPtr->tracePtr;
4360             while (tracePtr->nextPtr != lastTracePtr) {
4361           active.nextTracePtr = tracePtr;
4362           tracePtr = tracePtr->nextPtr;
4363             }
4364         } else {
4365       active.reverseScan = 0;
4366       active.nextTracePtr = tracePtr->nextPtr;
4367         }
4368   if (tracePtr->level > 0 && curLevel > tracePtr->level) {
4369       continue;
4370   }
4371   if (!(tracePtr->flags & TCL_TRACE_EXEC_IN_PROGRESS)) {
4372             /*
4373        * The proc invoked might delete the traced command which 
4374        * which might try to free tracePtr.  We want to use tracePtr
4375        * until the end of this if section, so we use
4376        * Tcl_Preserve() and Tcl_Release() to be sure it is not
4377        * freed while we still need it.
4378        */
4379       Tcl_Preserve((ClientData) tracePtr);
4380       tracePtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
4381       
4382       if (tracePtr->flags & (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC)) {
4383           /* New style trace */
4384     if (tracePtr->flags & traceFlags) {
4385         if (tracePtr->proc == TraceExecutionProc) {
4386       TraceCommandInfo *tcmdPtr =
4387         (TraceCommandInfo *) tracePtr->clientData;
4388       tcmdPtr->curFlags = traceFlags;
4389       tcmdPtr->curCode  = code;
4390         }
4391         traceCode = (tracePtr->proc)(tracePtr->clientData, 
4392           interp, curLevel, command, (Tcl_Command)cmdPtr,
4393           objc, objv);
4394     }
4395       } else {
4396     /* Old-style trace */
4397     
4398     if (traceFlags & TCL_TRACE_ENTER_EXEC) {
4399         /* 
4400          * Old-style interpreter-wide traces only trigger
4401          * before the command is executed.
4402          */
4403         traceCode = CallTraceProcedure(interp, tracePtr, cmdPtr,
4404                command, numChars, objc, objv);
4405     }
4406       }
4407       tracePtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
4408       Tcl_Release((ClientData) tracePtr);
4409   }
4410   if (active.nextTracePtr) {
4411       lastTracePtr = active.nextTracePtr->nextPtr;
4412   }
4413     }
4414     iPtr->activeInterpTracePtr = active.nextPtr;
4415     return(traceCode);
4416 }
int TclTraceCommandObjCmd (Tcl_Interp * interp, int optionIndex, int objc, objv)

Definition at line 3425 of file tclCmdMZ.c.
References ckalloc, ckfree, TraceCommandInfo::command, CONST, TraceCommandInfo::flags, TraceCommandInfo::length, NULL, TraceCommandInfo::refCount, size_t(), TraceCommandInfo::startCmd, TraceCommandInfo::startLevel, TraceCommandInfo::stepTrace, Tcl_CommandTraceInfo(), Tcl_DecrRefCount, TCL_ERROR, TCL_EXACT, Tcl_FindCommand(), Tcl_GetIndexFromObj(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, TCL_LEAVE_ERR_MSG, Tcl_ListObjAppendElement(), Tcl_ListObjGetElements(), Tcl_ListObjLength(), Tcl_NewListObj(), Tcl_NewStringObj(), TCL_OK, Tcl_SetObjResult(), Tcl_SetResult(), TCL_STATIC, TCL_TRACE_DELETE, TCL_TRACE_DESTROYED, TCL_TRACE_RENAME, Tcl_TraceCommand(), Tcl_UntraceCommand(), Tcl_WrongNumArgs(), and TraceCommandProc().3430 {
3431     int commandLength, index;
3432     char *name, *command;
3433     size_t length;
3434     enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
3435     static CONST char *opStrings[] = { "delete", "rename", (char *) NULL };
3436     enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME };
3437     
3438     switch ((enum traceOptions) optionIndex) {
3439   case TRACE_ADD: 
3440   case TRACE_REMOVE: {
3441       int flags = 0;
3442       int i, listLen, result;
3443       Tcl_Obj **elemPtrs;
3444       if (objc != 6) {
3445     Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
3446     return TCL_ERROR;
3447       }
3448       /*
3449        * Make sure the ops argument is a list object; get its length and
3450        * a pointer to its array of element pointers.
3451        */
3452 
3453       result = Tcl_ListObjGetElements(interp, objv[4], &listLen,
3454         &elemPtrs);
3455       if (result != TCL_OK) {
3456     return result;
3457       }
3458       if (listLen == 0) {
3459     Tcl_SetResult(interp, "bad operation list \"\": must be "
3460       "one or more of delete or rename", TCL_STATIC);
3461     return TCL_ERROR;
3462       }
3463       for (i = 0; i < listLen; i++) {
3464     if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
3465       "operation", TCL_EXACT, &index) != TCL_OK) {
3466         return TCL_ERROR;
3467     }
3468     switch ((enum operations) index) {
3469         case TRACE_CMD_RENAME:
3470       flags |= TCL_TRACE_RENAME;
3471       break;
3472         case TRACE_CMD_DELETE:
3473       flags |= TCL_TRACE_DELETE;
3474       break;
3475     }
3476       }
3477       command = Tcl_GetStringFromObj(objv[5], &commandLength);
3478       length = (size_t) commandLength;
3479       if ((enum traceOptions) optionIndex == TRACE_ADD) {
3480     TraceCommandInfo *tcmdPtr;
3481     tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
3482       (sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
3483         + length + 1));
3484     tcmdPtr->flags = flags;
3485     tcmdPtr->stepTrace = NULL;
3486     tcmdPtr->startLevel = 0;
3487     tcmdPtr->startCmd = NULL;
3488     tcmdPtr->length = length;
3489     tcmdPtr->refCount = 1;
3490     flags |= TCL_TRACE_DELETE;
3491     strcpy(tcmdPtr->command, command);
3492     name = Tcl_GetString(objv[3]);
3493     if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
3494       (ClientData) tcmdPtr) != TCL_OK) {
3495         ckfree((char *) tcmdPtr);
3496         return TCL_ERROR;
3497     }
3498       } else {
3499     /*
3500      * Search through all of our traces on this command to
3501      * see if there's one with the given command.  If so, then
3502      * delete the first one that matches.
3503      */
3504     
3505     TraceCommandInfo *tcmdPtr;
3506     ClientData clientData = NULL;
3507     name = Tcl_GetString(objv[3]);
3508     
3509     /* First ensure the name given is valid */
3510     if (Tcl_FindCommand(interp, name, NULL, 
3511             TCL_LEAVE_ERR_MSG) == NULL) {
3512         return TCL_ERROR;
3513     }
3514             
3515     while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
3516       TraceCommandProc, clientData)) != NULL) {
3517         tcmdPtr = (TraceCommandInfo *) clientData;
3518         if ((tcmdPtr->length == length)
3519           && (tcmdPtr->flags == flags)
3520           && (strncmp(command, tcmdPtr->command,
3521             (size_t) length) == 0)) {
3522       Tcl_UntraceCommand(interp, name,
3523         flags | TCL_TRACE_DELETE,
3524         TraceCommandProc, clientData);
3525       tcmdPtr->flags |= TCL_TRACE_DESTROYED;
3526       tcmdPtr->refCount--;
3527       if (tcmdPtr->refCount < 0) {
3528           Tcl_Panic("TclTraceCommandObjCmd: negative TraceCommandInfo refCount");
3529       }
3530       if (tcmdPtr->refCount == 0) {
3531           ckfree((char *) tcmdPtr);
3532       }
3533       break;
3534         }
3535     }
3536       }
3537       break;
3538   }
3539   case TRACE_INFO: {
3540       ClientData clientData;
3541       Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
3542       if (objc != 4) {
3543     Tcl_WrongNumArgs(interp, 3, objv, "name");
3544     return TCL_ERROR;
3545       }
3546 
3547       clientData = NULL;
3548       name = Tcl_GetString(objv[3]);
3549       
3550       /* First ensure the name given is valid */
3551       if (Tcl_FindCommand(interp, name, NULL, 
3552         TCL_LEAVE_ERR_MSG) == NULL) {
3553     return TCL_ERROR;
3554       }
3555         
3556       resultListPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
3557       while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
3558         TraceCommandProc, clientData)) != NULL) {
3559     int numOps = 0;
3560 
3561     TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
3562 
3563     /*
3564      * Build a list with the ops list as
3565      * the first obj element and the tcmdPtr->command string
3566      * as the second obj element.  Append this list (as an
3567      * element) to the end of the result object list.
3568      */
3569 
3570     elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
3571     Tcl_IncrRefCount(elemObjPtr);
3572     if (tcmdPtr->flags & TCL_TRACE_RENAME) {
3573         Tcl_ListObjAppendElement(NULL, elemObjPtr,
3574           Tcl_NewStringObj("rename",6));
3575     }
3576     if (tcmdPtr->flags & TCL_TRACE_DELETE) {
3577         Tcl_ListObjAppendElement(NULL, elemObjPtr,
3578           Tcl_NewStringObj("delete",6));
3579     }
3580     Tcl_ListObjLength(NULL, elemObjPtr, &numOps);
3581     if (0 == numOps) {
3582         Tcl_DecrRefCount(elemObjPtr);
3583                     continue;
3584                 }
3585     eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
3586     Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
3587     Tcl_DecrRefCount(elemObjPtr);
3588 
3589     elemObjPtr = Tcl_NewStringObj(tcmdPtr->command, -1);
3590     Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
3591     Tcl_ListObjAppendElement(interp, resultListPtr,
3592       eachTraceObjPtr);
3593       }
3594       Tcl_SetObjResult(interp, resultListPtr);
3595       break;
3596   }
3597     }
3598     return TCL_OK;
3599 }
int TclTraceExecutionObjCmd (Tcl_Interp * interp, int optionIndex, int objc, objv)

Definition at line 3179 of file tclCmdMZ.c.
References ckalloc, ckfree, TraceCommandInfo::command, CONST, TraceCommandInfo::flags, TraceCommandInfo::length, NULL, TraceCommandInfo::refCount, size_t(), TraceCommandInfo::startCmd, TraceCommandInfo::startLevel, TraceCommandInfo::stepTrace, Tcl_CommandTraceInfo(), Tcl_DecrRefCount, Tcl_DeleteTrace(), TCL_ERROR, TCL_EXACT, Tcl_FindCommand(), Tcl_GetIndexFromObj(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, TCL_LEAVE_ERR_MSG, Tcl_ListObjAppendElement(), Tcl_ListObjGetElements(), Tcl_ListObjLength(), Tcl_NewListObj(), Tcl_NewStringObj(), TCL_OK, Tcl_SetObjResult(), Tcl_SetResult(), TCL_STATIC, TCL_TRACE_ANY_EXEC, TCL_TRACE_DELETE, TCL_TRACE_ENTER_DURING_EXEC, TCL_TRACE_ENTER_EXEC, TCL_TRACE_EXEC_IN_PROGRESS, TCL_TRACE_LEAVE_DURING_EXEC, TCL_TRACE_LEAVE_EXEC, TCL_TRACE_RENAME, Tcl_TraceCommand(), Tcl_UntraceCommand(), Tcl_WrongNumArgs(), and TraceCommandProc().3184 {
3185     int commandLength, index;
3186     char *name, *command;
3187     size_t length;
3188     enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
3189     static CONST char *opStrings[] = { "enter", "leave", 
3190                                  "enterstep", "leavestep", (char *) NULL };
3191     enum operations { TRACE_EXEC_ENTER, TRACE_EXEC_LEAVE,
3192                       TRACE_EXEC_ENTER_STEP, TRACE_EXEC_LEAVE_STEP };
3193     
3194     switch ((enum traceOptions) optionIndex) {
3195   case TRACE_ADD: 
3196   case TRACE_REMOVE: {
3197       int flags = 0;
3198       int i, listLen, result;
3199       Tcl_Obj **elemPtrs;
3200       if (objc != 6) {
3201     Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
3202     return TCL_ERROR;
3203       }
3204       /*
3205        * Make sure the ops argument is a list object; get its length and
3206        * a pointer to its array of element pointers.
3207        */
3208 
3209       result = Tcl_ListObjGetElements(interp, objv[4], &listLen,
3210         &elemPtrs);
3211       if (result != TCL_OK) {
3212     return result;
3213       }
3214       if (listLen == 0) {
3215     Tcl_SetResult(interp, "bad operation list \"\": must be "
3216             "one or more of enter, leave, enterstep, or leavestep", 
3217       TCL_STATIC);
3218     return TCL_ERROR;
3219       }
3220       for (i = 0; i < listLen; i++) {
3221     if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
3222       "operation", TCL_EXACT, &index) != TCL_OK) {
3223         return TCL_ERROR;
3224     }
3225     switch ((enum operations) index) {
3226         case TRACE_EXEC_ENTER:
3227       flags |= TCL_TRACE_ENTER_EXEC;
3228       break;
3229         case TRACE_EXEC_LEAVE:
3230       flags |= TCL_TRACE_LEAVE_EXEC;
3231       break;
3232         case TRACE_EXEC_ENTER_STEP:
3233       flags |= TCL_TRACE_ENTER_DURING_EXEC;
3234       break;
3235         case TRACE_EXEC_LEAVE_STEP:
3236       flags |= TCL_TRACE_LEAVE_DURING_EXEC;
3237       break;
3238     }
3239       }
3240       command = Tcl_GetStringFromObj(objv[5], &commandLength);
3241       length = (size_t) commandLength;
3242       if ((enum traceOptions) optionIndex == TRACE_ADD) {
3243     TraceCommandInfo *tcmdPtr;
3244     tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
3245       (sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
3246         + length + 1));
3247     tcmdPtr->flags = flags;
3248     tcmdPtr->stepTrace = NULL;
3249     tcmdPtr->startLevel = 0;
3250     tcmdPtr->startCmd = NULL;
3251     tcmdPtr->length = length;
3252     tcmdPtr->refCount = 1;
3253     flags |= TCL_TRACE_DELETE;
3254     if (flags & (TCL_TRACE_ENTER_DURING_EXEC |
3255            TCL_TRACE_LEAVE_DURING_EXEC)) {
3256         flags |= (TCL_TRACE_ENTER_EXEC | 
3257             TCL_TRACE_LEAVE_EXEC);
3258     }
3259     strcpy(tcmdPtr->command, command);
3260     name = Tcl_GetString(objv[3]);
3261     if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
3262       (ClientData) tcmdPtr) != TCL_OK) {
3263         ckfree((char *) tcmdPtr);
3264         return TCL_ERROR;
3265     }
3266       } else {
3267     /*
3268      * Search through all of our traces on this command to
3269      * see if there's one with the given command.  If so, then
3270      * delete the first one that matches.
3271      */
3272     
3273     TraceCommandInfo *tcmdPtr;
3274     ClientData clientData = NULL;
3275     name = Tcl_GetString(objv[3]);
3276 
3277     /* First ensure the name given is valid */
3278     if (Tcl_FindCommand(interp, name, NULL, 
3279             TCL_LEAVE_ERR_MSG) == NULL) {
3280         return TCL_ERROR;
3281     }
3282             
3283     while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
3284       TraceCommandProc, clientData)) != NULL) {
3285         tcmdPtr = (TraceCommandInfo *) clientData;
3286         /* 
3287          * In checking the 'flags' field we must remove any
3288          * extraneous flags which may have been temporarily
3289          * added by various pieces of the trace mechanism.
3290          */
3291         if ((tcmdPtr->length == length)
3292           && ((tcmdPtr->flags & (TCL_TRACE_ANY_EXEC | 
3293                TCL_TRACE_RENAME | 
3294                TCL_TRACE_DELETE)) == flags)
3295           && (strncmp(command, tcmdPtr->command,
3296             (size_t) length) == 0)) {
3297       flags |= TCL_TRACE_DELETE;
3298       if (flags & (TCL_TRACE_ENTER_DURING_EXEC |
3299              TCL_TRACE_LEAVE_DURING_EXEC)) {
3300           flags |= (TCL_TRACE_ENTER_EXEC | 
3301               TCL_TRACE_LEAVE_EXEC);
3302       }
3303       Tcl_UntraceCommand(interp, name,
3304         flags, TraceCommandProc, clientData);
3305       if (tcmdPtr->stepTrace != NULL) {
3306           /* 
3307            * We need to remove the interpreter-wide trace 
3308            * which we created to allow 'step' traces.
3309            */
3310           Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
3311           tcmdPtr->stepTrace = NULL;
3312                             if (tcmdPtr->startCmd != NULL) {
3313               ckfree((char *)tcmdPtr->startCmd);
3314           }
3315       }
3316       if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
3317           /* Postpone deletion */
3318           tcmdPtr->flags = 0;
3319       }
3320       tcmdPtr->refCount--;
3321       if (tcmdPtr->refCount < 0) {
3322           Tcl_Panic("TclTraceExecutionObjCmd: negative TraceCommandInfo refCount");
3323       }
3324       if (tcmdPtr->refCount == 0) {
3325           ckfree((char*)tcmdPtr);
3326       }
3327       break;
3328         }
3329     }
3330       }
3331       break;
3332   }
3333   case TRACE_INFO: {
3334       ClientData clientData;
3335       Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
3336       if (objc != 4) {
3337     Tcl_WrongNumArgs(interp, 3, objv, "name");
3338     return TCL_ERROR;
3339       }
3340 
3341       clientData = NULL;
3342       name = Tcl_GetString(objv[3]);
3343       
3344       /* First ensure the name given is valid */
3345       if (Tcl_FindCommand(interp, name, NULL, 
3346         TCL_LEAVE_ERR_MSG) == NULL) {
3347     return TCL_ERROR;
3348       }
3349         
3350       resultListPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
3351       while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
3352         TraceCommandProc, clientData)) != NULL) {
3353     int numOps = 0;
3354 
3355     TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
3356 
3357     /*
3358      * Build a list with the ops list as the first obj
3359      * element and the tcmdPtr->command string as the
3360      * second obj element.  Append this list (as an
3361      * element) to the end of the result object list.
3362      */
3363 
3364     elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
3365     Tcl_IncrRefCount(elemObjPtr);
3366     if (tcmdPtr->flags & TCL_TRACE_ENTER_EXEC) {
3367         Tcl_ListObjAppendElement(NULL, elemObjPtr,
3368           Tcl_NewStringObj("enter",5));
3369     }
3370     if (tcmdPtr->flags & TCL_TRACE_LEAVE_EXEC) {
3371         Tcl_ListObjAppendElement(NULL, elemObjPtr,
3372           Tcl_NewStringObj("leave",5));
3373     }
3374     if (tcmdPtr->flags & TCL_TRACE_ENTER_DURING_EXEC) {
3375         Tcl_ListObjAppendElement(NULL, elemObjPtr,
3376           Tcl_NewStringObj("enterstep",9));
3377     }
3378     if (tcmdPtr->flags & TCL_TRACE_LEAVE_DURING_EXEC) {
3379         Tcl_ListObjAppendElement(NULL, elemObjPtr,
3380           Tcl_NewStringObj("leavestep",9));
3381     }
3382     Tcl_ListObjLength(NULL, elemObjPtr, &numOps);
3383     if (0 == numOps) {
3384         Tcl_DecrRefCount(elemObjPtr);
3385                     continue;
3386                 }
3387     eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
3388     Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
3389     Tcl_DecrRefCount(elemObjPtr);
3390     elemObjPtr = NULL;
3391     
3392     Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, 
3393       Tcl_NewStringObj(tcmdPtr->command, -1));
3394     Tcl_ListObjAppendElement(interp, resultListPtr,
3395       eachTraceObjPtr);
3396       }
3397       Tcl_SetObjResult(interp, resultListPtr);
3398       break;
3399   }
3400     }
3401     return TCL_OK;
3402 }
int TclTraceVariableObjCmd (Tcl_Interp * interp, int optionIndex, int objc, objv)

Definition at line 3622 of file tclCmdMZ.c.
References ckalloc, ckfree, VarTrace::clientData, TraceVarInfo::command, CONST, VarTrace::flags, TraceVarInfo::flags, TraceVarInfo::length, VarTrace::nextPtr, NULL, size_t(), TCL_ERROR, TCL_EXACT, Tcl_GetIndexFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), TCL_GLOBAL_ONLY, TCL_LEAVE_ERR_MSG, Tcl_ListObjAppendElement(), Tcl_ListObjGetElements(), TCL_NAMESPACE_ONLY, Tcl_NewListObj(), Tcl_NewStringObj(), TCL_OK, Tcl_SetObjResult(), Tcl_SetResult(), TCL_STATIC, TCL_TRACE_ARRAY, TCL_TRACE_OLD_STYLE, TCL_TRACE_READS, TCL_TRACE_RESULT_DYNAMIC, TCL_TRACE_RESULT_OBJECT, TCL_TRACE_UNSETS, TCL_TRACE_WRITES, Tcl_UntraceVar2(), Tcl_VarTraceInfo(), Tcl_WrongNumArgs(), TclLookupVar(), CompoundVarTrace::trace, VarTrace::traceProc, TraceVarProc(), CompoundVarTrace::tvar, and varPtr.3627 {
3628     int commandLength, index;
3629     char *name, *command;
3630     size_t length;
3631     enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
3632     static CONST char *opStrings[] = { "array", "read", "unset", "write",
3633              (char *) NULL };
3634     enum operations { TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET,
3635         TRACE_VAR_WRITE };
3636         
3637     switch ((enum traceOptions) optionIndex) {
3638   case TRACE_ADD: 
3639   case TRACE_REMOVE: {
3640       int flags = 0;
3641       int i, listLen, result;
3642       Tcl_Obj **elemPtrs;
3643       if (objc != 6) {
3644     Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
3645     return TCL_ERROR;
3646       }
3647       /*
3648        * Make sure the ops argument is a list object; get its length and
3649        * a pointer to its array of element pointers.
3650        */
3651 
3652       result = Tcl_ListObjGetElements(interp, objv[4], &listLen,
3653         &elemPtrs);
3654       if (result != TCL_OK) {
3655     return result;
3656       }
3657       if (listLen == 0) {
3658     Tcl_SetResult(interp, "bad operation list \"\": must be "
3659       "one or more of array, read, unset, or write",
3660       TCL_STATIC);
3661     return TCL_ERROR;
3662       }
3663       for (i = 0; i < listLen ; i++) {
3664     if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
3665       "operation", TCL_EXACT, &index) != TCL_OK) {
3666         return TCL_ERROR;
3667     }
3668     switch ((enum operations) index) {
3669         case TRACE_VAR_ARRAY:
3670       flags |= TCL_TRACE_ARRAY;
3671       break;
3672         case TRACE_VAR_READ:
3673       flags |= TCL_TRACE_READS;
3674       break;
3675         case TRACE_VAR_UNSET:
3676       flags |= TCL_TRACE_UNSETS;
3677       break;
3678         case TRACE_VAR_WRITE:
3679       flags |= TCL_TRACE_WRITES;
3680       break;
3681     }
3682       }
3683       command = Tcl_GetStringFromObj(objv[5], &commandLength);
3684       length = (size_t) commandLength;
3685       if ((enum traceOptions) optionIndex == TRACE_ADD) {
3686     /*
3687      * This code essentially mallocs together the VarTrace and the
3688      * TraceVarInfo, then inlines the Tcl_TraceVar(). This is
3689      * necessary in order to have the TraceVarInfo to be freed 
3690      * automatically when the VarTrace is freed [Bug 1348775]
3691      */
3692 
3693     CompoundVarTrace *compTracePtr;
3694     TraceVarInfo *tvarPtr;
3695     Var *varPtr, *arrayPtr;
3696     VarTrace *tracePtr;
3697     int flagMask;
3698 
3699     compTracePtr = (CompoundVarTrace *) ckalloc((unsigned)
3700       (sizeof(CompoundVarTrace) - sizeof(tvarPtr->command)
3701         + length + 1));
3702     tracePtr = &(compTracePtr->trace);
3703     tvarPtr = &(compTracePtr->tvar);
3704     tvarPtr->flags = flags;
3705     if (objv[0] == NULL) {
3706         tvarPtr->flags |= TCL_TRACE_OLD_STYLE;
3707     }
3708     tvarPtr->length = length;
3709     flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
3710     strcpy(tvarPtr->command, command);
3711     name = Tcl_GetString(objv[3]);
3712     flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
3713     varPtr = TclLookupVar(interp, name, NULL,
3714       (flags & flagMask) | TCL_LEAVE_ERR_MSG, "trace",
3715       /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
3716     if (varPtr == NULL) {
3717         ckfree((char *) tracePtr);
3718         return TCL_ERROR;
3719     }
3720     flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES
3721       | TCL_TRACE_UNSETS | TCL_TRACE_ARRAY
3722       | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
3723 #ifndef TCL_REMOVE_OBSOLETE_TRACES
3724     flagMask |= TCL_TRACE_OLD_STYLE;
3725 #endif
3726     tracePtr->traceProc = TraceVarProc;
3727     tracePtr->clientData = (ClientData) tvarPtr;
3728     tracePtr->flags = flags & flagMask;
3729     tracePtr->nextPtr = varPtr->tracePtr;
3730     varPtr->tracePtr = tracePtr;
3731       } else {
3732     /*
3733      * Search through all of our traces on this variable to
3734      * see if there's one with the given command.  If so, then
3735      * delete the first one that matches.
3736      */
3737     
3738     TraceVarInfo *tvarPtr;
3739     ClientData clientData = 0;
3740     name = Tcl_GetString(objv[3]);
3741     while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
3742       TraceVarProc, clientData)) != 0) {
3743         tvarPtr = (TraceVarInfo *) clientData;
3744         if ((tvarPtr->length == length)
3745           && ((tvarPtr->flags & ~TCL_TRACE_OLD_STYLE)==flags)
3746           && (strncmp(command, tvarPtr->command,
3747             (size_t) length) == 0)) {
3748       Tcl_UntraceVar2(interp, name, NULL, 
3749         flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
3750         TraceVarProc, clientData);
3751       break;
3752         }
3753     }
3754       }
3755       break;
3756   }
3757   case TRACE_INFO: {
3758       ClientData clientData;
3759       Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
3760       if (objc != 4) {
3761     Tcl_WrongNumArgs(interp, 3, objv, "name");
3762     return TCL_ERROR;
3763       }
3764 
3765       resultListPtr = Tcl_GetObjResult(interp);
3766       clientData = 0;
3767       name = Tcl_GetString(objv[3]);
3768       while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
3769         TraceVarProc, clientData)) != 0) {
3770 
3771     TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
3772 
3773     /*
3774      * Build a list with the ops list as
3775      * the first obj element and the tcmdPtr->command string
3776      * as the second obj element.  Append this list (as an
3777      * element) to the end of the result object list.
3778      */
3779 
3780     elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
3781     if (tvarPtr->flags & TCL_TRACE_ARRAY) {
3782         Tcl_ListObjAppendElement(NULL, elemObjPtr,
3783           Tcl_NewStringObj("array", 5));
3784     }
3785     if (tvarPtr->flags & TCL_TRACE_READS) {
3786         Tcl_ListObjAppendElement(NULL, elemObjPtr,
3787           Tcl_NewStringObj("read", 4));
3788     }
3789     if (tvarPtr->flags & TCL_TRACE_WRITES) {
3790         Tcl_ListObjAppendElement(NULL, elemObjPtr,
3791           Tcl_NewStringObj("write", 5));
3792     }
3793     if (tvarPtr->flags & TCL_TRACE_UNSETS) {
3794         Tcl_ListObjAppendElement(NULL, elemObjPtr,
3795           Tcl_NewStringObj("unset", 5));
3796     }
3797     eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
3798     Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
3799 
3800     elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
3801     Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
3802     Tcl_ListObjAppendElement(interp, resultListPtr,
3803       eachTraceObjPtr);
3804       }
3805       Tcl_SetObjResult(interp, resultListPtr);
3806       break;
3807   }
3808     }
3809     return TCL_OK;
3810 }
static void TraceCommandProc (ClientData clientData, Tcl_Interp * interp, CONST char * oldName, CONST char * newName, int flags) [static]

Definition at line 4067 of file tclCmdMZ.c.
References ckfree, TraceCommandInfo::command, TraceCommandInfo::flags, TraceCommandInfo::length, NULL, TraceCommandInfo::refCount, Interp::returnCode, TraceCommandInfo::startCmd, TraceCommandInfo::stepTrace, Tcl_DeleteTrace(), Tcl_DStringAppend(), Tcl_DStringAppendElement(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringValue, Tcl_EvalEx(), TCL_INTERP_DESTROYED, TCL_OK, Tcl_RestoreResult(), Tcl_SaveResult(), TCL_TRACE_ANY_EXEC, TCL_TRACE_DELETE, TCL_TRACE_DESTROYED, TCL_TRACE_ENTER_DURING_EXEC, TCL_TRACE_ENTER_EXEC, TCL_TRACE_EXEC_IN_PROGRESS, TCL_TRACE_LEAVE_DURING_EXEC, TCL_TRACE_LEAVE_EXEC, TCL_TRACE_RENAME, and Tcl_UntraceCommand().
Referenced by TclCheckExecutionTraces(), TclTraceCommandObjCmd(), and TclTraceExecutionObjCmd().4076 {
4077     Interp *iPtr = (Interp *) interp;
4078     int stateCode;
4079     Tcl_SavedResult state;
4080     TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
4081     int code;
4082     Tcl_DString cmd;
4083     
4084     tcmdPtr->refCount++;
4085     
4086     if ((tcmdPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)) {
4087   /*
4088    * Generate a command to execute by appending list elements
4089    * for the old and new command name and the operation.
4090    */
4091 
4092   Tcl_DStringInit(&cmd);
4093   Tcl_DStringAppend(&cmd, tcmdPtr->command, (int) tcmdPtr->length);
4094   Tcl_DStringAppendElement(&cmd, oldName);
4095   Tcl_DStringAppendElement(&cmd, (newName ? newName : ""));
4096   if (flags & TCL_TRACE_RENAME) {
4097       Tcl_DStringAppend(&cmd, " rename", 7);
4098   } else if (flags & TCL_TRACE_DELETE) {
4099       Tcl_DStringAppend(&cmd, " delete", 7);
4100   }
4101 
4102   /*
4103    * Execute the command.  Save the interp's result used for the
4104    * command, including the value of iPtr->returnCode which may be
4105    * modified when Tcl_Eval is invoked. We discard any object
4106    * result the command returns.
4107    *
4108    * Add the TCL_TRACE_DESTROYED flag to tcmdPtr to indicate to
4109    * other areas that this will be destroyed by us, otherwise a
4110    * double-free might occur depending on what the eval does.
4111    */
4112 
4113   Tcl_SaveResult(interp, &state);
4114   stateCode = iPtr->returnCode;
4115   if (flags & TCL_TRACE_DESTROYED) {
4116       tcmdPtr->flags |= TCL_TRACE_DESTROYED;
4117   }
4118 
4119   code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
4120     Tcl_DStringLength(&cmd), 0);
4121   if (code != TCL_OK) {      
4122       /* We ignore errors in these traced commands */
4123   }
4124 
4125   Tcl_RestoreResult(interp, &state);
4126   iPtr->returnCode = stateCode;
4127   
4128   Tcl_DStringFree(&cmd);
4129     }
4130     /*
4131      * We delete when the trace was destroyed or if this is a delete trace,
4132      * because command deletes are unconditional, so the trace must go away.
4133      */
4134     if (flags & (TCL_TRACE_DESTROYED | TCL_TRACE_DELETE)) {
4135   int untraceFlags = tcmdPtr->flags;
4136 
4137   if (tcmdPtr->stepTrace != NULL) {
4138       Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
4139       tcmdPtr->stepTrace = NULL;
4140             if (tcmdPtr->startCmd != NULL) {
4141           ckfree((char *)tcmdPtr->startCmd);
4142       }
4143   }
4144   if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
4145       /* Postpone deletion, until exec trace returns */
4146       tcmdPtr->flags = 0;
4147   }
4148 
4149   /*
4150    * We need to construct the same flags for Tcl_UntraceCommand
4151    * as were passed to Tcl_TraceCommand.  Reproduce the processing
4152    * of [trace add execution/command].  Be careful to keep this
4153    * code in sync with that.
4154    */
4155 
4156   if (untraceFlags & TCL_TRACE_ANY_EXEC) {
4157       untraceFlags |= TCL_TRACE_DELETE;
4158       if (untraceFlags & (TCL_TRACE_ENTER_DURING_EXEC 
4159         | TCL_TRACE_LEAVE_DURING_EXEC)) {
4160     untraceFlags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
4161       }
4162   } else if (untraceFlags & TCL_TRACE_RENAME) {
4163       untraceFlags |= TCL_TRACE_DELETE;
4164   }
4165 
4166   /* 
4167    * Remove the trace since TCL_TRACE_DESTROYED tells us to, or the
4168    * command we're tracing has just gone away.  Then decrement the
4169    * clientData refCount that was set up by trace creation.
4170    *
4171    * Note that we save the (return) state of the interpreter to prevent
4172    * bizarre error messages.
4173    */
4174 
4175   Tcl_SaveResult(interp, &state);
4176   stateCode = iPtr->returnCode;
4177   Tcl_UntraceCommand(interp, oldName, untraceFlags,
4178     TraceCommandProc, clientData);
4179   Tcl_RestoreResult(interp, &state);
4180   iPtr->returnCode = stateCode;
4181 
4182   tcmdPtr->refCount--;
4183     }
4184     tcmdPtr->refCount--;
4185     if (tcmdPtr->refCount < 0) {
4186   Tcl_Panic("TraceCommandProc: negative TraceCommandInfo refCount");
4187     }
4188     if (tcmdPtr->refCount == 0) {
4189         ckfree((char*)tcmdPtr);
4190     }
4191     return;
4192 }
static int TraceExecutionProc (ClientData clientData, Tcl_Interp * interp, int level, CONST char * command, Tcl_Command cmdInfo, int objc, struct Tcl_Obj *CONST objv[]) [static]

Definition at line 4527 of file tclCmdMZ.c.
References ckalloc, ckfree, TraceCommandInfo::command, CommandObjTraceDeleted(), TraceCommandInfo::curCode, TraceCommandInfo::curFlags, Interp::flags, TraceCommandInfo::flags, INTERP_TRACE_IN_PROGRESS, TraceCommandInfo::length, NULL, panic, TraceCommandInfo::refCount, Interp::returnCode, TraceCommandInfo::startCmd, TraceCommandInfo::startLevel, TraceCommandInfo::stepTrace, Tcl_CreateObjTrace(), Tcl_DecrRefCount, Tcl_DeleteTrace(), Tcl_DiscardResult(), Tcl_DStringAppend(), Tcl_DStringAppendElement(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, Tcl_Eval(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_GetStringResult(), TCL_INTERP_DESTROYED, Tcl_NewIntObj(), TCL_OK, Tcl_RestoreResult(), Tcl_SaveResult(), TCL_TRACE_ANY_EXEC, TCL_TRACE_DESTROYED, TCL_TRACE_ENTER_DURING_EXEC, TCL_TRACE_ENTER_EXEC, TCL_TRACE_EXEC_DIRECT, TCL_TRACE_EXEC_IN_PROGRESS, TCL_TRACE_LEAVE_DURING_EXEC, and TCL_TRACE_LEAVE_EXEC.4529                                                 {
4530     int call = 0;
4531     Interp *iPtr = (Interp *) interp;
4532     TraceCommandInfo* tcmdPtr = (TraceCommandInfo*)clientData;
4533     int flags = tcmdPtr->curFlags;
4534     int code  = tcmdPtr->curCode;
4535     int traceCode  = TCL_OK;
4536     
4537     if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
4538   /* 
4539    * Inside any kind of execution trace callback, we do
4540    * not allow any further execution trace callbacks to
4541    * be called for the same trace.
4542    */
4543   return traceCode;
4544     }
4545     
4546     if (!(flags & TCL_INTERP_DESTROYED)) {
4547   /*
4548    * Check whether the current call is going to eval arbitrary
4549    * Tcl code with a generated trace, or whether we are only
4550    * going to setup interpreter-wide traces to implement the
4551    * 'step' traces.  This latter situation can happen if
4552    * we create a command trace without either before or after
4553    * operations, but with either of the step operations.
4554    */
4555   if (flags & TCL_TRACE_EXEC_DIRECT) {
4556       call = flags & tcmdPtr->flags 
4557         & (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
4558   } else {
4559       call = 1;
4560   }
4561   /*
4562    * First, if we have returned back to the level at which we
4563    * created an interpreter trace for enterstep and/or leavestep
4564          * execution traces, we remove it here.
4565    */
4566   if (flags & TCL_TRACE_LEAVE_EXEC) {
4567       if ((tcmdPtr->stepTrace != NULL) && (level == tcmdPtr->startLevel)
4568                 && (strcmp(command, tcmdPtr->startCmd) == 0)) {
4569     Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
4570     tcmdPtr->stepTrace = NULL;
4571                 if (tcmdPtr->startCmd != NULL) {
4572               ckfree((char *)tcmdPtr->startCmd);
4573           }
4574       }
4575   }
4576   
4577   /*
4578    * Second, create the tcl callback, if required.
4579    */
4580   if (call) {
4581       Tcl_SavedResult state;
4582       int stateCode, i, saveInterpFlags;
4583       Tcl_DString cmd;
4584       Tcl_DString sub;
4585 
4586       Tcl_DStringInit(&cmd);
4587       Tcl_DStringAppend(&cmd, tcmdPtr->command, (int)tcmdPtr->length);
4588       /* Append command with arguments */
4589       Tcl_DStringInit(&sub);
4590       for (i = 0; i < objc; i++) {
4591           char* str;
4592           int len;
4593           str = Tcl_GetStringFromObj(objv[i],&len);
4594           Tcl_DStringAppendElement(&sub, str);
4595       }
4596       Tcl_DStringAppendElement(&cmd, Tcl_DStringValue(&sub));
4597       Tcl_DStringFree(&sub);
4598 
4599       if (flags & TCL_TRACE_ENTER_EXEC) {
4600     /* Append trace operation */
4601     if (flags & TCL_TRACE_EXEC_DIRECT) {
4602         Tcl_DStringAppendElement(&cmd, "enter");
4603     } else {
4604         Tcl_DStringAppendElement(&cmd, "enterstep");
4605     }
4606       } else if (flags & TCL_TRACE_LEAVE_EXEC) {
4607     Tcl_Obj* resultCode;
4608     char* resultCodeStr;
4609 
4610     /* Append result code */
4611     resultCode = Tcl_NewIntObj(code);
4612     resultCodeStr = Tcl_GetString(resultCode);
4613     Tcl_DStringAppendElement(&cmd, resultCodeStr);
4614     Tcl_DecrRefCount(resultCode);
4615     
4616     /* Append result string */
4617     Tcl_DStringAppendElement(&cmd, Tcl_GetStringResult(interp));
4618     /* Append trace operation */
4619     if (flags & TCL_TRACE_EXEC_DIRECT) {
4620         Tcl_DStringAppendElement(&cmd, "leave");
4621     } else {
4622         Tcl_DStringAppendElement(&cmd, "leavestep");
4623     }
4624       } else {
4625     panic("TraceExecutionProc: bad flag combination");
4626       }
4627       
4628       /*
4629        * Execute the command.  Save the interp's result used for
4630        * the command, including the value of iPtr->returnCode which
4631        * may be modified when Tcl_Eval is invoked.  We discard any
4632        * object result the command returns.
4633        */
4634 
4635       Tcl_SaveResult(interp, &state);
4636       stateCode = iPtr->returnCode;
4637 
4638       saveInterpFlags = iPtr->flags;
4639       iPtr->flags    |= INTERP_TRACE_IN_PROGRESS;
4640       tcmdPtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
4641       tcmdPtr->refCount++;
4642       /* 
4643        * This line can have quite arbitrary side-effects,
4644        * including deleting the trace, the command being
4645        * traced, or even the interpreter.
4646        */
4647       traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
4648       tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
4649 
4650       /*
4651        * Restore the interp tracing flag to prevent cmd traces
4652        * from affecting interp traces
4653        */
4654       iPtr->flags = saveInterpFlags;;
4655       if (tcmdPtr->flags == 0) {
4656     flags |= TCL_TRACE_DESTROYED;
4657       }
4658       
4659             if (traceCode == TCL_OK) {
4660     /* Restore result if trace execution was successful */
4661     Tcl_RestoreResult(interp, &state);
4662     iPtr->returnCode = stateCode;
4663             } else {
4664     Tcl_DiscardResult(&state);
4665       }
4666 
4667       Tcl_DStringFree(&cmd);
4668   }
4669   
4670   /*
4671    * Third, if there are any step execution traces for this proc,
4672          * we register an interpreter trace to invoke enterstep and/or
4673    * leavestep traces.
4674    * We also need to save the current stack level and the proc
4675          * string in startLevel and startCmd so that we can delete this
4676          * interpreter trace when it reaches the end of this proc.
4677    */
4678   if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL)
4679       && (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC | 
4680           TCL_TRACE_LEAVE_DURING_EXEC))) {
4681     tcmdPtr->startLevel = level;
4682     tcmdPtr->startCmd = 
4683         (char *) ckalloc((unsigned) (strlen(command) + 1));
4684     strcpy(tcmdPtr->startCmd, command);
4685     tcmdPtr->refCount++;
4686     tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
4687        (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2, 
4688        TraceExecutionProc, (ClientData)tcmdPtr, 
4689        CommandObjTraceDeleted);
4690   }
4691     }
4692     if (flags & TCL_TRACE_DESTROYED) {
4693   if (tcmdPtr->stepTrace != NULL) {
4694       Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
4695       tcmdPtr->stepTrace = NULL;
4696             if (tcmdPtr->startCmd != NULL) {
4697           ckfree((char *)tcmdPtr->startCmd);
4698       }
4699   }
4700     }
4701     if (call) {
4702   tcmdPtr->refCount--;
4703   if (tcmdPtr->refCount < 0) {
4704       Tcl_Panic("TraceExecutionProc: negative TraceCommandInfo refCount");
4705   }
4706   if (tcmdPtr->refCount == 0) {
4707       ckfree((char*)tcmdPtr);
4708   }
4709     }
4710     return traceCode;
4711 }
static char* TraceVarProc (ClientData clientData, Tcl_Interp * interp, CONST char * name1, CONST char * name2, int flags) [static]

Definition at line 4733 of file tclCmdMZ.c.
References TraceVarInfo::command, TraceVarInfo::flags, TraceVarInfo::length, NULL, size_t(), Tcl_DecrRefCount, Tcl_DStringAppend(), Tcl_DStringAppendElement(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringValue, Tcl_EvalEx(), Tcl_GetObjResult(), Tcl_IncrRefCount, TCL_INTERP_DESTROYED, TCL_OK, Tcl_RestoreResult(), Tcl_SaveResult(), TCL_TRACE_ARRAY, TCL_TRACE_DESTROYED, TCL_TRACE_OLD_STYLE, TCL_TRACE_READS, TCL_TRACE_UNSETS, and TCL_TRACE_WRITES.
Referenced by Tcl_TraceObjCmd(), and TclTraceVariableObjCmd().4741 {
4742     Tcl_SavedResult state;
4743     TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
4744     char *result;
4745     int code, destroy = 0;
4746     Tcl_DString cmd;
4747 
4748     /* 
4749      * We might call Tcl_Eval() below, and that might evaluate [trace
4750      * vdelete] which might try to free tvarPtr. However we do not
4751      * need to protect anything here; it's done by our caller because
4752      * the TraceVarInfo is really part of a CompoundVarTrace. [Bug 1348775]
4753      */
4754 
4755     result = NULL;
4756     if ((tvarPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)) {
4757   if (tvarPtr->length != (size_t) 0) {
4758       /*
4759        * Generate a command to execute by appending list elements
4760        * for the two variable names and the operation. 
4761        */
4762 
4763       Tcl_DStringInit(&cmd);
4764       Tcl_DStringAppend(&cmd, tvarPtr->command, (int) tvarPtr->length);
4765       Tcl_DStringAppendElement(&cmd, name1);
4766       Tcl_DStringAppendElement(&cmd, (name2 ? name2 : ""));
4767 #ifndef TCL_REMOVE_OBSOLETE_TRACES
4768       if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) {
4769     if (flags & TCL_TRACE_ARRAY) {
4770         Tcl_DStringAppend(&cmd, " a", 2);
4771     } else if (flags & TCL_TRACE_READS) {
4772         Tcl_DStringAppend(&cmd, " r", 2);
4773     } else if (flags & TCL_TRACE_WRITES) {
4774         Tcl_DStringAppend(&cmd, " w", 2);
4775     } else if (flags & TCL_TRACE_UNSETS) {
4776         Tcl_DStringAppend(&cmd, " u", 2);
4777     }
4778       } else {
4779 #endif
4780     if (flags & TCL_TRACE_ARRAY) {
4781         Tcl_DStringAppend(&cmd, " array", 6);
4782     } else if (flags & TCL_TRACE_READS) {
4783         Tcl_DStringAppend(&cmd, " read", 5);
4784     } else if (flags & TCL_TRACE_WRITES) {
4785         Tcl_DStringAppend(&cmd, " write", 6);
4786     } else if (flags & TCL_TRACE_UNSETS) {
4787         Tcl_DStringAppend(&cmd, " unset", 6);
4788     }
4789 #ifndef TCL_REMOVE_OBSOLETE_TRACES
4790       }
4791 #endif
4792       
4793       /*
4794        * Execute the command.  Save the interp's result used for
4795        * the command. We discard any object result the command returns.
4796        *
4797        * Add the TCL_TRACE_DESTROYED flag to tvarPtr to indicate to
4798        * other areas that this will be destroyed by us, otherwise a
4799        * double-free might occur depending on what the eval does.
4800        */
4801 
4802       Tcl_SaveResult(interp, &state);
4803       if ((flags & TCL_TRACE_DESTROYED)
4804         && !(tvarPtr->flags & TCL_TRACE_DESTROYED)) {
4805     destroy = 1;
4806     tvarPtr->flags |= TCL_TRACE_DESTROYED;
4807       }
4808 
4809       code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
4810         Tcl_DStringLength(&cmd), 0);
4811       if (code != TCL_OK) {      /* copy error msg to result */
4812     register Tcl_Obj *errMsgObj = Tcl_GetObjResult(interp);
4813     Tcl_IncrRefCount(errMsgObj);
4814     result = (char *) errMsgObj;
4815       }
4816 
4817       Tcl_RestoreResult(interp, &state);
4818 
4819       Tcl_DStringFree(&cmd);
4820   }
4821     }
4822     if (destroy) {
4823   if (result != NULL) {
4824       register Tcl_Obj *errMsgObj = (Tcl_Obj *) result;
4825 
4826       Tcl_DecrRefCount(errMsgObj);
4827       result = NULL;
4828   }
4829     }
4830     return result;
4831 }

Variable Documentation
Tcl_CmdObjTraceProc TraceExecutionProc [static]

Definition at line 139 of file tclCmdMZ.c.
Referenced by TclCheckExecutionTraces().Tcl_TraceTypeObjCmd* traceSubCmds[] [static]
Initial value: {
    TclTraceExecutionObjCmd,
    TclTraceCommandObjCmd,
    TclTraceVariableObjCmd,
}
Definition at line 120 of file tclCmdMZ.c.

generic/tclCompCmds.c File Reference
#include "tclInt.h"
#include "tclCompile.h"
Defines
#define TCL_CREATE_VAR  1
#define TCL_NO_LARGE_INDEX  2
#define STATIC_VAR_LIST_SIZE  5
Functions
static ClientData DupForeachInfo _ANSI_ARGS_ ((ClientData clientData))
static int TclPushVarName _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr))
int TclCompileAppendCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
int TclCompileBreakCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
int TclCompileCatchCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
int TclCompileContinueCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
int TclCompileExprCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
int TclCompileForCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
int TclCompileForeachCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
static ClientData DupForeachInfo (ClientData clientData)
static void FreeForeachInfo (ClientData clientData)
int TclCompileIfCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
int TclCompileIncrCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
int TclCompileLappendCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
int TclCompileLindexCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
int TclCompileListCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
int TclCompileLlengthCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
int TclCompileLsetCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
int TclCompileRegexpCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
int TclCompileReturnCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
int TclCompileSetCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
int TclCompileStringCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
int TclCompileVariableCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
int TclCompileWhileCmd (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
static int TclPushVarName (Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr)
Variables
AuxDataType tclForeachInfoType

Define Documentation
#define STATIC_VAR_LIST_SIZE  5

Referenced by TclCompileForeachCmd().#define TCL_CREATE_VAR  1

Definition at line 34 of file tclCompCmds.c.
Referenced by TclCompileAppendCmd(), TclCompileIncrCmd(), TclCompileLappendCmd(), TclCompileLsetCmd(), and TclCompileSetCmd().#define TCL_NO_LARGE_INDEX  2

Definition at line 35 of file tclCompCmds.c.
Referenced by TclCompileIncrCmd().
Function Documentation
static int TclPushVarName _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr)) [static]
static ClientData DupForeachInfo _ANSI_ARGS_ ((ClientData clientData)) [static]
static ClientData DupForeachInfo (ClientData clientData) [static]

Definition at line 1039 of file tclCompCmds.c.
References ckalloc, ForeachInfo::firstValueTemp, ForeachInfo::loopCtTemp, ForeachInfo::numLists, ForeachVarList::numVars, ForeachVarList::varIndexes, and ForeachInfo::varLists.1042 {
1043     register ForeachInfo *srcPtr = (ForeachInfo *) clientData;
1044     ForeachInfo *dupPtr;
1045     register ForeachVarList *srcListPtr, *dupListPtr;
1046     int numLists = srcPtr->numLists;
1047     int numVars, i, j;
1048     
1049     dupPtr = (ForeachInfo *) ckalloc((unsigned)
1050       (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
1051     dupPtr->numLists = numLists;
1052     dupPtr->firstValueTemp = srcPtr->firstValueTemp;
1053     dupPtr->loopCtTemp = srcPtr->loopCtTemp;
1054     
1055     for (i = 0;  i < numLists;  i++) {
1056   srcListPtr = srcPtr->varLists[i];
1057   numVars = srcListPtr->numVars;
1058   dupListPtr = (ForeachVarList *) ckalloc((unsigned)
1059           sizeof(ForeachVarList) + numVars*sizeof(int));
1060   dupListPtr->numVars = numVars;
1061   for (j = 0;  j < numVars;  j++) {
1062       dupListPtr->varIndexes[j] = srcListPtr->varIndexes[j];
1063   }
1064   dupPtr->varLists[i] = dupListPtr;
1065     }
1066     return (ClientData) dupPtr;
1067 }
static void FreeForeachInfo (ClientData clientData) [static]

Definition at line 1089 of file tclCompCmds.c.
References ckfree, ForeachInfo::numLists, and ForeachInfo::varLists.1092 {
1093     register ForeachInfo *infoPtr = (ForeachInfo *) clientData;
1094     register ForeachVarList *listPtr;
1095     int numLists = infoPtr->numLists;
1096     register int i;
1097 
1098     for (i = 0;  i < numLists;  i++) {
1099   listPtr = infoPtr->varLists[i];
1100   ckfree((char *) listPtr);
1101     }
1102     ckfree((char *) infoPtr);
1103 }
int TclCompileAppendCmd (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr)

Definition at line 71 of file tclCompCmds.c.
References INST_APPEND_ARRAY1, INST_APPEND_ARRAY4, INST_APPEND_ARRAY_STK, INST_APPEND_SCALAR1, INST_APPEND_SCALAR4, INST_APPEND_STK, Tcl_Token::numComponents, Tcl_Parse::numWords, Tcl_AppendToObj(), TCL_CREATE_VAR, TCL_ERROR, Tcl_GetObjResult(), TCL_OK, TCL_OUT_LINE_COMPILE, Tcl_ResetResult(), TCL_TOKEN_SIMPLE_WORD, TclCompileSetCmd(), TclCompileTokens(), TclEmitInstInt1, TclEmitInstInt4, TclEmitOpcode, TclEmitPush, TclPushVarName(), TclRegisterNewLiteral, Tcl_Parse::tokenPtr, and Tcl_Token::type.76 {
77     Tcl_Token *varTokenPtr, *valueTokenPtr;
78     int simpleVarName, isScalar, localIndex, numWords;
79     int code = TCL_OK;
80 
81     numWords = parsePtr->numWords;
82     if (numWords == 1) {
83   Tcl_ResetResult(interp);
84   Tcl_AppendToObj(Tcl_GetObjResult(interp),
85     "wrong # args: should be \"append varName ?value value ...?\"",
86     -1);
87   return TCL_ERROR;
88     } else if (numWords == 2) {
89   /*
90    * append varName === set varName
91    */
92         return TclCompileSetCmd(interp, parsePtr, envPtr);
93     } else if (numWords > 3) {
94   /*
95    * APPEND instructions currently only handle one value
96    */
97         return TCL_OUT_LINE_COMPILE;
98     }
99 
100     /*
101      * Decide if we can use a frame slot for the var/array name or if we
102      * need to emit code to compute and push the name at runtime. We use a
103      * frame slot (entry in the array of local vars) if we are compiling a
104      * procedure body and if the name is simple text that does not include
105      * namespace qualifiers. 
106      */
107 
108     varTokenPtr = parsePtr->tokenPtr
109       + (parsePtr->tokenPtr->numComponents + 1);
110 
111     code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
112       &localIndex, &simpleVarName, &isScalar);
113     if (code != TCL_OK) {
114   goto done;
115     }
116 
117     /*
118      * We are doing an assignment, otherwise TclCompileSetCmd was called,
119      * so push the new value.  This will need to be extended to push a
120      * value for each argument.
121      */
122 
123     if (numWords > 2) {
124   valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
125   if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
126       TclEmitPush(TclRegisterNewLiteral(envPtr, 
127         valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
128   } else {
129       code = TclCompileTokens(interp, valueTokenPtr+1,
130               valueTokenPtr->numComponents, envPtr);
131       if (code != TCL_OK) {
132     goto done;
133       }
134   }
135     }
136 
137     /*
138      * Emit instructions to set/get the variable.
139      */
140 
141     if (simpleVarName) {
142   if (isScalar) {
143       if (localIndex >= 0) {
144     if (localIndex <= 255) {
145         TclEmitInstInt1(INST_APPEND_SCALAR1, localIndex, envPtr);
146     } else {
147         TclEmitInstInt4(INST_APPEND_SCALAR4, localIndex, envPtr);
148     }
149       } else {
150     TclEmitOpcode(INST_APPEND_STK, envPtr);
151       }
152   } else {
153       if (localIndex >= 0) {
154     if (localIndex <= 255) {
155         TclEmitInstInt1(INST_APPEND_ARRAY1, localIndex, envPtr);
156     } else {
157         TclEmitInstInt4(INST_APPEND_ARRAY4, localIndex, envPtr);
158     }
159       } else {
160     TclEmitOpcode(INST_APPEND_ARRAY_STK, envPtr);
161       }
162   }
163     } else {
164   TclEmitOpcode(INST_APPEND_STK, envPtr);
165     }
166 
167     done:
168     return code;
169 }
int TclCompileBreakCmd (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr)

Definition at line 191 of file tclCompCmds.c.
References INST_BREAK, Tcl_Parse::numWords, Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), TCL_OK, Tcl_ResetResult(), and TclEmitOpcode.196 {
197     if (parsePtr->numWords != 1) {
198   Tcl_ResetResult(interp);
199   Tcl_AppendToObj(Tcl_GetObjResult(interp),
200           "wrong # args: should be \"break\"", -1);
201   return TCL_ERROR;
202     }
203 
204     /*
205      * Emit a break instruction.
206      */
207 
208     TclEmitOpcode(INST_BREAK, envPtr);
209     return TCL_OK;
210 }
int TclCompileCatchCmd (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr)

Definition at line 236 of file tclCompCmds.c.
References CATCH_EXCEPTION_RANGE, ExceptionRange::catchOffset, CompileEnv::codeNext, JumpFixup::codeOffset, ExceptionRange::codeOffset, CompileEnv::codeStart, CONST, CompileEnv::currStackDepth, CompileEnv::exceptArrayPtr, CompileEnv::exceptDepth, INST_BEGIN_CATCH4, INST_END_CATCH, INST_EVAL_STK, INST_POP, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, INST_STORE_SCALAR1, INST_STORE_SCALAR4, CompileEnv::maxExceptDepth, NULL, ExceptionRange::numCodeBytes, Tcl_Token::numComponents, Tcl_Parse::numWords, panic, CompileEnv::procPtr, range(), Tcl_Token::size, Tcl_Token::start, Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), TCL_OK, TCL_OUT_LINE_COMPILE, Tcl_ResetResult(), TCL_TOKEN_SIMPLE_WORD, TCL_UNCONDITIONAL_JUMP, TclCompileCmdWord(), TclCompileTokens(), TclCreateExceptRange(), TclEmitForwardJump(), TclEmitInstInt1, TclEmitInstInt4, TclEmitOpcode, TclEmitPush, TclFindCompiledLocal(), TclFixupForwardJump(), TclIsLocalScalar(), TclMax, TclRegisterNewLiteral, Tcl_Parse::tokenPtr, Tcl_Token::type, and VAR_SCALAR.241 {
242     JumpFixup jumpFixup;
243     Tcl_Token *cmdTokenPtr, *nameTokenPtr;
244     CONST char *name;
245     int localIndex, nameChars, range, startOffset, jumpDist;
246     int code;
247     int savedStackDepth = envPtr->currStackDepth;
248 
249     if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
250   Tcl_ResetResult(interp);
251   Tcl_AppendToObj(Tcl_GetObjResult(interp),
252           "wrong # args: should be \"catch command ?varName?\"", -1);
253   return TCL_ERROR;
254     }
255 
256     /*
257      * If a variable was specified and the catch command is at global level
258      * (not in a procedure), don't compile it inline: the payoff is
259      * too small.
260      */
261 
262     if ((parsePtr->numWords == 3) && (envPtr->procPtr == NULL)) {
263   return TCL_OUT_LINE_COMPILE;
264     }
265 
266     /*
267      * Make sure the variable name, if any, has no substitutions and just
268      * refers to a local scaler.
269      */
270 
271     localIndex = -1;
272     cmdTokenPtr = parsePtr->tokenPtr
273       + (parsePtr->tokenPtr->numComponents + 1);
274     if (parsePtr->numWords == 3) {
275   nameTokenPtr = cmdTokenPtr + (cmdTokenPtr->numComponents + 1);
276   if (nameTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
277       name = nameTokenPtr[1].start;
278       nameChars = nameTokenPtr[1].size;
279       if (!TclIsLocalScalar(name, nameChars)) {
280     return TCL_OUT_LINE_COMPILE;
281       }
282       localIndex = TclFindCompiledLocal(nameTokenPtr[1].start,
283         nameTokenPtr[1].size, /*create*/ 1, 
284         /*flags*/ VAR_SCALAR, envPtr->procPtr);
285   } else {
286      return TCL_OUT_LINE_COMPILE;
287   }
288     }
289 
290     /*
291      * We will compile the catch command. Emit a beginCatch instruction at
292      * the start of the catch body: the subcommand it controls.
293      */
294     
295     envPtr->exceptDepth++;
296     envPtr->maxExceptDepth =
297   TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
298     range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
299     TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
300 
301     /*
302      * If the body is a simple word, compile the instructions to
303      * eval it. Otherwise, compile instructions to substitute its
304      * text without catching, a catch instruction that resets the 
305      * stack to what it was before substituting the body, and then 
306      * an instruction to eval the body. Care has to be taken to 
307      * register the correct startOffset for the catch range so that
308      * errors in the substitution are not catched [Bug 219184]
309      */
310 
311     if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
312   startOffset = (envPtr->codeNext - envPtr->codeStart);
313   code = TclCompileCmdWord(interp, cmdTokenPtr+1, 1, envPtr);
314     } else {
315   code = TclCompileTokens(interp, cmdTokenPtr+1,
316           cmdTokenPtr->numComponents, envPtr);
317   startOffset = (envPtr->codeNext - envPtr->codeStart);
318   TclEmitOpcode(INST_EVAL_STK, envPtr);
319     }
320     envPtr->exceptArrayPtr[range].codeOffset = startOffset;
321 
322     if (code != TCL_OK) {
323   code = TCL_OUT_LINE_COMPILE;
324   goto done;
325     }
326     envPtr->exceptArrayPtr[range].numCodeBytes =
327       (envPtr->codeNext - envPtr->codeStart) - startOffset;
328         
329     /*
330      * The "no errors" epilogue code: store the body's result into the
331      * variable (if any), push "0" (TCL_OK) as the catch's "no error"
332      * result, and jump around the "error case" code.
333      */
334 
335     if (localIndex != -1) {
336   if (localIndex <= 255) {
337       TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
338   } else {
339       TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
340   }
341     }
342     TclEmitOpcode(INST_POP, envPtr);
343     TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr);
344     TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
345 
346     /*
347      * The "error case" code: store the body's result into the variable (if
348      * any), then push the error result code. The initial PC offset here is
349      * the catch's error target.
350      */
351 
352     envPtr->currStackDepth = savedStackDepth;
353     envPtr->exceptArrayPtr[range].catchOffset =
354       (envPtr->codeNext - envPtr->codeStart);
355     if (localIndex != -1) {
356   TclEmitOpcode(INST_PUSH_RESULT, envPtr);
357   if (localIndex <= 255) {
358       TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
359   } else {
360       TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
361   }
362   TclEmitOpcode(INST_POP, envPtr);
363     }
364     TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
365 
366 
367     /*
368      * Update the target of the jump after the "no errors" code, then emit
369      * an endCatch instruction at the end of the catch command.
370      */
371 
372     jumpDist = (envPtr->codeNext - envPtr->codeStart)
373       - jumpFixup.codeOffset;
374     if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
375   panic("TclCompileCatchCmd: bad jump distance %d\n", jumpDist);
376     }
377     TclEmitOpcode(INST_END_CATCH, envPtr);
378 
379     done:
380     envPtr->currStackDepth = savedStackDepth + 1;
381     envPtr->exceptDepth--;
382     return code;
383 }
int TclCompileContinueCmd (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr)

Definition at line 405 of file tclCompCmds.c.
References INST_CONTINUE, Tcl_Parse::numWords, Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), TCL_OK, Tcl_ResetResult(), and TclEmitOpcode.410 {
411     /*
412      * There should be no argument after the "continue".
413      */
414 
415     if (parsePtr->numWords != 1) {
416   Tcl_ResetResult(interp);
417   Tcl_AppendToObj(Tcl_GetObjResult(interp),
418           "wrong # args: should be \"continue\"", -1);
419   return TCL_ERROR;
420     }
421 
422     /*
423      * Emit a continue instruction.
424      */
425 
426     TclEmitOpcode(INST_CONTINUE, envPtr);
427     return TCL_OK;
428 }
int TclCompileExprCmd (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr)

Definition at line 450 of file tclCompCmds.c.
References Tcl_Token::numComponents, Tcl_Parse::numWords, Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), Tcl_ResetResult(), TclCompileExprWords(), and Tcl_Parse::tokenPtr.455 {
456     Tcl_Token *firstWordPtr;
457 
458     if (parsePtr->numWords == 1) {
459   Tcl_ResetResult(interp);
460   Tcl_AppendToObj(Tcl_GetObjResult(interp),
461           "wrong # args: should be \"expr arg ?arg ...?\"", -1);
462         return TCL_ERROR;
463     }
464 
465     firstWordPtr = parsePtr->tokenPtr
466       + (parsePtr->tokenPtr->numComponents + 1);
467     return TclCompileExprWords(interp, firstWordPtr, (parsePtr->numWords-1),
468       envPtr);
469 }
int TclCompileForCmd (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr)

Definition at line 490 of file tclCompCmds.c.
References ExceptionRange::breakOffset, CompileEnv::codeNext, ExceptionRange::codeOffset, JumpFixup::codeOffset, CompileEnv::codeStart, ExceptionRange::continueOffset, CompileEnv::currStackDepth, CompileEnv::exceptArrayPtr, CompileEnv::exceptDepth, INST_JUMP_TRUE1, INST_JUMP_TRUE4, INST_POP, LOOP_EXCEPTION_RANGE, CompileEnv::maxExceptDepth, ExceptionRange::numCodeBytes, Tcl_Token::numComponents, Tcl_Parse::numWords, Tcl_AddObjErrorInfo(), Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), TCL_INTEGER_SPACE, TCL_OK, TCL_OUT_LINE_COMPILE, Tcl_ResetResult(), TCL_TOKEN_SIMPLE_WORD, TCL_UNCONDITIONAL_JUMP, TclCompileCmdWord(), TclCompileExprWords(), TclCreateExceptRange(), TclEmitForwardJump(), TclEmitInstInt1, TclEmitInstInt4, TclEmitOpcode, TclEmitPush, TclFixupForwardJump(), TclMax, TclRegisterNewLiteral, Tcl_Parse::tokenPtr, and Tcl_Token::type.495 {
496     Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
497     JumpFixup jumpEvalCondFixup;
498     int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist;
499     int bodyRange, nextRange, code;
500     char buffer[32 + TCL_INTEGER_SPACE];
501     int savedStackDepth = envPtr->currStackDepth;
502 
503     if (parsePtr->numWords != 5) {
504   Tcl_ResetResult(interp);
505   Tcl_AppendToObj(Tcl_GetObjResult(interp),
506           "wrong # args: should be \"for start test next command\"", -1);
507   return TCL_ERROR;
508     }
509 
510     /*
511      * If the test expression requires substitutions, don't compile the for
512      * command inline. E.g., the expression might cause the loop to never
513      * execute or execute forever, as in "for {} "$x > 5" {incr x} {}".
514      */
515 
516     startTokenPtr = parsePtr->tokenPtr
517       + (parsePtr->tokenPtr->numComponents + 1);
518     testTokenPtr = startTokenPtr + (startTokenPtr->numComponents + 1);
519     if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
520   return TCL_OUT_LINE_COMPILE;
521     }
522 
523     /*
524      * Bail out also if the body or the next expression require substitutions
525      * in order to insure correct behaviour [Bug 219166]
526      */
527 
528     nextTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
529     bodyTokenPtr = nextTokenPtr + (nextTokenPtr->numComponents + 1);
530     if ((nextTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) 
531       || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
532   return TCL_OUT_LINE_COMPILE;
533     }
534 
535     /*
536      * Create ExceptionRange records for the body and the "next" command.
537      * The "next" command's ExceptionRange supports break but not continue
538      * (and has a -1 continueOffset).
539      */
540 
541     envPtr->exceptDepth++;
542     envPtr->maxExceptDepth =
543       TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
544     bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
545     nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
546 
547     /*
548      * Inline compile the initial command.
549      */
550 
551     code = TclCompileCmdWord(interp, startTokenPtr+1,
552       startTokenPtr->numComponents, envPtr);
553     if (code != TCL_OK) {
554   if (code == TCL_ERROR) {
555             Tcl_AddObjErrorInfo(interp,
556               "\n    (\"for\" initial command)", -1);
557         }
558   goto done;
559     }
560     TclEmitOpcode(INST_POP, envPtr);
561    
562     /*
563      * Jump to the evaluation of the condition. This code uses the "loop
564      * rotation" optimisation (which eliminates one branch from the loop).
565      * "for start cond next body" produces then:
566      *       start
567      *       goto A
568      *    B: body                : bodyCodeOffset
569      *       next                : nextCodeOffset, continueOffset
570      *    A: cond -> result      : testCodeOffset
571      *       if (result) goto B
572      */
573 
574     TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);
575 
576     /*
577      * Compile the loop body.
578      */
579 
580     bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
581 
582     code = TclCompileCmdWord(interp, bodyTokenPtr+1,
583       bodyTokenPtr->numComponents, envPtr);
584     envPtr->currStackDepth = savedStackDepth + 1;
585     if (code != TCL_OK) {
586   if (code == TCL_ERROR) {
587       sprintf(buffer, "\n    (\"for\" body line %d)",
588         interp->errorLine);
589             Tcl_AddObjErrorInfo(interp, buffer, -1);
590         }
591   goto done;
592     }
593     envPtr->exceptArrayPtr[bodyRange].numCodeBytes =
594       (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
595     TclEmitOpcode(INST_POP, envPtr);
596 
597 
598     /*
599      * Compile the "next" subcommand.
600      */
601 
602     nextCodeOffset = (envPtr->codeNext - envPtr->codeStart);
603 
604     envPtr->currStackDepth = savedStackDepth;
605     code = TclCompileCmdWord(interp, nextTokenPtr+1,
606       nextTokenPtr->numComponents, envPtr);
607     envPtr->currStackDepth = savedStackDepth + 1;
608     if (code != TCL_OK) {
609   if (code == TCL_ERROR) {
610       Tcl_AddObjErrorInfo(interp,
611               "\n    (\"for\" loop-end command)", -1);
612   }
613   goto done;
614     }
615     envPtr->exceptArrayPtr[nextRange].numCodeBytes =
616       (envPtr->codeNext - envPtr->codeStart)
617       - nextCodeOffset;
618     TclEmitOpcode(INST_POP, envPtr);
619     envPtr->currStackDepth = savedStackDepth;
620 
621     /*
622      * Compile the test expression then emit the conditional jump that
623      * terminates the for.
624      */
625 
626     testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
627 
628     jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
629     if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
630   bodyCodeOffset += 3;
631   nextCodeOffset += 3;
632   testCodeOffset += 3;
633     }
634     
635     envPtr->currStackDepth = savedStackDepth;
636     code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
637     if (code != TCL_OK) {
638   if (code == TCL_ERROR) {
639       Tcl_AddObjErrorInfo(interp,
640         "\n    (\"for\" test expression)", -1);
641   }
642   goto done;
643     }
644     envPtr->currStackDepth = savedStackDepth + 1;
645     
646     jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
647     if (jumpDist > 127) {
648   TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
649     } else {
650   TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
651     }
652     
653     /*
654      * Set the loop's offsets and break target.
655      */
656 
657     envPtr->exceptArrayPtr[bodyRange].codeOffset = bodyCodeOffset;
658     envPtr->exceptArrayPtr[bodyRange].continueOffset = nextCodeOffset;
659 
660     envPtr->exceptArrayPtr[nextRange].codeOffset = nextCodeOffset;
661 
662     envPtr->exceptArrayPtr[bodyRange].breakOffset =
663             envPtr->exceptArrayPtr[nextRange].breakOffset =
664       (envPtr->codeNext - envPtr->codeStart);
665     
666     /*
667      * The for command's result is an empty string.
668      */
669 
670     envPtr->currStackDepth = savedStackDepth;
671     TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
672     code = TCL_OK;
673 
674     done:
675     envPtr->exceptDepth--;
676     return code;
677 }
int TclCompileForeachCmd (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr)

Definition at line 703 of file tclCompCmds.c.
References ExceptionRange::breakOffset, ckalloc, ckfree, CompileEnv::codeNext, JumpFixup::codeOffset, ExceptionRange::codeOffset, CompileEnv::codeStart, CONST, ExceptionRange::continueOffset, CompileEnv::currStackDepth, CompileEnv::exceptArrayPtr, CompileEnv::exceptDepth, ForeachInfo::firstValueTemp, INST_FOREACH_START4, INST_FOREACH_STEP4, INST_JUMP1, INST_JUMP4, INST_POP, INST_STORE_SCALAR1, INST_STORE_SCALAR4, LOOP_EXCEPTION_RANGE, ForeachInfo::loopCtTemp, CompileEnv::maxExceptDepth, NULL, ExceptionRange::numCodeBytes, Tcl_Token::numComponents, ForeachInfo::numLists, Tcl_Parse::numWords, CompileEnv::procPtr, range(), STATIC_VAR_LIST_SIZE, Tcl_AddObjErrorInfo(), Tcl_AppendToObj(), Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, TCL_ERROR, TCL_FALSE_JUMP, Tcl_GetObjResult(), TCL_INTEGER_SPACE, TCL_OK, TCL_OUT_LINE_COMPILE, Tcl_ResetResult(), Tcl_SplitList(), TCL_TOKEN_SIMPLE_WORD, TclCompileCmdWord(), TclCompileTokens(), TclCreateAuxData(), TclCreateExceptRange(), TclEmitForwardJump(), TclEmitInstInt1, TclEmitInstInt4, TclEmitOpcode, TclEmitPush, TclFindCompiledLocal(), TclFixupForwardJump(), tclForeachInfoType, TclIsLocalScalar(), TclMax, TclRegisterNewLiteral, TclUpdateInstInt1AtPc, TclUpdateInstInt4AtPc, Tcl_Parse::tokenPtr, Tcl_Token::type, VAR_SCALAR, and ForeachInfo::varLists.708 {
709     Proc *procPtr = envPtr->procPtr;
710     ForeachInfo *infoPtr; /* Points to the structure describing this
711          * foreach command. Stored in a AuxData
712          * record in the ByteCode. */
713     int firstValueTemp;   /* Index of the first temp var in the frame
714          * used to point to a value list. */
715     int loopCtTemp;   /* Index of temp var holding the loop's
716          * iteration count. */
717     Tcl_Token *tokenPtr, *bodyTokenPtr;
718     unsigned char *jumpPc;
719     JumpFixup jumpFalseFixup;
720     int jumpDist, jumpBackDist, jumpBackOffset, infoIndex, range;
721     int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
722     char buffer[32 + TCL_INTEGER_SPACE];
723     int savedStackDepth = envPtr->currStackDepth;
724 
725     /*
726      * We parse the variable list argument words and create two arrays:
727      *    varcList[i] is number of variables in i-th var list
728      *    varvList[i] points to array of var names in i-th var list
729      */
730 
731 #define STATIC_VAR_LIST_SIZE 5
732     int varcListStaticSpace[STATIC_VAR_LIST_SIZE];
733     CONST char **varvListStaticSpace[STATIC_VAR_LIST_SIZE];
734     int *varcList = varcListStaticSpace;
735     CONST char ***varvList = varvListStaticSpace;
736 
737     /*
738      * If the foreach command isn't in a procedure, don't compile it inline:
739      * the payoff is too small.
740      */
741 
742     if (procPtr == NULL) {
743   return TCL_OUT_LINE_COMPILE;
744     }
745 
746     numWords = parsePtr->numWords;
747     if ((numWords < 4) || (numWords%2 != 0)) {
748   Tcl_ResetResult(interp);
749   Tcl_AppendToObj(Tcl_GetObjResult(interp),
750           "wrong # args: should be \"foreach varList list ?varList list ...? command\"", -1);
751         return TCL_ERROR;
752     }
753 
754     /*
755      * Bail out if the body requires substitutions
756      * in order to insure correct behaviour [Bug 219166]
757      */
758     for (i = 0, tokenPtr = parsePtr->tokenPtr;
759       i < numWords-1;
760       i++, tokenPtr += (tokenPtr->numComponents + 1)) {
761     }
762     bodyTokenPtr = tokenPtr;
763     if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
764   return TCL_OUT_LINE_COMPILE;
765     }
766 
767     /*
768      * Allocate storage for the varcList and varvList arrays if necessary.
769      */
770 
771     numLists = (numWords - 2)/2;
772     if (numLists > STATIC_VAR_LIST_SIZE) {
773         varcList = (int *) ckalloc(numLists * sizeof(int));
774         varvList = (CONST char ***) ckalloc(numLists * sizeof(CONST char **));
775     }
776     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
777         varcList[loopIndex] = 0;
778         varvList[loopIndex] = NULL;
779     }
780     
781     /*
782      * Set the exception stack depth.
783      */ 
784 
785     envPtr->exceptDepth++;
786     envPtr->maxExceptDepth =
787   TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
788 
789     /*
790      * Break up each var list and set the varcList and varvList arrays.
791      * Don't compile the foreach inline if any var name needs substitutions
792      * or isn't a scalar, or if any var list needs substitutions.
793      */
794 
795     loopIndex = 0;
796     for (i = 0, tokenPtr = parsePtr->tokenPtr;
797       i < numWords-1;
798       i++, tokenPtr += (tokenPtr->numComponents + 1)) {
799   if (i%2 == 1) {
800       if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
801     code = TCL_OUT_LINE_COMPILE;
802     goto done;
803       } else {
804     /* Lots of copying going on here.  Need a ListObj wizard
805      * to show a better way. */
806 
807     Tcl_DString varList;
808 
809     Tcl_DStringInit(&varList);
810     Tcl_DStringAppend(&varList, tokenPtr[1].start,
811       tokenPtr[1].size);
812     code = Tcl_SplitList(interp, Tcl_DStringValue(&varList),
813       &varcList[loopIndex], &varvList[loopIndex]);
814     Tcl_DStringFree(&varList);
815     if (code != TCL_OK) {
816         goto done;
817     }
818     numVars = varcList[loopIndex];
819     for (j = 0;  j < numVars;  j++) {
820         CONST char *varName = varvList[loopIndex][j];
821         if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
822       code = TCL_OUT_LINE_COMPILE;
823       goto done;
824         }
825     }
826       }
827       loopIndex++;
828   }
829     }
830 
831     /*
832      * We will compile the foreach command.
833      * Reserve (numLists + 1) temporary variables:
834      *    - numLists temps to hold each value list
835      *    - 1 temp for the loop counter (index of next element in each list)
836      * At this time we don't try to reuse temporaries; if there are two
837      * nonoverlapping foreach loops, they don't share any temps.
838      */
839 
840     firstValueTemp = -1;
841     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
842   tempVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
843     /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
844   if (loopIndex == 0) {
845       firstValueTemp = tempVar;
846   }
847     }
848     loopCtTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
849       /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
850     
851     /*
852      * Create and initialize the ForeachInfo and ForeachVarList data
853      * structures describing this command. Then create a AuxData record
854      * pointing to the ForeachInfo structure.
855      */
856 
857     infoPtr = (ForeachInfo *) ckalloc((unsigned)
858       (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
859     infoPtr->numLists = numLists;
860     infoPtr->firstValueTemp = firstValueTemp;
861     infoPtr->loopCtTemp = loopCtTemp;
862     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
863   ForeachVarList *varListPtr;
864   numVars = varcList[loopIndex];
865   varListPtr = (ForeachVarList *) ckalloc((unsigned)
866           sizeof(ForeachVarList) + (numVars * sizeof(int)));
867   varListPtr->numVars = numVars;
868   for (j = 0;  j < numVars;  j++) {
869       CONST char *varName = varvList[loopIndex][j];
870       int nameChars = strlen(varName);
871       varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
872         nameChars, /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
873   }
874   infoPtr->varLists[loopIndex] = varListPtr;
875     }
876     infoIndex = TclCreateAuxData((ClientData) infoPtr, &tclForeachInfoType, envPtr);
877 
878     /*
879      * Evaluate then store each value list in the associated temporary.
880      */
881 
882     range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
883     
884     loopIndex = 0;
885     for (i = 0, tokenPtr = parsePtr->tokenPtr;
886       i < numWords-1;
887       i++, tokenPtr += (tokenPtr->numComponents + 1)) {
888   if ((i%2 == 0) && (i > 0)) {
889       code = TclCompileTokens(interp, tokenPtr+1,
890         tokenPtr->numComponents, envPtr);
891       if (code != TCL_OK) {
892     goto done;
893       }
894 
895       tempVar = (firstValueTemp + loopIndex);
896       if (tempVar <= 255) {
897     TclEmitInstInt1(INST_STORE_SCALAR1, tempVar, envPtr);
898       } else {
899     TclEmitInstInt4(INST_STORE_SCALAR4, tempVar, envPtr);
900       }
901       TclEmitOpcode(INST_POP, envPtr);
902       loopIndex++;
903   }
904     }
905 
906     /*
907      * Initialize the temporary var that holds the count of loop iterations.
908      */
909 
910     TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);
911     
912     /*
913      * Top of loop code: assign each loop variable and check whether
914      * to terminate the loop.
915      */
916 
917     envPtr->exceptArrayPtr[range].continueOffset =
918       (envPtr->codeNext - envPtr->codeStart);
919     TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
920     TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
921     
922     /*
923      * Inline compile the loop body.
924      */
925 
926     envPtr->exceptArrayPtr[range].codeOffset =
927       (envPtr->codeNext - envPtr->codeStart);
928     code = TclCompileCmdWord(interp, bodyTokenPtr+1,
929       bodyTokenPtr->numComponents, envPtr);
930     envPtr->currStackDepth = savedStackDepth + 1;
931     if (code != TCL_OK) {
932   if (code == TCL_ERROR) {
933       sprintf(buffer, "\n    (\"foreach\" body line %d)",
934         interp->errorLine);
935             Tcl_AddObjErrorInfo(interp, buffer, -1);
936         }
937   goto done;
938     }
939     envPtr->exceptArrayPtr[range].numCodeBytes =
940       (envPtr->codeNext - envPtr->codeStart)
941       - envPtr->exceptArrayPtr[range].codeOffset;
942     TclEmitOpcode(INST_POP, envPtr);
943   
944     /*
945      * Jump back to the test at the top of the loop. Generate a 4 byte jump
946      * if the distance to the test is > 120 bytes. This is conservative and
947      * ensures that we won't have to replace this jump if we later need to
948      * replace the ifFalse jump with a 4 byte jump.
949      */
950 
951     jumpBackOffset = (envPtr->codeNext - envPtr->codeStart);
952     jumpBackDist =
953   (jumpBackOffset - envPtr->exceptArrayPtr[range].continueOffset);
954     if (jumpBackDist > 120) {
955   TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
956     } else {
957   TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
958     }
959 
960     /*
961      * Fix the target of the jump after the foreach_step test.
962      */
963 
964     jumpDist = (envPtr->codeNext - envPtr->codeStart)
965       - jumpFalseFixup.codeOffset;
966     if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
967   /*
968    * Update the loop body's starting PC offset since it moved down.
969    */
970 
971   envPtr->exceptArrayPtr[range].codeOffset += 3;
972 
973   /*
974    * Update the jump back to the test at the top of the loop since it
975    * also moved down 3 bytes.
976    */
977 
978   jumpBackOffset += 3;
979   jumpPc = (envPtr->codeStart + jumpBackOffset);
980   jumpBackDist += 3;
981   if (jumpBackDist > 120) {
982       TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
983   } else {
984       TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
985   }
986     }
987 
988     /*
989      * Set the loop's break target.
990      */
991 
992     envPtr->exceptArrayPtr[range].breakOffset =
993       (envPtr->codeNext - envPtr->codeStart);
994     
995     /*
996      * The foreach command's result is an empty string.
997      */
998 
999     envPtr->currStackDepth = savedStackDepth;
1000     TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
1001     envPtr->currStackDepth = savedStackDepth + 1;
1002 
1003     done:
1004     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
1005   if (varvList[loopIndex] != (CONST char **) NULL) {
1006       ckfree((char *) varvList[loopIndex]);
1007   }
1008     }
1009     if (varcList != varcListStaticSpace) {
1010   ckfree((char *) varcList);
1011         ckfree((char *) varvList);
1012     }
1013     envPtr->exceptDepth--;
1014     return code;
1015 }
int TclCompileIfCmd (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr)

Definition at line 1128 of file tclCompCmds.c.
References CONST, CompileEnv::currStackDepth, Tcl_Parse::numWords, TCL_OUT_LINE_COMPILE, TCL_TOKEN_SIMPLE_WORD, Tcl_Parse::tokenPtr, Tcl_Token::type, and word().1133 {
1134     JumpFixupArray jumpFalseFixupArray;
1135             /* Used to fix the ifFalse jump after each
1136          * test when its target PC is determined. */
1137     JumpFixupArray jumpEndFixupArray;
1138         /* Used to fix the jump after each "then"
1139          * body to the end of the "if" when that PC
1140          * is determined. */
1141     Tcl_Token *tokenPtr, *testTokenPtr;
1142     int jumpDist, jumpFalseDist;
1143     int jumpIndex = 0;          /* avoid compiler warning. */
1144     int numWords, wordIdx, numBytes, j, code;
1145     CONST char *word;
1146     char buffer[100];
1147     int savedStackDepth = envPtr->currStackDepth;
1148                                 /* Saved stack depth at the start of the first
1149          * test; the envPtr current depth is restored
1150          * to this value at the start of each test. */
1151     int realCond = 1;           /* set to 0 for static conditions: "if 0 {..}" */
1152     int boolVal;                /* value of static condition */
1153     int compileScripts = 1;            
1154 
1155     /*
1156      * Only compile the "if" command if all arguments are simple
1157      * words, in order to insure correct substitution [Bug 219166]
1158      */
1159 
1160     tokenPtr = parsePtr->tokenPtr;
1161     wordIdx = 0;
1162     numWords = parsePtr->numWords;
1163 
1164     for (wordIdx = 0; wordIdx < numWords; wordIdx++) {
1165   if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
1166       return TCL_OUT_LINE_COMPILE;
1167   }
1168   tokenPtr += 2;
1169     }
1170 
1171 
1172     TclInitJumpFixupArray(&jumpFalseFixupArray);
1173     TclInitJumpFixupArray(&jumpEndFixupArray);
1174     code = TCL_OK;
1175 
1176     /*
1177      * Each iteration of this loop compiles one "if expr ?then? body"
1178      * or "elseif expr ?then? body" clause. 
1179      */
1180 
1181     tokenPtr = parsePtr->tokenPtr;
1182     wordIdx = 0;
1183     while (wordIdx < numWords) {
1184   /*
1185    * Stop looping if the token isn't "if" or "elseif".
1186    */
1187 
1188   word = tokenPtr[1].start;
1189   numBytes = tokenPtr[1].size;
1190   if ((tokenPtr == parsePtr->tokenPtr)
1191           || ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) {
1192       tokenPtr += (tokenPtr->numComponents + 1);
1193       wordIdx++;
1194   } else {
1195       break;
1196   }
1197   if (wordIdx >= numWords) {
1198       sprintf(buffer,
1199               "wrong # args: no expression after \"%.*s\" argument",
1200         (numBytes > 50 ? 50 : numBytes), word);
1201       Tcl_ResetResult(interp);
1202       Tcl_AppendToObj(Tcl_GetObjResult(interp), buffer, -1);
1203       code = TCL_ERROR;
1204       goto done;
1205   }
1206 
1207   /*
1208    * Compile the test expression then emit the conditional jump
1209    * around the "then" part. 
1210    */
1211   
1212   envPtr->currStackDepth = savedStackDepth;
1213   testTokenPtr = tokenPtr;
1214 
1215 
1216   if (realCond) {
1217       /*
1218        * Find out if the condition is a constant. 
1219        */
1220   
1221       Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start,
1222         testTokenPtr[1].size);
1223       Tcl_IncrRefCount(boolObj);
1224       code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
1225       Tcl_DecrRefCount(boolObj);
1226       if (code == TCL_OK) {
1227     /*
1228      * A static condition
1229      */
1230     realCond = 0;
1231     if (!boolVal) {
1232         compileScripts = 0;
1233     }
1234       } else {
1235     Tcl_ResetResult(interp);
1236     code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
1237     if (code != TCL_OK) {
1238         if (code == TCL_ERROR) {
1239       Tcl_AddObjErrorInfo(interp,
1240               "\n    (\"if\" test expression)", -1);
1241         }
1242         goto done;
1243     }
1244     if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
1245         TclExpandJumpFixupArray(&jumpFalseFixupArray);
1246     }
1247     jumpIndex = jumpFalseFixupArray.next;
1248     jumpFalseFixupArray.next++;
1249     TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
1250              &(jumpFalseFixupArray.fixup[jumpIndex]));      
1251       }
1252   }
1253 
1254 
1255   /*
1256    * Skip over the optional "then" before the then clause.
1257    */
1258 
1259   tokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
1260   wordIdx++;
1261   if (wordIdx >= numWords) {
1262       sprintf(buffer,
1263         "wrong # args: no script following \"%.*s\" argument",
1264         (testTokenPtr->size > 50 ? 50 : testTokenPtr->size),
1265         testTokenPtr->start);
1266       Tcl_ResetResult(interp);
1267       Tcl_AppendToObj(Tcl_GetObjResult(interp), buffer, -1);
1268       code = TCL_ERROR;
1269       goto done;
1270   }
1271   if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
1272       word = tokenPtr[1].start;
1273       numBytes = tokenPtr[1].size;
1274       if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) {
1275     tokenPtr += (tokenPtr->numComponents + 1);
1276     wordIdx++;
1277     if (wordIdx >= numWords) {
1278         Tcl_ResetResult(interp);
1279         Tcl_AppendToObj(Tcl_GetObjResult(interp),
1280                 "wrong # args: no script following \"then\" argument", -1);
1281         code = TCL_ERROR;
1282         goto done;
1283     }
1284       }
1285   }
1286 
1287   /*
1288    * Compile the "then" command body.
1289    */
1290 
1291   if (compileScripts) {
1292       envPtr->currStackDepth = savedStackDepth;
1293       code = TclCompileCmdWord(interp, tokenPtr+1,
1294               tokenPtr->numComponents, envPtr);
1295       if (code != TCL_OK) {
1296     if (code == TCL_ERROR) {
1297         sprintf(buffer, "\n    (\"if\" then script line %d)",
1298                 interp->errorLine);
1299         Tcl_AddObjErrorInfo(interp, buffer, -1);
1300     }
1301     goto done;
1302       } 
1303   }
1304 
1305   if (realCond) {
1306       /*
1307        * Jump to the end of the "if" command. Both jumpFalseFixupArray and
1308        * jumpEndFixupArray are indexed by "jumpIndex".
1309        */
1310       
1311       if (jumpEndFixupArray.next >= jumpEndFixupArray.end) {
1312     TclExpandJumpFixupArray(&jumpEndFixupArray);
1313       }
1314       jumpEndFixupArray.next++;
1315       TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
1316               &(jumpEndFixupArray.fixup[jumpIndex]));
1317       
1318       /*
1319        * Fix the target of the jumpFalse after the test. Generate a 4 byte
1320        * jump if the distance is > 120 bytes. This is conservative, and
1321        * ensures that we won't have to replace this jump if we later also
1322        * need to replace the proceeding jump to the end of the "if" with a
1323        * 4 byte jump.
1324        */
1325 
1326       jumpDist = (envPtr->codeNext - envPtr->codeStart)
1327               - jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
1328       if (TclFixupForwardJump(envPtr,
1329               &(jumpFalseFixupArray.fixup[jumpIndex]), jumpDist, 120)) {
1330     /*
1331      * Adjust the code offset for the proceeding jump to the end
1332      * of the "if" command.
1333      */
1334     
1335     jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
1336       }
1337   } else if (boolVal) {
1338       /* 
1339        *We were processing an "if 1 {...}"; stop compiling
1340        * scripts
1341        */
1342 
1343       compileScripts = 0;
1344   } else {
1345       /* 
1346        *We were processing an "if 0 {...}"; reset so that
1347        * the rest (elseif, else) is compiled correctly
1348        */
1349 
1350       realCond = 1;
1351       compileScripts = 1;
1352   } 
1353 
1354   tokenPtr += (tokenPtr->numComponents + 1);
1355   wordIdx++;
1356     }
1357 
1358     /*
1359      * Restore the current stack depth in the environment; the 
1360      * "else" clause (or its default) will add 1 to this.
1361      */
1362 
1363     envPtr->currStackDepth = savedStackDepth;
1364 
1365     /*
1366      * Check for the optional else clause. Do not compile
1367      * anything if this was an "if 1 {...}" case.
1368      */
1369 
1370     if ((wordIdx < numWords)
1371       && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
1372   /*
1373    * There is an else clause. Skip over the optional "else" word.
1374    */
1375 
1376   word = tokenPtr[1].start;
1377   numBytes = tokenPtr[1].size;
1378   if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) {
1379       tokenPtr += (tokenPtr->numComponents + 1);
1380       wordIdx++;
1381       if (wordIdx >= numWords) {
1382     Tcl_ResetResult(interp);
1383     Tcl_AppendToObj(Tcl_GetObjResult(interp),
1384             "wrong # args: no script following \"else\" argument", -1);
1385     code = TCL_ERROR;
1386     goto done;
1387       }
1388   }
1389 
1390   if (compileScripts) {
1391       /*
1392        * Compile the else command body.
1393        */
1394       
1395       code = TclCompileCmdWord(interp, tokenPtr+1,
1396         tokenPtr->numComponents, envPtr);
1397       if (code != TCL_OK) {
1398     if (code == TCL_ERROR) {
1399         sprintf(buffer, "\n    (\"if\" else script line %d)",
1400           interp->errorLine);
1401         Tcl_AddObjErrorInfo(interp, buffer, -1);
1402     }
1403     goto done;
1404       }
1405   }
1406 
1407   /*
1408    * Make sure there are no words after the else clause.
1409    */
1410   
1411   wordIdx++;
1412   if (wordIdx < numWords) {
1413       Tcl_ResetResult(interp);
1414       Tcl_AppendToObj(Tcl_GetObjResult(interp),
1415         "wrong # args: extra words after \"else\" clause in \"if\" command", -1);
1416       code = TCL_ERROR;
1417       goto done;
1418   }
1419     } else {
1420   /*
1421    * No else clause: the "if" command's result is an empty string.
1422    */
1423 
1424   if (compileScripts) {
1425       TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
1426   }
1427     }
1428 
1429     /*
1430      * Fix the unconditional jumps to the end of the "if" command.
1431      */
1432     
1433     for (j = jumpEndFixupArray.next;  j > 0;  j--) {
1434   jumpIndex = (j - 1);  /* i.e. process the closest jump first */
1435   jumpDist = (envPtr->codeNext - envPtr->codeStart)
1436           - jumpEndFixupArray.fixup[jumpIndex].codeOffset;
1437   if (TclFixupForwardJump(envPtr,
1438           &(jumpEndFixupArray.fixup[jumpIndex]), jumpDist, 127)) {
1439       /*
1440        * Adjust the immediately preceeding "ifFalse" jump. We moved
1441        * it's target (just after this jump) down three bytes.
1442        */
1443 
1444       unsigned char *ifFalsePc = envPtr->codeStart
1445               + jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
1446       unsigned char opCode = *ifFalsePc;
1447       if (opCode == INST_JUMP_FALSE1) {
1448     jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1);
1449     jumpFalseDist += 3;
1450     TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
1451       } else if (opCode == INST_JUMP_FALSE4) {
1452     jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
1453     jumpFalseDist += 3;
1454     TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
1455       } else {
1456     panic("TclCompileIfCmd: unexpected opcode updating ifFalse jump");
1457       }
1458   }
1459     }
1460 
1461     /*
1462      * Free the jumpFixupArray array if malloc'ed storage was used.
1463      */
1464 
1465     done:
1466     envPtr->currStackDepth = savedStackDepth + 1;
1467     TclFreeJumpFixupArray(&jumpFalseFixupArray);
1468     TclFreeJumpFixupArray(&jumpEndFixupArray);
1469     return code;
1470 }
int TclCompileIncrCmd (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr)

Definition at line 1496 of file tclCompCmds.c.
References CONST, INST_INCR_ARRAY1, INST_INCR_ARRAY1_IMM, INST_INCR_ARRAY_STK, INST_INCR_ARRAY_STK_IMM, INST_INCR_SCALAR1, INST_INCR_SCALAR1_IMM, INST_INCR_SCALAR_STK, INST_INCR_SCALAR_STK_IMM, INST_INCR_STK, INST_INCR_STK_IMM, NULL, Tcl_Token::numComponents, Tcl_Parse::numWords, Tcl_Token::size, Tcl_Token::start, Tcl_AppendToObj(), TCL_CREATE_VAR, Tcl_DecrRefCount, TCL_ERROR, Tcl_GetIntFromObj(), Tcl_GetObjResult(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_NO_LARGE_INDEX, TCL_OK, Tcl_ResetResult(), TCL_TOKEN_SIMPLE_WORD, TclCompileTokens(), TclEmitInstInt1, TclEmitInt1, TclEmitOpcode, TclEmitPush, TclLooksLikeInt(), TclPushVarName(), TclRegisterNewLiteral, Tcl_Parse::tokenPtr, Tcl_Token::type, and word().1501 {
1502     Tcl_Token *varTokenPtr, *incrTokenPtr;
1503     int simpleVarName, isScalar, localIndex, haveImmValue, immValue;
1504     int code = TCL_OK;
1505 
1506     if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
1507   Tcl_ResetResult(interp);
1508   Tcl_AppendToObj(Tcl_GetObjResult(interp),
1509           "wrong # args: should be \"incr varName ?increment?\"", -1);
1510   return TCL_ERROR;
1511     }
1512 
1513     varTokenPtr = parsePtr->tokenPtr
1514       + (parsePtr->tokenPtr->numComponents + 1);
1515 
1516     code = TclPushVarName(interp, varTokenPtr, envPtr, 
1517       (TCL_NO_LARGE_INDEX | TCL_CREATE_VAR),
1518       &localIndex, &simpleVarName, &isScalar);
1519     if (code != TCL_OK) {
1520   goto done;
1521     }
1522 
1523     /*
1524      * If an increment is given, push it, but see first if it's a small
1525      * integer.
1526      */
1527 
1528     haveImmValue = 0;
1529     immValue = 1;
1530     if (parsePtr->numWords == 3) {
1531   incrTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
1532   if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
1533       CONST char *word = incrTokenPtr[1].start;
1534       int numBytes = incrTokenPtr[1].size;
1535 
1536       /*
1537        * Note there is a danger that modifying the string could have
1538        * undesirable side effects.  In this case, TclLooksLikeInt has
1539        * no dependencies on shared strings so we should be safe.
1540        */
1541 
1542       if (TclLooksLikeInt(word, numBytes)) {
1543     int code;
1544     Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes);
1545     Tcl_IncrRefCount(intObj);
1546     code = Tcl_GetIntFromObj(NULL, intObj, &immValue);
1547     Tcl_DecrRefCount(intObj);
1548     if ((code == TCL_OK)
1549       && (-127 <= immValue) && (immValue <= 127)) {
1550         haveImmValue = 1;
1551     }
1552       }
1553       if (!haveImmValue) {
1554     TclEmitPush(
1555       TclRegisterNewLiteral(envPtr, word, numBytes), envPtr);
1556       }
1557   } else {
1558       code = TclCompileTokens(interp, incrTokenPtr+1, 
1559               incrTokenPtr->numComponents, envPtr);
1560       if (code != TCL_OK) {
1561     goto done;
1562       }
1563   }
1564     } else {      /* no incr amount given so use 1 */
1565   haveImmValue = 1;
1566     }
1567     
1568     /*
1569      * Emit the instruction to increment the variable.
1570      */
1571 
1572     if (simpleVarName) {
1573   if (isScalar) {
1574       if (localIndex >= 0) {
1575     if (haveImmValue) {
1576         TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr);
1577         TclEmitInt1(immValue, envPtr);
1578     } else {
1579         TclEmitInstInt1(INST_INCR_SCALAR1, localIndex, envPtr);
1580     }
1581       } else {
1582     if (haveImmValue) {
1583         TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue, envPtr);
1584     } else {
1585         TclEmitOpcode(INST_INCR_SCALAR_STK, envPtr);
1586     }
1587       }
1588   } else {
1589       if (localIndex >= 0) {
1590     if (haveImmValue) {
1591         TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr);
1592         TclEmitInt1(immValue, envPtr);
1593     } else {
1594         TclEmitInstInt1(INST_INCR_ARRAY1, localIndex, envPtr);
1595     }
1596       } else {
1597     if (haveImmValue) {
1598         TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
1599     } else {
1600         TclEmitOpcode(INST_INCR_ARRAY_STK, envPtr);
1601     }
1602       }
1603   }
1604     } else {      /* non-simple variable name */
1605   if (haveImmValue) {
1606       TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr);
1607   } else {
1608       TclEmitOpcode(INST_INCR_STK, envPtr);
1609   }
1610     }
1611   
1612     done:
1613     return code;
1614 }
int TclCompileLappendCmd (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr)

Definition at line 1640 of file tclCompCmds.c.
References INST_LAPPEND_ARRAY1, INST_LAPPEND_ARRAY4, INST_LAPPEND_ARRAY_STK, INST_LAPPEND_SCALAR1, INST_LAPPEND_SCALAR4, INST_LAPPEND_STK, NULL, Tcl_Token::numComponents, Tcl_Parse::numWords, CompileEnv::procPtr, Tcl_AppendToObj(), TCL_CREATE_VAR, TCL_ERROR, Tcl_GetObjResult(), TCL_OK, TCL_OUT_LINE_COMPILE, Tcl_ResetResult(), TCL_TOKEN_SIMPLE_WORD, TclCompileTokens(), TclEmitInstInt1, TclEmitInstInt4, TclEmitOpcode, TclEmitPush, TclPushVarName(), TclRegisterNewLiteral, Tcl_Parse::tokenPtr, and Tcl_Token::type.1645 {
1646     Tcl_Token *varTokenPtr, *valueTokenPtr;
1647     int simpleVarName, isScalar, localIndex, numWords;
1648     int code = TCL_OK;
1649 
1650     /*
1651      * If we're not in a procedure, don't compile.
1652      */
1653     if (envPtr->procPtr == NULL) {
1654   return TCL_OUT_LINE_COMPILE;
1655     }
1656 
1657     numWords = parsePtr->numWords;
1658     if (numWords == 1) {
1659   Tcl_ResetResult(interp);
1660   Tcl_AppendToObj(Tcl_GetObjResult(interp),
1661     "wrong # args: should be \"lappend varName ?value value ...?\"", -1);
1662   return TCL_ERROR;
1663     }
1664     if (numWords != 3) {
1665   /*
1666    * LAPPEND instructions currently only handle one value appends
1667    */
1668         return TCL_OUT_LINE_COMPILE;
1669     }
1670 
1671     /*
1672      * Decide if we can use a frame slot for the var/array name or if we
1673      * need to emit code to compute and push the name at runtime. We use a
1674      * frame slot (entry in the array of local vars) if we are compiling a
1675      * procedure body and if the name is simple text that does not include
1676      * namespace qualifiers. 
1677      */
1678 
1679     varTokenPtr = parsePtr->tokenPtr
1680       + (parsePtr->tokenPtr->numComponents + 1);
1681 
1682     code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
1683       &localIndex, &simpleVarName, &isScalar);
1684     if (code != TCL_OK) {
1685   goto done;
1686     }
1687 
1688     /*
1689      * If we are doing an assignment, push the new value.
1690      * In the no values case, create an empty object.
1691      */
1692 
1693     if (numWords > 2) {
1694   valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
1695   if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
1696       TclEmitPush(TclRegisterNewLiteral(envPtr, 
1697         valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
1698   } else {
1699       code = TclCompileTokens(interp, valueTokenPtr+1,
1700               valueTokenPtr->numComponents, envPtr);
1701       if (code != TCL_OK) {
1702     goto done;
1703       }
1704   }
1705     }
1706 
1707     /*
1708      * Emit instructions to set/get the variable.
1709      */
1710 
1711     /*
1712      * The *_STK opcodes should be refactored to make better use of existing
1713      * LOAD/STORE instructions.
1714      */
1715     if (simpleVarName) {
1716   if (isScalar) {
1717       if (localIndex >= 0) {
1718     if (localIndex <= 255) {
1719         TclEmitInstInt1(INST_LAPPEND_SCALAR1, localIndex, envPtr);
1720     } else {
1721         TclEmitInstInt4(INST_LAPPEND_SCALAR4, localIndex, envPtr);
1722     }
1723       } else {
1724     TclEmitOpcode(INST_LAPPEND_STK, envPtr);
1725       }
1726   } else {
1727       if (localIndex >= 0) {
1728     if (localIndex <= 255) {
1729         TclEmitInstInt1(INST_LAPPEND_ARRAY1, localIndex, envPtr);
1730     } else {
1731         TclEmitInstInt4(INST_LAPPEND_ARRAY4, localIndex, envPtr);
1732     }
1733       } else {
1734     TclEmitOpcode(INST_LAPPEND_ARRAY_STK, envPtr);
1735       }
1736   }
1737     } else {
1738   TclEmitOpcode(INST_LAPPEND_STK, envPtr);
1739     }
1740 
1741     done:
1742     return code;
1743 }
int TclCompileLindexCmd (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr)

Definition at line 1767 of file tclCompCmds.c.
References Tcl_Token::numComponents, Tcl_Parse::numWords, TCL_OK, TCL_OUT_LINE_COMPILE, TCL_TOKEN_SIMPLE_WORD, TclCompileTokens(), TclEmitPush, TclRegisterNewLiteral, Tcl_Parse::tokenPtr, and Tcl_Token::type.1772 {
1773     Tcl_Token *varTokenPtr;
1774     int code, i;
1775 
1776     int numWords;
1777     numWords = parsePtr->numWords;
1778 
1779     /*
1780      * Quit if too few args
1781      */
1782 
1783     if ( numWords <= 1 ) {
1784   return TCL_OUT_LINE_COMPILE;
1785     }
1786 
1787     varTokenPtr = parsePtr->tokenPtr
1788   + (parsePtr->tokenPtr->numComponents + 1);
1789     
1790     /*
1791      * Push the operands onto the stack.
1792      */
1793   
1794     for ( i = 1 ; i < numWords ; i++ ) {
1795   if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
1796       TclEmitPush(
1797         TclRegisterNewLiteral( envPtr, varTokenPtr[1].start,
1798         varTokenPtr[1].size), envPtr);
1799   } else {
1800       code = TclCompileTokens(interp, varTokenPtr+1,
1801             varTokenPtr->numComponents, envPtr);
1802       if (code != TCL_OK) {
1803     return code;
1804       }
1805   }
1806   varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
1807     }
1808   
1809     /*
1810      * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI
1811      * if there are multiple index args.
1812      */
1813 
1814     if ( numWords == 3 ) {
1815   TclEmitOpcode( INST_LIST_INDEX, envPtr );
1816     } else {
1817   TclEmitInstInt4( INST_LIST_INDEX_MULTI, numWords-1, envPtr );
1818     }
1819 
1820     return TCL_OK;
1821 }
int TclCompileListCmd (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr)

Definition at line 1847 of file tclCompCmds.c.
References INST_LIST, NULL, Tcl_Token::numComponents, Tcl_Parse::numWords, CompileEnv::procPtr, TCL_OK, TCL_OUT_LINE_COMPILE, TCL_TOKEN_SIMPLE_WORD, TclCompileTokens(), TclEmitInstInt4, TclEmitPush, TclRegisterNewLiteral, Tcl_Parse::tokenPtr, and Tcl_Token::type.1852 {
1853     /*
1854      * If we're not in a procedure, don't compile.
1855      */
1856     if (envPtr->procPtr == NULL) {
1857   return TCL_OUT_LINE_COMPILE;
1858     }
1859 
1860     if (parsePtr->numWords == 1) {
1861   /*
1862    * Empty args case
1863    */
1864 
1865   TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
1866     } else {
1867   /*
1868    * Push the all values onto the stack.
1869    */
1870   Tcl_Token *valueTokenPtr;
1871   int i, code, numWords;
1872 
1873   numWords = parsePtr->numWords;
1874 
1875   valueTokenPtr = parsePtr->tokenPtr
1876       + (parsePtr->tokenPtr->numComponents + 1);
1877   for (i = 1; i < numWords; i++) {
1878       if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
1879     TclEmitPush(TclRegisterNewLiteral(envPtr,
1880       valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
1881       } else {
1882     code = TclCompileTokens(interp, valueTokenPtr+1,
1883       valueTokenPtr->numComponents, envPtr);
1884     if (code != TCL_OK) {
1885         return code;
1886     }
1887       }
1888       valueTokenPtr = valueTokenPtr + (valueTokenPtr->numComponents + 1);
1889   }
1890   TclEmitInstInt4(INST_LIST, numWords - 1, envPtr);
1891     }
1892 
1893     return TCL_OK;
1894 }
int TclCompileLlengthCmd (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr)

Definition at line 1918 of file tclCompCmds.c.
References INST_LIST_LENGTH, Tcl_Token::numComponents, Tcl_Parse::numWords, TCL_ERROR, TCL_OK, Tcl_SetResult(), TCL_STATIC, TCL_TOKEN_SIMPLE_WORD, TclCompileTokens(), TclEmitOpcode, TclEmitPush, TclRegisterNewLiteral, Tcl_Parse::tokenPtr, and Tcl_Token::type.1923 {
1924     Tcl_Token *varTokenPtr;
1925     int code;
1926 
1927     if (parsePtr->numWords != 2) {
1928   Tcl_SetResult(interp, "wrong # args: should be \"llength list\"",
1929     TCL_STATIC);
1930   return TCL_ERROR;
1931     }
1932     varTokenPtr = parsePtr->tokenPtr
1933   + (parsePtr->tokenPtr->numComponents + 1);
1934 
1935     if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
1936   /*
1937    * We could simply count the number of elements here and push
1938    * that value, but that is too rare a case to waste the code space.
1939    */
1940   TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
1941     varTokenPtr[1].size), envPtr);
1942     } else {
1943   code = TclCompileTokens(interp, varTokenPtr+1,
1944     varTokenPtr->numComponents, envPtr);
1945   if (code != TCL_OK) {
1946       return code;
1947   }
1948     }
1949     TclEmitOpcode(INST_LIST_LENGTH, envPtr);
1950     return TCL_OK;
1951 }
int TclCompileLsetCmd (Tcl_Interp* interp, Tcl_Parse* parsePtr, CompileEnv* envPtr)

Definition at line 1998 of file tclCompCmds.c.
References Tcl_Token::numComponents, Tcl_Parse::numWords, TCL_CREATE_VAR, TCL_OK, TCL_OUT_LINE_COMPILE, TCL_TOKEN_SIMPLE_WORD, TclCompileTokens(), TclEmitPush, TclPushVarName(), TclRegisterNewLiteral, Tcl_Parse::tokenPtr, and Tcl_Token::type.2003 {
2004 
2005     int tempDepth;    /* Depth used for emitting one part
2006          * of the code burst. */
2007     Tcl_Token* varTokenPtr; /* Pointer to the Tcl_Token representing
2008          * the parse of the variable name */
2009 
2010     int result;     /* Status return from library calls */
2011 
2012     int localIndex;   /* Index of var in local var table */
2013     int simpleVarName;    /* Flag == 1 if var name is simple */
2014     int isScalar;   /* Flag == 1 if scalar, 0 if array */
2015 
2016     int i;
2017 
2018     /* Check argument count */
2019 
2020     if ( parsePtr->numWords < 3 ) {
2021   /* Fail at run time, not in compilation */
2022   return TCL_OUT_LINE_COMPILE;
2023     }
2024 
2025     /*
2026      * Decide if we can use a frame slot for the var/array name or if we
2027      * need to emit code to compute and push the name at runtime. We use a
2028      * frame slot (entry in the array of local vars) if we are compiling a
2029      * procedure body and if the name is simple text that does not include
2030      * namespace qualifiers. 
2031      */
2032 
2033     varTokenPtr = parsePtr->tokenPtr
2034       + (parsePtr->tokenPtr->numComponents + 1);
2035     result = TclPushVarName( interp, varTokenPtr, envPtr, 
2036             TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar );
2037     if (result != TCL_OK) {
2038   return result;
2039     }
2040 
2041     /* Push the "index" args and the new element value. */
2042 
2043     for ( i = 2; i < parsePtr->numWords; ++i ) {
2044 
2045   /* Advance to next arg */
2046 
2047   varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
2048 
2049   /* Push an arg */
2050 
2051   if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
2052       TclEmitPush(TclRegisterNewLiteral( envPtr, varTokenPtr[1].start,
2053         varTokenPtr[1].size), envPtr);
2054   } else {
2055       result = TclCompileTokens(interp, varTokenPtr+1,
2056               varTokenPtr->numComponents, envPtr);
2057       if ( result != TCL_OK ) {
2058     return result;
2059       }
2060   }
2061     }
2062 
2063     /*
2064      * Duplicate the variable name if it's been pushed.  
2065      */
2066 
2067     if ( !simpleVarName || localIndex < 0 ) {
2068   if ( !simpleVarName || isScalar ) {
2069       tempDepth = parsePtr->numWords - 2;
2070   } else {
2071       tempDepth = parsePtr->numWords - 1;
2072   }
2073   TclEmitInstInt4( INST_OVER, tempDepth, envPtr );
2074     }
2075 
2076     /*
2077      * Duplicate an array index if one's been pushed
2078      */
2079 
2080     if ( simpleVarName && !isScalar ) {
2081   if ( localIndex < 0 ) {
2082       tempDepth = parsePtr->numWords - 1;
2083   } else {
2084       tempDepth = parsePtr->numWords - 2;
2085   }
2086   TclEmitInstInt4( INST_OVER, tempDepth, envPtr );
2087     }
2088 
2089     /*
2090      * Emit code to load the variable's value.
2091      */
2092 
2093     if ( !simpleVarName ) {
2094   TclEmitOpcode( INST_LOAD_STK, envPtr );
2095     } else if ( isScalar ) {
2096   if ( localIndex < 0 ) {
2097       TclEmitOpcode( INST_LOAD_SCALAR_STK, envPtr );
2098   } else if ( localIndex < 0x100 ) {
2099       TclEmitInstInt1( INST_LOAD_SCALAR1, localIndex, envPtr );
2100   } else {
2101       TclEmitInstInt4( INST_LOAD_SCALAR4, localIndex, envPtr );
2102   }
2103     } else {
2104   if ( localIndex < 0 ) {
2105       TclEmitOpcode( INST_LOAD_ARRAY_STK, envPtr );
2106   } else if ( localIndex < 0x100 ) {
2107       TclEmitInstInt1( INST_LOAD_ARRAY1, localIndex, envPtr );
2108   } else {
2109       TclEmitInstInt4( INST_LOAD_ARRAY4, localIndex, envPtr );
2110   }
2111     }
2112 
2113     /*
2114      * Emit the correct variety of 'lset' instruction
2115      */
2116 
2117     if ( parsePtr->numWords == 4 ) {
2118   TclEmitOpcode( INST_LSET_LIST, envPtr );
2119     } else {
2120   TclEmitInstInt4( INST_LSET_FLAT, (parsePtr->numWords - 1), envPtr );
2121     }
2122 
2123     /*
2124      * Emit code to put the value back in the variable
2125      */
2126 
2127     if ( !simpleVarName ) {
2128   TclEmitOpcode( INST_STORE_STK, envPtr );
2129     } else if ( isScalar ) {
2130   if ( localIndex < 0 ) {
2131       TclEmitOpcode( INST_STORE_SCALAR_STK, envPtr );
2132   } else if ( localIndex < 0x100 ) {
2133       TclEmitInstInt1( INST_STORE_SCALAR1, localIndex, envPtr );
2134   } else {
2135       TclEmitInstInt4( INST_STORE_SCALAR4, localIndex, envPtr );
2136   }
2137     } else {
2138   if ( localIndex < 0 ) {
2139       TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr );
2140   } else if ( localIndex < 0x100 ) {
2141       TclEmitInstInt1( INST_STORE_ARRAY1, localIndex, envPtr );
2142   } else {
2143       TclEmitInstInt4( INST_STORE_ARRAY4, localIndex, envPtr );
2144   }
2145     }
2146     
2147     return TCL_OK;
2148 
2149 }
int TclCompileRegexpCmd (Tcl_Interp* interp, Tcl_Parse* parsePtr, CompileEnv* envPtr)

Definition at line 2174 of file tclCompCmds.c.
References Tcl_Token::numComponents, Tcl_Parse::numWords, Tcl_Token::size, TCL_OUT_LINE_COMPILE, TCL_TOKEN_SIMPLE_WORD, Tcl_Parse::tokenPtr, and Tcl_Token::type.2179 {
2180     Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing
2181          * the parse of the RE or string */
2182     int i, len, code, nocase, anchorLeft, anchorRight, start;
2183     char *str;
2184 
2185     /*
2186      * We are only interested in compiling simple regexp cases.
2187      * Currently supported compile cases are:
2188      *   regexp ?-nocase? ?--? staticString $var
2189      *   regexp ?-nocase? ?--? {^staticString$} $var
2190      */
2191     if (parsePtr->numWords < 3) {
2192   return TCL_OUT_LINE_COMPILE;
2193     }
2194 
2195     nocase = 0;
2196     varTokenPtr = parsePtr->tokenPtr;
2197 
2198     /*
2199      * We only look for -nocase and -- as options.  Everything else
2200      * gets pushed to runtime execution.  This is different than regexp's
2201      * runtime option handling, but satisfies our stricter needs.
2202      */
2203     for (i = 1; i < parsePtr->numWords - 2; i++) {
2204   varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
2205   if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
2206       /* Not a simple string - punt to runtime. */
2207       return TCL_OUT_LINE_COMPILE;
2208   }
2209   str = (char *) varTokenPtr[1].start;
2210   len = varTokenPtr[1].size;
2211   if ((len == 2) && (str[0] == '-') && (str[1] == '-')) {
2212       i++;
2213       break;
2214   } else if ((len > 1)
2215     && (strncmp(str, "-nocase", (unsigned) len) == 0)) {
2216       nocase = 1;
2217   } else {
2218       /* Not an option we recognize. */
2219       return TCL_OUT_LINE_COMPILE;
2220   }
2221     }
2222 
2223     if ((parsePtr->numWords - i) != 2) {
2224   /* We don't support capturing to variables */
2225   return TCL_OUT_LINE_COMPILE;
2226     }
2227 
2228     /*
2229      * Get the regexp string.  If it is not a simple string, punt to runtime.
2230      * If it has a '-', it could be an incorrectly formed regexp command.
2231      */
2232     varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
2233     str = (char *) varTokenPtr[1].start;
2234     len = varTokenPtr[1].size;
2235     if ((varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (*str == '-')) {
2236   return TCL_OUT_LINE_COMPILE;
2237     }
2238 
2239     if (len == 0) {
2240   /*
2241    * The semantics of regexp are always match on re == "".
2242    */
2243   TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);
2244   return TCL_OK;
2245     }
2246 
2247     /*
2248      * Make a copy of the string that is null-terminated for checks which
2249      * require such.
2250      */
2251     str = (char *) ckalloc((unsigned) len + 1);
2252     strncpy(str, varTokenPtr[1].start, (size_t) len);
2253     str[len] = '\0';
2254     start = 0;
2255 
2256     /*
2257      * Check for anchored REs (ie ^foo$), so we can use string equal if
2258      * possible. Do not alter the start of str so we can free it correctly.
2259      */
2260     if (str[0] == '^') {
2261   start++;
2262   anchorLeft = 1;
2263     } else {
2264   anchorLeft = 0;
2265     }
2266     if ((str[len-1] == '$') && ((len == 1) || (str[len-2] != '\\'))) {
2267   anchorRight = 1;
2268   str[--len] = '\0';
2269     } else {
2270   anchorRight = 0;
2271     }
2272 
2273     /*
2274      * On the first (pattern) arg, check to see if any RE special characters
2275      * are in the word.  If not, this is the same as 'string equal'.
2276      */
2277     if ((len > (1+start)) && (str[start] == '.') && (str[start+1] == '*')) {
2278   start += 2;
2279   anchorLeft = 0;
2280     }
2281     if ((len > (2+start)) && (str[len-3] != '\\')
2282       && (str[len-2] == '.') && (str[len-1] == '*')) {
2283   len -= 2;
2284   str[len] = '\0';
2285   anchorRight = 0;
2286     }
2287 
2288     /*
2289      * Don't do anything with REs with other special chars.  Also check if
2290      * this is a bad RE (do this at the end because it can be expensive).
2291      * If so, let it complain at runtime.
2292      */
2293     if ((strpbrk(str + start, "*+?{}()[].\\|^$") != NULL)
2294       || (Tcl_RegExpCompile(NULL, str) == NULL)) {
2295   ckfree((char *) str);
2296   return TCL_OUT_LINE_COMPILE;
2297     }
2298 
2299     if (anchorLeft && anchorRight) {
2300   TclEmitPush(TclRegisterNewLiteral(envPtr, str+start, len-start),
2301     envPtr);
2302     } else {
2303   /*
2304    * This needs to find the substring anywhere in the string, so
2305    * use string match and *foo*, with appropriate anchoring.
2306    */
2307   char *newStr  = ckalloc((unsigned) len + 3);
2308   len -= start;
2309   if (anchorLeft) {
2310       strncpy(newStr, str + start, (size_t) len);
2311   } else {
2312       newStr[0] = '*';
2313       strncpy(newStr + 1, str + start, (size_t) len++);
2314   }
2315   if (!anchorRight) {
2316       newStr[len++] = '*';
2317   }
2318   newStr[len] = '\0';
2319   TclEmitPush(TclRegisterNewLiteral(envPtr, newStr, len), envPtr);
2320   ckfree((char *) newStr);
2321     }
2322     ckfree((char *) str);
2323 
2324     /*
2325      * Push the string arg
2326      */
2327     varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
2328     if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
2329   TclEmitPush(TclRegisterNewLiteral(envPtr,
2330     varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
2331     } else {
2332   code = TclCompileTokens(interp, varTokenPtr+1,
2333     varTokenPtr->numComponents, envPtr);
2334   if (code != TCL_OK) {
2335       return code;
2336   }
2337     }
2338 
2339     if (anchorLeft && anchorRight && !nocase) {
2340   TclEmitOpcode(INST_STR_EQ, envPtr);
2341     } else {
2342   TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
2343     }
2344 
2345     return TCL_OK;
2346 }
int TclCompileReturnCmd (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr)

Definition at line 2372 of file tclCompCmds.c.
References CATCH_EXCEPTION_RANGE, CompileEnv::exceptArrayNext, CompileEnv::exceptArrayPtr, INST_DONE, NULL, Tcl_Token::numComponents, Tcl_Parse::numWords, CompileEnv::procPtr, range(), TCL_OK, TCL_OUT_LINE_COMPILE, TCL_TOKEN_SIMPLE_WORD, TclCompileTokens(), TclEmitOpcode, TclEmitPush, TclRegisterNewLiteral, Tcl_Parse::tokenPtr, and Tcl_Token::type.2377 {
2378     Tcl_Token *varTokenPtr;
2379     int code;
2380     int index = envPtr->exceptArrayNext - 1;
2381 
2382     /*
2383      * If we're not in a procedure, don't compile.
2384      */
2385 
2386     if (envPtr->procPtr == NULL) {
2387   return TCL_OUT_LINE_COMPILE;
2388     }
2389 
2390     /*
2391      * Look back through the ExceptionRanges of the current CompileEnv,
2392      * from exceptArrayPtr[(exceptArrayNext - 1)] down to 
2393      * exceptArrayPtr[0] to see if any of them is an enclosing [catch].
2394      * If there's an enclosing [catch], don't compile.
2395      */
2396 
2397     while (index >= 0) {
2398   ExceptionRange range = envPtr->exceptArrayPtr[index];
2399   if ((range.type == CATCH_EXCEPTION_RANGE) 
2400     && (range.catchOffset == -1)) {
2401       return TCL_OUT_LINE_COMPILE;
2402   }
2403   index--;
2404     }
2405 
2406     switch (parsePtr->numWords) {
2407   case 1: {
2408       /*
2409        * Simple case:  [return]
2410        * Just push the literal string "".
2411        */
2412       TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
2413       break;
2414   }
2415   case 2: {
2416       /*
2417        * More complex cases:
2418        * [return "foo"]
2419        * [return $value]
2420        * [return [otherCmd]]
2421        */
2422       varTokenPtr = parsePtr->tokenPtr
2423     + (parsePtr->tokenPtr->numComponents + 1);
2424       if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
2425     /*
2426      * [return "foo"] case:  the parse token is a simple word,
2427      * so just push it.
2428      */
2429     TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
2430       varTokenPtr[1].size), envPtr);
2431       } else {
2432     /*
2433      * Parse token is more complex, so compile it; this handles the
2434      * variable reference and nested command cases.  If the
2435      * parse token can be byte-compiled, then this instance of
2436      * "return" will be byte-compiled; otherwise it will be
2437      * out line compiled.
2438      */
2439     code = TclCompileTokens(interp, varTokenPtr+1,
2440       varTokenPtr->numComponents, envPtr);
2441     if (code != TCL_OK) {
2442         return code;
2443     }
2444       }
2445       break;
2446   }
2447   default: {
2448       /*
2449        * Most complex return cases: everything else, including
2450        * [return -code error], etc.
2451        */
2452       return TCL_OUT_LINE_COMPILE;
2453   }
2454     }
2455 
2456     /*
2457      * The INST_DONE opcode actually causes the branching out of the
2458      * subroutine, and takes the top stack item as the return result
2459      * (which is why we pushed the value above).
2460      */
2461     TclEmitOpcode(INST_DONE, envPtr);
2462     return TCL_OK;
2463 }
int TclCompileSetCmd (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr)

Definition at line 2489 of file tclCompCmds.c.
References INST_LOAD_ARRAY1, INST_LOAD_ARRAY4, INST_LOAD_ARRAY_STK, INST_LOAD_SCALAR1, INST_LOAD_SCALAR4, INST_LOAD_SCALAR_STK, INST_LOAD_STK, INST_STORE_ARRAY1, INST_STORE_ARRAY4, INST_STORE_ARRAY_STK, INST_STORE_SCALAR1, INST_STORE_SCALAR4, INST_STORE_SCALAR_STK, INST_STORE_STK, Tcl_Token::numComponents, Tcl_Parse::numWords, Tcl_AppendToObj(), TCL_CREATE_VAR, TCL_ERROR, Tcl_GetObjResult(), TCL_OK, Tcl_ResetResult(), TCL_TOKEN_SIMPLE_WORD, TclCompileTokens(), TclEmitInstInt1, TclEmitInstInt4, TclEmitOpcode, TclEmitPush, TclPushVarName(), TclRegisterNewLiteral, Tcl_Parse::tokenPtr, and Tcl_Token::type.
Referenced by TclCompileAppendCmd().2494 {
2495     Tcl_Token *varTokenPtr, *valueTokenPtr;
2496     int isAssignment, isScalar, simpleVarName, localIndex, numWords;
2497     int code = TCL_OK;
2498 
2499     numWords = parsePtr->numWords;
2500     if ((numWords != 2) && (numWords != 3)) {
2501   Tcl_ResetResult(interp);
2502   Tcl_AppendToObj(Tcl_GetObjResult(interp),
2503           "wrong # args: should be \"set varName ?newValue?\"", -1);
2504         return TCL_ERROR;
2505     }
2506     isAssignment = (numWords == 3);
2507 
2508     /*
2509      * Decide if we can use a frame slot for the var/array name or if we
2510      * need to emit code to compute and push the name at runtime. We use a
2511      * frame slot (entry in the array of local vars) if we are compiling a
2512      * procedure body and if the name is simple text that does not include
2513      * namespace qualifiers. 
2514      */
2515 
2516     varTokenPtr = parsePtr->tokenPtr
2517       + (parsePtr->tokenPtr->numComponents + 1);
2518 
2519     code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
2520       &localIndex, &simpleVarName, &isScalar);
2521     if (code != TCL_OK) {
2522   goto done;
2523     }
2524 
2525     /*
2526      * If we are doing an assignment, push the new value.
2527      */
2528 
2529     if (isAssignment) {
2530   valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
2531   if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
2532       TclEmitPush(TclRegisterNewLiteral(envPtr, valueTokenPtr[1].start,
2533         valueTokenPtr[1].size), envPtr);
2534   } else {
2535       code = TclCompileTokens(interp, valueTokenPtr+1,
2536               valueTokenPtr->numComponents, envPtr);
2537       if (code != TCL_OK) {
2538     goto done;
2539       }
2540   }
2541     }
2542 
2543     /*
2544      * Emit instructions to set/get the variable.
2545      */
2546 
2547     if (simpleVarName) {
2548   if (isScalar) {
2549       if (localIndex >= 0) {
2550     if (localIndex <= 255) {
2551         TclEmitInstInt1((isAssignment?
2552                 INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
2553           localIndex, envPtr);
2554     } else {
2555         TclEmitInstInt4((isAssignment?
2556           INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
2557           localIndex, envPtr);
2558     }
2559       } else {
2560     TclEmitOpcode((isAssignment?
2561             INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK), envPtr);
2562       }
2563   } else {
2564       if (localIndex >= 0) {
2565     if (localIndex <= 255) {
2566         TclEmitInstInt1((isAssignment?
2567                 INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
2568           localIndex, envPtr);
2569     } else {
2570         TclEmitInstInt4((isAssignment?
2571           INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
2572           localIndex, envPtr);
2573     }
2574       } else {
2575     TclEmitOpcode((isAssignment?
2576             INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), envPtr);
2577       }
2578   }
2579     } else {
2580   TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK), envPtr);
2581     }
2582   
2583     done:
2584     return code;
2585 }
int TclCompileStringCmd (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr)

Definition at line 2609 of file tclCompCmds.c.
References CONST, INST_STR_CMP, INST_STR_EQ, INST_STR_INDEX, INST_STR_LEN, INST_STR_MATCH, NULL, Tcl_Token::numComponents, Tcl_Parse::numWords, Tcl_Token::size, size_t(), Tcl_Token::start, Tcl_DecrRefCount, Tcl_GetIndexFromObj(), Tcl_GetString(), Tcl_IncrRefCount, TCL_INTEGER_SPACE, Tcl_NewStringObj(), Tcl_NumUtfChars(), TCL_OK, TCL_OUT_LINE_COMPILE, Tcl_ResetResult(), TCL_TOKEN_SIMPLE_WORD, TclCompileTokens(), TclEmitInstInt1, TclEmitOpcode, TclEmitPush, TclRegisterNewLiteral, Tcl_Parse::tokenPtr, and Tcl_Token::type.2614 {
2615     Tcl_Token *opTokenPtr, *varTokenPtr;
2616     Tcl_Obj *opObj;
2617     int index;
2618     int code;
2619     
2620     static CONST char *options[] = {
2621   "bytelength", "compare",  "equal",  "first",
2622   "index",  "is",   "last",   "length",
2623   "map",    "match",  "range",  "repeat",
2624   "replace",  "tolower",  "toupper",  "totitle",
2625   "trim",   "trimleft", "trimright",
2626   "wordend",  "wordstart",  (char *) NULL
2627     };
2628     enum options {
2629   STR_BYTELENGTH, STR_COMPARE,  STR_EQUAL,  STR_FIRST,
2630   STR_INDEX,  STR_IS,   STR_LAST, STR_LENGTH,
2631   STR_MAP,  STR_MATCH,  STR_RANGE,  STR_REPEAT,
2632   STR_REPLACE,  STR_TOLOWER,  STR_TOUPPER,  STR_TOTITLE,
2633   STR_TRIM, STR_TRIMLEFT, STR_TRIMRIGHT,
2634   STR_WORDEND,  STR_WORDSTART
2635     };    
2636 
2637     if (parsePtr->numWords < 2) {
2638   /* Fail at run time, not in compilation */
2639   return TCL_OUT_LINE_COMPILE;
2640     }
2641     opTokenPtr = parsePtr->tokenPtr
2642   + (parsePtr->tokenPtr->numComponents + 1);
2643 
2644     opObj = Tcl_NewStringObj(opTokenPtr->start, opTokenPtr->size);
2645     if (Tcl_GetIndexFromObj(interp, opObj, options, "option", 0,
2646       &index) != TCL_OK) {
2647   Tcl_DecrRefCount(opObj);
2648   Tcl_ResetResult(interp);
2649   return TCL_OUT_LINE_COMPILE;
2650     }
2651     Tcl_DecrRefCount(opObj);
2652 
2653     varTokenPtr = opTokenPtr + (opTokenPtr->numComponents + 1);
2654 
2655     switch ((enum options) index) {
2656   case STR_BYTELENGTH:
2657   case STR_FIRST:
2658   case STR_IS:
2659   case STR_LAST:
2660   case STR_MAP:
2661   case STR_RANGE:
2662   case STR_REPEAT:
2663   case STR_REPLACE:
2664   case STR_TOLOWER:
2665   case STR_TOUPPER:
2666   case STR_TOTITLE:
2667   case STR_TRIM:
2668   case STR_TRIMLEFT:
2669   case STR_TRIMRIGHT:
2670   case STR_WORDEND:
2671   case STR_WORDSTART:
2672       /*
2673        * All other cases: compile out of line.
2674        */
2675       return TCL_OUT_LINE_COMPILE;
2676 
2677   case STR_COMPARE: 
2678   case STR_EQUAL: {
2679       int i;
2680       /*
2681        * If there are any flags to the command, we can't byte compile it
2682        * because the INST_STR_EQ bytecode doesn't support flags.
2683        */
2684 
2685       if (parsePtr->numWords != 4) {
2686     return TCL_OUT_LINE_COMPILE;
2687       }
2688 
2689       /*
2690        * Push the two operands onto the stack.
2691        */
2692 
2693       for (i = 0; i < 2; i++) {
2694     if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
2695         TclEmitPush(TclRegisterNewLiteral(envPtr,
2696           varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
2697     } else {
2698         code = TclCompileTokens(interp, varTokenPtr+1,
2699           varTokenPtr->numComponents, envPtr);
2700         if (code != TCL_OK) {
2701       return code;
2702         }
2703     }
2704     varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
2705       }
2706 
2707       TclEmitOpcode(((((enum options) index) == STR_COMPARE) ?
2708         INST_STR_CMP : INST_STR_EQ), envPtr);
2709       return TCL_OK;
2710   }
2711   case STR_INDEX: {
2712       int i;
2713 
2714       if (parsePtr->numWords != 4) {
2715     /* Fail at run time, not in compilation */
2716     return TCL_OUT_LINE_COMPILE;
2717       }
2718 
2719       /*
2720        * Push the two operands onto the stack.
2721        */
2722 
2723       for (i = 0; i < 2; i++) {
2724     if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
2725         TclEmitPush(TclRegisterNewLiteral(envPtr,
2726           varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
2727     } else {
2728         code = TclCompileTokens(interp, varTokenPtr+1,
2729           varTokenPtr->numComponents, envPtr);
2730         if (code != TCL_OK) {
2731       return code;
2732         }
2733     }
2734     varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
2735       }
2736 
2737       TclEmitOpcode(INST_STR_INDEX, envPtr);
2738       return TCL_OK;
2739   }
2740   case STR_LENGTH: {
2741       if (parsePtr->numWords != 3) {
2742     /* Fail at run time, not in compilation */
2743     return TCL_OUT_LINE_COMPILE;
2744       }
2745 
2746       if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
2747     /*
2748      * Here someone is asking for the length of a static string.
2749      * Just push the actual character (not byte) length.
2750      */
2751     char buf[TCL_INTEGER_SPACE];
2752     int len = Tcl_NumUtfChars(varTokenPtr[1].start,
2753       varTokenPtr[1].size);
2754     len = sprintf(buf, "%d", len);
2755     TclEmitPush(TclRegisterNewLiteral(envPtr, buf, len), envPtr);
2756     return TCL_OK;
2757       } else {
2758     code = TclCompileTokens(interp, varTokenPtr+1,
2759       varTokenPtr->numComponents, envPtr);
2760     if (code != TCL_OK) {
2761         return code;
2762     }
2763       }
2764       TclEmitOpcode(INST_STR_LEN, envPtr);
2765       return TCL_OK;
2766   }
2767   case STR_MATCH: {
2768       int i, length, exactMatch = 0, nocase = 0;
2769       CONST char *str;
2770 
2771       if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
2772     /* Fail at run time, not in compilation */
2773     return TCL_OUT_LINE_COMPILE;
2774       }
2775 
2776       if (parsePtr->numWords == 5) {
2777     if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
2778         return TCL_OUT_LINE_COMPILE;
2779     }
2780     str    = varTokenPtr[1].start;
2781     length = varTokenPtr[1].size;
2782     if ((length > 1) &&
2783       strncmp(str, "-nocase", (size_t) length) == 0) {
2784         nocase = 1;
2785     } else {
2786         /* Fail at run time, not in compilation */
2787         return TCL_OUT_LINE_COMPILE;
2788     }
2789     varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
2790       }
2791 
2792       for (i = 0; i < 2; i++) {
2793     if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
2794         str = varTokenPtr[1].start;
2795         length = varTokenPtr[1].size;
2796         if (!nocase && (i == 0)) {
2797       /*
2798        * On the first (pattern) arg, check to see if any
2799        * glob special characters are in the word '*[]?\\'.
2800        * If not, this is the same as 'string equal'.  We
2801        * can use strpbrk here because the glob chars are all
2802        * in the ascii-7 range.  If -nocase was specified,
2803        * we can't do this because INST_STR_EQ has no support
2804        * for nocase.
2805        */
2806       Tcl_Obj *copy = Tcl_NewStringObj(str, length);
2807       Tcl_IncrRefCount(copy);
2808       exactMatch = (strpbrk(Tcl_GetString(copy),
2809         "*[]?\\") == NULL);
2810       Tcl_DecrRefCount(copy);
2811         }
2812         TclEmitPush(
2813           TclRegisterNewLiteral(envPtr, str, length), envPtr);
2814     } else {
2815         code = TclCompileTokens(interp, varTokenPtr+1,
2816           varTokenPtr->numComponents, envPtr);
2817         if (code != TCL_OK) {
2818       return code;
2819         }
2820     }
2821     varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
2822       }
2823 
2824       if (exactMatch) {
2825     TclEmitOpcode(INST_STR_EQ, envPtr);
2826       } else {
2827     TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
2828       }
2829       return TCL_OK;
2830   }
2831     }
2832 
2833     return TCL_OK;
2834 }
int TclCompileVariableCmd (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr)

Definition at line 2853 of file tclCompCmds.c.
References CONST, NULL, Tcl_Token::numComponents, Tcl_Parse::numWords, CompileEnv::procPtr, Tcl_Token::size, Tcl_Token::start, TCL_OUT_LINE_COMPILE, TCL_TOKEN_SIMPLE_WORD, TclFindCompiledLocal(), Tcl_Parse::tokenPtr, Tcl_Token::type, and void().2858 {
2859     Tcl_Token *varTokenPtr;
2860     int i, numWords;
2861     CONST char *varName, *tail;
2862     
2863     if (envPtr->procPtr == NULL) {
2864   return TCL_OUT_LINE_COMPILE;
2865     }
2866 
2867     numWords = parsePtr->numWords;
2868     
2869     varTokenPtr = parsePtr->tokenPtr
2870   + (parsePtr->tokenPtr->numComponents + 1);
2871     for (i = 1; i < numWords; i += 2) {
2872   if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
2873       varName = varTokenPtr[1].start;
2874       tail = varName + varTokenPtr[1].size - 1;
2875       if ((*tail == ')') || (tail < varName)) continue;
2876       while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) {
2877     tail--;
2878       }
2879       if ((*tail == ':') && (tail > varName)) {
2880     tail++;
2881       }
2882       (void) TclFindCompiledLocal(tail, (tail-varName+1),
2883         /*create*/ 1, /*flags*/ 0, envPtr->procPtr);
2884       varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
2885   }
2886     }
2887     return TCL_OUT_LINE_COMPILE;
2888 }
int TclCompileWhileCmd (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr)

Definition at line 2914 of file tclCompCmds.c.
References ExceptionRange::breakOffset, CompileEnv::codeNext, ExceptionRange::codeOffset, JumpFixup::codeOffset, CompileEnv::codeStart, ExceptionRange::continueOffset, CompileEnv::currStackDepth, CompileEnv::exceptArrayPtr, CompileEnv::exceptDepth, INST_JUMP1, INST_JUMP4, INST_JUMP_TRUE1, INST_JUMP_TRUE4, INST_POP, LOOP_EXCEPTION_RANGE, CompileEnv::maxExceptDepth, NULL, ExceptionRange::numCodeBytes, Tcl_Token::numComponents, Tcl_Parse::numWords, range(), Tcl_AddObjErrorInfo(), Tcl_AppendToObj(), Tcl_DecrRefCount, TCL_ERROR, Tcl_GetBooleanFromObj(), Tcl_GetObjResult(), Tcl_IncrRefCount, TCL_INTEGER_SPACE, Tcl_NewStringObj(), TCL_OK, TCL_OUT_LINE_COMPILE, Tcl_ResetResult(), TCL_TOKEN_SIMPLE_WORD, TCL_UNCONDITIONAL_JUMP, TclCompileCmdWord(), TclCompileExprWords(), TclCreateExceptRange(), TclEmitForwardJump(), TclEmitInstInt1, TclEmitInstInt4, TclEmitOpcode, TclEmitPush, TclFixupForwardJump(), TclMax, TclRegisterNewLiteral, Tcl_Parse::tokenPtr, and Tcl_Token::type.2919 {
2920     Tcl_Token *testTokenPtr, *bodyTokenPtr;
2921     JumpFixup jumpEvalCondFixup;
2922     int testCodeOffset, bodyCodeOffset, jumpDist;
2923     int range, code;
2924     char buffer[32 + TCL_INTEGER_SPACE];
2925     int savedStackDepth = envPtr->currStackDepth;
2926     int loopMayEnd = 1;         /* This is set to 0 if it is recognized as
2927          * an infinite loop. */
2928     Tcl_Obj *boolObj;
2929     int boolVal;
2930 
2931     if (parsePtr->numWords != 3) {
2932   Tcl_ResetResult(interp);
2933   Tcl_AppendToObj(Tcl_GetObjResult(interp),
2934           "wrong # args: should be \"while test command\"", -1);
2935   return TCL_ERROR;
2936     }
2937 
2938     /*
2939      * If the test expression requires substitutions, don't compile the
2940      * while command inline. E.g., the expression might cause the loop to
2941      * never execute or execute forever, as in "while "$x < 5" {}".
2942      *
2943      * Bail out also if the body expression requires substitutions
2944      * in order to insure correct behaviour [Bug 219166]
2945      */
2946 
2947     testTokenPtr = parsePtr->tokenPtr
2948       + (parsePtr->tokenPtr->numComponents + 1);
2949     bodyTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
2950     if ((testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
2951       || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
2952   return TCL_OUT_LINE_COMPILE;
2953     }
2954 
2955     /*
2956      * Find out if the condition is a constant. 
2957      */
2958 
2959     boolObj = Tcl_NewStringObj(testTokenPtr[1].start, testTokenPtr[1].size);
2960     Tcl_IncrRefCount(boolObj);
2961     code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
2962     Tcl_DecrRefCount(boolObj);
2963     if (code == TCL_OK) {
2964   if (boolVal) {
2965       /*
2966        * it is an infinite loop 
2967        */
2968 
2969       loopMayEnd = 0;  
2970   } else {
2971       /*
2972        * This is an empty loop: "while 0 {...}" or such.
2973        * Compile no bytecodes.
2974        */
2975 
2976       goto pushResult;
2977   }
2978     }
2979 
2980     /* 
2981      * Create a ExceptionRange record for the loop body. This is used to
2982      * implement break and continue.
2983      */
2984 
2985     envPtr->exceptDepth++;
2986     envPtr->maxExceptDepth =
2987   TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
2988     range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
2989 
2990     /*
2991      * Jump to the evaluation of the condition. This code uses the "loop
2992      * rotation" optimisation (which eliminates one branch from the loop).
2993      * "while cond body" produces then:
2994      *       goto A
2995      *    B: body                : bodyCodeOffset
2996      *    A: cond -> result      : testCodeOffset, continueOffset
2997      *       if (result) goto B
2998      *
2999      * The infinite loop "while 1 body" produces:
3000      *    B: body                : all three offsets here
3001      *       goto B
3002      */
3003 
3004     if (loopMayEnd) {
3005   TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);
3006   testCodeOffset = 0; /* avoid compiler warning */
3007     } else {
3008   testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
3009     }
3010     
3011 
3012     /*
3013      * Compile the loop body.
3014      */
3015 
3016     bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
3017     code = TclCompileCmdWord(interp, bodyTokenPtr+1,
3018       bodyTokenPtr->numComponents, envPtr);
3019     envPtr->currStackDepth = savedStackDepth + 1;
3020     if (code != TCL_OK) {
3021   if (code == TCL_ERROR) {
3022       sprintf(buffer, "\n    (\"while\" body line %d)",
3023         interp->errorLine);
3024             Tcl_AddObjErrorInfo(interp, buffer, -1);
3025         }
3026   goto error;
3027     }
3028     envPtr->exceptArrayPtr[range].numCodeBytes =
3029       (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
3030     TclEmitOpcode(INST_POP, envPtr);
3031 
3032     /*
3033      * Compile the test expression then emit the conditional jump that
3034      * terminates the while. We already know it's a simple word.
3035      */
3036 
3037     if (loopMayEnd) {
3038   testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
3039   jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
3040   if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
3041       bodyCodeOffset += 3;
3042       testCodeOffset += 3;
3043   }
3044   envPtr->currStackDepth = savedStackDepth;
3045   code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
3046   if (code != TCL_OK) {
3047       if (code == TCL_ERROR) {
3048     Tcl_AddObjErrorInfo(interp,
3049             "\n    (\"while\" test expression)", -1);
3050       }
3051       goto error;
3052   }
3053   envPtr->currStackDepth = savedStackDepth + 1;
3054     
3055   jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
3056   if (jumpDist > 127) {
3057       TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
3058   } else {
3059       TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
3060   }
3061     } else {
3062   jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
3063   if (jumpDist > 127) {
3064       TclEmitInstInt4(INST_JUMP4, -jumpDist, envPtr);
3065   } else {
3066       TclEmitInstInt1(INST_JUMP1, -jumpDist, envPtr);
3067   } 
3068     }
3069 
3070 
3071     /*
3072      * Set the loop's body, continue and break offsets.
3073      */
3074 
3075     envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
3076     envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
3077     envPtr->exceptArrayPtr[range].breakOffset =
3078       (envPtr->codeNext - envPtr->codeStart);
3079     
3080     /*
3081      * The while command's result is an empty string.
3082      */
3083 
3084     pushResult:
3085     envPtr->currStackDepth = savedStackDepth;
3086     TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
3087     envPtr->exceptDepth--;
3088     return TCL_OK;
3089 
3090     error:
3091     envPtr->exceptDepth--;
3092     return code;
3093 }
static int TclPushVarName (Tcl_Interp * interp, Tcl_Token * varTokenPtr, CompileEnv * envPtr, int flags, int * localIndexPtr, int * simpleVarNamePtr, int * isScalarPtr) [static]

Definition at line 3116 of file tclCompCmds.c.
References ckalloc, CONST, NULL, Tcl_Token::numComponents, Tcl_Token::size, Tcl_Token::start, TCL_OK, TCL_TOKEN_SIMPLE_WORD, TCL_TOKEN_TEXT, and Tcl_Token::type.
Referenced by TclCompileAppendCmd(), TclCompileIncrCmd(), TclCompileLappendCmd(), TclCompileLsetCmd(), and TclCompileSetCmd().3126 {
3127     register CONST char *p;
3128     CONST char *name, *elName;
3129     register int i, n;
3130     int nameChars, elNameChars, simpleVarName, localIndex;
3131     int code = TCL_OK;
3132 
3133     Tcl_Token *elemTokenPtr = NULL;
3134     int elemTokenCount = 0;
3135     int allocedTokens = 0;
3136     int removedParen = 0;
3137 
3138     /*
3139      * Decide if we can use a frame slot for the var/array name or if we
3140      * need to emit code to compute and push the name at runtime. We use a
3141      * frame slot (entry in the array of local vars) if we are compiling a
3142      * procedure body and if the name is simple text that does not include
3143      * namespace qualifiers. 
3144      */
3145 
3146     simpleVarName = 0;
3147     name = elName = NULL;
3148     nameChars = elNameChars = 0;
3149     localIndex = -1;
3150 
3151     /*
3152      * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
3153      * curly braces surround the variable name.
3154      * This really matters for array elements to handle things like
3155      *    set {x($foo)} 5
3156      * which raises an undefined var error if we are not careful here.
3157      */
3158 
3159     if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
3160       (varTokenPtr->start[0] != '{')) {
3161   /*
3162    * A simple variable name. Divide it up into "name" and "elName"
3163    * strings. If it is not a local variable, look it up at runtime.
3164    */
3165   simpleVarName = 1;
3166 
3167   name = varTokenPtr[1].start;
3168   nameChars = varTokenPtr[1].size;
3169   if ( *(name + nameChars - 1) == ')') {
3170       /* 
3171        * last char is ')' => potential array reference.
3172        */
3173 
3174       for (i = 0, p = name;  i < nameChars;  i++, p++) {
3175     if (*p == '(') {
3176         elName = p + 1;
3177         elNameChars = nameChars - i - 2;
3178         nameChars = i ;
3179         break;
3180     }
3181       }
3182 
3183       if ((elName != NULL) && elNameChars) {
3184     /*
3185      * An array element, the element name is a simple
3186      * string: assemble the corresponding token.
3187      */
3188 
3189     elemTokenPtr = (Tcl_Token *) ckalloc(sizeof(Tcl_Token));
3190     allocedTokens = 1;
3191     elemTokenPtr->type = TCL_TOKEN_TEXT;
3192     elemTokenPtr->start = elName;
3193     elemTokenPtr->size = elNameChars;
3194     elemTokenPtr->numComponents = 0;
3195     elemTokenCount = 1;
3196       }
3197   }
3198     } else if (((n = varTokenPtr->numComponents) > 1)
3199       && (varTokenPtr[1].type == TCL_TOKEN_TEXT)
3200             && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
3201             && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
3202 
3203         /*
3204    * Check for parentheses inside first token
3205    */
3206 
3207         simpleVarName = 0;
3208         for (i = 0, p = varTokenPtr[1].start; 
3209        i < varTokenPtr[1].size; i++, p++) {
3210             if (*p == '(') {
3211                 simpleVarName = 1;
3212                 break;
3213             }
3214         }
3215         if (simpleVarName) {
3216       int remainingChars;
3217 
3218       /*
3219        * Check the last token: if it is just ')', do not count
3220        * it. Otherwise, remove the ')' and flag so that it is
3221        * restored at the end.
3222        */
3223 
3224       if (varTokenPtr[n].size == 1) {
3225     --n;
3226       } else {
3227     --varTokenPtr[n].size;
3228     removedParen = n;
3229       }
3230 
3231             name = varTokenPtr[1].start;
3232             nameChars = p - varTokenPtr[1].start;
3233             elName = p + 1;
3234             remainingChars = (varTokenPtr[2].start - p) - 1;
3235             elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2;
3236 
3237       if (remainingChars) {
3238     /*
3239      * Make a first token with the extra characters in the first 
3240      * token.
3241      */
3242 
3243     elemTokenPtr = (Tcl_Token *) ckalloc(n * sizeof(Tcl_Token));
3244     allocedTokens = 1;
3245     elemTokenPtr->type = TCL_TOKEN_TEXT;
3246     elemTokenPtr->start = elName;
3247     elemTokenPtr->size = remainingChars;
3248     elemTokenPtr->numComponents = 0;
3249     elemTokenCount = n;
3250     
3251     /*
3252      * Copy the remaining tokens.
3253      */
3254     
3255     memcpy((void *) (elemTokenPtr+1), (void *) (&varTokenPtr[2]),
3256            ((n-1) * sizeof(Tcl_Token)));
3257       } else {
3258     /*
3259      * Use the already available tokens.
3260      */
3261     
3262     elemTokenPtr = &varTokenPtr[2];
3263     elemTokenCount = n - 1;     
3264       }
3265   }
3266     }
3267 
3268     if (simpleVarName) {
3269   /*
3270    * See whether name has any namespace separators (::'s).
3271    */
3272 
3273   int hasNsQualifiers = 0;
3274   for (i = 0, p = name;  i < nameChars;  i++, p++) {
3275       if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
3276     hasNsQualifiers = 1;
3277     break;
3278       }
3279   }
3280 
3281   /*
3282    * Look up the var name's index in the array of local vars in the
3283    * proc frame. If retrieving the var's value and it doesn't already
3284    * exist, push its name and look it up at runtime.
3285    */
3286 
3287   if ((envPtr->procPtr != NULL) && !hasNsQualifiers) {
3288       localIndex = TclFindCompiledLocal(name, nameChars,
3289         /*create*/ (flags & TCL_CREATE_VAR),
3290                     /*flags*/ ((elName==NULL)? VAR_SCALAR : VAR_ARRAY),
3291         envPtr->procPtr);
3292       if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) {
3293     /* we'll push the name */
3294     localIndex = -1;
3295       }
3296   }
3297   if (localIndex < 0) {
3298       TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameChars), envPtr);
3299   }
3300 
3301   /*
3302    * Compile the element script, if any.
3303    */
3304 
3305   if (elName != NULL) {
3306       if (elNameChars) {
3307     code = TclCompileTokens(interp, elemTokenPtr,
3308                         elemTokenCount, envPtr);
3309     if (code != TCL_OK) {
3310         goto done;
3311     }
3312       } else {
3313     TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
3314       }
3315   }
3316     } else {
3317   /*
3318    * The var name isn't simple: compile and push it.
3319    */
3320 
3321   code = TclCompileTokens(interp, varTokenPtr+1,
3322     varTokenPtr->numComponents, envPtr);
3323   if (code != TCL_OK) {
3324       goto done;
3325   }
3326     }
3327 
3328     done:
3329     if (removedParen) {
3330   ++varTokenPtr[removedParen].size;
3331     }
3332     if (allocedTokens) {
3333         ckfree((char *) elemTokenPtr);
3334     }
3335     *localIndexPtr  = localIndex;
3336     *simpleVarNamePtr = simpleVarName;
3337     *isScalarPtr  = (elName == NULL);
3338     return code;
3339 }

Variable Documentation
AuxDataType tclForeachInfoType
Initial value: {
    "ForeachInfo",        
    DupForeachInfo,       
    FreeForeachInfo       
}
Definition at line 41 of file tclCompCmds.c.
Referenced by TclCompileForeachCmd(), and TclInitAuxDataTypeTable().

generic/tclCompExpr.c File Reference
#include "tclInt.h"
#include "tclCompile.h"
#include "tclPort.h"
Classes
struct ExprInfo
Defines
#define OP_MULT  0
#define OP_DIVIDE  1
#define OP_MOD  2
#define OP_PLUS  3
#define OP_MINUS  4
#define OP_LSHIFT  5
#define OP_RSHIFT  6
#define OP_LESS  7
#define OP_GREATER  8
#define OP_LE  9
#define OP_GE  10
#define OP_EQ  11
#define OP_NEQ  12
#define OP_BITAND  13
#define OP_BITXOR  14
#define OP_BITOR  15
#define OP_LAND  16
#define OP_LOR  17
#define OP_QUESTY  18
#define OP_LNOT  19
#define OP_BITNOT  20
#define OP_STREQ  21
#define OP_STRNEQ  22
#define TRACE(exprBytes, exprLength, tokenBytes, tokenLength)
Functions
TCL_DECLARE_MUTEX (opMutex)
static int CompileCondExpr _ANSI_ARGS_ ((Tcl_Token *exprTokenPtr, ExprInfo *infoPtr, CompileEnv *envPtr, Tcl_Token **endPtrPtr))
static int CompileLandOrLorExpr _ANSI_ARGS_ ((Tcl_Token *exprTokenPtr, int opIndex, ExprInfo *infoPtr, CompileEnv *envPtr, Tcl_Token **endPtrPtr))
static int CompileMathFuncCall _ANSI_ARGS_ ((Tcl_Token *exprTokenPtr, CONST char *funcName, ExprInfo *infoPtr, CompileEnv *envPtr, Tcl_Token **endPtrPtr))
static int CompileSubExpr _ANSI_ARGS_ ((Tcl_Token *exprTokenPtr, ExprInfo *infoPtr, CompileEnv *envPtr))
static void LogSyntaxError _ANSI_ARGS_ ((ExprInfo *infoPtr))
int TclCompileExpr (Tcl_Interp *interp, CONST char *script, int numBytes, CompileEnv *envPtr)
void TclFinalizeCompilation ()
static int CompileSubExpr (Tcl_Token *exprTokenPtr, ExprInfo *infoPtr, CompileEnv *envPtr)
static int CompileLandOrLorExpr (Tcl_Token *exprTokenPtr, int opIndex, ExprInfo *infoPtr, CompileEnv *envPtr, Tcl_Token **endPtrPtr)
static int CompileCondExpr (Tcl_Token *exprTokenPtr, ExprInfo *infoPtr, CompileEnv *envPtr, Tcl_Token **endPtrPtr)
static int CompileMathFuncCall (Tcl_Token *exprTokenPtr, CONST char *funcName, ExprInfo *infoPtr, CompileEnv *envPtr, Tcl_Token **endPtrPtr)
static void LogSyntaxError (ExprInfo *infoPtr)
Variables
static int opTableInitialized = 0
OperatorDesc
static OperatorDesc operatorTable []
static Tcl_HashTable opHashTable

Define Documentation
#define OP_BITAND  13

Definition at line 85 of file tclCompExpr.c.#define OP_BITNOT  20

Definition at line 92 of file tclCompExpr.c.#define OP_BITOR  15

Definition at line 87 of file tclCompExpr.c.#define OP_BITXOR  14

Definition at line 86 of file tclCompExpr.c.#define OP_DIVIDE  1

Definition at line 73 of file tclCompExpr.c.#define OP_EQ  11

Definition at line 83 of file tclCompExpr.c.#define OP_GE  10

Definition at line 82 of file tclCompExpr.c.#define OP_GREATER  8

Definition at line 80 of file tclCompExpr.c.#define OP_LAND  16

Definition at line 88 of file tclCompExpr.c.
Referenced by CompileLandOrLorExpr(), and CompileSubExpr().#define OP_LE  9

Definition at line 81 of file tclCompExpr.c.#define OP_LESS  7

Definition at line 79 of file tclCompExpr.c.#define OP_LNOT  19

Definition at line 91 of file tclCompExpr.c.#define OP_LOR  17

Definition at line 89 of file tclCompExpr.c.
Referenced by CompileSubExpr().#define OP_LSHIFT  5

Definition at line 77 of file tclCompExpr.c.#define OP_MINUS  4

Definition at line 76 of file tclCompExpr.c.
Referenced by CompileSubExpr().#define OP_MOD  2

Definition at line 74 of file tclCompExpr.c.#define OP_MULT  0

Definition at line 72 of file tclCompExpr.c.#define OP_NEQ  12

Definition at line 84 of file tclCompExpr.c.#define OP_PLUS  3

Definition at line 75 of file tclCompExpr.c.
Referenced by CompileSubExpr().#define OP_QUESTY  18

Definition at line 90 of file tclCompExpr.c.
Referenced by CompileSubExpr().#define OP_RSHIFT  6

Definition at line 78 of file tclCompExpr.c.#define OP_STREQ  21

Definition at line 93 of file tclCompExpr.c.#define OP_STRNEQ  22

Definition at line 94 of file tclCompExpr.c.#define TRACE(exprBytes, exprLength, tokenBytes, tokenLength)

Definition at line 178 of file tclCompExpr.c.
Referenced by CompileSubExpr(), and TclExecuteByteCode().
Function Documentation
static void LogSyntaxError _ANSI_ARGS_ ((ExprInfo *infoPtr)) [static]
static int CompileSubExpr _ANSI_ARGS_ ((Tcl_Token *exprTokenPtr, ExprInfo *infoPtr, CompileEnv *envPtr)) [static]
static int CompileMathFuncCall _ANSI_ARGS_ ((Tcl_Token *exprTokenPtr, CONST char *funcName, ExprInfo *infoPtr, CompileEnv *envPtr, Tcl_Token **endPtrPtr)) [static]
static int CompileLandOrLorExpr _ANSI_ARGS_ ((Tcl_Token *exprTokenPtr, int opIndex, ExprInfo *infoPtr, CompileEnv *envPtr, Tcl_Token **endPtrPtr)) [static]
static int CompileCondExpr _ANSI_ARGS_ ((Tcl_Token *exprTokenPtr, ExprInfo *infoPtr, CompileEnv *envPtr, Tcl_Token **endPtrPtr)) [static]
static int CompileCondExpr (Tcl_Token * exprTokenPtr, ExprInfo * infoPtr, CompileEnv * envPtr, Tcl_Token ** endPtrPtr) [static]

Definition at line 699 of file tclCompExpr.c.
References CompileEnv::codeNext, JumpFixup::codeOffset, CompileEnv::codeStart, CompileSubExpr(), CompileEnv::currStackDepth, ExprInfo::hasOperators, INST_TRY_CVT_TO_NUMERIC, Tcl_Token::numComponents, TCL_FALSE_JUMP, TCL_OK, TCL_UNCONDITIONAL_JUMP, TclEmitForwardJump(), TclEmitOpcode, and TclFixupForwardJump().
Referenced by CompileSubExpr().708 {
709     JumpFixup jumpAroundThenFixup, jumpAroundElseFixup;
710         /* Used to update or replace one-byte jumps
711          * around the then and else expressions when
712          * their target PCs are determined. */
713     Tcl_Token *tokenPtr;
714     int elseCodeOffset, dist, code;
715     int savedStackDepth = envPtr->currStackDepth;
716 
717     /*
718      * Emit code for the test.
719      */
720 
721     tokenPtr = exprTokenPtr+2;
722     code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
723     if (code != TCL_OK) {
724   goto done;
725     }
726     tokenPtr += (tokenPtr->numComponents + 1);
727     
728     /*
729      * Emit the jump to the "else" expression if the test was false.
730      */
731     
732     TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpAroundThenFixup);
733 
734     /*
735      * Compile the "then" expression. Note that if a subexpression is only
736      * a primary, we need to try to convert it to numeric. We do this to
737      * support Tcl's policy of interpreting operands if at all possible as
738      * first integers, else floating-point numbers.
739      */
740 
741     infoPtr->hasOperators = 0;
742     code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
743     if (code != TCL_OK) {
744   goto done;
745     }
746     tokenPtr += (tokenPtr->numComponents + 1);
747     if (!infoPtr->hasOperators) {
748   TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
749     }
750 
751     /*
752      * Emit an unconditional jump around the "else" condExpr.
753      */
754     
755     TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
756       &jumpAroundElseFixup);
757 
758     /*
759      * Compile the "else" expression.
760      */
761 
762     envPtr->currStackDepth = savedStackDepth;
763     elseCodeOffset = (envPtr->codeNext - envPtr->codeStart);
764     infoPtr->hasOperators = 0;
765     code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
766     if (code != TCL_OK) {
767   goto done;
768     }
769     tokenPtr += (tokenPtr->numComponents + 1);
770     if (!infoPtr->hasOperators) {
771   TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
772     }
773 
774     /*
775      * Fix up the second jump around the "else" expression.
776      */
777 
778     dist = (envPtr->codeNext - envPtr->codeStart)
779       - jumpAroundElseFixup.codeOffset;
780     if (TclFixupForwardJump(envPtr, &jumpAroundElseFixup, dist, 127)) {
781   /*
782    * Update the else expression's starting code offset since it
783    * moved down 3 bytes too.
784    */
785   
786   elseCodeOffset += 3;
787     }
788   
789     /*
790      * Fix up the first jump to the "else" expression if the test was false.
791      */
792     
793     dist = (elseCodeOffset - jumpAroundThenFixup.codeOffset);
794     TclFixupForwardJump(envPtr, &jumpAroundThenFixup, dist, 127);
795     *endPtrPtr = tokenPtr;
796 
797     done:
798     envPtr->currStackDepth = savedStackDepth + 1;
799     return code;
800 }
static int CompileLandOrLorExpr (Tcl_Token * exprTokenPtr, int opIndex, ExprInfo * infoPtr, CompileEnv * envPtr, Tcl_Token ** endPtrPtr) [static]

Definition at line 581 of file tclCompExpr.c.
References CompileEnv::codeNext, JumpFixup::codeOffset, CompileEnv::codeStart, CompileSubExpr(), CompileEnv::currStackDepth, INST_DUP, INST_LAND, INST_LOR, Tcl_Token::numComponents, OP_LAND, panic, TCL_FALSE_JUMP, TCL_OK, TCL_TRUE_JUMP, TCL_UNCONDITIONAL_JUMP, TclEmitForwardJump(), TclEmitOpcode, TclEmitPush, TclFixupForwardJump(), and TclRegisterNewLiteral.
Referenced by CompileSubExpr().585                     : either OP_LAND or OP_LOR. */
586     ExprInfo *infoPtr;     /* Describes the compilation state for the
587           * expression being compiled. */
588     CompileEnv *envPtr;    /* Holds resulting instructions. */
589     Tcl_Token **endPtrPtr;   /* If successful, a pointer to the token
590           * just after the last token in the
591           * subexpression is stored here. */
592 {
593     JumpFixup shortCircuitFixup; /* Used to fix up the short circuit jump
594           * after the first subexpression. */
595     JumpFixup lhsTrueFixup, lhsEndFixup;
596              /* Used to fix up jumps used to convert the
597           * first operand to 0 or 1. */
598     Tcl_Token *tokenPtr;
599     int dist, code;
600     int savedStackDepth = envPtr->currStackDepth;
601 
602     /*
603      * Emit code for the first operand.
604      */
605 
606     tokenPtr = exprTokenPtr+2;
607     code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
608     if (code != TCL_OK) {
609   goto done;
610     }
611     tokenPtr += (tokenPtr->numComponents + 1);
612 
613     /*
614      * Convert the first operand to the result that Tcl requires:
615      * "0" or "1". Eventually we'll use a new instruction for this.
616      */
617     
618     TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &lhsTrueFixup);
619     TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr);
620     TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &lhsEndFixup);
621     dist = (envPtr->codeNext - envPtr->codeStart) - lhsTrueFixup.codeOffset;
622     if (TclFixupForwardJump(envPtr, &lhsTrueFixup, dist, 127)) {
623         badDist:
624   panic("CompileLandOrLorExpr: bad jump distance %d\n", dist);
625     }
626     envPtr->currStackDepth = savedStackDepth;
627     TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);
628     dist = (envPtr->codeNext - envPtr->codeStart) - lhsEndFixup.codeOffset;
629     if (TclFixupForwardJump(envPtr, &lhsEndFixup, dist, 127)) {
630   goto badDist;
631     }
632 
633     /*
634      * Emit the "short circuit" jump around the rest of the expression.
635      * Duplicate the "0" or "1" on top of the stack first to keep the
636      * jump from consuming it.
637      */
638 
639     TclEmitOpcode(INST_DUP, envPtr);
640     TclEmitForwardJump(envPtr,
641       ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP),
642       &shortCircuitFixup);
643 
644     /*
645      * Emit code for the second operand.
646      */
647 
648     code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
649     if (code != TCL_OK) {
650   goto done;
651     }
652     tokenPtr += (tokenPtr->numComponents + 1);
653 
654     /*
655      * Emit a "logical and" or "logical or" instruction. This does not try
656      * to "short- circuit" the evaluation of both operands, but instead
657      * ensures that we either have a "1" or a "0" result.
658      */
659 
660     TclEmitOpcode(((opIndex==OP_LAND)? INST_LAND : INST_LOR), envPtr);
661 
662     /*
663      * Now that we know the target of the forward jump, update it with the
664      * correct distance.
665      */
666 
667     dist = (envPtr->codeNext - envPtr->codeStart)
668       - shortCircuitFixup.codeOffset;
669     TclFixupForwardJump(envPtr, &shortCircuitFixup, dist, 127);
670     *endPtrPtr = tokenPtr;
671 
672     done:
673     envPtr->currStackDepth = savedStackDepth + 1;
674     return code;
675 }
static int CompileMathFuncCall (Tcl_Token * exprTokenPtr, CONST char * funcName, ExprInfo * infoPtr, CompileEnv * envPtr, Tcl_Token ** endPtrPtr) [static]

Definition at line 825 of file tclCompExpr.c.
References MathFunc::builtinFuncIndex, CompileSubExpr(), CompileEnv::currStackDepth, INST_CALL_BUILTIN_FUNC1, INST_CALL_FUNC1, ExprInfo::interp, Interp::mathFuncTable, CompileEnv::maxStackDepth, NULL, MathFunc::numArgs, Tcl_Token::numComponents, Tcl_AppendToObj(), TCL_ERROR, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_GetObjResult(), TCL_OK, Tcl_ResetResult(), TclEmitInstInt1, TclEmitPush, and TclRegisterNewLiteral.
Referenced by CompileSubExpr().835 {
836     Tcl_Interp *interp = infoPtr->interp;
837     Interp *iPtr = (Interp *) interp;
838     MathFunc *mathFuncPtr;
839     Tcl_HashEntry *hPtr;
840     Tcl_Token *tokenPtr, *afterSubexprPtr;
841     int code, i;
842 
843     /*
844      * Look up the MathFunc record for the function.
845      */
846 
847     code = TCL_OK;
848     hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
849     if (hPtr == NULL) {
850   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
851     "unknown math function \"", funcName, "\"", (char *) NULL);
852   code = TCL_ERROR;
853   goto done;
854     }
855     mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
856 
857     /*
858      * If not a builtin function, push an object with the function's name.
859      */
860 
861     if (mathFuncPtr->builtinFuncIndex < 0) {
862   TclEmitPush(TclRegisterNewLiteral(envPtr, funcName, -1), envPtr);
863     }
864 
865     /*
866      * Compile any arguments for the function.
867      */
868 
869     tokenPtr = exprTokenPtr+2;
870     afterSubexprPtr = exprTokenPtr + (exprTokenPtr->numComponents + 1);
871     if (mathFuncPtr->numArgs > 0) {
872   for (i = 0;  i < mathFuncPtr->numArgs;  i++) {
873       if (tokenPtr == afterSubexprPtr) {
874     Tcl_ResetResult(interp);
875     Tcl_AppendToObj(Tcl_GetObjResult(interp),
876             "too few arguments for math function", -1);
877     code = TCL_ERROR;
878     goto done;
879       }
880       code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
881       if (code != TCL_OK) {
882     goto done;
883       }
884       tokenPtr += (tokenPtr->numComponents + 1);
885   }
886   if (tokenPtr != afterSubexprPtr) {
887       Tcl_ResetResult(interp);
888       Tcl_AppendToObj(Tcl_GetObjResult(interp),
889         "too many arguments for math function", -1);
890       code = TCL_ERROR;
891       goto done;
892   } 
893     } else if (tokenPtr != afterSubexprPtr) {
894   Tcl_ResetResult(interp);
895   Tcl_AppendToObj(Tcl_GetObjResult(interp),
896     "too many arguments for math function", -1);
897   code = TCL_ERROR;
898   goto done;
899     }
900     
901     /*
902      * Compile the call on the math function. Note that the "objc" argument
903      * count for non-builtin functions is incremented by 1 to include the
904      * function name itself.
905      */
906 
907     if (mathFuncPtr->builtinFuncIndex >= 0) { /* a builtin function */
908   /*
909    * Adjust the current stack depth by the number of arguments
910    * of the builtin function. This cannot be handled by the 
911    * TclEmitInstInt1 macro as the number of arguments is not
912    * passed as an operand.
913    */
914 
915   if (envPtr->maxStackDepth < envPtr->currStackDepth) {
916       envPtr->maxStackDepth = envPtr->currStackDepth;
917   }
918   TclEmitInstInt1(INST_CALL_BUILTIN_FUNC1,
919           mathFuncPtr->builtinFuncIndex, envPtr);
920   envPtr->currStackDepth -= mathFuncPtr->numArgs;
921     } else {
922   TclEmitInstInt1(INST_CALL_FUNC1, (mathFuncPtr->numArgs+1), envPtr);
923     }
924     *endPtrPtr = afterSubexprPtr;
925 
926     done:
927     return code;
928 }
static int CompileSubExpr (Tcl_Token * exprTokenPtr, ExprInfo * infoPtr, CompileEnv * envPtr) [static]

Definition at line 333 of file tclCompExpr.c.
References CompileCondExpr(), CompileLandOrLorExpr(), CompileMathFuncCall(), CONST, ExprInfo::hasOperators, INST_ADD, INST_SUB, INST_UMINUS, INST_UPLUS, ExprInfo::interp, LogSyntaxError(), NULL, Tcl_Token::numComponents, OP_LAND, OP_LOR, OP_MINUS, OP_PLUS, OP_QUESTY, OperatorDesc, operatorTable, opHashTable, panic, Tcl_Token::size, Tcl_Token::start, Tcl_DStringFree(), Tcl_DStringInit(), TCL_ERROR, Tcl_FindHashEntry, Tcl_GetHashValue, TCL_OK, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, TCL_TOKEN_OPERATOR, TCL_TOKEN_SUB_EXPR, TCL_TOKEN_TEXT, TCL_TOKEN_VARIABLE, TCL_TOKEN_WORD, TCL_UTF_MAX, Tcl_UtfBackslash(), TclCompileScript(), TclCompileTokens(), TclEmitOpcode, TclEmitPush, TclRegisterNewLiteral, TRACE, and Tcl_Token::type.
Referenced by CompileCondExpr(), CompileLandOrLorExpr(), CompileMathFuncCall(), and TclCompileExpr().339 {
340     Tcl_Interp *interp = infoPtr->interp;
341     Tcl_Token *tokenPtr, *endPtr = NULL; /* silence gcc 4 warning */
342     Tcl_Token *afterSubexprPtr;
343     OperatorDesc *opDescPtr;
344     Tcl_HashEntry *hPtr;
345     CONST char *operator;
346     Tcl_DString opBuf;
347     int objIndex, opIndex, length, code;
348     char buffer[TCL_UTF_MAX];
349 
350     if (exprTokenPtr->type != TCL_TOKEN_SUB_EXPR) {
351   panic("CompileSubExpr: token type %d not TCL_TOKEN_SUB_EXPR\n",
352           exprTokenPtr->type);
353     }
354     code = TCL_OK;
355 
356     /*
357      * Switch on the type of the first token after the subexpression token.
358      * After processing it, advance tokenPtr to point just after the
359      * subexpression's last token.
360      */
361     
362     tokenPtr = exprTokenPtr+1;
363     TRACE(exprTokenPtr->start, exprTokenPtr->size,
364       tokenPtr->start, tokenPtr->size);
365     switch (tokenPtr->type) {
366         case TCL_TOKEN_WORD:
367       code = TclCompileTokens(interp, tokenPtr+1,
368               tokenPtr->numComponents, envPtr);
369       if (code != TCL_OK) {
370     goto done;
371       }
372       tokenPtr += (tokenPtr->numComponents + 1);
373       break;
374       
375         case TCL_TOKEN_TEXT:
376       if (tokenPtr->size > 0) {
377     objIndex = TclRegisterNewLiteral(envPtr, tokenPtr->start,
378                   tokenPtr->size);
379       } else {
380     objIndex = TclRegisterNewLiteral(envPtr, "", 0);
381       }
382       TclEmitPush(objIndex, envPtr);
383       tokenPtr += 1;
384       break;
385       
386         case TCL_TOKEN_BS:
387       length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
388         buffer);
389       if (length > 0) {
390     objIndex = TclRegisterNewLiteral(envPtr, buffer, length);
391       } else {
392     objIndex = TclRegisterNewLiteral(envPtr, "", 0);
393       }
394       TclEmitPush(objIndex, envPtr);
395       tokenPtr += 1;
396       break;
397       
398         case TCL_TOKEN_COMMAND:
399       code = TclCompileScript(interp, tokenPtr->start+1,
400         tokenPtr->size-2, /*nested*/ 0, envPtr);
401       if (code != TCL_OK) {
402     goto done;
403       }
404       tokenPtr += 1;
405       break;
406       
407         case TCL_TOKEN_VARIABLE:
408       code = TclCompileTokens(interp, tokenPtr, 1, envPtr);
409       if (code != TCL_OK) {
410     goto done;
411       }
412       tokenPtr += (tokenPtr->numComponents + 1);
413       break;
414       
415         case TCL_TOKEN_SUB_EXPR:
416       code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
417       if (code != TCL_OK) {
418     goto done;
419       }
420       tokenPtr += (tokenPtr->numComponents + 1);
421       break;
422       
423         case TCL_TOKEN_OPERATOR:
424       /*
425        * Look up the operator.  If the operator isn't found, treat it
426        * as a math function.
427        */
428       Tcl_DStringInit(&opBuf);
429       operator = Tcl_DStringAppend(&opBuf, 
430         tokenPtr->start, tokenPtr->size);
431       hPtr = Tcl_FindHashEntry(&opHashTable, operator);
432       if (hPtr == NULL) {
433     code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr,
434       envPtr, &endPtr);
435     Tcl_DStringFree(&opBuf);
436     if (code != TCL_OK) {
437         goto done;
438     }
439     tokenPtr = endPtr;
440     break;
441       }
442       Tcl_DStringFree(&opBuf);
443       opIndex = (int) Tcl_GetHashValue(hPtr);
444       opDescPtr = &(operatorTable[opIndex]);
445 
446       /*
447        * If the operator is "normal", compile it using information
448        * from the operator table.
449        */
450 
451       if (opDescPtr->numOperands > 0) {
452     tokenPtr++;
453     code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
454     if (code != TCL_OK) {
455         goto done;
456     }
457     tokenPtr += (tokenPtr->numComponents + 1);
458 
459     if (opDescPtr->numOperands == 2) {
460         code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
461         if (code != TCL_OK) {
462       goto done;
463         }
464         tokenPtr += (tokenPtr->numComponents + 1);
465     }
466     TclEmitOpcode(opDescPtr->instruction, envPtr);
467     infoPtr->hasOperators = 1;
468     break;
469       }
470       
471       /*
472        * The operator requires special treatment, and is either
473        * "+" or "-", or one of "&&", "||" or "?".
474        */
475       
476       switch (opIndex) {
477           case OP_PLUS:
478           case OP_MINUS:
479         tokenPtr++;
480         code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
481         if (code != TCL_OK) {
482       goto done;
483         }
484         tokenPtr += (tokenPtr->numComponents + 1);
485         
486         /*
487          * Check whether the "+" or "-" is unary.
488          */
489         
490         afterSubexprPtr = exprTokenPtr
491           + exprTokenPtr->numComponents+1;
492         if (tokenPtr == afterSubexprPtr) {
493       TclEmitOpcode(((opIndex==OP_PLUS)?
494               INST_UPLUS : INST_UMINUS),
495               envPtr);
496       break;
497         }
498         
499         /*
500          * The "+" or "-" is binary.
501          */
502         
503         code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
504         if (code != TCL_OK) {
505       goto done;
506         }
507         tokenPtr += (tokenPtr->numComponents + 1);
508         TclEmitOpcode(((opIndex==OP_PLUS)? INST_ADD : INST_SUB),
509           envPtr);
510         break;
511 
512           case OP_LAND:
513           case OP_LOR:
514         code = CompileLandOrLorExpr(exprTokenPtr, opIndex,
515           infoPtr, envPtr, &endPtr);
516         if (code != TCL_OK) {
517       goto done;
518         }
519         tokenPtr = endPtr;
520         break;
521       
522           case OP_QUESTY:
523         code = CompileCondExpr(exprTokenPtr, infoPtr,
524           envPtr, &endPtr);
525         if (code != TCL_OK) {
526       goto done;
527         }
528         tokenPtr = endPtr;
529         break;
530         
531     default:
532         panic("CompileSubExpr: unexpected operator %d requiring special treatment\n",
533             opIndex);
534       } /* end switch on operator requiring special treatment */
535       infoPtr->hasOperators = 1;
536       break;
537 
538         default:
539       panic("CompileSubExpr: unexpected token type %d\n",
540               tokenPtr->type);
541     }
542 
543     /*
544      * Verify that the subexpression token had the required number of
545      * subtokens: that we've advanced tokenPtr just beyond the
546      * subexpression's last token. For example, a "*" subexpression must
547      * contain the tokens for exactly two operands.
548      */
549     
550     if (tokenPtr != (exprTokenPtr + exprTokenPtr->numComponents+1)) {
551   LogSyntaxError(infoPtr);
552   code = TCL_ERROR;
553     }
554     
555     done:
556     return code;
557 }
static void LogSyntaxError (ExprInfo * infoPtr) [static]

Definition at line 950 of file tclCompExpr.c.
References NULL, Tcl_GetObjResult(), and Tcl_ResetResult().
Referenced by CompileSubExpr(), ParseCondExpr(), ParsePrimaryExpr(), and Tcl_ParseExpr().953 {
954     int numBytes = (infoPtr->lastChar - infoPtr->expr);
955     char buffer[100];
956 
957     sprintf(buffer, "syntax error in expression \"%.*s\"",
958       ((numBytes > 60)? 60 : numBytes), infoPtr->expr);
959     Tcl_ResetResult(infoPtr->interp);
960     Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),
961       buffer, (char *) NULL);
962 }
TCL_DECLARE_MUTEX (opMutex)

Definition at line 103 of file tclCompExpr.c.105                             {
106     char *name;     /* Name of the operator. */
107     int numOperands;    /* Number of operands. 0 if the operator
108          * requires special handling. */
109     int instruction;    /* Instruction opcode for the operator.
110          * Ignored if numOperands is 0. */
111 } OperatorDesc;
int TclCompileExpr (Tcl_Interp * interp, CONST char * script, int numBytes, CompileEnv * envPtr)

Definition at line 204 of file tclCompExpr.c.
References CompileSubExpr(), ExprInfo::expr, ExprInfo::hasOperators, INST_TRY_CVT_TO_NUMERIC, ExprInfo::interp, ExprInfo::lastChar, NULL, operatorTable, opHashTable, opTableInitialized, parse(), ExprInfo::parsePtr, Tcl_CreateHashEntry, Tcl_FreeParse(), Tcl_InitHashTable(), Tcl_MutexLock, Tcl_MutexUnlock, TCL_OK, Tcl_ParseExpr(), Tcl_SetHashValue, TCL_STRING_KEYS, and TclEmitOpcode.
Referenced by Tcl_ExprObj(), and TclCompileExprWords().211 {
212     ExprInfo info;
213     Tcl_Parse parse;
214     Tcl_HashEntry *hPtr;
215     int new, i, code;
216 
217     /*
218      * If this is the first time we've been called, initialize the table
219      * of expression operators.
220      */
221 
222     if (numBytes < 0) {
223   numBytes = (script? strlen(script) : 0);
224     }
225     if (!opTableInitialized) {
226   Tcl_MutexLock(&opMutex);
227   if (!opTableInitialized) {
228       Tcl_InitHashTable(&opHashTable, TCL_STRING_KEYS);
229       for (i = 0;  operatorTable[i].name != NULL;  i++) {
230     hPtr = Tcl_CreateHashEntry(&opHashTable,
231       operatorTable[i].name, &new);
232     if (new) {
233         Tcl_SetHashValue(hPtr, (ClientData) i);
234     }
235       }
236       opTableInitialized = 1;
237   }
238   Tcl_MutexUnlock(&opMutex);
239     }
240 
241     /*
242      * Initialize the structure containing information abvout this
243      * expression compilation.
244      */
245 
246     info.interp = interp;
247     info.parsePtr = &parse;
248     info.expr = script;
249     info.lastChar = (script + numBytes); 
250     info.hasOperators = 0;
251 
252     /*
253      * Parse the expression then compile it.
254      */
255 
256     code = Tcl_ParseExpr(interp, script, numBytes, &parse);
257     if (code != TCL_OK) {
258   goto done;
259     }
260 
261     code = CompileSubExpr(parse.tokenPtr, &info, envPtr);
262     if (code != TCL_OK) {
263   Tcl_FreeParse(&parse);
264   goto done;
265     }
266     
267     if (!info.hasOperators) {
268   /*
269    * Attempt to convert the primary's object to an int or double.
270    * This is done in order to support Tcl's policy of interpreting
271    * operands if at all possible as first integers, else
272    * floating-point numbers.
273    */
274   
275   TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
276     }
277     Tcl_FreeParse(&parse);
278 
279     done:
280     return code;
281 }
void TclFinalizeCompilation ()

Definition at line 302 of file tclCompExpr.c.
References opHashTable, opTableInitialized, Tcl_DeleteHashTable(), Tcl_MutexLock, and Tcl_MutexUnlock.
Referenced by Tcl_Finalize().303 {
304     Tcl_MutexLock(&opMutex);
305     if (opTableInitialized) {
306         Tcl_DeleteHashTable(&opHashTable);
307         opTableInitialized = 0;
308     }
309     Tcl_MutexUnlock(&opMutex);
310 }

Variable Documentation
OperatorDesc

Definition at line 111 of file tclCompExpr.c.
Referenced by CompileSubExpr().OperatorDesc operatorTable[] [static]
Initial value: {
    {"*",   2,  INST_MULT},
    {"/",   2,  INST_DIV},
    {"%",   2,  INST_MOD},
    {"+",   0}, 
    {"-",   0},
    {"<<",  2,  INST_LSHIFT},
    {">>",  2,  INST_RSHIFT},
    {"<",   2,  INST_LT},
    {">",   2,  INST_GT},
    {"<=",  2,  INST_LE},
    {">=",  2,  INST_GE},
    {"==",  2,  INST_EQ},
    {"!=",  2,  INST_NEQ},
    {"&",   2,  INST_BITAND},
    {"^",   2,  INST_BITXOR},
    {"|",   2,  INST_BITOR},
    {"&&",  0},
    {"||",  0},
    {"?",   0},
    {"!",   1,  INST_LNOT},
    {"~",   1,  INST_BITNOT},
    {"eq",  2,  INST_STR_EQ},
    {"ne",  2,  INST_STR_NEQ},
    {NULL}
}
Definition at line 113 of file tclCompExpr.c.
Referenced by CompileSubExpr(), and TclCompileExpr().Tcl_HashTable opHashTable [static]

Definition at line 145 of file tclCompExpr.c.
Referenced by CompileSubExpr(), TclCompileExpr(), and TclFinalizeCompilation().int opTableInitialized = 0 [static]

Definition at line 101 of file tclCompExpr.c.
Referenced by TclCompileExpr(), and TclFinalizeCompilation().

generic/tclCompile.c File Reference
#include "tclInt.h"
#include "tclCompile.h"
Functions
TCL_DECLARE_MUTEX (tableMutex)
static void DupByteCodeInternalRep _ANSI_ARGS_ ((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr))
static unsigned char *EncodeCmdLocMap _ANSI_ARGS_ ((CompileEnv *envPtr, ByteCode *codePtr, unsigned char *startPtr))
static void EnterCmdExtentData _ANSI_ARGS_ ((CompileEnv *envPtr, int cmdNumber, int numSrcBytes, int numCodeBytes))
static void EnterCmdStartData _ANSI_ARGS_ ((CompileEnv *envPtr, int cmdNumber, int srcOffset, int codeOffset))
static void FreeByteCodeInternalRep _ANSI_ARGS_ ((Tcl_Obj *objPtr))
static int GetCmdLocEncodingSize _ANSI_ARGS_ ((CompileEnv *envPtr))
static void LogCompilationInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *script, CONST char *command, int length))
static int SetByteCodeFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
int TclSetByteCodeFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData)
static int SetByteCodeFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr)
static void DupByteCodeInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
static void FreeByteCodeInternalRep (Tcl_Obj *objPtr)
void TclCleanupByteCode (ByteCode *codePtr)
void TclInitCompileEnv (Tcl_Interp *interp, CompileEnv *envPtr, char *string, int numBytes)
void TclFreeCompileEnv (CompileEnv *envPtr)
int TclCompileScript (Tcl_Interp *interp, CONST char *script, int numBytes, int nested, CompileEnv *envPtr)
int TclCompileTokens (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, CompileEnv *envPtr)
int TclCompileCmdWord (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, CompileEnv *envPtr)
int TclCompileExprWords (Tcl_Interp *interp, Tcl_Token *tokenPtr, int numWords, CompileEnv *envPtr)
void TclInitByteCodeObj (Tcl_Obj *objPtr, CompileEnv *envPtr)
static void LogCompilationInfo (Tcl_Interp *interp, CONST char *script, CONST char *command, int length)
int TclFindCompiledLocal (CONST char *name, int nameBytes, int create, int flags, Proc *procPtr)
void TclInitCompiledLocals (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr)
void TclExpandCodeArray (void *envArgPtr)
static void EnterCmdStartData (CompileEnv *envPtr, int cmdIndex, int srcOffset, int codeOffset)
static void EnterCmdExtentData (CompileEnv *envPtr, int cmdIndex, int numSrcBytes, int numCodeBytes)
int TclCreateExceptRange (ExceptionRangeType type, CompileEnv *envPtr)
int TclCreateAuxData (ClientData clientData, AuxDataType *typePtr, CompileEnv *envPtr)
void TclInitJumpFixupArray (JumpFixupArray *fixupArrayPtr)
void TclExpandJumpFixupArray (JumpFixupArray *fixupArrayPtr)
void TclFreeJumpFixupArray (JumpFixupArray *fixupArrayPtr)
void TclEmitForwardJump (CompileEnv *envPtr, TclJumpType jumpType, JumpFixup *jumpFixupPtr)
int TclFixupForwardJump (CompileEnv *envPtr, JumpFixup *jumpFixupPtr, int jumpDist, int distThreshold)
void * TclGetInstructionTable ()
void TclRegisterAuxDataType (AuxDataType *typePtr)
AuxDataType * TclGetAuxDataType (char *typeName)
void TclInitAuxDataTypeTable ()
void TclFinalizeAuxDataTypeTable ()
static int GetCmdLocEncodingSize (CompileEnv *envPtr)
static unsigned char * EncodeCmdLocMap (CompileEnv *envPtr, ByteCode *codePtr, unsigned char *startPtr)
int TclPrintInstruction (ByteCode *codePtr, unsigned char *pc)
void TclPrintObject (FILE *outFile, Tcl_Obj *objPtr, int maxChars)
void TclPrintSource (FILE *outFile, CONST char *string, int maxChars)
Variables
static Tcl_HashTable auxDataTypeTable
static int auxDataTypeTableInitialized
Tcl_ObjType tclByteCodeType

Function Documentation
static int SetByteCodeFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr)) [static]
static void LogCompilationInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *script, CONST char *command, int length)) [static]
static int GetCmdLocEncodingSize _ANSI_ARGS_ ((CompileEnv *envPtr)) [static]
static void FreeByteCodeInternalRep _ANSI_ARGS_ ((Tcl_Obj *objPtr)) [static]
static void EnterCmdStartData _ANSI_ARGS_ ((CompileEnv *envPtr, int cmdNumber, int srcOffset, int codeOffset)) [static]
static void EnterCmdExtentData _ANSI_ARGS_ ((CompileEnv *envPtr, int cmdNumber, int numSrcBytes, int numCodeBytes)) [static]
static unsigned char* EncodeCmdLocMap _ANSI_ARGS_ ((CompileEnv *envPtr, ByteCode *codePtr, unsigned char *startPtr)) [static]
static void DupByteCodeInternalRep _ANSI_ARGS_ ((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)) [static]
static void DupByteCodeInternalRep (Tcl_Obj * srcPtr, Tcl_Obj * copyPtr) [static]

Definition at line 501 of file tclCompile.c.504 {
505     return;
506 }
static unsigned char* EncodeCmdLocMap (CompileEnv * envPtr, ByteCode * codePtr, unsigned char * startPtr) [static]

Definition at line 2848 of file tclCompile.c.
References ByteCode::codeDeltaStart, ByteCode::codeLengthStart, CmdLocation::codeOffset, panic, ByteCode::srcDeltaStart, ByteCode::srcLengthStart, CmdLocation::srcOffset, TclStoreInt1AtPtr, and TclStoreInt4AtPtr.
Referenced by TclInitByteCodeObj().2857 {
2858     register CmdLocation *mapPtr = envPtr->cmdMapPtr;
2859     int numCmds = envPtr->numCommands;
2860     register unsigned char *p = startPtr;
2861     int codeDelta, codeLen, srcDelta, srcLen, prevOffset;
2862     register int i;
2863     
2864     /*
2865      * Encode the code offset for each command as a sequence of deltas.
2866      */
2867 
2868     codePtr->codeDeltaStart = p;
2869     prevOffset = 0;
2870     for (i = 0;  i < numCmds;  i++) {
2871   codeDelta = (mapPtr[i].codeOffset - prevOffset);
2872   if (codeDelta < 0) {
2873       panic("EncodeCmdLocMap: bad code offset");
2874   } else if (codeDelta <= 127) {
2875       TclStoreInt1AtPtr(codeDelta, p);
2876       p++;
2877   } else {
2878       TclStoreInt1AtPtr(0xFF, p);
2879       p++;
2880       TclStoreInt4AtPtr(codeDelta, p);
2881       p += 4;
2882   }
2883   prevOffset = mapPtr[i].codeOffset;
2884     }
2885 
2886     /*
2887      * Encode the code length for each command.
2888      */
2889 
2890     codePtr->codeLengthStart = p;
2891     for (i = 0;  i < numCmds;  i++) {
2892   codeLen = mapPtr[i].numCodeBytes;
2893   if (codeLen < 0) {
2894       panic("EncodeCmdLocMap: bad code length");
2895   } else if (codeLen <= 127) {
2896       TclStoreInt1AtPtr(codeLen, p);
2897       p++;
2898   } else {
2899       TclStoreInt1AtPtr(0xFF, p);
2900       p++;
2901       TclStoreInt4AtPtr(codeLen, p);
2902       p += 4;
2903   }
2904     }
2905 
2906     /*
2907      * Encode the source offset for each command as a sequence of deltas.
2908      */
2909 
2910     codePtr->srcDeltaStart = p;
2911     prevOffset = 0;
2912     for (i = 0;  i < numCmds;  i++) {
2913   srcDelta = (mapPtr[i].srcOffset - prevOffset);
2914   if ((-127 <= srcDelta) && (srcDelta <= 127)) {
2915       TclStoreInt1AtPtr(srcDelta, p);
2916       p++;
2917   } else {
2918       TclStoreInt1AtPtr(0xFF, p);
2919       p++;
2920       TclStoreInt4AtPtr(srcDelta, p);
2921       p += 4;
2922   }
2923   prevOffset = mapPtr[i].srcOffset;
2924     }
2925 
2926     /*
2927      * Encode the source length for each command.
2928      */
2929 
2930     codePtr->srcLengthStart = p;
2931     for (i = 0;  i < numCmds;  i++) {
2932   srcLen = mapPtr[i].numSrcBytes;
2933   if (srcLen < 0) {
2934       panic("EncodeCmdLocMap: bad source length");
2935   } else if (srcLen <= 127) {
2936       TclStoreInt1AtPtr(srcLen, p);
2937       p++;
2938   } else {
2939       TclStoreInt1AtPtr(0xFF, p);
2940       p++;
2941       TclStoreInt4AtPtr(srcLen, p);
2942       p += 4;
2943   }
2944     }
2945     
2946     return p;
2947 }
static void EnterCmdExtentData (CompileEnv * envPtr, int cmdIndex, int numSrcBytes, int numCodeBytes) [static]

Definition at line 2113 of file tclCompile.c.
References CmdLocation::numCodeBytes, CmdLocation::numSrcBytes, and panic.
Referenced by TclCompileScript().2121 {
2122     CmdLocation *cmdLocPtr;
2123 
2124     if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) {
2125   panic("EnterCmdExtentData: bad command index %d\n", cmdIndex);
2126     }
2127     
2128     if (cmdIndex > envPtr->cmdMapEnd) {
2129   panic("EnterCmdExtentData: missing start data for command %d\n",
2130           cmdIndex);
2131     }
2132 
2133     cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
2134     cmdLocPtr->numSrcBytes = numSrcBytes;
2135     cmdLocPtr->numCodeBytes = numCodeBytes;
2136 }
static void EnterCmdStartData (CompileEnv * envPtr, int cmdIndex, int srcOffset, int codeOffset) [static]

Definition at line 2036 of file tclCompile.c.
References ckalloc, ckfree, CmdLocation::codeOffset, CmdLocation::numCodeBytes, CmdLocation::numSrcBytes, panic, size_t(), CmdLocation::srcOffset, and VOID.
Referenced by TclCompileScript().2044 {
2045     CmdLocation *cmdLocPtr;
2046     
2047     if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) {
2048   panic("EnterCmdStartData: bad command index %d\n", cmdIndex);
2049     }
2050     
2051     if (cmdIndex >= envPtr->cmdMapEnd) {
2052   /*
2053    * Expand the command location array by allocating more storage from
2054    * the heap. The currently allocated CmdLocation entries are stored
2055    * from cmdMapPtr[0] up to cmdMapPtr[envPtr->cmdMapEnd] (inclusive).
2056    */
2057 
2058   size_t currElems = envPtr->cmdMapEnd;
2059   size_t newElems  = 2*currElems;
2060   size_t currBytes = currElems * sizeof(CmdLocation);
2061   size_t newBytes  = newElems  * sizeof(CmdLocation);
2062   CmdLocation *newPtr = (CmdLocation *) ckalloc((unsigned) newBytes);
2063   
2064   /*
2065    * Copy from old command location array to new, free old command
2066    * location array if needed, and mark new array as malloced.
2067    */
2068   
2069   memcpy((VOID *) newPtr, (VOID *) envPtr->cmdMapPtr, currBytes);
2070   if (envPtr->mallocedCmdMap) {
2071       ckfree((char *) envPtr->cmdMapPtr);
2072   }
2073   envPtr->cmdMapPtr = (CmdLocation *) newPtr;
2074   envPtr->cmdMapEnd = newElems;
2075   envPtr->mallocedCmdMap = 1;
2076     }
2077 
2078     if (cmdIndex > 0) {
2079   if (codeOffset < envPtr->cmdMapPtr[cmdIndex-1].codeOffset) {
2080       panic("EnterCmdStartData: cmd map not sorted by code offset");
2081   }
2082     }
2083 
2084     cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
2085     cmdLocPtr->codeOffset = codeOffset;
2086     cmdLocPtr->srcOffset = srcOffset;
2087     cmdLocPtr->numSrcBytes = -1;
2088     cmdLocPtr->numCodeBytes = -1;
2089 }
static void FreeByteCodeInternalRep (Tcl_Obj * objPtr) [static]

Definition at line 530 of file tclCompile.c.
References NULL, ByteCode::refCount, and TclCleanupByteCode().532 {
533     register ByteCode *codePtr =
534       (ByteCode *) objPtr->internalRep.otherValuePtr;
535 
536     codePtr->refCount--;
537     if (codePtr->refCount <= 0) {
538   TclCleanupByteCode(codePtr);
539     }
540     objPtr->typePtr = NULL;
541     objPtr->internalRep.otherValuePtr = NULL;
542 }
static int GetCmdLocEncodingSize (CompileEnv * envPtr) [static]

Definition at line 2769 of file tclCompile.c.
References CmdLocation::codeOffset, CmdLocation::numCodeBytes, CmdLocation::numSrcBytes, panic, and CmdLocation::srcOffset.
Referenced by TclInitByteCodeObj().2773 {
2774     register CmdLocation *mapPtr = envPtr->cmdMapPtr;
2775     int numCmds = envPtr->numCommands;
2776     int codeDelta, codeLen, srcDelta, srcLen;
2777     int codeDeltaNext, codeLengthNext, srcDeltaNext, srcLengthNext;
2778         /* The offsets in their respective byte
2779          * sequences where the next encoded offset
2780          * or length should go. */
2781     int prevCodeOffset, prevSrcOffset, i;
2782 
2783     codeDeltaNext = codeLengthNext = srcDeltaNext = srcLengthNext = 0;
2784     prevCodeOffset = prevSrcOffset = 0;
2785     for (i = 0;  i < numCmds;  i++) {
2786   codeDelta = (mapPtr[i].codeOffset - prevCodeOffset);
2787   if (codeDelta < 0) {
2788       panic("GetCmdLocEncodingSize: bad code offset");
2789   } else if (codeDelta <= 127) {
2790       codeDeltaNext++;
2791   } else {
2792       codeDeltaNext += 5;  /* 1 byte for 0xFF, 4 for positive delta */
2793   }
2794   prevCodeOffset = mapPtr[i].codeOffset;
2795 
2796   codeLen = mapPtr[i].numCodeBytes;
2797   if (codeLen < 0) {
2798       panic("GetCmdLocEncodingSize: bad code length");
2799   } else if (codeLen <= 127) {
2800       codeLengthNext++;
2801   } else {
2802       codeLengthNext += 5; /* 1 byte for 0xFF, 4 for length */
2803   }
2804 
2805   srcDelta = (mapPtr[i].srcOffset - prevSrcOffset);
2806   if ((-127 <= srcDelta) && (srcDelta <= 127)) {
2807       srcDeltaNext++;
2808   } else {
2809       srcDeltaNext += 5;   /* 1 byte for 0xFF, 4 for delta */
2810   }
2811   prevSrcOffset = mapPtr[i].srcOffset;
2812 
2813   srcLen = mapPtr[i].numSrcBytes;
2814   if (srcLen < 0) {
2815       panic("GetCmdLocEncodingSize: bad source length");
2816   } else if (srcLen <= 127) {
2817       srcLengthNext++;
2818   } else {
2819       srcLengthNext += 5;  /* 1 byte for 0xFF, 4 for length */
2820   }
2821     }
2822 
2823     return (codeDeltaNext + codeLengthNext + srcDeltaNext + srcLengthNext);
2824 }
static void LogCompilationInfo (Tcl_Interp * interp, CONST char * script, CONST char * command, int length) [static]

Definition at line 1690 of file tclCompile.c.
References CONST, ERR_ALREADY_LOGGED, Interp::errorLine, Interp::flags, and Tcl_AddObjErrorInfo().
Referenced by TclCompileScript().1699 {
1700     char buffer[200];
1701     register CONST char *p;
1702     char *ellipsis = "";
1703     Interp *iPtr = (Interp *) interp;
1704 
1705     if (iPtr->flags & ERR_ALREADY_LOGGED) {
1706   /*
1707    * Someone else has already logged error information for this
1708    * command; we shouldn't add anything more.
1709    */
1710 
1711   return;
1712     }
1713 
1714     /*
1715      * Compute the line number where the error occurred.
1716      */
1717 
1718     iPtr->errorLine = 1;
1719     for (p = script; p != command; p++) {
1720   if (*p == '\n') {
1721       iPtr->errorLine++;
1722   }
1723     }
1724 
1725     /*
1726      * Create an error message to add to errorInfo, including up to a
1727      * maximum number of characters of the command.
1728      */
1729 
1730     if (length < 0) {
1731   length = strlen(command);
1732     }
1733     if (length > 150) {
1734   length = 150;
1735   ellipsis = "...";
1736     }
1737     while ( (command[length] & 0xC0) == 0x80 ) {
1738         /*
1739    * Back up truncation point so that we don't truncate in the
1740    * middle of a multi-byte character (in UTF-8)
1741    */
1742    length--;
1743    ellipsis = "...";
1744     }
1745     sprintf(buffer, "\n    while compiling\n\"%.*s%s\"",
1746       length, command, ellipsis);
1747     Tcl_AddObjErrorInfo(interp, buffer, -1);
1748 }
static int SetByteCodeFromAny (Tcl_Interp * interp, Tcl_Obj * objPtr) [static]

Definition at line 472 of file tclCompile.c.
References NULL, and TclSetByteCodeFromAny().476 {
477     return TclSetByteCodeFromAny(interp, objPtr,
478       (CompileHookProc *) NULL, (ClientData) NULL);
479 }
TCL_DECLARE_MUTEX (tableMutex)

Definition at line 27 of file tclCompile.c.
References INT_MIN, OPERAND_INT1, OPERAND_INT4, OPERAND_NONE, OPERAND_UINT1, OPERAND_UINT4, and tclInstructionTable.31                                    :
32  *    0: no compilation tracing
33  *    1: summarize compilation of top level cmds and proc bodies
34  *    2: display all instructions of each ByteCode compiled
35  * This variable is linked to the Tcl variable "tcl_traceCompile".
36  */
37 
38 #ifdef TCL_COMPILE_DEBUG
39 int tclTraceCompile = 0;
40 static int traceInitialized = 0;
41 #endif
42 
43 /*
44  * A table describing the Tcl bytecode instructions. Entries in this table
45  * must correspond to the instruction opcode definitions in tclCompile.h.
46  * The names "op1" and "op4" refer to an instruction's one or four byte
47  * first operand. Similarly, "stktop" and "stknext" refer to the topmost
48  * and next to topmost stack elements.
49  *
50  * Note that the load, store, and incr instructions do not distinguish local
51  * from global variables; the bytecode interpreter at runtime uses the
52  * existence of a procedure call frame to distinguish these.
53  */
54 
55 InstructionDesc tclInstructionTable[] = {
56    /* Name        Bytes stackEffect #Opnds Operand types  Stack top, next   */
57     {"done",      1,   -1,        0,   {OPERAND_NONE}},
58   /* Finish ByteCode execution and return stktop (top stack item) */
59     {"push1",     2,   +1,         1,   {OPERAND_UINT1}},
60   /* Push object at ByteCode objArray[op1] */
61     {"push4",     5,   +1,         1,   {OPERAND_UINT4}},
62   /* Push object at ByteCode objArray[op4] */
63     {"pop",     1,   -1,        0,   {OPERAND_NONE}},
64   /* Pop the topmost stack object */
65     {"dup",     1,   +1,         0,   {OPERAND_NONE}},
66   /* Duplicate the topmost stack object and push the result */
67     {"concat1",     2,   INT_MIN,    1,   {OPERAND_UINT1}},
68   /* Concatenate the top op1 items and push result */
69     {"invokeStk1",    2,   INT_MIN,    1,   {OPERAND_UINT1}},
70   /* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */
71     {"invokeStk4",    5,   INT_MIN,    1,   {OPERAND_UINT4}},
72   /* Invoke command named objv[0]; <objc,objv> = <op4,top op4> */
73     {"evalStk",     1,   0,          0,   {OPERAND_NONE}},
74   /* Evaluate command in stktop using Tcl_EvalObj. */
75     {"exprStk",     1,   0,          0,   {OPERAND_NONE}},
76   /* Execute expression in stktop using Tcl_ExprStringObj. */
77     
78     {"loadScalar1",   2,   1,          1,   {OPERAND_UINT1}},
79   /* Load scalar variable at index op1 <= 255 in call frame */
80     {"loadScalar4",   5,   1,          1,   {OPERAND_UINT4}},
81   /* Load scalar variable at index op1 >= 256 in call frame */
82     {"loadScalarStk",   1,   0,          0,   {OPERAND_NONE}},
83   /* Load scalar variable; scalar's name is stktop */
84     {"loadArray1",    2,   0,          1,   {OPERAND_UINT1}},
85   /* Load array element; array at slot op1<=255, element is stktop */
86     {"loadArray4",    5,   0,          1,   {OPERAND_UINT4}},
87   /* Load array element; array at slot op1 > 255, element is stktop */
88     {"loadArrayStk",    1,   -1,         0,   {OPERAND_NONE}},
89   /* Load array element; element is stktop, array name is stknext */
90     {"loadStk",     1,   0,          0,   {OPERAND_NONE}},
91   /* Load general variable; unparsed variable name is stktop */
92     {"storeScalar1",    2,   0,          1,   {OPERAND_UINT1}},
93   /* Store scalar variable at op1<=255 in frame; value is stktop */
94     {"storeScalar4",    5,   0,          1,   {OPERAND_UINT4}},
95   /* Store scalar variable at op1 > 255 in frame; value is stktop */
96     {"storeScalarStk",    1,   -1,         0,   {OPERAND_NONE}},
97   /* Store scalar; value is stktop, scalar name is stknext */
98     {"storeArray1",   2,   -1,         1,   {OPERAND_UINT1}},
99   /* Store array element; array at op1<=255, value is top then elem */
100     {"storeArray4",   5,   -1,          1,   {OPERAND_UINT4}},
101   /* Store array element; array at op1>=256, value is top then elem */
102     {"storeArrayStk",   1,   -2,         0,   {OPERAND_NONE}},
103   /* Store array element; value is stktop, then elem, array names */
104     {"storeStk",    1,   -1,         0,   {OPERAND_NONE}},
105   /* Store general variable; value is stktop, then unparsed name */
106     
107     {"incrScalar1",   2,   0,          1,   {OPERAND_UINT1}},
108   /* Incr scalar at index op1<=255 in frame; incr amount is stktop */
109     {"incrScalarStk",   1,   -1,         0,   {OPERAND_NONE}},
110   /* Incr scalar; incr amount is stktop, scalar's name is stknext */
111     {"incrArray1",    2,   -1,         1,   {OPERAND_UINT1}},
112   /* Incr array elem; arr at slot op1<=255, amount is top then elem */
113     {"incrArrayStk",    1,   -2,         0,   {OPERAND_NONE}},
114   /* Incr array element; amount is top then elem then array names */
115     {"incrStk",     1,   -1,         0,   {OPERAND_NONE}},
116   /* Incr general variable; amount is stktop then unparsed var name */
117     {"incrScalar1Imm",    3,   +1,         2,   {OPERAND_UINT1, OPERAND_INT1}},
118   /* Incr scalar at slot op1 <= 255; amount is 2nd operand byte */
119     {"incrScalarStkImm",  2,   0,          1,   {OPERAND_INT1}},
120   /* Incr scalar; scalar name is stktop; incr amount is op1 */
121     {"incrArray1Imm",   3,   0,         2,   {OPERAND_UINT1, OPERAND_INT1}},
122   /* Incr array elem; array at slot op1 <= 255, elem is stktop,
123    * amount is 2nd operand byte */
124     {"incrArrayStkImm",   2,   -1,         1,   {OPERAND_INT1}},
125   /* Incr array element; elem is top then array name, amount is op1 */
126     {"incrStkImm",    2,   0,         1,   {OPERAND_INT1}},
127   /* Incr general variable; unparsed name is top, amount is op1 */
128     
129     {"jump1",     2,   0,          1,   {OPERAND_INT1}},
130   /* Jump relative to (pc + op1) */
131     {"jump4",     5,   0,          1,   {OPERAND_INT4}},
132   /* Jump relative to (pc + op4) */
133     {"jumpTrue1",   2,   -1,         1,   {OPERAND_INT1}},
134   /* Jump relative to (pc + op1) if stktop expr object is true */
135     {"jumpTrue4",   5,   -1,         1,   {OPERAND_INT4}},
136   /* Jump relative to (pc + op4) if stktop expr object is true */
137     {"jumpFalse1",    2,   -1,         1,   {OPERAND_INT1}},
138   /* Jump relative to (pc + op1) if stktop expr object is false */
139     {"jumpFalse4",    5,   -1,         1,   {OPERAND_INT4}},
140   /* Jump relative to (pc + op4) if stktop expr object is false */
141 
142     {"lor",     1,   -1,         0,   {OPERAND_NONE}},
143   /* Logical or:  push (stknext || stktop) */
144     {"land",      1,   -1,         0,   {OPERAND_NONE}},
145   /* Logical and: push (stknext && stktop) */
146     {"bitor",     1,   -1,         0,   {OPERAND_NONE}},
147   /* Bitwise or:  push (stknext | stktop) */
148     {"bitxor",      1,   -1,         0,   {OPERAND_NONE}},
149   /* Bitwise xor  push (stknext ^ stktop) */
150     {"bitand",      1,   -1,         0,   {OPERAND_NONE}},
151   /* Bitwise and: push (stknext & stktop) */
152     {"eq",      1,   -1,         0,   {OPERAND_NONE}},
153   /* Equal: push (stknext == stktop) */
154     {"neq",     1,   -1,         0,   {OPERAND_NONE}},
155   /* Not equal: push (stknext != stktop) */
156     {"lt",      1,   -1,         0,   {OPERAND_NONE}},
157   /* Less:  push (stknext < stktop) */
158     {"gt",      1,   -1,         0,   {OPERAND_NONE}},
159   /* Greater: push (stknext || stktop) */
160     {"le",      1,   -1,         0,   {OPERAND_NONE}},
161   /* Logical or:  push (stknext || stktop) */
162     {"ge",      1,   -1,         0,   {OPERAND_NONE}},
163   /* Logical or:  push (stknext || stktop) */
164     {"lshift",      1,   -1,         0,   {OPERAND_NONE}},
165   /* Left shift:  push (stknext << stktop) */
166     {"rshift",      1,   -1,         0,   {OPERAND_NONE}},
167   /* Right shift: push (stknext >> stktop) */
168     {"add",     1,   -1,         0,   {OPERAND_NONE}},
169   /* Add:   push (stknext + stktop) */
170     {"sub",     1,   -1,         0,   {OPERAND_NONE}},
171   /* Sub:   push (stkext - stktop) */
172     {"mult",      1,   -1,         0,   {OPERAND_NONE}},
173   /* Multiply:  push (stknext * stktop) */
174     {"div",     1,   -1,         0,   {OPERAND_NONE}},
175   /* Divide:  push (stknext / stktop) */
176     {"mod",     1,   -1,         0,   {OPERAND_NONE}},
177   /* Mod:   push (stknext % stktop) */
178     {"uplus",     1,   0,          0,   {OPERAND_NONE}},
179   /* Unary plus:  push +stktop */
180     {"uminus",      1,   0,          0,   {OPERAND_NONE}},
181   /* Unary minus: push -stktop */
182     {"bitnot",      1,   0,          0,   {OPERAND_NONE}},
183   /* Bitwise not: push ~stktop */
184     {"not",     1,   0,          0,   {OPERAND_NONE}},
185   /* Logical not: push !stktop */
186     {"callBuiltinFunc1",  2,   1,          1,   {OPERAND_UINT1}},
187   /* Call builtin math function with index op1; any args are on stk */
188     {"callFunc1",   2,   INT_MIN,    1,   {OPERAND_UINT1}},
189   /* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1>  */
190     {"tryCvtToNumeric",   1,   0,          0,   {OPERAND_NONE}},
191   /* Try converting stktop to first int then double if possible. */
192 
193     {"break",     1,   0,          0,   {OPERAND_NONE}},
194   /* Abort closest enclosing loop; if none, return TCL_BREAK code. */
195     {"continue",    1,   0,          0,   {OPERAND_NONE}},
196   /* Skip to next iteration of closest enclosing loop; if none,
197    * return TCL_CONTINUE code. */
198 
199     {"foreach_start4",    5,   0,          1,   {OPERAND_UINT4}},
200   /* Initialize execution of a foreach loop. Operand is aux data index
201    * of the ForeachInfo structure for the foreach command. */
202     {"foreach_step4",   5,   +1,         1,   {OPERAND_UINT4}},
203   /* "Step" or begin next iteration of foreach loop. Push 0 if to
204    *  terminate loop, else push 1. */
205 
206     {"beginCatch4",   5,   0,          1,   {OPERAND_UINT4}},
207   /* Record start of catch with the operand's exception index.
208    * Push the current stack depth onto a special catch stack. */
209     {"endCatch",    1,   0,          0,   {OPERAND_NONE}},
210   /* End of last catch. Pop the bytecode interpreter's catch stack. */
211     {"pushResult",    1,   +1,         0,   {OPERAND_NONE}},
212   /* Push the interpreter's object result onto the stack. */
213     {"pushReturnCode",    1,   +1,         0,   {OPERAND_NONE}},
214   /* Push interpreter's return code (e.g. TCL_OK or TCL_ERROR) as
215    * a new object onto the stack. */
216     {"streq",     1,   -1,         0,   {OPERAND_NONE}},
217   /* Str Equal: push (stknext eq stktop) */
218     {"strneq",      1,   -1,         0,   {OPERAND_NONE}},
219   /* Str !Equal:  push (stknext neq stktop) */
220     {"strcmp",      1,   -1,         0,   {OPERAND_NONE}},
221   /* Str Compare: push (stknext cmp stktop) */
222     {"strlen",      1,   0,          0,   {OPERAND_NONE}},
223   /* Str Length:  push (strlen stktop) */
224     {"strindex",    1,   -1,         0,   {OPERAND_NONE}},
225   /* Str Index: push (strindex stknext stktop) */
226     {"strmatch",    2,   -1,         1,   {OPERAND_INT1}},
227   /* Str Match: push (strmatch stknext stktop) opnd == nocase */
228     {"list",      5,   INT_MIN,    1,   {OPERAND_UINT4}},
229   /* List:  push (stk1 stk2 ... stktop) */
230     {"listindex",   1,   -1,         0,   {OPERAND_NONE}},
231   /* List Index:  push (listindex stknext stktop) */
232     {"listlength",    1,   0,          0,   {OPERAND_NONE}},
233   /* List Len:  push (listlength stktop) */
234     {"appendScalar1",   2,   0,          1,   {OPERAND_UINT1}},
235   /* Append scalar variable at op1<=255 in frame; value is stktop */
236     {"appendScalar4",   5,   0,          1,   {OPERAND_UINT4}},
237   /* Append scalar variable at op1 > 255 in frame; value is stktop */
238     {"appendArray1",    2,   -1,         1,   {OPERAND_UINT1}},
239   /* Append array element; array at op1<=255, value is top then elem */
240     {"appendArray4",    5,   -1,         1,   {OPERAND_UINT4}},
241   /* Append array element; array at op1>=256, value is top then elem */
242     {"appendArrayStk",    1,   -2,         0,   {OPERAND_NONE}},
243   /* Append array element; value is stktop, then elem, array names */
244     {"appendStk",   1,   -1,         0,   {OPERAND_NONE}},
245   /* Append general variable; value is stktop, then unparsed name */
246     {"lappendScalar1",    2,   0,          1,   {OPERAND_UINT1}},
247   /* Lappend scalar variable at op1<=255 in frame; value is stktop */
248     {"lappendScalar4",    5,   0,          1,   {OPERAND_UINT4}},
249   /* Lappend scalar variable at op1 > 255 in frame; value is stktop */
250     {"lappendArray1",   2,   -1,         1,   {OPERAND_UINT1}},
251   /* Lappend array element; array at op1<=255, value is top then elem */
252     {"lappendArray4",   5,   -1,         1,   {OPERAND_UINT4}},
253   /* Lappend array element; array at op1>=256, value is top then elem */
254     {"lappendArrayStk",   1,   -2,         0,   {OPERAND_NONE}},
255   /* Lappend array element; value is stktop, then elem, array names */
256     {"lappendStk",    1,   -1,         0,   {OPERAND_NONE}},
257   /* Lappend general variable; value is stktop, then unparsed name */
258     {"lindexMulti",   5,   INT_MIN,   1,   {OPERAND_UINT4}},
259         /* Lindex with generalized args, operand is number of stacked objs 
260    * used: (operand-1) entries from stktop are the indices; then list 
261    * to process. */
262     {"over",      5,   +1,         1,   {OPERAND_UINT4}},
263         /* Duplicate the arg-th element from top of stack (TOS=0) */
264     {"lsetList",          1,   -2,         0,   {OPERAND_NONE}},
265         /* Four-arg version of 'lset'. stktop is old value; next is
266          * new element value, next is the index list; pushes new value */
267     {"lsetFlat",          5,   INT_MIN,   1,   {OPERAND_UINT4}},
268         /* Three- or >=5-arg version of 'lset', operand is number of 
269    * stacked objs: stktop is old value, next is new element value, next 
270    * come (operand-2) indices; pushes the new value.
271    */
272     {0}
273 };

void TclCleanupByteCode (ByteCode * codePtr)

Definition at line 565 of file tclCompile.c.
References NULL, Tcl_Time::sec, TCL_BYTECODE_PRECOMPILED, Tcl_DecrRefCount, Tcl_GetTime(), TclReleaseLiteral(), and Tcl_Time::usec.
Referenced by FreeByteCodeInternalRep(), and TclCompEvalObj().567 {
568     Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
569     int numLitObjects = codePtr->numLitObjects;
570     int numAuxDataItems = codePtr->numAuxDataItems;
571     register Tcl_Obj **objArrayPtr;
572     register AuxData *auxDataPtr;
573     int i;
574 #ifdef TCL_COMPILE_STATS
575 
576     if (interp != NULL) {
577   ByteCodeStats *statsPtr;
578   Tcl_Time destroyTime;
579   int lifetimeSec, lifetimeMicroSec, log2;
580 
581   statsPtr = &((Interp *) interp)->stats;
582 
583   statsPtr->numByteCodesFreed++;
584   statsPtr->currentSrcBytes -= (double) codePtr->numSrcBytes;
585   statsPtr->currentByteCodeBytes -= (double) codePtr->structureSize;
586 
587   statsPtr->currentInstBytes   -= (double) codePtr->numCodeBytes;
588   statsPtr->currentLitBytes    -=
589     (double) (codePtr->numLitObjects * sizeof(Tcl_Obj *)); 
590   statsPtr->currentExceptBytes -=
591     (double) (codePtr->numExceptRanges * sizeof(ExceptionRange));
592   statsPtr->currentAuxBytes    -=
593     (double) (codePtr->numAuxDataItems * sizeof(AuxData));
594   statsPtr->currentCmdMapBytes -= (double) codePtr->numCmdLocBytes;
595 
596   Tcl_GetTime(&destroyTime);
597   lifetimeSec = destroyTime.sec - codePtr->createTime.sec;
598   if (lifetimeSec > 2000) { /* avoid overflow */
599       lifetimeSec = 2000;
600   }
601   lifetimeMicroSec =
602       1000000*lifetimeSec + (destroyTime.usec - codePtr->createTime.usec);
603   
604   log2 = TclLog2(lifetimeMicroSec);
605   if (log2 > 31) {
606       log2 = 31;
607   }
608   statsPtr->lifetimeCount[log2]++;
609     }
610 #endif /* TCL_COMPILE_STATS */
611 
612     /*
613      * A single heap object holds the ByteCode structure and its code,
614      * object, command location, and auxiliary data arrays. This means we
615      * only need to 1) decrement the ref counts of the LiteralEntry's in
616      * its literal array, 2) call the free procs for the auxiliary data
617      * items, and 3) free the ByteCode structure's heap object.
618      *
619      * The case for TCL_BYTECODE_PRECOMPILED (precompiled ByteCodes,
620      * like those generated from tbcload) is special, as they doesn't
621      * make use of the global literal table.  They instead maintain
622      * private references to their literals which must be decremented.
623      */
624 
625     if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
626   register Tcl_Obj *objPtr;
627  
628   objArrayPtr = codePtr->objArrayPtr;
629   for (i = 0;  i < numLitObjects;  i++) {
630       objPtr = *objArrayPtr;
631       if (objPtr) {
632     Tcl_DecrRefCount(objPtr);
633       }
634       objArrayPtr++;
635   }
636   codePtr->numLitObjects = 0;
637     } else if (interp != NULL) {
638   /*
639    * If the interp has already been freed, then Tcl will have already 
640    * forcefully released all the literals used by ByteCodes compiled
641    * with respect to that interp.
642    */
643    
644   objArrayPtr = codePtr->objArrayPtr;
645   for (i = 0;  i < numLitObjects;  i++) {
646       /*
647        * TclReleaseLiteral sets a ByteCode's object array entry NULL to
648        * indicate that it has already freed the literal.
649        */
650       
651       if (*objArrayPtr != NULL) {
652     TclReleaseLiteral(interp, *objArrayPtr);
653       }
654       objArrayPtr++;
655   }
656     }
657     
658     auxDataPtr = codePtr->auxDataArrayPtr;
659     for (i = 0;  i < numAuxDataItems;  i++) {
660   if (auxDataPtr->type->freeProc != NULL) {
661       (*auxDataPtr->type->freeProc)(auxDataPtr->clientData);
662   }
663   auxDataPtr++;
664     }
665 
666     TclHandleRelease(codePtr->interpHandle);
667     ckfree((char *) codePtr);
668 }
int TclCompileCmdWord (Tcl_Interp * interp, Tcl_Token * tokenPtr, int count, CompileEnv * envPtr)

Definition at line 1393 of file tclCompile.c.
References INST_EVAL_STK, Tcl_Token::size, Tcl_Token::start, TCL_OK, TCL_TOKEN_TEXT, TclCompileScript(), TclCompileTokens(), TclEmitOpcode, and Tcl_Token::type.
Referenced by TclCompileCatchCmd(), TclCompileForCmd(), TclCompileForeachCmd(), and TclCompileWhileCmd().1400 {
1401     int code;
1402 
1403     /*
1404      * Handle the common case: if there is a single text token, compile it
1405      * into an inline sequence of instructions.
1406      */
1407     
1408     if ((count == 1) && (tokenPtr->type == TCL_TOKEN_TEXT)) {
1409   code = TclCompileScript(interp, tokenPtr->start, tokenPtr->size,
1410           /*nested*/ 0, envPtr);
1411   return code;
1412     }
1413 
1414     /*
1415      * Multiple tokens or the single token involves substitutions. Emit
1416      * instructions to invoke the eval command procedure at runtime on the
1417      * result of evaluating the tokens.
1418      */
1419 
1420     code = TclCompileTokens(interp, tokenPtr, count, envPtr);
1421     if (code != TCL_OK) {
1422   return code;
1423     }
1424     TclEmitOpcode(INST_EVAL_STK, envPtr);
1425     return TCL_OK;
1426 }
int TclCompileExprWords (Tcl_Interp * interp, Tcl_Token * tokenPtr, int numWords, CompileEnv * envPtr)

Definition at line 1450 of file tclCompile.c.
References CONST, INST_CONCAT1, INST_EXPR_STK, Tcl_Token::numComponents, Tcl_Token::size, Tcl_Token::start, TCL_OK, TCL_TOKEN_SIMPLE_WORD, TclCompileExpr(), TclCompileTokens(), TclEmitInstInt1, TclEmitOpcode, TclEmitPush, TclRegisterLiteral(), and Tcl_Token::type.
Referenced by TclCompileExprCmd(), TclCompileForCmd(), and TclCompileWhileCmd().1459 {
1460     Tcl_Token *wordPtr;
1461     int numBytes, i, code;
1462     CONST char *script;
1463 
1464     code = TCL_OK;
1465 
1466     /*
1467      * If the expression is a single word that doesn't require
1468      * substitutions, just compile its string into inline instructions.
1469      */
1470 
1471     if ((numWords == 1) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
1472   script = tokenPtr[1].start;
1473   numBytes = tokenPtr[1].size;
1474   code = TclCompileExpr(interp, script, numBytes, envPtr);
1475   return code;
1476     }
1477    
1478     /*
1479      * Emit code to call the expr command proc at runtime. Concatenate the
1480      * (already substituted once) expr tokens with a space between each.
1481      */
1482 
1483     wordPtr = tokenPtr;
1484     for (i = 0;  i < numWords;  i++) {
1485   code = TclCompileTokens(interp, wordPtr+1, wordPtr->numComponents,
1486                 envPtr);
1487   if (code != TCL_OK) {
1488       break;
1489   }
1490   if (i < (numWords - 1)) {
1491       TclEmitPush(TclRegisterLiteral(envPtr, " ", 1, /*onHeap*/ 0),
1492               envPtr);
1493   }
1494   wordPtr += (wordPtr->numComponents + 1);
1495     }
1496     if (code == TCL_OK) {
1497   int concatItems = 2*numWords - 1;
1498   while (concatItems > 255) {
1499       TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
1500       concatItems -= 254;
1501   }
1502   if (concatItems > 1) {
1503       TclEmitInstInt1(INST_CONCAT1, concatItems, envPtr);
1504   }
1505   TclEmitOpcode(INST_EXPR_STK, envPtr);
1506     }
1507 
1508     return code;
1509 }
int TclCompileScript (Tcl_Interp * interp, CONST char * script, int numBytes, int nested, CompileEnv * envPtr)

Definition at line 800 of file tclCompile.c.
References CMD_HAS_EXEC_TRACES, CompileEnv::cmdMapPtr, Proc::cmdPtr, CompileEnv::codeNext, CompileEnv::codeStart, Command::compileProc, CONST, DONT_COMPILE_CMDS_INLINE, EnterCmdExtentData(), EnterCmdStartData(), Interp::flags, Command::flags, INST_INVOKE_STK1, INST_INVOKE_STK4, INST_POP, CompileEnv::literalArrayPtr, LogCompilationInfo(), next(), Command::nsPtr, NULL, CmdLocation::numCodeBytes, CompileEnv::numCommands, Tcl_Token::numComponents, LiteralEntry::objPtr, parse(), CompileEnv::procPtr, CompileEnv::source, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringSetLength(), Tcl_DStringValue, TCL_ERROR, Tcl_FindCommand(), Tcl_FreeParse(), Tcl_NewStringObj(), TCL_OK, TCL_OUT_LINE_COMPILE, Tcl_ParseCommand(), Tcl_ResetResult(), Tcl_SetObjResult(), TCL_TOKEN_SIMPLE_WORD, TclCompileTokens(), TclEmitInstInt1, TclEmitInstInt4, TclEmitOpcode, TclEmitPush, TclMin, TclPrintSource(), TclRegisterLiteral(), TclRegisterNewLiteral, TclSetCmdNameObj(), Interp::termOffset, and Tcl_Token::type.
Referenced by CompileSubExpr(), TclCompileCmdWord(), TclCompileTokens(), and TclSetByteCodeFromAny().808                                                               :
809          * close bracket ']' should be considered a
810          * command terminator. If zero, close
811          * bracket has no special meaning. */
812     CompileEnv *envPtr;   /* Holds resulting instructions. */
813 {
814     Interp *iPtr = (Interp *) interp;
815     Tcl_Parse parse;
816     int lastTopLevelCmdIndex = -1;
817             /* Index of most recent toplevel command in
818          * the command location table. Initialized
819          * to avoid compiler warning. */
820     int startCodeOffset = -1; /* Offset of first byte of current command's
821                                  * code. Init. to avoid compiler warning. */
822     unsigned char *entryCodeNext = envPtr->codeNext;
823     CONST char *p, *next;
824     Namespace *cmdNsPtr;
825     Command *cmdPtr;
826     Tcl_Token *tokenPtr;
827     int bytesLeft, isFirstCmd, gotParse, wordIdx, currCmdIndex;
828     int commandLength, objIndex, code;
829     Tcl_DString ds;
830 
831     Tcl_DStringInit(&ds);
832 
833     if (numBytes < 0) {
834   numBytes = strlen(script);
835     }
836     Tcl_ResetResult(interp);
837     isFirstCmd = 1;
838 
839     /*
840      * Each iteration through the following loop compiles the next
841      * command from the script.
842      */
843 
844     p = script;
845     bytesLeft = numBytes;
846     gotParse = 0;
847     do {
848   if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse) != TCL_OK) {
849       code = TCL_ERROR;
850       goto error;
851   }
852   gotParse = 1;
853   if (nested) {
854       /*
855        * This is an unusual situation where the caller has passed us
856        * a non-zero value for "nested".  How unusual?  Well, this
857        * procedure, TclCompileScript, is internal to Tcl, so all
858        * callers should be within Tcl itself.  All but one of those
859        * callers explicitly pass in (nested = 0).  The exceptional
860        * caller is TclSetByteCodeFromAny, which will pass in
861        * (nested = 1) if and only if the flag TCL_BRACKET_TERM
862        * is set in the evalFlags field of interp.
863        *
864        * It appears that the TCL_BRACKET_TERM flag is only ever set
865        * by Tcl_SubstObj, and it immediately calls Tcl_EvalEx
866        * which clears the flag before passing the interp along.
867        * So, I don't think this procedure, TclCompileScript, is
868        * **ever** called with (nested != 0). 
869        * (The testsuite indeed doesn't exercise this code. MS)
870        *
871        * This means that the branches in this procedure that are
872        * only active when (nested != 0) are probably never exercised.
873        * This means that any bugs in them go unnoticed, and any bug
874        * fixes in them have a semi-theoretical nature.
875        *
876        * All that said, the spec for this procedure says it should
877        * handle the (nested != 0) case, so here's an attempt to fix
878        * bugs (Tcl Bug 681841) in that case.  Just in case some
879        * callers eventually come along and expect it to work...
880        */
881 
882       if (parse.term == (script + numBytes)) {
883     /* 
884      * The (nested != 0) case is meant to indicate that the
885      * caller found an open bracket ([) and asked us to
886      * parse and compile Tcl commands up to the matching
887      * close bracket (]).  We have to detect and handle
888      * the case where the close bracket is missing.
889      */
890 
891     Tcl_SetObjResult(interp,
892       Tcl_NewStringObj("missing close-bracket", -1));
893     code = TCL_ERROR;
894     goto error;
895       }
896   }
897   if (parse.numWords > 0) {
898       /*
899        * If not the first command, pop the previous command's result
900        * and, if we're compiling a top level command, update the last
901        * command's code size to account for the pop instruction.
902        */
903 
904       if (!isFirstCmd) {
905     TclEmitOpcode(INST_POP, envPtr);
906     if (!nested) {
907         envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
908          (envPtr->codeNext - envPtr->codeStart)
909          - startCodeOffset;
910     }
911       }
912 
913       /*
914        * Determine the actual length of the command.
915        */
916 
917       commandLength = parse.commandSize;
918       if (parse.term == parse.commandStart + commandLength - 1) {
919     /*
920      * The command terminator character (such as ; or ]) is
921      * the last character in the parsed command.  Reduce the
922      * length by one so that the trace message doesn't include
923      * the terminator character.
924      */
925     
926     commandLength -= 1;
927       }
928 
929 #ifdef TCL_COMPILE_DEBUG
930       /*
931              * If tracing, print a line for each top level command compiled.
932              */
933 
934       if ((tclTraceCompile >= 1)
935         && !nested && (envPtr->procPtr == NULL)) {
936     fprintf(stdout, "  Compiling: ");
937     TclPrintSource(stdout, parse.commandStart,
938       TclMin(commandLength, 55));
939     fprintf(stdout, "\n");
940       }
941 #endif
942       /*
943        * Each iteration of the following loop compiles one word
944        * from the command.
945        */
946       
947       envPtr->numCommands++;
948       currCmdIndex = (envPtr->numCommands - 1);
949       if (!nested) {
950     lastTopLevelCmdIndex = currCmdIndex;
951       }
952       startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
953       EnterCmdStartData(envPtr, currCmdIndex,
954               (parse.commandStart - envPtr->source), startCodeOffset);
955       
956       for (wordIdx = 0, tokenPtr = parse.tokenPtr;
957         wordIdx < parse.numWords;
958         wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
959     if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
960         /*
961          * If this is the first word and the command has a
962          * compile procedure, let it compile the command.
963          */
964 
965         if (wordIdx == 0) {
966       if (envPtr->procPtr != NULL) {
967           cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr;
968       } else {
969           cmdNsPtr = NULL; /* use current NS */
970       }
971 
972       /*
973        * We copy the string before trying to find the command
974        * by name.  We used to modify the string in place, but
975        * this is not safe because the name resolution
976        * handlers could have side effects that rely on the
977        * unmodified string.
978        */
979 
980       Tcl_DStringSetLength(&ds, 0);
981       Tcl_DStringAppend(&ds, tokenPtr[1].start,
982         tokenPtr[1].size);
983 
984       cmdPtr = (Command *) Tcl_FindCommand(interp,
985         Tcl_DStringValue(&ds),
986               (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
987 
988       if ((cmdPtr != NULL)
989               && (cmdPtr->compileProc != NULL)
990               && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)
991               && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
992           int savedNumCmds = envPtr->numCommands;
993           unsigned int savedCodeNext =
994             envPtr->codeNext - envPtr->codeStart;
995 
996           code = (*(cmdPtr->compileProc))(interp, &parse,
997                   envPtr);
998           if (code == TCL_OK) {
999         goto finishCommand;
1000           } else if (code == TCL_OUT_LINE_COMPILE) {
1001         /*
1002          * Restore numCommands and codeNext to their correct 
1003          * values, removing any commands compiled before 
1004          * TCL_OUT_LINE_COMPILE [Bugs 705406 and 735055]
1005          */
1006         envPtr->numCommands = savedNumCmds;
1007         envPtr->codeNext = envPtr->codeStart + savedCodeNext;
1008           } else { /* an error */
1009         /*
1010          * There was a compilation error, the last
1011          * command did not get compiled into (*envPtr).
1012          * Decrement the number of commands
1013          * claimed to be in (*envPtr).
1014          */
1015         envPtr->numCommands--;
1016         goto log;
1017           }
1018       }
1019 
1020       /*
1021        * No compile procedure so push the word. If the
1022        * command was found, push a CmdName object to
1023        * reduce runtime lookups.
1024        */
1025 
1026       objIndex = TclRegisterNewLiteral(envPtr,
1027         tokenPtr[1].start, tokenPtr[1].size);
1028       if (cmdPtr != NULL) {
1029           TclSetCmdNameObj(interp,
1030                  envPtr->literalArrayPtr[objIndex].objPtr,
1031            cmdPtr);
1032       }
1033         } else {
1034       objIndex = TclRegisterNewLiteral(envPtr,
1035         tokenPtr[1].start, tokenPtr[1].size);
1036         }
1037         TclEmitPush(objIndex, envPtr);
1038     } else {
1039         /*
1040          * The word is not a simple string of characters.
1041          */
1042         
1043         code = TclCompileTokens(interp, tokenPtr+1,
1044           tokenPtr->numComponents, envPtr);
1045         if (code != TCL_OK) {
1046       goto log;
1047         }
1048     }
1049       }
1050 
1051       /*
1052        * Emit an invoke instruction for the command. We skip this
1053        * if a compile procedure was found for the command.
1054        */
1055       
1056       if (wordIdx > 0) {
1057     if (wordIdx <= 255) {
1058         TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
1059     } else {
1060         TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr);
1061     }
1062       }
1063 
1064       /*
1065        * Update the compilation environment structure and record the
1066        * offsets of the source and code for the command.
1067        */
1068 
1069       finishCommand:
1070       EnterCmdExtentData(envPtr, currCmdIndex, commandLength,
1071         (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
1072       isFirstCmd = 0;
1073   } /* end if parse.numWords > 0 */
1074 
1075   /*
1076    * Advance to the next command in the script.
1077    */
1078   
1079   next = parse.commandStart + parse.commandSize;
1080   bytesLeft -= (next - p);
1081   p = next;
1082   Tcl_FreeParse(&parse);
1083   gotParse = 0;
1084   if (nested && (*parse.term == ']')) {
1085       /*
1086        * We get here in the special case where TCL_BRACKET_TERM was
1087        * set in the interpreter and the latest parsed command was
1088        * terminated by the matching close-bracket we were looking for.
1089        * Stop compilation.
1090        */
1091       
1092       break;
1093   }
1094     } while (bytesLeft > 0);
1095 
1096     /*
1097      * If the source script yielded no instructions (e.g., if it was empty),
1098      * push an empty string as the command's result.
1099      */
1100     
1101     if (envPtr->codeNext == entryCodeNext) {
1102   TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0),
1103           envPtr);
1104     }
1105     
1106     if (nested) {
1107   /*
1108    * When (nested != 0) back up 1 character to have 
1109    * iPtr->termOffset indicate the offset to the matching
1110    * close-bracket.
1111    */
1112 
1113   iPtr->termOffset = (p - 1) - script;
1114     } else {
1115   iPtr->termOffset = (p - script);
1116     }
1117     Tcl_DStringFree(&ds);
1118     return TCL_OK;
1119   
1120     error:
1121     /*
1122      * Generate various pieces of error information, such as the line
1123      * number where the error occurred and information to add to the
1124      * errorInfo variable. Then free resources that had been allocated
1125      * to the command.
1126      */
1127 
1128     commandLength = parse.commandSize;
1129     if (parse.term == parse.commandStart + commandLength - 1) {
1130   /*
1131    * The terminator character (such as ; or ]) of the command where
1132    * the error occurred is the last character in the parsed command.
1133    * Reduce the length by one so that the error message doesn't
1134    * include the terminator character.
1135    */
1136 
1137   commandLength -= 1;
1138     }
1139 
1140     log:
1141     LogCompilationInfo(interp, script, parse.commandStart, commandLength);
1142     if (gotParse) {
1143   Tcl_FreeParse(&parse);
1144     }
1145     iPtr->termOffset = (p - script);
1146     Tcl_DStringFree(&ds);
1147     return code;
1148 }

int TclCompileTokens (Tcl_Interp * interp, Tcl_Token * tokenPtr, int count, CompileEnv * envPtr)

Definition at line 1172 of file tclCompile.c.
References CompileEnv::codeNext, CONST, INST_LOAD_SCALAR1, INST_LOAD_SCALAR4, INST_LOAD_SCALAR_STK, NULL, Tcl_Token::numComponents, CompileEnv::procPtr, Tcl_Token::size, Tcl_Token::start, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringValue, TCL_OK, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, TCL_TOKEN_TEXT, TCL_TOKEN_VARIABLE, TCL_UTF_MAX, Tcl_UtfBackslash(), TclCompileScript(), TclEmitInstInt1, TclEmitInstInt4, TclEmitOpcode, TclEmitPush, TclFindCompiledLocal(), TclRegisterLiteral(), TclRegisterNewLiteral, and Tcl_Token::type.
Referenced by CompileSubExpr(), TclCompileAppendCmd(), TclCompileCatchCmd(), TclCompileCmdWord(), TclCompileExprWords(), TclCompileForeachCmd(), TclCompileIncrCmd(), TclCompileLappendCmd(), TclCompileLindexCmd(), TclCompileListCmd(), TclCompileLlengthCmd(), TclCompileLsetCmd(), TclCompileNoOp(), TclCompileReturnCmd(), TclCompileScript(), TclCompileSetCmd(), and TclCompileStringCmd().1179 {
1180     Tcl_DString textBuffer; /* Holds concatenated chars from adjacent
1181          * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
1182     char buffer[TCL_UTF_MAX];
1183     CONST char *name, *p;
1184     int numObjsToConcat, nameBytes, localVarName, localVar;
1185     int length, i, code;
1186     unsigned char *entryCodeNext = envPtr->codeNext;
1187 
1188     Tcl_DStringInit(&textBuffer);
1189     numObjsToConcat = 0;
1190     for ( ;  count > 0;  count--, tokenPtr++) {
1191   switch (tokenPtr->type) {
1192       case TCL_TOKEN_TEXT:
1193     Tcl_DStringAppend(&textBuffer, tokenPtr->start,
1194       tokenPtr->size);
1195     break;
1196 
1197       case TCL_TOKEN_BS:
1198     length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
1199       buffer);
1200     Tcl_DStringAppend(&textBuffer, buffer, length);
1201     break;
1202 
1203       case TCL_TOKEN_COMMAND:
1204     /*
1205      * Push any accumulated chars appearing before the command.
1206      */
1207     
1208     if (Tcl_DStringLength(&textBuffer) > 0) {
1209         int literal;
1210         
1211         literal = TclRegisterLiteral(envPtr,
1212           Tcl_DStringValue(&textBuffer),
1213           Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
1214         TclEmitPush(literal, envPtr);
1215         numObjsToConcat++;
1216         Tcl_DStringFree(&textBuffer);
1217     }
1218     
1219     code = TclCompileScript(interp, tokenPtr->start+1,
1220       tokenPtr->size-2, /*nested*/ 0, envPtr);
1221     if (code != TCL_OK) {
1222         goto error;
1223     }
1224     numObjsToConcat++;
1225     break;
1226 
1227       case TCL_TOKEN_VARIABLE:
1228     /*
1229      * Push any accumulated chars appearing before the $<var>.
1230      */
1231     
1232     if (Tcl_DStringLength(&textBuffer) > 0) {
1233         int literal;
1234         
1235         literal = TclRegisterLiteral(envPtr,
1236           Tcl_DStringValue(&textBuffer),
1237           Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
1238         TclEmitPush(literal, envPtr);
1239         numObjsToConcat++;
1240         Tcl_DStringFree(&textBuffer);
1241     }
1242     
1243     /*
1244      * Determine how the variable name should be handled: if it contains 
1245      * any namespace qualifiers it is not a local variable (localVarName=-1);
1246      * if it looks like an array element and the token has a single component, 
1247      * it should not be created here [Bug 569438] (localVarName=0); otherwise, 
1248      * the local variable can safely be created (localVarName=1).
1249      */
1250     
1251     name = tokenPtr[1].start;
1252     nameBytes = tokenPtr[1].size;
1253     localVarName = -1;
1254     if (envPtr->procPtr != NULL) {
1255         localVarName = 1;
1256         for (i = 0, p = name;  i < nameBytes;  i++, p++) {
1257       if ((*p == ':') && (i < (nameBytes-1))
1258               && (*(p+1) == ':')) {
1259           localVarName = -1;
1260           break;
1261       } else if ((*p == '(')
1262               && (tokenPtr->numComponents == 1) 
1263         && (*(name + nameBytes - 1) == ')')) {
1264           localVarName = 0;
1265           break;
1266       }
1267         }
1268     }
1269 
1270     /*
1271      * Either push the variable's name, or find its index in
1272      * the array of local variables in a procedure frame. 
1273      */
1274 
1275     localVar = -1;
1276     if (localVarName != -1) {
1277         localVar = TclFindCompiledLocal(name, nameBytes, 
1278               localVarName, /*flags*/ 0, envPtr->procPtr);
1279     }
1280     if (localVar < 0) {
1281         TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes),
1282           envPtr); 
1283     }
1284 
1285     /*
1286      * Emit instructions to load the variable.
1287      */
1288     
1289     if (tokenPtr->numComponents == 1) {
1290         if (localVar < 0) {
1291       TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
1292         } else if (localVar <= 255) {
1293       TclEmitInstInt1(INST_LOAD_SCALAR1, localVar,
1294               envPtr);
1295         } else {
1296       TclEmitInstInt4(INST_LOAD_SCALAR4, localVar,
1297         envPtr);
1298         }
1299     } else {
1300         code = TclCompileTokens(interp, tokenPtr+2,
1301           tokenPtr->numComponents-1, envPtr);
1302         if (code != TCL_OK) {
1303       char errorBuffer[150];
1304       sprintf(errorBuffer,
1305               "\n    (parsing index for array \"%.*s\")",
1306         ((nameBytes > 100)? 100 : nameBytes), name);
1307       Tcl_AddObjErrorInfo(interp, errorBuffer, -1);
1308       goto error;
1309         }
1310         if (localVar < 0) {
1311       TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
1312         } else if (localVar <= 255) {
1313       TclEmitInstInt1(INST_LOAD_ARRAY1, localVar,
1314               envPtr);
1315         } else {
1316       TclEmitInstInt4(INST_LOAD_ARRAY4, localVar,
1317               envPtr);
1318         }
1319     }
1320     numObjsToConcat++;
1321     count -= tokenPtr->numComponents;
1322     tokenPtr += tokenPtr->numComponents;
1323     break;
1324 
1325       default:
1326     panic("Unexpected token type in TclCompileTokens");
1327   }
1328     }
1329 
1330     /*
1331      * Push any accumulated characters appearing at the end.
1332      */
1333 
1334     if (Tcl_DStringLength(&textBuffer) > 0) {
1335   int literal;
1336 
1337   literal = TclRegisterLiteral(envPtr, Tcl_DStringValue(&textBuffer),
1338           Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
1339   TclEmitPush(literal, envPtr);
1340   numObjsToConcat++;
1341     }
1342 
1343     /*
1344      * If necessary, concatenate the parts of the word.
1345      */
1346 
1347     while (numObjsToConcat > 255) {
1348   TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
1349   numObjsToConcat -= 254; /* concat pushes 1 obj, the result */
1350     }
1351     if (numObjsToConcat > 1) {
1352   TclEmitInstInt1(INST_CONCAT1, numObjsToConcat, envPtr);
1353     }
1354 
1355     /*
1356      * If the tokens yielded no instructions, push an empty string.
1357      */
1358     
1359     if (envPtr->codeNext == entryCodeNext) {
1360   TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0),
1361           envPtr);
1362     }
1363     Tcl_DStringFree(&textBuffer);
1364     return TCL_OK;
1365 
1366     error:
1367     Tcl_DStringFree(&textBuffer);
1368     return code;
1369 }
int TclCreateAuxData (ClientData clientData, AuxDataType * typePtr, CompileEnv * envPtr)

Definition at line 2234 of file tclCompile.c.
References ckalloc, ckfree, AuxData::clientData, size_t(), AuxData::type, and VOID.
Referenced by TclCompileForeachCmd().2240 {
2241     int index;      /* Index for the new AuxData structure. */
2242     register AuxData *auxDataPtr;
2243             /* Points to the new AuxData structure */
2244     
2245     index = envPtr->auxDataArrayNext;
2246     if (index >= envPtr->auxDataArrayEnd) {
2247         /*
2248    * Expand the AuxData array. The currently allocated entries are
2249    * stored between elements 0 and (envPtr->auxDataArrayNext - 1)
2250    * [inclusive].
2251    */
2252   
2253   size_t currBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
2254   int newElems = 2*envPtr->auxDataArrayEnd;
2255   size_t newBytes = newElems * sizeof(AuxData);
2256   AuxData *newPtr = (AuxData *) ckalloc((unsigned) newBytes);
2257   
2258   /*
2259    * Copy from old AuxData array to new, free old AuxData array if
2260    * needed, and mark the new AuxData array as malloced.
2261    */
2262   
2263   memcpy((VOID *) newPtr, (VOID *) envPtr->auxDataArrayPtr,
2264           currBytes);
2265   if (envPtr->mallocedAuxDataArray) {
2266       ckfree((char *) envPtr->auxDataArrayPtr);
2267   }
2268   envPtr->auxDataArrayPtr = newPtr;
2269   envPtr->auxDataArrayEnd = newElems;
2270   envPtr->mallocedAuxDataArray = 1;
2271     }
2272     envPtr->auxDataArrayNext++;
2273     
2274     auxDataPtr = &(envPtr->auxDataArrayPtr[index]);
2275     auxDataPtr->clientData = clientData;
2276     auxDataPtr->type = typePtr;
2277     return index;
2278 }
int TclCreateExceptRange (ExceptionRangeType type, CompileEnv * envPtr)

Definition at line 2160 of file tclCompile.c.
References ExceptionRange::breakOffset, ExceptionRange::catchOffset, ckalloc, ckfree, ExceptionRange::codeOffset, ExceptionRange::continueOffset, ExceptionRange::nestingLevel, ExceptionRange::numCodeBytes, size_t(), ExceptionRange::type, and VOID.
Referenced by TclCompileCatchCmd(), TclCompileForCmd(), TclCompileForeachCmd(), and TclCompileWhileCmd().2164 {
2165     register ExceptionRange *rangePtr;
2166     int index = envPtr->exceptArrayNext;
2167     
2168     if (index >= envPtr->exceptArrayEnd) {
2169         /*
2170    * Expand the ExceptionRange array. The currently allocated entries
2171    * are stored between elements 0 and (envPtr->exceptArrayNext - 1)
2172    * [inclusive].
2173    */
2174   
2175   size_t currBytes =
2176           envPtr->exceptArrayNext * sizeof(ExceptionRange);
2177   int newElems = 2*envPtr->exceptArrayEnd;
2178   size_t newBytes = newElems * sizeof(ExceptionRange);
2179   ExceptionRange *newPtr = (ExceptionRange *)
2180           ckalloc((unsigned) newBytes);
2181   
2182   /*
2183    * Copy from old ExceptionRange array to new, free old
2184    * ExceptionRange array if needed, and mark the new ExceptionRange
2185    * array as malloced.
2186    */
2187   
2188   memcpy((VOID *) newPtr, (VOID *) envPtr->exceptArrayPtr,
2189           currBytes);
2190   if (envPtr->mallocedExceptArray) {
2191       ckfree((char *) envPtr->exceptArrayPtr);
2192   }
2193   envPtr->exceptArrayPtr = (ExceptionRange *) newPtr;
2194   envPtr->exceptArrayEnd = newElems;
2195   envPtr->mallocedExceptArray = 1;
2196     }
2197     envPtr->exceptArrayNext++;
2198     
2199     rangePtr = &(envPtr->exceptArrayPtr[index]);
2200     rangePtr->type = type;
2201     rangePtr->nestingLevel = envPtr->exceptDepth;
2202     rangePtr->codeOffset = -1;
2203     rangePtr->numCodeBytes = -1;
2204     rangePtr->breakOffset = -1;
2205     rangePtr->continueOffset = -1;
2206     rangePtr->catchOffset = -1;
2207     return index;
2208 }
void TclEmitForwardJump (CompileEnv * envPtr, TclJumpType jumpType, JumpFixup * jumpFixupPtr)

Definition at line 2410 of file tclCompile.c.
References JumpFixup::cmdIndex, JumpFixup::codeOffset, JumpFixup::exceptIndex, INST_JUMP1, INST_JUMP_FALSE1, INST_JUMP_TRUE1, JumpFixup::jumpType, TCL_TRUE_JUMP, TCL_UNCONDITIONAL_JUMP, and TclEmitInstInt1.
Referenced by CompileCondExpr(), CompileLandOrLorExpr(), TclCompileCatchCmd(), TclCompileForCmd(), TclCompileForeachCmd(), and TclCompileWhileCmd().2413                                                        : if true or
2414          * false or unconditional. */
2415     JumpFixup *jumpFixupPtr;  /* Points to the JumpFixup structure to
2416          * initialize with information about this
2417          * forward jump. */
2418 {
2419     /*
2420      * Initialize the JumpFixup structure:
2421      *    - codeOffset is offset of first byte of jump below
2422      *    - cmdIndex is index of the command after the current one
2423      *    - exceptIndex is the index of the first ExceptionRange after
2424      *      the current one.
2425      */
2426     
2427     jumpFixupPtr->jumpType = jumpType;
2428     jumpFixupPtr->codeOffset = (envPtr->codeNext - envPtr->codeStart);
2429     jumpFixupPtr->cmdIndex = envPtr->numCommands;
2430     jumpFixupPtr->exceptIndex = envPtr->exceptArrayNext;
2431     
2432     switch (jumpType) {
2433     case TCL_UNCONDITIONAL_JUMP:
2434   TclEmitInstInt1(INST_JUMP1, 0, envPtr);
2435   break;
2436     case TCL_TRUE_JUMP:
2437   TclEmitInstInt1(INST_JUMP_TRUE1, 0, envPtr);
2438   break;
2439     default:
2440   TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr);
2441   break;
2442     }
2443 }
void TclExpandCodeArray (void * envArgPtr)

Definition at line 1983 of file tclCompile.c.
References ckalloc, ckfree, CompileEnv::codeEnd, CompileEnv::codeNext, CompileEnv::codeStart, CompileEnv::mallocedCodeArray, size_t(), and VOID.
Referenced by TclFixupForwardJump().1986 {
1987     CompileEnv *envPtr = (CompileEnv*) envArgPtr; /* Points to the CompileEnv whose code array
1988                * must be enlarged. */
1989 
1990     /*
1991      * envPtr->codeNext is equal to envPtr->codeEnd. The currently defined
1992      * code bytes are stored between envPtr->codeStart and
1993      * (envPtr->codeNext - 1) [inclusive].
1994      */
1995     
1996     size_t currBytes = (envPtr->codeNext - envPtr->codeStart);
1997     size_t newBytes  = 2*(envPtr->codeEnd  - envPtr->codeStart);
1998     unsigned char *newPtr = (unsigned char *) ckalloc((unsigned) newBytes);
1999 
2000     /*
2001      * Copy from old code array to new, free old code array if needed, and
2002      * mark new code array as malloced.
2003      */
2004  
2005     memcpy((VOID *) newPtr, (VOID *) envPtr->codeStart, currBytes);
2006     if (envPtr->mallocedCodeArray) {
2007         ckfree((char *) envPtr->codeStart);
2008     }
2009     envPtr->codeStart = newPtr;
2010     envPtr->codeNext = (newPtr + currBytes);
2011     envPtr->codeEnd  = (newPtr + newBytes);
2012     envPtr->mallocedCodeArray = 1;
2013 }
void TclExpandJumpFixupArray (JumpFixupArray * fixupArrayPtr)

Definition at line 2330 of file tclCompile.c.
References ckalloc, ckfree, size_t(), and VOID.2334 {
2335     /*
2336      * The currently allocated jump fixup entries are stored from fixup[0]
2337      * up to fixup[fixupArrayPtr->fixupNext] (*not* inclusive). We assume
2338      * fixupArrayPtr->fixupNext is equal to fixupArrayPtr->fixupEnd.
2339      */
2340 
2341     size_t currBytes = fixupArrayPtr->next * sizeof(JumpFixup);
2342     int newElems = 2*(fixupArrayPtr->end + 1);
2343     size_t newBytes = newElems * sizeof(JumpFixup);
2344     JumpFixup *newPtr = (JumpFixup *) ckalloc((unsigned) newBytes);
2345 
2346     /*
2347      * Copy from the old array to new, free the old array if needed,
2348      * and mark the new array as malloced.
2349      */
2350  
2351     memcpy((VOID *) newPtr, (VOID *) fixupArrayPtr->fixup, currBytes);
2352     if (fixupArrayPtr->mallocedArray) {
2353   ckfree((char *) fixupArrayPtr->fixup);
2354     }
2355     fixupArrayPtr->fixup = (JumpFixup *) newPtr;
2356     fixupArrayPtr->end = newElems;
2357     fixupArrayPtr->mallocedArray = 1;
2358 }
void TclFinalizeAuxDataTypeTable ()

Definition at line 2741 of file tclCompile.c.
References auxDataTypeTable, auxDataTypeTableInitialized, Tcl_DeleteHashTable(), Tcl_MutexLock, and Tcl_MutexUnlock.
Referenced by TclFinalizeExecution().2742 {
2743     Tcl_MutexLock(&tableMutex);
2744     if (auxDataTypeTableInitialized) {
2745         Tcl_DeleteHashTable(&auxDataTypeTable);
2746         auxDataTypeTableInitialized = 0;
2747     }
2748     Tcl_MutexUnlock(&tableMutex);
2749 }
int TclFindCompiledLocal (CONST char * name, int nameBytes, int create, int flags, Proc * procPtr)

Definition at line 1777 of file tclCompile.c.
References ckalloc, CompiledLocal::defValuePtr, CompiledLocal::flags, CompiledLocal::frameIndex, CompiledLocal::name, CompiledLocal::nameLength, CompiledLocal::nextPtr, NULL, CompiledLocal::resolveInfo, size_t(), TclIsVarTemporary, VAR_TEMPORARY, VAR_UNDEFINED, and VOID.
Referenced by TclCompileCatchCmd(), TclCompileForeachCmd(), TclCompileTokens(), and TclCompileVariableCmd().1789 {
1790     register CompiledLocal *localPtr;
1791     int localVar = -1;
1792     register int i;
1793 
1794     /*
1795      * If not creating a temporary, does a local variable of the specified
1796      * name already exist?
1797      */
1798 
1799     if (name != NULL) { 
1800   int localCt = procPtr->numCompiledLocals;
1801   localPtr = procPtr->firstLocalPtr;
1802   for (i = 0;  i < localCt;  i++) {
1803       if (!TclIsVarTemporary(localPtr)) {
1804     char *localName = localPtr->name;
1805     if ((nameBytes == localPtr->nameLength)
1806                   && (strncmp(name, localName, (unsigned) nameBytes) == 0)) {
1807         return i;
1808     }
1809       }
1810       localPtr = localPtr->nextPtr;
1811   }
1812     }
1813 
1814     /*
1815      * Create a new variable if appropriate.
1816      */
1817     
1818     if (create || (name == NULL)) {
1819   localVar = procPtr->numCompiledLocals;
1820   localPtr = (CompiledLocal *) ckalloc((unsigned) 
1821           (sizeof(CompiledLocal) - sizeof(localPtr->name)
1822     + nameBytes+1));
1823   if (procPtr->firstLocalPtr == NULL) {
1824       procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
1825   } else {
1826       procPtr->lastLocalPtr->nextPtr = localPtr;
1827       procPtr->lastLocalPtr = localPtr;
1828   }
1829   localPtr->nextPtr = NULL;
1830   localPtr->nameLength = nameBytes;
1831   localPtr->frameIndex = localVar;
1832   localPtr->flags = flags | VAR_UNDEFINED;
1833   if (name == NULL) {
1834       localPtr->flags |= VAR_TEMPORARY;
1835   }
1836   localPtr->defValuePtr = NULL;
1837   localPtr->resolveInfo = NULL;
1838 
1839   if (name != NULL) {
1840       memcpy((VOID *) localPtr->name, (VOID *) name,
1841               (size_t) nameBytes);
1842   }
1843   localPtr->name[nameBytes] = '\0';
1844   procPtr->numCompiledLocals++;
1845     }
1846     return localVar;
1847 }
int TclFixupForwardJump (CompileEnv * envPtr, JumpFixup * jumpFixupPtr, int jumpDist, int distThreshold)

Definition at line 2473 of file tclCompile.c.
References CATCH_EXCEPTION_RANGE, JumpFixup::cmdIndex, JumpFixup::codeOffset, JumpFixup::exceptIndex, INST_JUMP1, INST_JUMP4, INST_JUMP_FALSE1, INST_JUMP_FALSE4, INST_JUMP_TRUE1, INST_JUMP_TRUE4, JumpFixup::jumpType, LOOP_EXCEPTION_RANGE, panic, TCL_TRUE_JUMP, TCL_UNCONDITIONAL_JUMP, TclExpandCodeArray(), TclUpdateInstInt1AtPc, and TclUpdateInstInt4AtPc.
Referenced by CompileCondExpr(), CompileLandOrLorExpr(), TclCompileCatchCmd(), TclCompileForCmd(), TclCompileForeachCmd(), and TclCompileWhileCmd().2482 {
2483     unsigned char *jumpPc, *p;
2484     int firstCmd, lastCmd, firstRange, lastRange, k;
2485     unsigned int numBytes;
2486     
2487     if (jumpDist <= distThreshold) {
2488   jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
2489   switch (jumpFixupPtr->jumpType) {
2490   case TCL_UNCONDITIONAL_JUMP:
2491       TclUpdateInstInt1AtPc(INST_JUMP1, jumpDist, jumpPc);
2492       break;
2493   case TCL_TRUE_JUMP:
2494       TclUpdateInstInt1AtPc(INST_JUMP_TRUE1, jumpDist, jumpPc);
2495       break;
2496   default:
2497       TclUpdateInstInt1AtPc(INST_JUMP_FALSE1, jumpDist, jumpPc);
2498       break;
2499   }
2500   return 0;
2501     }
2502 
2503     /*
2504      * We must grow the jump then move subsequent instructions down.
2505      * Note that if we expand the space for generated instructions,
2506      * code addresses might change; be careful about updating any of
2507      * these addresses held in variables.
2508      */
2509     
2510     if ((envPtr->codeNext + 3) > envPtr->codeEnd) {
2511         TclExpandCodeArray(envPtr);
2512     }
2513     jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
2514     for (numBytes = envPtr->codeNext-jumpPc-2, p = jumpPc+2+numBytes-1;
2515       numBytes > 0;  numBytes--, p--) {
2516   p[3] = p[0];
2517     }
2518     envPtr->codeNext += 3;
2519     jumpDist += 3;
2520     switch (jumpFixupPtr->jumpType) {
2521     case TCL_UNCONDITIONAL_JUMP:
2522   TclUpdateInstInt4AtPc(INST_JUMP4, jumpDist, jumpPc);
2523   break;
2524     case TCL_TRUE_JUMP:
2525   TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDist, jumpPc);
2526   break;
2527     default:
2528   TclUpdateInstInt4AtPc(INST_JUMP_FALSE4, jumpDist, jumpPc);
2529   break;
2530     }
2531     
2532     /*
2533      * Adjust the code offsets for any commands and any ExceptionRange
2534      * records between the jump and the current code address.
2535      */
2536     
2537     firstCmd = jumpFixupPtr->cmdIndex;
2538     lastCmd  = (envPtr->numCommands - 1);
2539     if (firstCmd < lastCmd) {
2540   for (k = firstCmd;  k <= lastCmd;  k++) {
2541       (envPtr->cmdMapPtr[k]).codeOffset += 3;
2542   }
2543     }
2544     
2545     firstRange = jumpFixupPtr->exceptIndex;
2546     lastRange  = (envPtr->exceptArrayNext - 1);
2547     for (k = firstRange;  k <= lastRange;  k++) {
2548   ExceptionRange *rangePtr = &(envPtr->exceptArrayPtr[k]);
2549   rangePtr->codeOffset += 3;
2550   
2551   switch (rangePtr->type) {
2552   case LOOP_EXCEPTION_RANGE:
2553       rangePtr->breakOffset += 3;
2554       if (rangePtr->continueOffset != -1) {
2555     rangePtr->continueOffset += 3;
2556       }
2557       break;
2558   case CATCH_EXCEPTION_RANGE:
2559       rangePtr->catchOffset += 3;
2560       break;
2561   default:
2562       panic("TclFixupForwardJump: bad ExceptionRange type %d\n",
2563               rangePtr->type);
2564   }
2565     }
2566     return 1;     /* the jump was grown */
2567 }
void TclFreeCompileEnv (CompileEnv * envPtr)

Definition at line 757 of file tclCompile.c.
References ckfree.
Referenced by Tcl_ExprObj().759 {
760     if (envPtr->mallocedCodeArray) {
761   ckfree((char *) envPtr->codeStart);
762     }
763     if (envPtr->mallocedLiteralArray) {
764   ckfree((char *) envPtr->literalArrayPtr);
765     }
766     if (envPtr->mallocedExceptArray) {
767   ckfree((char *) envPtr->exceptArrayPtr);
768     }
769     if (envPtr->mallocedCmdMap) {
770   ckfree((char *) envPtr->cmdMapPtr);
771     }
772     if (envPtr->mallocedAuxDataArray) {
773   ckfree((char *) envPtr->auxDataArrayPtr);
774     }
775 }
void TclFreeJumpFixupArray (JumpFixupArray * fixupArrayPtr)

Definition at line 2377 of file tclCompile.c.
References ckfree.2381 {
2382     if (fixupArrayPtr->mallocedArray) {
2383   ckfree((char *) fixupArrayPtr->fixup);
2384     }
2385 }
AuxDataType* TclGetAuxDataType (char * typeName)

Definition at line 2665 of file tclCompile.c.
References auxDataTypeTable, auxDataTypeTableInitialized, NULL, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_MutexLock, Tcl_MutexUnlock, and TclInitAuxDataTypeTable().2667 {
2668     register Tcl_HashEntry *hPtr;
2669     AuxDataType *typePtr = NULL;
2670 
2671     Tcl_MutexLock(&tableMutex);
2672     if (!auxDataTypeTableInitialized) {
2673         TclInitAuxDataTypeTable();
2674     }
2675 
2676     hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typeName);
2677     if (hPtr != (Tcl_HashEntry *) NULL) {
2678         typePtr = (AuxDataType *) Tcl_GetHashValue(hPtr);
2679     }
2680     Tcl_MutexUnlock(&tableMutex);
2681 
2682     return typePtr;
2683 }
void* TclGetInstructionTable ()

Definition at line 2589 of file tclCompile.c.2590 {
2591     return &tclInstructionTable[0];
2592 }
void TclInitAuxDataTypeTable ()

Definition at line 2705 of file tclCompile.c.
References auxDataTypeTable, auxDataTypeTableInitialized, Tcl_InitHashTable(), TCL_STRING_KEYS, tclForeachInfoType, and TclRegisterAuxDataType().
Referenced by TclCreateExecEnv(), TclGetAuxDataType(), and TclRegisterAuxDataType().2706 {
2707     /*
2708      * The table mutex must already be held before this routine is invoked.
2709      */
2710 
2711     auxDataTypeTableInitialized = 1;
2712     Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);
2713 
2714     /*
2715      * There is only one AuxData type at this time, so register it here.
2716      */
2717 
2718     TclRegisterAuxDataType(&tclForeachInfoType);
2719 }
void TclInitByteCodeObj (Tcl_Obj * objPtr, CompileEnv * envPtr)

Definition at line 1537 of file tclCompile.c.
References ByteCode::auxDataArrayPtr, ckalloc, ByteCode::codeStart, Interp::compileEpoch, ByteCode::compileEpoch, EncodeCmdLocMap(), ByteCode::exceptArrayPtr, ByteCode::flags, GetCmdLocEncodingSize(), Interp::handle, ByteCode::interpHandle, ByteCode::maxExceptDepth, ByteCode::maxStackDepth, ByteCode::nsEpoch, ByteCode::nsPtr, NULL, ByteCode::numAuxDataItems, ByteCode::numCmdLocBytes, ByteCode::numCodeBytes, ByteCode::numCommands, ByteCode::numExceptRanges, ByteCode::numLitObjects, ByteCode::numSrcBytes, ByteCode::objArrayPtr, panic, ByteCode::procPtr, ByteCode::refCount, Namespace::resolverEpoch, size_t(), ByteCode::source, ByteCode::structureSize, TCL_ALIGN, Tcl_GetTime(), tclByteCodeType, TclHandlePreserve(), and VOID.
Referenced by Tcl_ExprObj(), and TclSetByteCodeFromAny().1543 {
1544     register ByteCode *codePtr;
1545     size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes;
1546     size_t auxDataArrayBytes, structureSize;
1547     register unsigned char *p;
1548 #ifdef TCL_COMPILE_DEBUG
1549     unsigned char *nextPtr;
1550 #endif
1551     int numLitObjects = envPtr->literalArrayNext;
1552     Namespace *namespacePtr;
1553     int i;
1554     Interp *iPtr;
1555 
1556     iPtr = envPtr->iPtr;
1557 
1558     codeBytes = (envPtr->codeNext - envPtr->codeStart);
1559     objArrayBytes = (envPtr->literalArrayNext * sizeof(Tcl_Obj *));
1560     exceptArrayBytes = (envPtr->exceptArrayNext * sizeof(ExceptionRange));
1561     auxDataArrayBytes = (envPtr->auxDataArrayNext * sizeof(AuxData));
1562     cmdLocBytes = GetCmdLocEncodingSize(envPtr);
1563     
1564     /*
1565      * Compute the total number of bytes needed for this bytecode.
1566      */
1567 
1568     structureSize = sizeof(ByteCode);
1569     structureSize += TCL_ALIGN(codeBytes);        /* align object array */
1570     structureSize += TCL_ALIGN(objArrayBytes);    /* align exc range arr */
1571     structureSize += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
1572     structureSize += auxDataArrayBytes;
1573     structureSize += cmdLocBytes;
1574 
1575     if (envPtr->iPtr->varFramePtr != NULL) {
1576         namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
1577     } else {
1578         namespacePtr = envPtr->iPtr->globalNsPtr;
1579     }
1580     
1581     p = (unsigned char *) ckalloc((size_t) structureSize);
1582     codePtr = (ByteCode *) p;
1583     codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
1584     codePtr->compileEpoch = iPtr->compileEpoch;
1585     codePtr->nsPtr = namespacePtr;
1586     codePtr->nsEpoch = namespacePtr->resolverEpoch;
1587     codePtr->refCount = 1;
1588     codePtr->flags = 0;
1589     codePtr->source = envPtr->source;
1590     codePtr->procPtr = envPtr->procPtr;
1591 
1592     codePtr->numCommands = envPtr->numCommands;
1593     codePtr->numSrcBytes = envPtr->numSrcBytes;
1594     codePtr->numCodeBytes = codeBytes;
1595     codePtr->numLitObjects = numLitObjects;
1596     codePtr->numExceptRanges = envPtr->exceptArrayNext;
1597     codePtr->numAuxDataItems = envPtr->auxDataArrayNext;
1598     codePtr->numCmdLocBytes = cmdLocBytes;
1599     codePtr->maxExceptDepth = envPtr->maxExceptDepth;
1600     codePtr->maxStackDepth = envPtr->maxStackDepth;
1601 
1602     p += sizeof(ByteCode);
1603     codePtr->codeStart = p;
1604     memcpy((VOID *) p, (VOID *) envPtr->codeStart, (size_t) codeBytes);
1605     
1606     p += TCL_ALIGN(codeBytes);        /* align object array */
1607     codePtr->objArrayPtr = (Tcl_Obj **) p;
1608     for (i = 0;  i < numLitObjects;  i++) {
1609   codePtr->objArrayPtr[i] = envPtr->literalArrayPtr[i].objPtr;
1610     }
1611 
1612     p += TCL_ALIGN(objArrayBytes);    /* align exception range array */
1613     if (exceptArrayBytes > 0) {
1614   codePtr->exceptArrayPtr = (ExceptionRange *) p;
1615   memcpy((VOID *) p, (VOID *) envPtr->exceptArrayPtr,
1616           (size_t) exceptArrayBytes);
1617     } else {
1618   codePtr->exceptArrayPtr = NULL;
1619     }
1620     
1621     p += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
1622     if (auxDataArrayBytes > 0) {
1623   codePtr->auxDataArrayPtr = (AuxData *) p;
1624   memcpy((VOID *) p, (VOID *) envPtr->auxDataArrayPtr,
1625           (size_t) auxDataArrayBytes);
1626     } else {
1627   codePtr->auxDataArrayPtr = NULL;
1628     }
1629 
1630     p += auxDataArrayBytes;
1631 #ifndef TCL_COMPILE_DEBUG
1632     EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
1633 #else
1634     nextPtr = EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
1635     if (((size_t)(nextPtr - p)) != cmdLocBytes) { 
1636   panic("TclInitByteCodeObj: encoded cmd location bytes %d != expected size %d\n", (nextPtr - p), cmdLocBytes);
1637     }
1638 #endif
1639     
1640     /*
1641      * Record various compilation-related statistics about the new ByteCode
1642      * structure. Don't include overhead for statistics-related fields.
1643      */
1644 
1645 #ifdef TCL_COMPILE_STATS
1646     codePtr->structureSize = structureSize
1647       - (sizeof(size_t) + sizeof(Tcl_Time));
1648     Tcl_GetTime(&(codePtr->createTime));
1649     
1650     RecordByteCodeStats(codePtr);
1651 #endif /* TCL_COMPILE_STATS */
1652     
1653     /*
1654      * Free the old internal rep then convert the object to a
1655      * bytecode object by making its internal rep point to the just
1656      * compiled ByteCode.
1657      */
1658       
1659     if ((objPtr->typePtr != NULL) &&
1660       (objPtr->typePtr->freeIntRepProc != NULL)) {
1661   (*objPtr->typePtr->freeIntRepProc)(objPtr);
1662     }
1663     objPtr->internalRep.otherValuePtr = (VOID *) codePtr;
1664     objPtr->typePtr = &tclByteCodeType;
1665 }
void TclInitCompiledLocals (Tcl_Interp * interp, CallFrame * framePtr, Namespace * nsPtr)

Definition at line 1868 of file tclCompile.c.
References CallFrame::compiledLocals, ResolverScheme::compiledVarResProc, Namespace::compiledVarResProc, Tcl_ResolvedVarInfo::fetchProc, Proc::firstLocalPtr, CompiledLocal::flags, Namespace::interp, CompiledLocal::name, CompiledLocal::nameLength, ResolverScheme::nextPtr, CompiledLocal::nextPtr, NULL, CallFrame::procPtr, Var::refCount, Tcl_Obj::refCount, CompiledLocal::resolveInfo, Interp::resolverPtr, TCL_CONTINUE, TCL_OK, TclSetVarLink, VAR_ARGUMENT, VAR_RESOLVED, VAR_TEMPORARY, and varPtr.
Referenced by TclObjInterpProc().1872 {
1873     register CompiledLocal *localPtr;
1874     Interp *iPtr = (Interp*) interp;
1875     Tcl_ResolvedVarInfo *vinfo, *resVarInfo;
1876     Var *varPtr = framePtr->compiledLocals;
1877     Var *resolvedVarPtr;
1878     ResolverScheme *resPtr;
1879     int result;
1880 
1881     /*
1882      * Initialize the array of local variables stored in the call frame.
1883      * Some variables may have special resolution rules.  In that case,
1884      * we call their "resolver" procs to get our hands on the variable,
1885      * and we make the compiled local a link to the real variable.
1886      */
1887 
1888     for (localPtr = framePtr->procPtr->firstLocalPtr;
1889    localPtr != NULL;
1890    localPtr = localPtr->nextPtr) {
1891 
1892   /*
1893    * Check to see if this local is affected by namespace or
1894    * interp resolvers.  The resolver to use is cached for the
1895    * next invocation of the procedure.
1896    */
1897 
1898   if (!(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY|VAR_RESOLVED))
1899     && (nsPtr->compiledVarResProc || iPtr->resolverPtr)) {
1900       resPtr = iPtr->resolverPtr;
1901 
1902       if (nsPtr->compiledVarResProc) {
1903     result = (*nsPtr->compiledVarResProc)(nsPtr->interp,
1904       localPtr->name, localPtr->nameLength,
1905       (Tcl_Namespace *) nsPtr, &vinfo);
1906       } else {
1907     result = TCL_CONTINUE;
1908       }
1909 
1910       while ((result == TCL_CONTINUE) && resPtr) {
1911     if (resPtr->compiledVarResProc) {
1912         result = (*resPtr->compiledVarResProc)(nsPtr->interp,
1913           localPtr->name, localPtr->nameLength,
1914           (Tcl_Namespace *) nsPtr, &vinfo);
1915     }
1916     resPtr = resPtr->nextPtr;
1917       }
1918       if (result == TCL_OK) {
1919     localPtr->resolveInfo = vinfo;
1920     localPtr->flags |= VAR_RESOLVED;
1921       }
1922   }
1923 
1924   /*
1925    * Now invoke the resolvers to determine the exact variables that
1926    * should be used.
1927    */
1928 
1929         resVarInfo = localPtr->resolveInfo;
1930         resolvedVarPtr = NULL;
1931 
1932         if (resVarInfo && resVarInfo->fetchProc) {
1933             resolvedVarPtr = (Var*) (*resVarInfo->fetchProc)(interp,
1934         resVarInfo);
1935         }
1936 
1937         if (resolvedVarPtr) {
1938       varPtr->name = localPtr->name; /* will be just '\0' if temp var */
1939       varPtr->nsPtr = NULL;
1940       varPtr->hPtr = NULL;
1941       varPtr->refCount = 0;
1942       varPtr->tracePtr = NULL;
1943       varPtr->searchPtr = NULL;
1944       varPtr->flags = 0;
1945             TclSetVarLink(varPtr);
1946             varPtr->value.linkPtr = resolvedVarPtr;
1947             resolvedVarPtr->refCount++;
1948         } else {
1949       varPtr->value.objPtr = NULL;
1950       varPtr->name = localPtr->name; /* will be just '\0' if temp var */
1951       varPtr->nsPtr = NULL;
1952       varPtr->hPtr = NULL;
1953       varPtr->refCount = 0;
1954       varPtr->tracePtr = NULL;
1955       varPtr->searchPtr = NULL;
1956       varPtr->flags = localPtr->flags;
1957         }
1958   varPtr++;
1959     }
1960 }
void TclInitCompileEnv (Tcl_Interp * interp, CompileEnv * envPtr, char * string, int numBytes)

Definition at line 688 of file tclCompile.c.
References Interp::compiledProcPtr, COMPILEENV_INIT_AUX_DATA_SIZE, COMPILEENV_INIT_CMD_MAP_SIZE, COMPILEENV_INIT_CODE_BYTES, COMPILEENV_INIT_EXCEPT_RANGES, COMPILEENV_INIT_NUM_OBJECTS, and TclInitLiteralTable().
Referenced by Tcl_ExprObj(), and TclSetByteCodeFromAny().695 {
696     Interp *iPtr = (Interp *) interp;
697     
698     envPtr->iPtr = iPtr;
699     envPtr->source = string;
700     envPtr->numSrcBytes = numBytes;
701     envPtr->procPtr = iPtr->compiledProcPtr;
702     envPtr->numCommands = 0;
703     envPtr->exceptDepth = 0;
704     envPtr->maxExceptDepth = 0;
705     envPtr->maxStackDepth = 0;
706     envPtr->currStackDepth = 0;
707     TclInitLiteralTable(&(envPtr->localLitTable));
708 
709     envPtr->codeStart = envPtr->staticCodeSpace;
710     envPtr->codeNext = envPtr->codeStart;
711     envPtr->codeEnd = (envPtr->codeStart + COMPILEENV_INIT_CODE_BYTES);
712     envPtr->mallocedCodeArray = 0;
713 
714     envPtr->literalArrayPtr = envPtr->staticLiteralSpace;
715     envPtr->literalArrayNext = 0;
716     envPtr->literalArrayEnd = COMPILEENV_INIT_NUM_OBJECTS;
717     envPtr->mallocedLiteralArray = 0;
718     
719     envPtr->exceptArrayPtr = envPtr->staticExceptArraySpace;
720     envPtr->exceptArrayNext = 0;
721     envPtr->exceptArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES;
722     envPtr->mallocedExceptArray = 0;
723     
724     envPtr->cmdMapPtr = envPtr->staticCmdMapSpace;
725     envPtr->cmdMapEnd = COMPILEENV_INIT_CMD_MAP_SIZE;
726     envPtr->mallocedCmdMap = 0;
727     
728     envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
729     envPtr->auxDataArrayNext = 0;
730     envPtr->auxDataArrayEnd = COMPILEENV_INIT_AUX_DATA_SIZE;
731     envPtr->mallocedAuxDataArray = 0;
732 }
void TclInitJumpFixupArray (JumpFixupArray * fixupArrayPtr)

Definition at line 2298 of file tclCompile.c.
References JUMPFIXUP_INIT_ENTRIES.2302 {
2303     fixupArrayPtr->fixup = fixupArrayPtr->staticFixupSpace;
2304     fixupArrayPtr->next = 0;
2305     fixupArrayPtr->end = (JUMPFIXUP_INIT_ENTRIES - 1);
2306     fixupArrayPtr->mallocedArray = 0;
2307 }
int TclPrintInstruction (ByteCode* codePtr, unsigned char * pc)

Definition at line 3242 of file tclCompile.c.
References Proc::firstLocalPtr, INST_JUMP1, INST_JUMP4, INST_JUMP_FALSE1, INST_JUMP_FALSE4, INST_JUMP_TRUE1, INST_JUMP_TRUE4, INST_LOAD_ARRAY1, INST_LOAD_ARRAY4, INST_LOAD_SCALAR1, INST_LOAD_SCALAR4, INST_PUSH1, INST_PUSH4, INST_STORE_ARRAY1, INST_STORE_ARRAY4, INST_STORE_SCALAR1, INST_STORE_SCALAR4, CompiledLocal::name, InstructionDesc::name, CompiledLocal::nextPtr, InstructionDesc::numBytes, Proc::numCompiledLocals, InstructionDesc::numOperands, OPERAND_INT1, OPERAND_INT4, OPERAND_NONE, OPERAND_UINT1, OPERAND_UINT4, InstructionDesc::opTypes, panic, TclGetInt1AtPtr, TclGetInt4AtPtr, TclGetUInt1AtPtr, TclGetUInt4AtPtr, TclIsVarTemporary, TclPrintObject(), and TclPrintSource().
Referenced by TclExecuteByteCode().3245 {
3246     Proc *procPtr = codePtr->procPtr;
3247     unsigned char opCode = *pc;
3248     register InstructionDesc *instDesc = &tclInstructionTable[opCode];
3249     unsigned char *codeStart = codePtr->codeStart;
3250     unsigned int pcOffset = (pc - codeStart);
3251     int opnd, i, j;
3252     
3253     fprintf(stdout, "(%u) %s ", pcOffset, instDesc->name);
3254     for (i = 0;  i < instDesc->numOperands;  i++) {
3255   switch (instDesc->opTypes[i]) {
3256   case OPERAND_INT1:
3257       opnd = TclGetInt1AtPtr(pc+1+i);
3258       if ((i == 0) && ((opCode == INST_JUMP1)
3259            || (opCode == INST_JUMP_TRUE1)
3260                  || (opCode == INST_JUMP_FALSE1))) {
3261     fprintf(stdout, "%d   # pc %u", opnd, (pcOffset + opnd));
3262       } else {
3263     fprintf(stdout, "%d", opnd);
3264       }
3265       break;
3266   case OPERAND_INT4:
3267       opnd = TclGetInt4AtPtr(pc+1+i);
3268       if ((i == 0) && ((opCode == INST_JUMP4)
3269            || (opCode == INST_JUMP_TRUE4)
3270                  || (opCode == INST_JUMP_FALSE4))) {
3271     fprintf(stdout, "%d   # pc %u", opnd, (pcOffset + opnd));
3272       } else {
3273     fprintf(stdout, "%d", opnd);
3274       }
3275       break;
3276   case OPERAND_UINT1:
3277       opnd = TclGetUInt1AtPtr(pc+1+i);
3278       if ((i == 0) && (opCode == INST_PUSH1)) {
3279     fprintf(stdout, "%u   # ", (unsigned int) opnd);
3280     TclPrintObject(stdout, codePtr->objArrayPtr[opnd], 40);
3281       } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR1)
3282             || (opCode == INST_LOAD_ARRAY1)
3283             || (opCode == INST_STORE_SCALAR1)
3284             || (opCode == INST_STORE_ARRAY1))) {
3285     int localCt = procPtr->numCompiledLocals;
3286     CompiledLocal *localPtr = procPtr->firstLocalPtr;
3287     if (opnd >= localCt) {
3288         panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
3289            (unsigned int) opnd, localCt);
3290         return instDesc->numBytes;
3291     }
3292     for (j = 0;  j < opnd;  j++) {
3293         localPtr = localPtr->nextPtr;
3294     }
3295     if (TclIsVarTemporary(localPtr)) {
3296         fprintf(stdout, "%u # temp var %u",
3297           (unsigned int) opnd, (unsigned int) opnd);
3298     } else {
3299         fprintf(stdout, "%u # var ", (unsigned int) opnd);
3300         TclPrintSource(stdout, localPtr->name, 40);
3301     }
3302       } else {
3303     fprintf(stdout, "%u ", (unsigned int) opnd);
3304       }
3305       break;
3306   case OPERAND_UINT4:
3307       opnd = TclGetUInt4AtPtr(pc+1+i);
3308       if (opCode == INST_PUSH4) {
3309     fprintf(stdout, "%u   # ", opnd);
3310     TclPrintObject(stdout, codePtr->objArrayPtr[opnd], 40);
3311       } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR4)
3312             || (opCode == INST_LOAD_ARRAY4)
3313             || (opCode == INST_STORE_SCALAR4)
3314             || (opCode == INST_STORE_ARRAY4))) {
3315     int localCt = procPtr->numCompiledLocals;
3316     CompiledLocal *localPtr = procPtr->firstLocalPtr;
3317     if (opnd >= localCt) {
3318         panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
3319            (unsigned int) opnd, localCt);
3320         return instDesc->numBytes;
3321     }
3322     for (j = 0;  j < opnd;  j++) {
3323         localPtr = localPtr->nextPtr;
3324     }
3325     if (TclIsVarTemporary(localPtr)) {
3326         fprintf(stdout, "%u # temp var %u",
3327           (unsigned int) opnd, (unsigned int) opnd);
3328     } else {
3329         fprintf(stdout, "%u # var ", (unsigned int) opnd);
3330         TclPrintSource(stdout, localPtr->name, 40);
3331     }
3332       } else {
3333     fprintf(stdout, "%u ", (unsigned int) opnd);
3334       }
3335       break;
3336   case OPERAND_NONE:
3337   default:
3338       break;
3339   }
3340     }
3341     fprintf(stdout, "\n");
3342     return instDesc->numBytes;
3343 }
void TclPrintObject (FILE * outFile, Tcl_Obj * objPtr, int maxChars)

Definition at line 3363 of file tclCompile.c.
References Tcl_GetStringFromObj(), TclMin, and TclPrintSource().
Referenced by TclExecuteByteCode(), and TclPrintInstruction().3368 {
3369     char *bytes;
3370     int length;
3371     
3372     bytes = Tcl_GetStringFromObj(objPtr, &length);
3373     TclPrintSource(outFile, bytes, TclMin(length, maxChars));
3374 }
void TclPrintSource (FILE * outFile, CONST char * string, int maxChars)

Definition at line 3395 of file tclCompile.c.
References CONST, and NULL.
Referenced by TclCompileScript(), TclPrintInstruction(), and TclPrintObject().3399 {
3400     register CONST char *p;
3401     register int i = 0;
3402 
3403     if (string == NULL) {
3404   fprintf(outFile, "\"\"");
3405   return;
3406     }
3407 
3408     fprintf(outFile, "\"");
3409     p = string;
3410     for (;  (*p != '\0') && (i < maxChars);  p++, i++) {
3411   switch (*p) {
3412       case '"':
3413     fprintf(outFile, "\\\"");
3414     continue;
3415       case '\f':
3416     fprintf(outFile, "\\f");
3417     continue;
3418       case '\n':
3419     fprintf(outFile, "\\n");
3420     continue;
3421             case '\r':
3422     fprintf(outFile, "\\r");
3423     continue;
3424       case '\t':
3425     fprintf(outFile, "\\t");
3426     continue;
3427             case '\v':
3428     fprintf(outFile, "\\v");
3429     continue;
3430       default:
3431     fprintf(outFile, "%c", *p);
3432     continue;
3433   }
3434     }
3435     fprintf(outFile, "\"");
3436 }
void TclRegisterAuxDataType (AuxDataType * typePtr)

Definition at line 2614 of file tclCompile.c.
References auxDataTypeTable, auxDataTypeTableInitialized, NULL, Tcl_CreateHashEntry, Tcl_DeleteHashEntry(), Tcl_FindHashEntry, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_SetHashValue, and TclInitAuxDataTypeTable().
Referenced by TclInitAuxDataTypeTable().2618 {
2619     register Tcl_HashEntry *hPtr;
2620     int new;
2621 
2622     Tcl_MutexLock(&tableMutex);
2623     if (!auxDataTypeTableInitialized) {
2624         TclInitAuxDataTypeTable();
2625     }
2626 
2627     /*
2628      * If there's already a type with the given name, remove it.
2629      */
2630 
2631     hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typePtr->name);
2632     if (hPtr != (Tcl_HashEntry *) NULL) {
2633         Tcl_DeleteHashEntry(hPtr);
2634     }
2635 
2636     /*
2637      * Now insert the new object type.
2638      */
2639 
2640     hPtr = Tcl_CreateHashEntry(&auxDataTypeTable, typePtr->name, &new);
2641     if (new) {
2642         Tcl_SetHashValue(hPtr, typePtr);
2643     }
2644     Tcl_MutexUnlock(&tableMutex);
2645 }
int TclSetByteCodeFromAny (Tcl_Interp * interp, Tcl_Obj * objPtr, CompileHookProc * hookProc, ClientData clientData)

Definition at line 344 of file tclCompile.c.
References CompileEnv::auxDataArrayNext, CompileEnv::auxDataArrayPtr, AuxData::clientData, Interp::evalFlags, AuxDataType::freeProc, INST_DONE, CompileEnv::literalArrayNext, CompileEnv::literalArrayPtr, CompileEnv::localLitTable, NULL, CompileEnv::numSrcBytes, LiteralEntry::objPtr, panic, TCL_BRACKET_TERM, Tcl_GetStringFromObj(), TCL_LINK_INT, Tcl_LinkVar(), TCL_OK, TclCompileScript(), TclEmitOpcode, TclInitByteCodeObj(), TclInitCompileEnv(), TclReleaseLiteral(), Interp::termOffset, and AuxData::type.
Referenced by SetByteCodeFromAny().350 {
351     Interp *iPtr = (Interp *) interp;
352     CompileEnv compEnv;   /* Compilation environment structure
353          * allocated in frame. */
354     LiteralTable *localTablePtr = &(compEnv.localLitTable);
355     register AuxData *auxDataPtr;
356     LiteralEntry *entryPtr;
357     register int i;
358     int length, nested, result;
359     char *string;
360 
361 #ifdef TCL_COMPILE_DEBUG
362     if (!traceInitialized) {
363         if (Tcl_LinkVar(interp, "tcl_traceCompile",
364               (char *) &tclTraceCompile,  TCL_LINK_INT) != TCL_OK) {
365             panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable");
366         }
367         traceInitialized = 1;
368     }
369 #endif
370 
371     if (iPtr->evalFlags & TCL_BRACKET_TERM) {
372   nested = 1;
373     } else {
374   nested = 0;
375     }
376     string = Tcl_GetStringFromObj(objPtr, &length);
377     TclInitCompileEnv(interp, &compEnv, string, length);
378     result = TclCompileScript(interp, string, length, nested, &compEnv);
379 
380     if (result == TCL_OK) {
381   /*
382    * Successful compilation. Add a "done" instruction at the end.
383    */
384 
385   compEnv.numSrcBytes = iPtr->termOffset;
386   TclEmitOpcode(INST_DONE, &compEnv);
387 
388   /*
389    * Invoke the compilation hook procedure if one exists.
390    */
391 
392   if (hookProc) {
393       result = (*hookProc)(interp, &compEnv, clientData);
394   }
395 
396   /*
397    * Change the object into a ByteCode object. Ownership of the literal
398    * objects and aux data items is given to the ByteCode object.
399    */
400     
401 #ifdef TCL_COMPILE_DEBUG
402   TclVerifyLocalLiteralTable(&compEnv);
403 #endif /*TCL_COMPILE_DEBUG*/
404 
405   TclInitByteCodeObj(objPtr, &compEnv);
406 #ifdef TCL_COMPILE_DEBUG
407   if (tclTraceCompile >= 2) {
408       TclPrintByteCodeObj(interp, objPtr);
409   }
410 #endif /* TCL_COMPILE_DEBUG */
411     }
412   
413     if (result != TCL_OK) {
414   /*
415    * Compilation errors. 
416    */
417 
418   entryPtr = compEnv.literalArrayPtr;
419   for (i = 0;  i < compEnv.literalArrayNext;  i++) {
420       TclReleaseLiteral(interp, entryPtr->objPtr);
421       entryPtr++;
422   }
423 #ifdef TCL_COMPILE_DEBUG
424   TclVerifyGlobalLiteralTable(iPtr);
425 #endif /*TCL_COMPILE_DEBUG*/
426 
427   auxDataPtr = compEnv.auxDataArrayPtr;
428   for (i = 0;  i < compEnv.auxDataArrayNext;  i++) {
429       if (auxDataPtr->type->freeProc != NULL) {
430     auxDataPtr->type->freeProc(auxDataPtr->clientData);
431       }
432       auxDataPtr++;
433   }
434     }
435 
436 
437     /*
438      * Free storage allocated during compilation.
439      */
440     
441     if (localTablePtr->buckets != localTablePtr->staticBuckets) {
442   ckfree((char *) localTablePtr->buckets);
443     }
444     TclFreeCompileEnv(&compEnv);
445     return result;
446 }

Variable Documentation
Tcl_HashTable auxDataTypeTable [static]

Definition at line 24 of file tclCompile.c.
Referenced by TclFinalizeAuxDataTypeTable(), TclGetAuxDataType(), TclInitAuxDataTypeTable(), and TclRegisterAuxDataType().int auxDataTypeTableInitialized [static]

Definition at line 25 of file tclCompile.c.
Referenced by TclFinalizeAuxDataTypeTable(), TclGetAuxDataType(), TclInitAuxDataTypeTable(), and TclRegisterAuxDataType().Tcl_ObjType tclByteCodeType
Initial value: {
    "bytecode",       
    FreeByteCodeInternalRep,    
    DupByteCodeInternalRep,   
    (Tcl_UpdateStringProc *) NULL,  
    SetByteCodeFromAny      
}
Definition at line 309 of file tclCompile.c.
Referenced by ProcCompileProc(), Tcl_ExprObj(), TclCompEvalObj(), TclInitByteCodeObj(), TclInitObjSubsystem(), and TclReleaseLiteral().

generic/tclCompile.h File Reference
#include "tclInt.h"
Classes
struct ExceptionRange
struct CmdLocation
struct AuxDataType
struct AuxData
struct CompileEnv
struct ByteCode
struct InstructionDesc
struct BuiltinFunc
struct JumpFixup
struct JumpFixupArray
struct ForeachVarList
struct ForeachInfo
Defines
#define _TCLCOMPILATION  1
#define COMPILEENV_INIT_CODE_BYTES  250
#define COMPILEENV_INIT_NUM_OBJECTS  60
#define COMPILEENV_INIT_EXCEPT_RANGES  5
#define COMPILEENV_INIT_CMD_MAP_SIZE  40
#define COMPILEENV_INIT_AUX_DATA_SIZE  5
#define TCL_BYTECODE_PRECOMPILED  0x0001
#define INST_DONE  0
#define INST_PUSH1  1
#define INST_PUSH4  2
#define INST_POP  3
#define INST_DUP  4
#define INST_CONCAT1  5
#define INST_INVOKE_STK1  6
#define INST_INVOKE_STK4  7
#define INST_EVAL_STK  8
#define INST_EXPR_STK  9
#define INST_LOAD_SCALAR1  10
#define INST_LOAD_SCALAR4  11
#define INST_LOAD_SCALAR_STK  12
#define INST_LOAD_ARRAY1  13
#define INST_LOAD_ARRAY4  14
#define INST_LOAD_ARRAY_STK  15
#define INST_LOAD_STK  16
#define INST_STORE_SCALAR1  17
#define INST_STORE_SCALAR4  18
#define INST_STORE_SCALAR_STK  19
#define INST_STORE_ARRAY1  20
#define INST_STORE_ARRAY4  21
#define INST_STORE_ARRAY_STK  22
#define INST_STORE_STK  23
#define INST_INCR_SCALAR1  24
#define INST_INCR_SCALAR_STK  25
#define INST_INCR_ARRAY1  26
#define INST_INCR_ARRAY_STK  27
#define INST_INCR_STK  28
#define INST_INCR_SCALAR1_IMM  29
#define INST_INCR_SCALAR_STK_IMM  30
#define INST_INCR_ARRAY1_IMM  31
#define INST_INCR_ARRAY_STK_IMM  32
#define INST_INCR_STK_IMM  33
#define INST_JUMP1  34
#define INST_JUMP4  35
#define INST_JUMP_TRUE1  36
#define INST_JUMP_TRUE4  37
#define INST_JUMP_FALSE1  38
#define INST_JUMP_FALSE4  39
#define INST_LOR  40
#define INST_LAND  41
#define INST_BITOR  42
#define INST_BITXOR  43
#define INST_BITAND  44
#define INST_EQ  45
#define INST_NEQ  46
#define INST_LT  47
#define INST_GT  48
#define INST_LE  49
#define INST_GE  50
#define INST_LSHIFT  51
#define INST_RSHIFT  52
#define INST_ADD  53
#define INST_SUB  54
#define INST_MULT  55
#define INST_DIV  56
#define INST_MOD  57
#define INST_UPLUS  58
#define INST_UMINUS  59
#define INST_BITNOT  60
#define INST_LNOT  61
#define INST_CALL_BUILTIN_FUNC1  62
#define INST_CALL_FUNC1  63
#define INST_TRY_CVT_TO_NUMERIC  64
#define INST_BREAK  65
#define INST_CONTINUE  66
#define INST_FOREACH_START4  67
#define INST_FOREACH_STEP4  68
#define INST_BEGIN_CATCH4  69
#define INST_END_CATCH  70
#define INST_PUSH_RESULT  71
#define INST_PUSH_RETURN_CODE  72
#define INST_STR_EQ  73
#define INST_STR_NEQ  74
#define INST_STR_CMP  75
#define INST_STR_LEN  76
#define INST_STR_INDEX  77
#define INST_STR_MATCH  78
#define INST_LIST  79
#define INST_LIST_INDEX  80
#define INST_LIST_LENGTH  81
#define INST_APPEND_SCALAR1  82
#define INST_APPEND_SCALAR4  83
#define INST_APPEND_ARRAY1  84
#define INST_APPEND_ARRAY4  85
#define INST_APPEND_ARRAY_STK  86
#define INST_APPEND_STK  87
#define INST_LAPPEND_SCALAR1  88
#define INST_LAPPEND_SCALAR4  89
#define INST_LAPPEND_ARRAY1  90
#define INST_LAPPEND_ARRAY4  91
#define INST_LAPPEND_ARRAY_STK  92
#define INST_LAPPEND_STK  93
#define INST_LIST_INDEX_MULTI  94
#define INST_OVER  95
#define INST_LSET_LIST  96
#define INST_LSET_FLAT  97
#define LAST_INST_OPCODE  97
#define MAX_INSTRUCTION_OPERANDS  2
#define BUILTIN_FUNC_ACOS  0
#define BUILTIN_FUNC_ASIN  1
#define BUILTIN_FUNC_ATAN  2
#define BUILTIN_FUNC_ATAN2  3
#define BUILTIN_FUNC_CEIL  4
#define BUILTIN_FUNC_COS  5
#define BUILTIN_FUNC_COSH  6
#define BUILTIN_FUNC_EXP  7
#define BUILTIN_FUNC_FLOOR  8
#define BUILTIN_FUNC_FMOD  9
#define BUILTIN_FUNC_HYPOT  10
#define BUILTIN_FUNC_LOG  11
#define BUILTIN_FUNC_LOG10  12
#define BUILTIN_FUNC_POW  13
#define BUILTIN_FUNC_SIN  14
#define BUILTIN_FUNC_SINH  15
#define BUILTIN_FUNC_SQRT  16
#define BUILTIN_FUNC_TAN  17
#define BUILTIN_FUNC_TANH  18
#define BUILTIN_FUNC_ABS  19
#define BUILTIN_FUNC_DOUBLE  20
#define BUILTIN_FUNC_INT  21
#define BUILTIN_FUNC_RAND  22
#define BUILTIN_FUNC_ROUND  23
#define BUILTIN_FUNC_SRAND  24
#define BUILTIN_FUNC_WIDE  25
#define LAST_BUILTIN_FUNC  25
#define JUMPFIXUP_INIT_ENTRIES  10
#define TclRegisterNewLiteral(envPtr, bytes, length)  TclRegisterLiteral(envPtr, (char *)(bytes), length, /*onHeap*/ 0)
#define TclUpdateStackReqs(op, i, envPtr)
#define TclEmitOpcode(op, envPtr)
#define TclEmitInt1(i, envPtr)
#define TclEmitInstInt1(op, i, envPtr)
#define TclEmitInstInt4(op, i, envPtr)
#define TclEmitPush(objIndex, envPtr)
#define TclStoreInt1AtPtr(i, p)  *(p)   = (unsigned char) ((unsigned int) (i))
#define TclStoreInt4AtPtr(i, p)
#define TclUpdateInstInt1AtPc(op, i, pc)
#define TclUpdateInstInt4AtPc(op, i, pc)
#define TclGetInt1AtPtr(p)  ((int) *((char *) p))
#define TclGetInt4AtPtr(p)
#define TclGetUInt1AtPtr(p)  ((unsigned int) *(p))
#define TclGetUInt4AtPtr(p)
#define TclMin(i, j)  ((((int) i) < ((int) j))? (i) : (j))
#define TclMax(i, j)  ((((int) i) > ((int) j))? (i) : (j))
#define TCL_STORAGE_CLASS  DLLIMPORT
Typedefs
typedef ExecEnv * eePtr
typedef ExecEnv ClientData clientData
Enumerations
enum ExceptionRangeType { LOOP_EXCEPTION_RANGE, CATCH_EXCEPTION_RANGE }
enum InstOperandType { OPERAND_NONE, OPERAND_INT1, OPERAND_INT4, OPERAND_UINT1, OPERAND_UINT4 }
enum TclJumpType { TCL_UNCONDITIONAL_JUMP, TCL_TRUE_JUMP, TCL_FALSE_JUMP }
Functions
typedef ClientData (AuxDataDupProc) _ANSI_ARGS_((ClientData clientData))
typedef void (AuxDataFreeProc) _ANSI_ARGS_((ClientData clientData))
typedef int (CallBuiltinFuncProc) _ANSI_ARGS_((Tcl_Interp *interp
EXTERN int TclEvalObjvInternal _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], CONST char *command, int length, int flags))
EXTERN int TclInterpReady _ANSI_ARGS_ ((Tcl_Interp *interp))
EXTERN int TclCompEvalObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
EXTERN void TclCleanupByteCode _ANSI_ARGS_ ((ByteCode *codePtr))
EXTERN int TclCompileCmdWord _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, CompileEnv *envPtr))
EXTERN int TclCompileExpr _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *script, int numBytes, CompileEnv *envPtr))
EXTERN int TclCompileExprWords _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Token *tokenPtr, int numWords, CompileEnv *envPtr))
EXTERN int TclCompileScript _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *script, int numBytes, int nested, CompileEnv *envPtr))
EXTERN int TclCreateAuxData _ANSI_ARGS_ ((ClientData clientData, AuxDataType *typePtr, CompileEnv *envPtr))
EXTERN int TclCreateExceptRange _ANSI_ARGS_ ((ExceptionRangeType type, CompileEnv *envPtr))
EXTERN void TclDeleteExecEnv _ANSI_ARGS_ ((ExecEnv *eePtr))
EXTERN void TclDeleteLiteralTable _ANSI_ARGS_ ((Tcl_Interp *interp, LiteralTable *tablePtr))
EXTERN void TclEmitForwardJump _ANSI_ARGS_ ((CompileEnv *envPtr, TclJumpType jumpType, JumpFixup *jumpFixupPtr))
EXTERN ExceptionRange *TclGetExceptionRangeForPc _ANSI_ARGS_ ((unsigned char *pc, int catchOnly, ByteCode *codePtr))
EXTERN void TclExpandJumpFixupArray _ANSI_ARGS_ ((JumpFixupArray *fixupArrayPtr))
EXTERN void TclFinalizeAuxDataTypeTable _ANSI_ARGS_ ((void))
EXTERN int TclFindCompiledLocal _ANSI_ARGS_ ((CONST char *name, int nameChars, int create, int flags, Proc *procPtr))
EXTERN int TclFixupForwardJump _ANSI_ARGS_ ((CompileEnv *envPtr, JumpFixup *jumpFixupPtr, int jumpDist, int distThreshold))
EXTERN void TclFreeCompileEnv _ANSI_ARGS_ ((CompileEnv *envPtr))
EXTERN void TclInitByteCodeObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, CompileEnv *envPtr))
EXTERN void TclInitCompileEnv _ANSI_ARGS_ ((Tcl_Interp *interp, CompileEnv *envPtr, char *string, int numBytes))
EXTERN void TclInitLiteralTable _ANSI_ARGS_ ((LiteralTable *tablePtr))
EXTERN int TclPrintInstruction _ANSI_ARGS_ ((ByteCode *codePtr, unsigned char *pc))
EXTERN void TclPrintObject _ANSI_ARGS_ ((FILE *outFile, Tcl_Obj *objPtr, int maxChars))
EXTERN void TclPrintSource _ANSI_ARGS_ ((FILE *outFile, CONST char *string, int maxChars))
EXTERN void TclRegisterAuxDataType _ANSI_ARGS_ ((AuxDataType *typePtr))
EXTERN int TclRegisterLiteral _ANSI_ARGS_ ((CompileEnv *envPtr, char *bytes, int length, int onHeap))
EXTERN void TclSetCmdNameObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Command *cmdPtr))
EXTERN int TclCompileVariableCmd _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr))
Variables
InstructionDesc tclInstructionTable []
BuiltinFunc tclBuiltinFuncTable []
AuxDataType tclForeachInfoType

Define Documentation
#define _TCLCOMPILATION  1

Definition at line 15 of file tclCompile.h.#define BUILTIN_FUNC_ABS  19

Definition at line 590 of file tclCompile.h.#define BUILTIN_FUNC_ACOS  0

Definition at line 571 of file tclCompile.h.#define BUILTIN_FUNC_ASIN  1

Definition at line 572 of file tclCompile.h.#define BUILTIN_FUNC_ATAN  2

Definition at line 573 of file tclCompile.h.#define BUILTIN_FUNC_ATAN2  3

Definition at line 574 of file tclCompile.h.#define BUILTIN_FUNC_CEIL  4

Definition at line 575 of file tclCompile.h.#define BUILTIN_FUNC_COS  5

Definition at line 576 of file tclCompile.h.#define BUILTIN_FUNC_COSH  6

Definition at line 577 of file tclCompile.h.#define BUILTIN_FUNC_DOUBLE  20

Definition at line 591 of file tclCompile.h.#define BUILTIN_FUNC_EXP  7

Definition at line 578 of file tclCompile.h.#define BUILTIN_FUNC_FLOOR  8

Definition at line 579 of file tclCompile.h.#define BUILTIN_FUNC_FMOD  9

Definition at line 580 of file tclCompile.h.#define BUILTIN_FUNC_HYPOT  10

Definition at line 581 of file tclCompile.h.#define BUILTIN_FUNC_INT  21

Definition at line 592 of file tclCompile.h.#define BUILTIN_FUNC_LOG  11

Definition at line 582 of file tclCompile.h.#define BUILTIN_FUNC_LOG10  12

Definition at line 583 of file tclCompile.h.#define BUILTIN_FUNC_POW  13

Definition at line 584 of file tclCompile.h.#define BUILTIN_FUNC_RAND  22

Definition at line 593 of file tclCompile.h.#define BUILTIN_FUNC_ROUND  23

Definition at line 594 of file tclCompile.h.#define BUILTIN_FUNC_SIN  14

Definition at line 585 of file tclCompile.h.#define BUILTIN_FUNC_SINH  15

Definition at line 586 of file tclCompile.h.#define BUILTIN_FUNC_SQRT  16

Definition at line 587 of file tclCompile.h.#define BUILTIN_FUNC_SRAND  24

Definition at line 595 of file tclCompile.h.#define BUILTIN_FUNC_TAN  17

Definition at line 588 of file tclCompile.h.#define BUILTIN_FUNC_TANH  18

Definition at line 589 of file tclCompile.h.#define BUILTIN_FUNC_WIDE  25

Definition at line 596 of file tclCompile.h.#define COMPILEENV_INIT_AUX_DATA_SIZE  5

Definition at line 186 of file tclCompile.h.
Referenced by TclInitCompileEnv().#define COMPILEENV_INIT_CMD_MAP_SIZE  40

Definition at line 185 of file tclCompile.h.
Referenced by TclInitCompileEnv().#define COMPILEENV_INIT_CODE_BYTES  250

Definition at line 182 of file tclCompile.h.
Referenced by TclInitCompileEnv().#define COMPILEENV_INIT_EXCEPT_RANGES  5

Definition at line 184 of file tclCompile.h.
Referenced by TclInitCompileEnv().#define COMPILEENV_INIT_NUM_OBJECTS  60

Definition at line 183 of file tclCompile.h.
Referenced by TclInitCompileEnv().#define INST_ADD  53

Definition at line 456 of file tclCompile.h.
Referenced by CompileSubExpr(), and TclExecuteByteCode().#define INST_APPEND_ARRAY1  84

Definition at line 499 of file tclCompile.h.
Referenced by TclCompileAppendCmd(), and TclExecuteByteCode().#define INST_APPEND_ARRAY4  85

Definition at line 500 of file tclCompile.h.
Referenced by TclCompileAppendCmd(), and TclExecuteByteCode().#define INST_APPEND_ARRAY_STK  86

Definition at line 501 of file tclCompile.h.
Referenced by TclCompileAppendCmd(), and TclExecuteByteCode().#define INST_APPEND_SCALAR1  82

Definition at line 497 of file tclCompile.h.
Referenced by TclCompileAppendCmd(), and TclExecuteByteCode().#define INST_APPEND_SCALAR4  83

Definition at line 498 of file tclCompile.h.
Referenced by TclCompileAppendCmd(), and TclExecuteByteCode().#define INST_APPEND_STK  87

Definition at line 502 of file tclCompile.h.
Referenced by TclCompileAppendCmd(), and TclExecuteByteCode().#define INST_BEGIN_CATCH4  69

Definition at line 478 of file tclCompile.h.
Referenced by TclCompileCatchCmd(), and TclExecuteByteCode().#define INST_BITAND  44

Definition at line 447 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_BITNOT  60

Definition at line 463 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_BITOR  42

Definition at line 445 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_BITXOR  43

Definition at line 446 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_BREAK  65

Definition at line 470 of file tclCompile.h.
Referenced by TclCompileBreakCmd(), and TclExecuteByteCode().#define INST_CALL_BUILTIN_FUNC1  62

Definition at line 465 of file tclCompile.h.
Referenced by CompileMathFuncCall(), and TclExecuteByteCode().#define INST_CALL_FUNC1  63

Definition at line 466 of file tclCompile.h.
Referenced by CompileMathFuncCall(), and TclExecuteByteCode().#define INST_CONCAT1  5

Definition at line 400 of file tclCompile.h.
Referenced by TclCompileExprWords(), and TclExecuteByteCode().#define INST_CONTINUE  66

Definition at line 471 of file tclCompile.h.
Referenced by TclCompileContinueCmd(), and TclExecuteByteCode().#define INST_DIV  56

Definition at line 459 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_DONE  0

Definition at line 395 of file tclCompile.h.
Referenced by Tcl_ExprObj(), TclCompileReturnCmd(), TclExecuteByteCode(), and TclSetByteCodeFromAny().#define INST_DUP  4

Definition at line 399 of file tclCompile.h.
Referenced by CompileLandOrLorExpr(), and TclExecuteByteCode().#define INST_END_CATCH  70

Definition at line 479 of file tclCompile.h.
Referenced by TclCompileCatchCmd(), and TclExecuteByteCode().#define INST_EQ  45

Definition at line 448 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_EVAL_STK  8

Definition at line 403 of file tclCompile.h.
Referenced by TclCompileCatchCmd(), TclCompileCmdWord(), and TclExecuteByteCode().#define INST_EXPR_STK  9

Definition at line 404 of file tclCompile.h.
Referenced by TclCompileExprWords(), and TclExecuteByteCode().#define INST_FOREACH_START4  67

Definition at line 474 of file tclCompile.h.
Referenced by TclCompileForeachCmd(), and TclExecuteByteCode().#define INST_FOREACH_STEP4  68

Definition at line 475 of file tclCompile.h.
Referenced by TclCompileForeachCmd(), and TclExecuteByteCode().#define INST_GE  50

Definition at line 453 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_GT  48

Definition at line 451 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_INCR_ARRAY1  26

Definition at line 425 of file tclCompile.h.
Referenced by TclCompileIncrCmd(), and TclExecuteByteCode().#define INST_INCR_ARRAY1_IMM  31

Definition at line 430 of file tclCompile.h.
Referenced by TclCompileIncrCmd(), and TclExecuteByteCode().#define INST_INCR_ARRAY_STK  27

Definition at line 426 of file tclCompile.h.
Referenced by TclCompileIncrCmd(), and TclExecuteByteCode().#define INST_INCR_ARRAY_STK_IMM  32

Definition at line 431 of file tclCompile.h.
Referenced by TclCompileIncrCmd(), and TclExecuteByteCode().#define INST_INCR_SCALAR1  24

Definition at line 423 of file tclCompile.h.
Referenced by TclCompileIncrCmd(), and TclExecuteByteCode().#define INST_INCR_SCALAR1_IMM  29

Definition at line 428 of file tclCompile.h.
Referenced by TclCompileIncrCmd(), and TclExecuteByteCode().#define INST_INCR_SCALAR_STK  25

Definition at line 424 of file tclCompile.h.
Referenced by TclCompileIncrCmd(), and TclExecuteByteCode().#define INST_INCR_SCALAR_STK_IMM  30

Definition at line 429 of file tclCompile.h.
Referenced by TclCompileIncrCmd(), and TclExecuteByteCode().#define INST_INCR_STK  28

Definition at line 427 of file tclCompile.h.
Referenced by TclCompileIncrCmd(), and TclExecuteByteCode().#define INST_INCR_STK_IMM  33

Definition at line 432 of file tclCompile.h.
Referenced by TclCompileIncrCmd(), and TclExecuteByteCode().#define INST_INVOKE_STK1  6

Definition at line 401 of file tclCompile.h.
Referenced by TclCompileScript(), and TclExecuteByteCode().#define INST_INVOKE_STK4  7

Definition at line 402 of file tclCompile.h.
Referenced by TclCompileScript(), and TclExecuteByteCode().#define INST_JUMP1  34

Definition at line 435 of file tclCompile.h.
Referenced by TclCompileForeachCmd(), TclCompileWhileCmd(), TclEmitForwardJump(), TclExecuteByteCode(), TclFixupForwardJump(), and TclPrintInstruction().#define INST_JUMP4  35

Definition at line 436 of file tclCompile.h.
Referenced by TclCompileForeachCmd(), TclCompileWhileCmd(), TclExecuteByteCode(), TclFixupForwardJump(), and TclPrintInstruction().#define INST_JUMP_FALSE1  38

Definition at line 439 of file tclCompile.h.
Referenced by TclEmitForwardJump(), TclExecuteByteCode(), TclFixupForwardJump(), and TclPrintInstruction().#define INST_JUMP_FALSE4  39

Definition at line 440 of file tclCompile.h.
Referenced by TclExecuteByteCode(), TclFixupForwardJump(), and TclPrintInstruction().#define INST_JUMP_TRUE1  36

Definition at line 437 of file tclCompile.h.
Referenced by TclCompileForCmd(), TclCompileWhileCmd(), TclEmitForwardJump(), TclExecuteByteCode(), TclFixupForwardJump(), and TclPrintInstruction().#define INST_JUMP_TRUE4  37

Definition at line 438 of file tclCompile.h.
Referenced by TclCompileForCmd(), TclCompileWhileCmd(), TclExecuteByteCode(), TclFixupForwardJump(), and TclPrintInstruction().#define INST_LAND  41

Definition at line 444 of file tclCompile.h.
Referenced by CompileLandOrLorExpr(), and TclExecuteByteCode().#define INST_LAPPEND_ARRAY1  90

Definition at line 507 of file tclCompile.h.
Referenced by TclCompileLappendCmd(), and TclExecuteByteCode().#define INST_LAPPEND_ARRAY4  91

Definition at line 508 of file tclCompile.h.
Referenced by TclCompileLappendCmd(), and TclExecuteByteCode().#define INST_LAPPEND_ARRAY_STK  92

Definition at line 509 of file tclCompile.h.
Referenced by TclCompileLappendCmd(), and TclExecuteByteCode().#define INST_LAPPEND_SCALAR1  88

Definition at line 505 of file tclCompile.h.
Referenced by TclCompileLappendCmd(), and TclExecuteByteCode().#define INST_LAPPEND_SCALAR4  89

Definition at line 506 of file tclCompile.h.
Referenced by TclCompileLappendCmd(), and TclExecuteByteCode().#define INST_LAPPEND_STK  93

Definition at line 510 of file tclCompile.h.
Referenced by TclCompileLappendCmd(), and TclExecuteByteCode().#define INST_LE  49

Definition at line 452 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_LIST  79

Definition at line 492 of file tclCompile.h.
Referenced by TclCompileListCmd(), and TclExecuteByteCode().#define INST_LIST_INDEX  80

Definition at line 493 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_LIST_INDEX_MULTI  94

Definition at line 514 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_LIST_LENGTH  81

Definition at line 494 of file tclCompile.h.
Referenced by TclCompileLlengthCmd(), and TclExecuteByteCode().#define INST_LNOT  61

Definition at line 464 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_LOAD_ARRAY1  13

Definition at line 410 of file tclCompile.h.
Referenced by TclCompileSetCmd(), TclExecuteByteCode(), and TclPrintInstruction().#define INST_LOAD_ARRAY4  14

Definition at line 411 of file tclCompile.h.
Referenced by TclCompileSetCmd(), TclExecuteByteCode(), and TclPrintInstruction().#define INST_LOAD_ARRAY_STK  15

Definition at line 412 of file tclCompile.h.
Referenced by TclCompileSetCmd(), and TclExecuteByteCode().#define INST_LOAD_SCALAR1  10

Definition at line 407 of file tclCompile.h.
Referenced by TclCompileSetCmd(), TclCompileTokens(), TclExecuteByteCode(), and TclPrintInstruction().#define INST_LOAD_SCALAR4  11

Definition at line 408 of file tclCompile.h.
Referenced by TclCompileSetCmd(), TclCompileTokens(), TclExecuteByteCode(), and TclPrintInstruction().#define INST_LOAD_SCALAR_STK  12

Definition at line 409 of file tclCompile.h.
Referenced by TclCompileSetCmd(), TclCompileTokens(), and TclExecuteByteCode().#define INST_LOAD_STK  16

Definition at line 413 of file tclCompile.h.
Referenced by TclCompileSetCmd(), and TclExecuteByteCode().#define INST_LOR  40

Definition at line 443 of file tclCompile.h.
Referenced by CompileLandOrLorExpr(), IllegalExprOperandType(), and TclExecuteByteCode().#define INST_LSET_FLAT  97

Definition at line 523 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_LSET_LIST  96

Definition at line 522 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_LSHIFT  51

Definition at line 454 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_LT  47

Definition at line 450 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_MOD  57

Definition at line 460 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_MULT  55

Definition at line 458 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_NEQ  46

Definition at line 449 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_OVER  95

Definition at line 521 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_POP  3

Definition at line 398 of file tclCompile.h.
Referenced by TclCompileCatchCmd(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileNoOp(), TclCompileScript(), TclCompileWhileCmd(), and TclExecuteByteCode().#define INST_PUSH1  1

Definition at line 396 of file tclCompile.h.
Referenced by TclExecuteByteCode(), and TclPrintInstruction().#define INST_PUSH4  2

Definition at line 397 of file tclCompile.h.
Referenced by TclExecuteByteCode(), and TclPrintInstruction().#define INST_PUSH_RESULT  71

Definition at line 480 of file tclCompile.h.
Referenced by TclCompileCatchCmd(), and TclExecuteByteCode().#define INST_PUSH_RETURN_CODE  72

Definition at line 481 of file tclCompile.h.
Referenced by TclCompileCatchCmd(), and TclExecuteByteCode().#define INST_RSHIFT  52

Definition at line 455 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_STORE_ARRAY1  20

Definition at line 417 of file tclCompile.h.
Referenced by TclCompileSetCmd(), TclExecuteByteCode(), and TclPrintInstruction().#define INST_STORE_ARRAY4  21

Definition at line 418 of file tclCompile.h.
Referenced by TclCompileSetCmd(), TclExecuteByteCode(), and TclPrintInstruction().#define INST_STORE_ARRAY_STK  22

Definition at line 419 of file tclCompile.h.
Referenced by TclCompileSetCmd(), and TclExecuteByteCode().#define INST_STORE_SCALAR1  17

Definition at line 414 of file tclCompile.h.
Referenced by TclCompileCatchCmd(), TclCompileForeachCmd(), TclCompileSetCmd(), TclExecuteByteCode(), and TclPrintInstruction().#define INST_STORE_SCALAR4  18

Definition at line 415 of file tclCompile.h.
Referenced by TclCompileCatchCmd(), TclCompileForeachCmd(), TclCompileSetCmd(), TclExecuteByteCode(), and TclPrintInstruction().#define INST_STORE_SCALAR_STK  19

Definition at line 416 of file tclCompile.h.
Referenced by TclCompileSetCmd(), and TclExecuteByteCode().#define INST_STORE_STK  23

Definition at line 420 of file tclCompile.h.
Referenced by TclCompileSetCmd(), and TclExecuteByteCode().#define INST_STR_CMP  75

Definition at line 486 of file tclCompile.h.
Referenced by TclCompileStringCmd(), and TclExecuteByteCode().#define INST_STR_EQ  73

Definition at line 484 of file tclCompile.h.
Referenced by TclCompileStringCmd(), and TclExecuteByteCode().#define INST_STR_INDEX  77

Definition at line 488 of file tclCompile.h.
Referenced by TclCompileStringCmd(), and TclExecuteByteCode().#define INST_STR_LEN  76

Definition at line 487 of file tclCompile.h.
Referenced by TclCompileStringCmd(), and TclExecuteByteCode().#define INST_STR_MATCH  78

Definition at line 489 of file tclCompile.h.
Referenced by TclCompileStringCmd(), and TclExecuteByteCode().#define INST_STR_NEQ  74

Definition at line 485 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define INST_SUB  54

Definition at line 457 of file tclCompile.h.
Referenced by CompileSubExpr(), and TclExecuteByteCode().#define INST_TRY_CVT_TO_NUMERIC  64

Definition at line 467 of file tclCompile.h.
Referenced by CompileCondExpr(), TclCompileExpr(), and TclExecuteByteCode().#define INST_UMINUS  59

Definition at line 462 of file tclCompile.h.
Referenced by CompileSubExpr(), and TclExecuteByteCode().#define INST_UPLUS  58

Definition at line 461 of file tclCompile.h.
Referenced by CompileSubExpr(), and TclExecuteByteCode().#define JUMPFIXUP_INIT_ENTRIES  10

Definition at line 657 of file tclCompile.h.
Referenced by TclInitJumpFixupArray().#define LAST_BUILTIN_FUNC  25

Definition at line 598 of file tclCompile.h.
Referenced by TclExecuteByteCode().#define LAST_INST_OPCODE  97

Definition at line 526 of file tclCompile.h.#define MAX_INSTRUCTION_OPERANDS  2

Definition at line 537 of file tclCompile.h.#define TCL_BYTECODE_PRECOMPILED  0x0001

Definition at line 281 of file tclCompile.h.
Referenced by ProcCompileProc(), Tcl_ExprObj(), TclCleanupByteCode(), and TclCompEvalObj().#define TCL_STORAGE_CLASS  DLLIMPORT

Definition at line 1039 of file tclCompile.h.#define TclEmitInstInt1(op, i, envPtr)
Value:if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \
        TclExpandCodeArray(envPtr); \
    } \
    *(envPtr)->codeNext++ = (unsigned char) (op); \
    *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));\
    TclUpdateStackReqs(op, i, envPtr)
Definition at line 905 of file tclCompile.h.
Referenced by CompileMathFuncCall(), TclCompileAppendCmd(), TclCompileCatchCmd(), TclCompileExprWords(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileIncrCmd(), TclCompileLappendCmd(), TclCompileScript(), TclCompileSetCmd(), TclCompileStringCmd(), TclCompileTokens(), TclCompileWhileCmd(), and TclEmitForwardJump().#define TclEmitInstInt4(op, i, envPtr)
Value:if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \
        TclExpandCodeArray(envPtr); \
    } \
    *(envPtr)->codeNext++ = (unsigned char) (op); \
    *(envPtr)->codeNext++ = \
        (unsigned char) ((unsigned int) (i) >> 24); \
    *(envPtr)->codeNext++ = \
        (unsigned char) ((unsigned int) (i) >> 16); \
    *(envPtr)->codeNext++ = \
        (unsigned char) ((unsigned int) (i) >>  8); \
    *(envPtr)->codeNext++ = \
        (unsigned char) ((unsigned int) (i)      );\
    TclUpdateStackReqs(op, i, envPtr)
Definition at line 913 of file tclCompile.h.
Referenced by TclCompileAppendCmd(), TclCompileCatchCmd(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileLappendCmd(), TclCompileListCmd(), TclCompileScript(), TclCompileSetCmd(), TclCompileTokens(), and TclCompileWhileCmd().#define TclEmitInt1(i, envPtr)
Value:if ((envPtr)->codeNext == (envPtr)->codeEnd) \
        TclExpandCodeArray(envPtr); \
    *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i))
Definition at line 887 of file tclCompile.h.
Referenced by TclCompileIncrCmd().#define TclEmitOpcode(op, envPtr)
Value:if ((envPtr)->codeNext == (envPtr)->codeEnd) \
        TclExpandCodeArray(envPtr); \
    *(envPtr)->codeNext++ = (unsigned char) (op);\
    TclUpdateStackReqs(op, 0, envPtr)
Definition at line 874 of file tclCompile.h.
Referenced by CompileCondExpr(), CompileLandOrLorExpr(), CompileSubExpr(), Tcl_ExprObj(), TclCompileAppendCmd(), TclCompileBreakCmd(), TclCompileCatchCmd(), TclCompileCmdWord(), TclCompileContinueCmd(), TclCompileExpr(), TclCompileExprWords(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileIncrCmd(), TclCompileLappendCmd(), TclCompileLlengthCmd(), TclCompileNoOp(), TclCompileReturnCmd(), TclCompileScript(), TclCompileSetCmd(), TclCompileStringCmd(), TclCompileTokens(), TclCompileWhileCmd(), and TclSetByteCodeFromAny().#define TclEmitPush(objIndex, envPtr)
Value:{\
        register int objIndexCopy = (objIndex);\
        if (objIndexCopy <= 255) { \
      TclEmitInstInt1(INST_PUSH1, objIndexCopy, (envPtr)); \
        } else { \
      TclEmitInstInt4(INST_PUSH4, objIndexCopy, (envPtr)); \
  }\
    }
Definition at line 937 of file tclCompile.h.
Referenced by CompileLandOrLorExpr(), CompileMathFuncCall(), CompileSubExpr(), Tcl_ExprObj(), TclCompileAppendCmd(), TclCompileCatchCmd(), TclCompileExprWords(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileIncrCmd(), TclCompileLappendCmd(), TclCompileLindexCmd(), TclCompileListCmd(), TclCompileLlengthCmd(), TclCompileLsetCmd(), TclCompileReturnCmd(), TclCompileScript(), TclCompileSetCmd(), TclCompileStringCmd(), TclCompileTokens(), and TclCompileWhileCmd().#define TclGetInt1AtPtr(p)  ((int) *((char *) p))

Definition at line 1006 of file tclCompile.h.
Referenced by GetSrcInfoForPc(), TclExecuteByteCode(), and TclPrintInstruction().#define TclGetInt4AtPtr(p)
Value:(((int) TclGetInt1AtPtr(p) << 24) | \
                            (*((p)+1) << 16) | \
                (*((p)+2) <<  8) | \
                (*((p)+3)))
Definition at line 1016 of file tclCompile.h.
Referenced by GetSrcInfoForPc(), TclExecuteByteCode(), and TclPrintInstruction().#define TclGetUInt1AtPtr(p)  ((unsigned int) *(p))

Definition at line 1021 of file tclCompile.h.
Referenced by TclExecuteByteCode(), and TclPrintInstruction().#define TclGetUInt4AtPtr(p)
Value:((unsigned int) (*(p)     << 24) | \
                                (*((p)+1) << 16) | \
                    (*((p)+2) <<  8) | \
                    (*((p)+3)))
Definition at line 1022 of file tclCompile.h.
Referenced by TclExecuteByteCode(), and TclPrintInstruction().#define TclMax(i, j)  ((((int) i) > ((int) j))? (i) : (j))

Definition at line 1036 of file tclCompile.h.
Referenced by TclCompileCatchCmd(), TclCompileForCmd(), TclCompileForeachCmd(), and TclCompileWhileCmd().#define TclMin(i, j)  ((((int) i) < ((int) j))? (i) : (j))

Definition at line 1035 of file tclCompile.h.
Referenced by TclCompileScript(), and TclPrintObject().#define TclRegisterNewLiteral(envPtr, bytes, length)  TclRegisterLiteral(envPtr, (char *)(bytes), length, /*onHeap*/ 0)

Definition at line 838 of file tclCompile.h.
Referenced by CompileLandOrLorExpr(), CompileMathFuncCall(), CompileSubExpr(), TclCompileAppendCmd(), TclCompileCatchCmd(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileIncrCmd(), TclCompileLappendCmd(), TclCompileLindexCmd(), TclCompileListCmd(), TclCompileLlengthCmd(), TclCompileLsetCmd(), TclCompileReturnCmd(), TclCompileScript(), TclCompileSetCmd(), TclCompileStringCmd(), TclCompileTokens(), and TclCompileWhileCmd().#define TclStoreInt1AtPtr(i, p)  *(p)   = (unsigned char) ((unsigned int) (i))

Definition at line 956 of file tclCompile.h.
Referenced by EncodeCmdLocMap().#define TclStoreInt4AtPtr(i, p)
Value:*(p)   = (unsigned char) ((unsigned int) (i) >> 24); \
    *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \
    *(p+2) = (unsigned char) ((unsigned int) (i) >>  8); \
    *(p+3) = (unsigned char) ((unsigned int) (i)      )
Definition at line 959 of file tclCompile.h.
Referenced by EncodeCmdLocMap().#define TclUpdateInstInt1AtPc(op, i, pc)
Value:*(pc) = (unsigned char) (op); \
    TclStoreInt1AtPtr((i), ((pc)+1))
Definition at line 976 of file tclCompile.h.
Referenced by TclCompileForeachCmd(), and TclFixupForwardJump().#define TclUpdateInstInt4AtPc(op, i, pc)
Value:*(pc) = (unsigned char) (op); \
    TclStoreInt4AtPtr((i), ((pc)+1))
Definition at line 980 of file tclCompile.h.
Referenced by TclCompileForeachCmd(), and TclFixupForwardJump().#define TclUpdateStackReqs(op, i, envPtr)
Value:{\
  int delta = tclInstructionTable[(op)].stackEffect;\
  if (delta) {\
      if (delta < 0) {\
    if((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {\
        (envPtr)->maxStackDepth = (envPtr)->currStackDepth;\
    }\
    if (delta == INT_MIN) {\
        delta = 1 - (i);\
    }\
      }\
      (envPtr)->currStackDepth += delta;\
  }\
    }
Definition at line 850 of file tclCompile.h.
Typedef Documentation
typedef ExecEnv ClientData clientData

Definition at line 607 of file tclCompile.h.typedef ExecEnv* eePtr

Definition at line 607 of file tclCompile.h.
Enumeration Type Documentation
enum ExceptionRangeType

Enumerator: 
LOOP_EXCEPTION_RANGE  
CATCH_EXCEPTION_RANGE  

Definition at line 82 of file tclCompile.h.82              {
83     LOOP_EXCEPTION_RANGE, /* Exception's range is part of a loop.
84          * Break and continue "exceptions" cause
85          * jumps to appropriate PC offsets. */
86     CATCH_EXCEPTION_RANGE /* Exception's range is controlled by a
87          * catch command. Errors in the range cause
88          * a jump to a catch PC offset. */
89 } ExceptionRangeType;
enum InstOperandType

Enumerator: 
OPERAND_NONE  
OPERAND_INT1  
OPERAND_INT4  
OPERAND_UINT1  
OPERAND_UINT4  

Definition at line 539 of file tclCompile.h.539                              {
540     OPERAND_NONE,
541     OPERAND_INT1,   /* One byte signed integer. */
542     OPERAND_INT4,   /* Four byte signed integer. */
543     OPERAND_UINT1,    /* One byte unsigned integer. */
544     OPERAND_UINT4   /* Four byte unsigned integer. */
545 } InstOperandType;
enum TclJumpType

Enumerator: 
TCL_UNCONDITIONAL_JUMP  
TCL_TRUE_JUMP  
TCL_FALSE_JUMP  

Definition at line 634 of file tclCompile.h.634              {
635     TCL_UNCONDITIONAL_JUMP,
636     TCL_TRUE_JUMP,
637     TCL_FALSE_JUMP
638 } TclJumpType;

Function Documentation
EXTERN int TclCompileVariableCmd _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr))
EXTERN void TclSetCmdNameObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Command *cmdPtr))
EXTERN int TclRegisterLiteral _ANSI_ARGS_ ((CompileEnv *envPtr, char *bytes, int length, int onHeap))
EXTERN void TclRegisterAuxDataType _ANSI_ARGS_ ((AuxDataType *typePtr))
EXTERN void TclPrintSource _ANSI_ARGS_ ((FILE *outFile, CONST char *string, int maxChars))
EXTERN void TclPrintObject _ANSI_ARGS_ ((FILE *outFile, Tcl_Obj *objPtr, int maxChars))
EXTERN int TclPrintInstruction _ANSI_ARGS_ ((ByteCode *codePtr, unsigned char *pc))
EXTERN void TclInitLiteralTable _ANSI_ARGS_ ((LiteralTable *tablePtr))
EXTERN void TclInitCompileEnv _ANSI_ARGS_ ((Tcl_Interp *interp, CompileEnv *envPtr, char *string, int numBytes))
EXTERN void TclInitByteCodeObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, CompileEnv *envPtr))
EXTERN void TclFreeCompileEnv _ANSI_ARGS_ ((CompileEnv *envPtr))
EXTERN int TclFixupForwardJump _ANSI_ARGS_ ((CompileEnv *envPtr, JumpFixup *jumpFixupPtr, int jumpDist, int distThreshold))
EXTERN int TclFindCompiledLocal _ANSI_ARGS_ ((CONST char *name, int nameChars, int create, int flags, Proc *procPtr))
EXTERN void TclFinalizeAuxDataTypeTable _ANSI_ARGS_ ((void))
EXTERN void TclExpandJumpFixupArray _ANSI_ARGS_ ((JumpFixupArray *fixupArrayPtr))
EXTERN ExceptionRange* TclGetExceptionRangeForPc _ANSI_ARGS_ ((unsigned char *pc, int catchOnly, ByteCode *codePtr))
EXTERN void TclEmitForwardJump _ANSI_ARGS_ ((CompileEnv *envPtr, TclJumpType jumpType, JumpFixup *jumpFixupPtr))
EXTERN void TclDeleteLiteralTable _ANSI_ARGS_ ((Tcl_Interp *interp, LiteralTable *tablePtr))
EXTERN void TclDeleteExecEnv _ANSI_ARGS_ ((ExecEnv *eePtr))
EXTERN int TclCreateExceptRange _ANSI_ARGS_ ((ExceptionRangeType type, CompileEnv *envPtr))
EXTERN int TclCreateAuxData _ANSI_ARGS_ ((ClientData clientData, AuxDataType *typePtr, CompileEnv *envPtr))
EXTERN int TclCompileScript _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *script, int numBytes, int nested, CompileEnv *envPtr))
EXTERN int TclCompileExprWords _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Token *tokenPtr, int numWords, CompileEnv *envPtr))
EXTERN int TclCompileExpr _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *script, int numBytes, CompileEnv *envPtr))
EXTERN int TclCompileCmdWord _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, CompileEnv *envPtr))
EXTERN void TclCleanupByteCode _ANSI_ARGS_ ((ByteCode *codePtr))
EXTERN int TclCompEvalObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
EXTERN int TclInterpReady _ANSI_ARGS_ ((Tcl_Interp *interp))
EXTERN int TclEvalObjvInternal _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], CONST char *command, int length, int flags))
typedef ClientData (AuxDataDupProc)
typedef int (CallBuiltinFuncProc)
typedef void (AuxDataFreeProc)

Variable Documentation
BuiltinFunc tclBuiltinFuncTable[]

Definition at line 388 of file tclExecute.c.
Referenced by TclExecuteByteCode().AuxDataType tclForeachInfoType

Definition at line 41 of file tclCompCmds.c.
Referenced by TclCompileForeachCmd(), and TclInitAuxDataTypeTable().InstructionDesc tclInstructionTable[]

Referenced by TCL_DECLARE_MUTEX().

generic/tclDate.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Classes
struct _TABLE
union YYSTYPE
struct TclDatetoktype
Defines
#define EPOCH  1970
#define START_OF_TIME  1902
#define END_OF_TIME  2037
#define TM_YEAR_BASE  1900
#define HOUR(x)  ((int) (60 * x))
#define SECSPERDAY  (24L * 60L * 60L)
#define IsLeapYear(x)  ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))
#define tAGO  257
#define tDAY  258
#define tDAYZONE  259
#define tID  260
#define tMERIDIAN  261
#define tMINUTE_UNIT  262
#define tMONTH  263
#define tMONTH_UNIT  264
#define tSTARDATE  265
#define tSEC_UNIT  266
#define tSNUMBER  267
#define tUNUMBER  268
#define tZONE  269
#define tEPOCH  270
#define tDST  271
#define tISOBASE  272
#define tDAY_UNIT  273
#define tNEXT  274
#define TclDateclearin  TclDatechar = -1
#define TclDateerrok  TclDateerrflag = 0
#define YYMAXDEPTH  150
#define YYERRCODE  256
#define YYNPROD  56
#define YYLAST  261
#define YYDEBUG  0
#define YYERROR  goto TclDateerrlab
#define YYACCEPT  return(0)
#define YYABORT  return(1)
#define YYBACKUP(newtoken, newvalue)
#define YYRECOVERING()  (!!TclDateerrflag)
#define YYNEW(type)  malloc(sizeof(type) * TclDatenewmax)
#define YYCOPY(to, from, type)  (type *) memcpy(to, (char *) from, TclDatemaxdepth * sizeof (type))
#define YYENLARGE(from, type)  (type *) realloc((char *) from, TclDatenewmax * sizeof(type))
#define YYFLAG  (-10000000)
#define YYLEX()  TclDatelex()
Typedefs
typedef _TABLE TABLE
typedef enum _DSTMODE DSTMODE
typedef enum _MERIDIAN MERIDIAN
typedef int TclDatetabelem
Enumerations
enum _DSTMODE { DSTon, DSToff, DSTmaybe }
enum _MERIDIAN { MERam, MERpm, MER24 }
Functions
static void TclDateerror _ANSI_ARGS_ ((char *s))
static time_t ToSeconds _ANSI_ARGS_ ((time_t Hours, time_t Minutes, time_t Seconds, MERIDIAN Meridian))
static int Convert _ANSI_ARGS_ ((time_t Month, time_t Day, time_t Year, time_t Hours, time_t Minutes, time_t Seconds, MERIDIAN Meridia, DSTMODE DSTmode, time_t *TimePtr))
static time_t DSTcorrect _ANSI_ARGS_ ((time_t Start, time_t Future))
static time_t NamedDay _ANSI_ARGS_ ((time_t Start, time_t DayOrdinal, time_t DayNumber))
static time_t NamedMonth _ANSI_ARGS_ ((time_t Start, time_t MonthOrdinal, time_t MonthNumber))
static int RelativeMonth _ANSI_ARGS_ ((time_t Start, time_t RelMonth, time_t *TimePtr))
static int RelativeDay _ANSI_ARGS_ ((time_t Start, time_t RelDay, time_t *TimePtr))
static int LookupWord _ANSI_ARGS_ ((char *buff))
static int TclDatelex _ANSI_ARGS_ ((void))
static void TclDateerror (char *s)
static time_t ToSeconds (time_t Hours, time_t Minutes, time_t Seconds, MERIDIAN Meridian)
static int Convert (time_t Month, time_t Day, time_t Year, time_t Hours, time_t Minutes, time_t Seconds, MERIDIAN Meridian, DSTMODE DSTmode, time_t *TimePtr)
static time_t DSTcorrect (time_t Start, time_t Future)
static time_t NamedDay (time_t Start, time_t DayOrdinal, time_t DayNumber)
static time_t NamedMonth (time_t Start, time_t MonthOrdinal, time_t MonthNumber)
static int RelativeMonth (time_t Start, time_t RelMonth, time_t *TimePtr)
static int RelativeDay (time_t Start, time_t RelDay, time_t *TimePtr)
static int LookupWord (char *buff)
static int TclDatelex ()
int TclGetDate (char *p, Tcl_WideInt now, long zone, Tcl_WideInt *timePtr)
int TclDateparse ()
Variables
static char * TclDateInput
static DSTMODE TclDateDSTmode
static time_t TclDateDayOrdinal
static time_t TclDateDayNumber
static time_t TclDateMonthOrdinal
static int TclDateHaveDate
static int TclDateHaveDay
static int TclDateHaveOrdinalMonth
static int TclDateHaveRel
static int TclDateHaveTime
static int TclDateHaveZone
static time_t TclDateTimezone
static time_t TclDateDay
static time_t TclDateHour
static time_t TclDateMinutes
static time_t TclDateMonth
static time_t TclDateSeconds
static time_t TclDateYear
static MERIDIAN TclDateMeridian
static time_t TclDateRelMonth
static time_t TclDateRelDay
static time_t TclDateRelSeconds
static time_t * TclDateRelPointer
int TclDatechar
int TclDateerrflag
YYSTYPE TclDatelval
YYSTYPE TclDateval
int TclDate_TclDates [YYMAXDEPTH]
int * TclDates = TclDate_TclDates
YYSTYPE TclDate_TclDatev [YYMAXDEPTH]
YYSTYPE * TclDatev = TclDate_TclDatev
static int TclDatemaxdepth = YYMAXDEPTH
static TABLE MonthDayTable []
static TABLE UnitsTable []
static TABLE OtherTable []
static TABLE TimezoneTable []
static TABLE MilitaryTable []
static CONST TclDatetabelem TclDateexca []
static CONST TclDatetabelem TclDateact []
static CONST TclDatetabelem TclDatepact []
static CONST TclDatetabelem TclDatepgo []
static CONST TclDatetabelem TclDater1 []
static CONST TclDatetabelem TclDater2 []
static CONST TclDatetabelem TclDatechk []
static CONST TclDatetabelem TclDatedef []
int TclDatedebug
YYSTYPE * TclDatepv
int * TclDateps
int TclDatestate
int TclDatetmp
int TclDatenerrs
int TclDateerrflag
int TclDatechar

Define Documentation
#define END_OF_TIME  2037

Definition at line 26 of file tclDate.c.
Referenced by Convert().#define EPOCH  1970

Definition at line 24 of file tclDate.c.
Referenced by Convert(), and TclDateparse().#define HOUR(x)  ((int) (60 * x))

Definition at line 38 of file tclDate.c.
Referenced by TclDateparse(), and TclpGetTZName().#define IsLeapYear(x)  ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))

Definition at line 40 of file tclDate.c.#define SECSPERDAY  (24L * 60L * 60L)

Definition at line 39 of file tclDate.c.
Referenced by ComputeGMT(), Convert(), NamedDay(), and TclpGetDate().#define START_OF_TIME  1902

Definition at line 25 of file tclDate.c.#define tAGO  257

Definition at line 128 of file tclDate.c.#define TclDateclearin  TclDatechar = -1

Definition at line 170 of file tclDate.c.#define TclDateerrok  TclDateerrflag = 0

Definition at line 171 of file tclDate.c.#define tDAY  258

Definition at line 129 of file tclDate.c.#define tDAY_UNIT  273

Definition at line 144 of file tclDate.c.#define tDAYZONE  259

Definition at line 130 of file tclDate.c.#define tDST  271

Definition at line 142 of file tclDate.c.#define tEPOCH  270

Definition at line 141 of file tclDate.c.#define tID  260

Definition at line 131 of file tclDate.c.#define tISOBASE  272

Definition at line 143 of file tclDate.c.
Referenced by TclDatelex().#define TM_YEAR_BASE  1900

Definition at line 36 of file tclDate.c.#define tMERIDIAN  261

Definition at line 132 of file tclDate.c.
Referenced by LookupWord().#define tMINUTE_UNIT  262

Definition at line 133 of file tclDate.c.#define tMONTH  263

Definition at line 134 of file tclDate.c.#define tMONTH_UNIT  264

Definition at line 135 of file tclDate.c.#define tNEXT  274

Definition at line 145 of file tclDate.c.#define tSEC_UNIT  266

Definition at line 137 of file tclDate.c.#define tSNUMBER  267

Definition at line 138 of file tclDate.c.#define tSTARDATE  265

Definition at line 136 of file tclDate.c.#define tUNUMBER  268

Definition at line 139 of file tclDate.c.
Referenced by TclDatelex().#define tZONE  269

Definition at line 140 of file tclDate.c.#define YYABORT  return(1)

Definition at line 1138 of file tclDate.c.
Referenced by TclDateparse().#define YYACCEPT  return(0)

Definition at line 1137 of file tclDate.c.
Referenced by TclDateparse().#define YYBACKUP(newtoken, newvalue)
Value:{\
  if ( TclDatechar >= 0 || ( TclDater2[ TclDatetmp ] >> 1 ) != 1 )\
  {\
    TclDateerror( "syntax error - cannot backup" );\
    goto TclDateerrlab;\
  }\
  TclDatechar = newtoken;\
  TclDatestate = *TclDateps;\
  TclDatelval = newvalue;\
  goto TclDatenewstate;\
}
Definition at line 1139 of file tclDate.c.#define YYCOPY(to, from, type)  (type *) memcpy(to, (char *) from, TclDatemaxdepth * sizeof (type))

Definition at line 1153 of file tclDate.c.
Referenced by TclDateparse().#define YYDEBUG  0

Definition at line 1036 of file tclDate.c.#define YYENLARGE(from, type)  (type *) realloc((char *) from, TclDatenewmax * sizeof(type))

Definition at line 1155 of file tclDate.c.
Referenced by TclDateparse().#define YYERRCODE  256

Definition at line 188 of file tclDate.c.
Referenced by TclDateparse().#define YYERROR  goto TclDateerrlab

Definition at line 1136 of file tclDate.c.#define YYFLAG  (-10000000)

Definition at line 1169 of file tclDate.c.
Referenced by TclDateparse().#define YYLAST  261

Definition at line 947 of file tclDate.c.
Referenced by TclDateparse().#define YYLEX()  TclDatelex()
YYNMBCHARS 

Definition at line 1226 of file tclDate.c.
Referenced by TclDateparse().#define YYMAXDEPTH  150

Definition at line 178 of file tclDate.c.
Referenced by TclDateparse().#define YYNEW(type)  malloc(sizeof(type) * TclDatenewmax)

Definition at line 1152 of file tclDate.c.
Referenced by TclDateparse().#define YYNPROD  56

Definition at line 946 of file tclDate.c.#define YYRECOVERING()  (!!TclDateerrflag)

Definition at line 1151 of file tclDate.c.
Typedef Documentation
typedef enum _DSTMODE  DSTMODE
typedef enum _MERIDIAN  MERIDIAN
typedef struct _TABLE  TABLE
typedef int TclDatetabelem

Definition at line 176 of file tclDate.c.
Enumeration Type Documentation
enum _DSTMODE

Enumerator: 
DSTon  
DSToff  
DSTmaybe  

Definition at line 55 of file tclDate.c.55                       {
56     DSTon, DSToff, DSTmaybe
57 } DSTMODE;
enum _MERIDIAN

Enumerator: 
MERam  
MERpm  
MER24  

Definition at line 62 of file tclDate.c.62                        {
63     MERam, MERpm, MER24
64 } MERIDIAN;

Function Documentation
static int TclDatelex _ANSI_ARGS_ ((void)) [static]
static int LookupWord _ANSI_ARGS_ ((char *buff)) [static]
static int RelativeDay _ANSI_ARGS_ ((time_t Start, time_t RelDay, time_t *TimePtr)) [static]
static int RelativeMonth _ANSI_ARGS_ ((time_t Start, time_t RelMonth, time_t *TimePtr)) [static]
static time_t NamedMonth _ANSI_ARGS_ ((time_t Start, time_t MonthOrdinal, time_t MonthNumber)) [static]
static time_t NamedDay _ANSI_ARGS_ ((time_t Start, time_t DayOrdinal, time_t DayNumber)) [static]
static time_t DSTcorrect _ANSI_ARGS_ ((time_t Start, time_t Future)) [static]
static int Convert _ANSI_ARGS_ ((time_t Month, time_t Day, time_t Year, time_t Hours, time_t Minutes, time_t Seconds, MERIDIAN Meridia, DSTMODE DSTmode, time_t *TimePtr)) [static]
static time_t ToSeconds _ANSI_ARGS_ ((time_t Hours, time_t Minutes, time_t Seconds, MERIDIAN Meridian)) [static]
static void TclDateerror _ANSI_ARGS_ ((char *s)) [static]
static int Convert (time_t Month, time_t Day, time_t Year, time_t Hours, time_t Minutes, time_t Seconds, MERIDIAN Meridian, DSTMODE DSTmode, time_t     * TimePtr) [static]

Definition at line 441 of file tclDate.c.
References DSTmaybe, DSTon, END_OF_TIME, EPOCH, IsLeapYear, SECSPERDAY, TclDateTimezone, TclpGetDate(), and ToSeconds().
Referenced by NamedMonth(), RelativeMonth(), and TclGetDate().451 {
452     static int  DaysInMonth[12] = {
453         31, 0, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
454     };
455     time_t tod;
456     time_t Julian;
457     int i;
458 
459     /* Figure out how many days are in February for the given year.
460      * Every year divisible by 4 is a leap year.
461      * But, every year divisible by 100 is not a leap year.
462      * But, every year divisible by 400 is a leap year after all.
463      */
464     DaysInMonth[1] = IsLeapYear(Year) ? 29 : 28;
465 
466     /* Check the inputs for validity */
467     if (Month < 1 || Month > 12
468       || Year < START_OF_TIME || Year > END_OF_TIME
469       || Day < 1 || Day > DaysInMonth[(int)--Month])
470         return -1;
471 
472     /* Start computing the value.  First determine the number of days
473      * represented by the date, then multiply by the number of seconds/day.
474      */
475     for (Julian = Day - 1, i = 0; i < Month; i++)
476         Julian += DaysInMonth[i];
477     if (Year >= EPOCH) {
478         for (i = EPOCH; i < Year; i++)
479             Julian += 365 + IsLeapYear(i);
480     } else {
481         for (i = (int)Year; i < EPOCH; i++)
482             Julian -= 365 + IsLeapYear(i);
483     }
484     Julian *= SECSPERDAY;
485 
486     /* Add the timezone offset ?? */
487     Julian += TclDateTimezone * 60L;
488 
489     /* Add the number of seconds represented by the time component */
490     if ((tod = ToSeconds(Hours, Minutes, Seconds, Meridian)) < 0)
491         return -1;
492     Julian += tod;
493 
494     /* Perform a preliminary DST compensation ?? */
495     if (DSTmode == DSTon
496      || (DSTmode == DSTmaybe && TclpGetDate((TclpTime_t)&Julian, 0)->tm_isdst))
497         Julian -= 60 * 60;
498     *TimePtr = Julian;
499     return 0;
500 }
static time_t DSTcorrect (time_t Start, time_t Future) [static]

Definition at line 504 of file tclDate.c.
References TclpGetDate().
Referenced by NamedDay(), NamedMonth(), RelativeDay(), and RelativeMonth().507 {
508     time_t      StartDay;
509     time_t      FutureDay;
510     StartDay = (TclpGetDate((TclpTime_t)&Start, 0)->tm_hour + 1) % 24;
511     FutureDay = (TclpGetDate((TclpTime_t)&Future, 0)->tm_hour + 1) % 24;
512     return (Future - Start) + (StartDay - FutureDay) * 60L * 60L;
513 }
static int LookupWord (char                * buff) [static]

Definition at line 655 of file tclDate.c.
References MERam, YYSTYPE::Meridian, MERpm, MonthDayTable, _TABLE::name, YYSTYPE::Number, Tcl_UtfToLower(), TclDatelval, tMERIDIAN, _TABLE::type, and _TABLE::value.
Referenced by TclDatelex().657 {
658     register char *p;
659     register char *q;
660     register TABLE *tp;
661     int i;
662     int abbrev;
663 
664     /*
665      * Make it lowercase.
666      */
667 
668     Tcl_UtfToLower(buff);
669 
670     if (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0) {
671         TclDatelval.Meridian = MERam;
672         return tMERIDIAN;
673     }
674     if (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0) {
675         TclDatelval.Meridian = MERpm;
676         return tMERIDIAN;
677     }
678 
679     /*
680      * See if we have an abbreviation for a month.
681      */
682     if (strlen(buff) == 3) {
683         abbrev = 1;
684     } else if (strlen(buff) == 4 && buff[3] == '.') {
685         abbrev = 1;
686         buff[3] = '\0';
687     } else {
688         abbrev = 0;
689     }
690 
691     for (tp = MonthDayTable; tp->name; tp++) {
692         if (abbrev) {
693             if (strncmp(buff, tp->name, 3) == 0) {
694                 TclDatelval.Number = tp->value;
695                 return tp->type;
696             }
697         } else if (strcmp(buff, tp->name) == 0) {
698             TclDatelval.Number = tp->value;
699             return tp->type;
700         }
701     }
702 
703     for (tp = TimezoneTable; tp->name; tp++) {
704         if (strcmp(buff, tp->name) == 0) {
705             TclDatelval.Number = tp->value;
706             return tp->type;
707         }
708     }
709 
710     for (tp = UnitsTable; tp->name; tp++) {
711         if (strcmp(buff, tp->name) == 0) {
712             TclDatelval.Number = tp->value;
713             return tp->type;
714         }
715     }
716 
717     /*
718      * Strip off any plural and try the units table again.
719      */
720     i = strlen(buff) - 1;
721     if (buff[i] == 's') {
722         buff[i] = '\0';
723         for (tp = UnitsTable; tp->name; tp++) {
724             if (strcmp(buff, tp->name) == 0) {
725                 TclDatelval.Number = tp->value;
726                 return tp->type;
727             }
728   }
729     }
730 
731     for (tp = OtherTable; tp->name; tp++) {
732         if (strcmp(buff, tp->name) == 0) {
733             TclDatelval.Number = tp->value;
734             return tp->type;
735         }
736     }
737 
738     /*
739      * Military timezones.
740      */
741     if (buff[1] == '\0' && !(*buff & 0x80)
742       && isalpha(UCHAR(*buff))) { /* INTL: ISO only */
743         for (tp = MilitaryTable; tp->name; tp++) {
744             if (strcmp(buff, tp->name) == 0) {
745                 TclDatelval.Number = tp->value;
746                 return tp->type;
747             }
748   }
749     }
750 
751     /*
752      * Drop out any periods and try the timezone table again.
753      */
754     for (i = 0, p = q = buff; *q; q++)
755         if (*q != '.') {
756             *p++ = *q;
757         } else {
758             i++;
759   }
760     *p = '\0';
761     if (i) {
762         for (tp = TimezoneTable; tp->name; tp++) {
763             if (strcmp(buff, tp->name) == 0) {
764                 TclDatelval.Number = tp->value;
765                 return tp->type;
766             }
767   }
768     }
769     
770     return tID;
771 }
static time_t NamedDay (time_t Start, time_t DayOrdinal, time_t DayNumber) [static]

Definition at line 517 of file tclDate.c.
References DSTcorrect(), SECSPERDAY, and TclpGetDate().
Referenced by TclGetDate().521 {
522     struct tm   *tm;
523     time_t      now;
524 
525     now = Start;
526     tm = TclpGetDate((TclpTime_t)&now, 0);
527     now += SECSPERDAY * ((DayNumber - tm->tm_wday + 7) % 7);
528     now += 7 * SECSPERDAY * (DayOrdinal <= 0 ? DayOrdinal : DayOrdinal - 1);
529     return DSTcorrect(Start, now);
530 }
static time_t NamedMonth (time_t Start, time_t MonthOrdinal, time_t MonthNumber) [static]

Definition at line 533 of file tclDate.c.
References Convert(), DSTcorrect(), DSTmaybe, MER24, TclpGetDate(), and TM_YEAR_BASE.
Referenced by TclGetDate().537 {
538     struct tm *tm;
539     time_t now;
540     int result;
541     
542     now = Start;
543     tm = TclpGetDate((TclpTime_t)&now, 0);
544     /* To compute the next n'th month, we use this alg:
545      * add n to year value
546      * if currentMonth < requestedMonth decrement year value by 1 (so that
547      *  doing next february from january gives us february of the current year)
548      * set day to 1, time to 0
549      */
550     tm->tm_year += (int)MonthOrdinal;
551     if (tm->tm_mon < MonthNumber - 1) {
552   tm->tm_year--;
553     }
554     result = Convert(MonthNumber, (time_t) 1, tm->tm_year + TM_YEAR_BASE,
555       (time_t) 0, (time_t) 0, (time_t) 0, MER24, DSTmaybe, &now);
556     if (result < 0) {
557   return 0;
558     }
559     return DSTcorrect(Start, now);
560 }
static int RelativeDay (time_t Start, time_t RelDay, time_t * TimePtr) [static]

Definition at line 642 of file tclDate.c.
References DSTcorrect().
Referenced by TclGetDate().646 {
647     time_t new;
648 
649     new = Start + (RelDay * 60 * 60 * 24);
650     *TimePtr = DSTcorrect(Start, new);
651     return 1;
652 }
static int RelativeMonth (time_t Start, time_t RelMonth, time_t * TimePtr) [static]

Definition at line 563 of file tclDate.c.
References Convert(), DSTcorrect(), DSTmaybe, MER24, TclDateTimezone, TclpGetDate(), TclpGetTimeZone(), and TM_YEAR_BASE.
Referenced by TclGetDate().567 {
568     struct tm *tm;
569     time_t Month;
570     time_t Year;
571     time_t Julian;
572     int result;
573 
574     if (RelMonth == 0) {
575         *TimePtr = 0;
576         return 0;
577     }
578     tm = TclpGetDate((TclpTime_t)&Start, 0);
579     Month = 12 * (tm->tm_year + TM_YEAR_BASE) + tm->tm_mon + RelMonth;
580     Year = Month / 12;
581     Month = Month % 12 + 1;
582     result = Convert(Month, (time_t) tm->tm_mday, Year,
583       (time_t) tm->tm_hour, (time_t) tm->tm_min, (time_t) tm->tm_sec,
584       MER24, DSTmaybe, &Julian);
585 
586     /*
587      * The Julian time returned above is behind by one day, if "month" 
588      * or "year" is used to specify relative time and the GMT flag is true.
589      * This problem occurs only when the current time is closer to
590      * midnight, the difference being not more than its time difference
591      * with GMT. For example, in US/Pacific time zone, the problem occurs
592      * whenever the current time is between midnight to 8:00am or 7:00amDST.
593      * See Bug# 413397 for more details and sample script.
594      * To resolve this bug, we simply add the number of seconds corresponding
595      * to timezone difference with GMT to Julian time, if GMT flag is true.
596      */
597 
598     if (TclDateTimezone == 0) {
599         Julian += TclpGetTimeZone((unsigned long) Start) * 60L;
600     }
601 
602     /*
603      * The following iteration takes into account the case were we jump
604      * into a "short month".  Far example, "one month from Jan 31" will
605      * fail because there is no Feb 31.  The code below will reduce the
606      * day and try converting the date until we succed or the date equals
607      * 28 (which always works unless the date is bad in another way).
608      */
609 
610     while ((result != 0) && (tm->tm_mday > 28)) {
611   tm->tm_mday--;
612   result = Convert(Month, (time_t) tm->tm_mday, Year,
613     (time_t) tm->tm_hour, (time_t) tm->tm_min, (time_t) tm->tm_sec,
614     MER24, DSTmaybe, &Julian);
615     }
616     if (result != 0) {
617   return -1;
618     }
619     *TimePtr = DSTcorrect(Start, Julian);
620     return 0;
621 }
static void TclDateerror (char  * s) [static]

Definition at line 392 of file tclDate.c.
Referenced by TclDateparse().394 {
395 }
static int TclDatelex () [static]

Definition at line 775 of file tclDate.c.
References LookupWord(), YYSTYPE::Number, TclDateInput, TclDatelval, tISOBASE, tUNUMBER, and UCHAR.776 {
777     register char       c;
778     register char       *p;
779     char                buff[20];
780     int                 Count;
781 
782     for ( ; ; ) {
783         while (isspace(UCHAR(*TclDateInput))) {
784             TclDateInput++;
785   }
786 
787         if (isdigit(UCHAR(c = *TclDateInput))) { /* INTL: digit */
788       /* convert the string into a number; count the number of digits */
789       Count = 0;
790             for (TclDatelval.Number = 0;
791         isdigit(UCHAR(c = *TclDateInput++)); ) { /* INTL: digit */
792                 TclDatelval.Number = 10 * TclDatelval.Number + c - '0';
793     Count++;
794       }
795             TclDateInput--;
796       /* A number with 6 or more digits is considered an ISO 8601 base */
797       if (Count >= 6) {
798     return tISOBASE;
799       } else {
800     return tUNUMBER;
801       }
802         }
803         if (!(c & 0x80) && isalpha(UCHAR(c))) { /* INTL: ISO only. */
804             for (p = buff; isalpha(UCHAR(c = *TclDateInput++)) /* INTL: ISO only. */
805          || c == '.'; ) {
806                 if (p < &buff[sizeof buff - 1]) {
807                     *p++ = c;
808     }
809       }
810             *p = '\0';
811             TclDateInput--;
812             return LookupWord(buff);
813         }
814         if (c != '(') {
815             return *TclDateInput++;
816   }
817         Count = 0;
818         do {
819             c = *TclDateInput++;
820             if (c == '\0') {
821                 return c;
822       } else if (c == '(') {
823                 Count++;
824       } else if (c == ')') {
825                 Count--;
826       }
827         } while (Count > 0);
828     }
829 }
int TclDateparse ()
YYNMBCHARS 

Definition at line 1235 of file tclDate.c.
References CONST, DSToff, DSTon, EPOCH, HOUR, IsLeapYear, MER24, YYSTYPE::Meridian, YYSTYPE::Number, TclDatetoktype::t_val, TclDateDay, TclDateDayNumber, TclDateDayOrdinal, TclDateDSTmode, TclDateerror(), TclDateHaveDate, TclDateHaveDay, TclDateHaveOrdinalMonth, TclDateHaveRel, TclDateHaveTime, TclDateHaveZone, TclDateHour, TclDatelval, TclDatemaxdepth, TclDateMeridian, TclDateMinutes, TclDateMonth, TclDateMonthOrdinal, TclDatepv, TclDateRelDay, TclDateRelMonth, TclDateRelPointer, TclDateRelSeconds, TclDates, TclDateSeconds, TclDateTimezone, TclDatev, TclDateval, TclDateYear, YYABORT, YYACCEPT, YYCOPY, YYENLARGE, YYERRCODE, YYFLAG, YYLAST, YYLEX, YYMAXDEPTH, and YYNEW.
Referenced by TclGetDate().1237 {
1238   register YYSTYPE *TclDatepvt = 0; /* top of value stack for $vars */
1239 
1240 #if defined(__cplusplus) || defined(lint)
1241 /*
1242   hacks to please C++ and lint - goto's inside
1243   switch should never be executed
1244 */
1245   static int __yaccpar_lint_hack__ = 0;
1246   switch (__yaccpar_lint_hack__)
1247   {
1248     case 1: goto TclDateerrlab;
1249     case 2: goto TclDatenewstate;
1250   }
1251 #endif
1252 
1253   /*
1254   ** Initialize externals - TclDateparse may be called more than once
1255   */
1256   TclDatepv = &TclDatev[-1];
1257   TclDateps = &TclDates[-1];
1258   TclDatestate = 0;
1259   TclDatetmp = 0;
1260   TclDatenerrs = 0;
1261   TclDateerrflag = 0;
1262   TclDatechar = -1;
1263 
1264 #if YYMAXDEPTH <= 0
1265   if (TclDatemaxdepth <= 0)
1266   {
1267     if ((TclDatemaxdepth = YYEXPAND(0)) <= 0)
1268     {
1269       TclDateerror("yacc initialization error");
1270       YYABORT;
1271     }
1272   }
1273 #endif
1274 
1275   {
1276     register YYSTYPE *TclDate_pv; /* top of value stack */
1277     register int *TclDate_ps;   /* top of state stack */
1278     register int TclDate_state;   /* current state */
1279     register int  TclDate_n;    /* internal state number info */
1280   goto TclDatestack;  /* moved from 6 lines above to here to please C++ */
1281 
1282     /*
1283     ** get globals into registers.
1284     ** branch to here only if YYBACKUP was called.
1285     */
1286     TclDate_pv = TclDatepv;
1287     TclDate_ps = TclDateps;
1288     TclDate_state = TclDatestate;
1289     goto TclDate_newstate;
1290 
1291     /*
1292     ** get globals into registers.
1293     ** either we just started, or we just finished a reduction
1294     */
1295   TclDatestack:
1296     TclDate_pv = TclDatepv;
1297     TclDate_ps = TclDateps;
1298     TclDate_state = TclDatestate;
1299 
1300     /*
1301     ** top of for (;;) loop while no reductions done
1302     */
1303   TclDate_stack:
1304     /*
1305     ** put a state and value onto the stacks
1306     */
1307 #if YYDEBUG
1308     /*
1309     ** if debugging, look up token value in list of value vs.
1310     ** name pairs.  0 and negative (-1) are special values.
1311     ** Note: linear search is used since time is not a real
1312     ** consideration while debugging.
1313     */
1314     if ( TclDatedebug )
1315     {
1316       register int TclDate_i;
1317 
1318       printf( "State %d, token ", TclDate_state );
1319       if ( TclDatechar == 0 )
1320         printf( "end-of-file\n" );
1321       else if ( TclDatechar < 0 )
1322         printf( "-none-\n" );
1323       else
1324       {
1325         for ( TclDate_i = 0; TclDatetoks[TclDate_i].t_val >= 0;
1326           TclDate_i++ )
1327         {
1328           if ( TclDatetoks[TclDate_i].t_val == TclDatechar )
1329             break;
1330         }
1331         printf( "%s\n", TclDatetoks[TclDate_i].t_name );
1332       }
1333     }
1334 #endif /* YYDEBUG */
1335     if ( ++TclDate_ps >= &TclDates[ TclDatemaxdepth ] ) /* room on stack? */
1336     {
1337       /*
1338       ** reallocate and recover.  Note that pointers
1339       ** have to be reset, or bad things will happen
1340       */
1341       long TclDateps_index = (TclDate_ps - TclDates);
1342       long TclDatepv_index = (TclDate_pv - TclDatev);
1343       long TclDatepvt_index = (TclDatepvt - TclDatev);
1344       int TclDatenewmax;
1345 #ifdef YYEXPAND
1346       TclDatenewmax = YYEXPAND(TclDatemaxdepth);
1347 #else
1348       TclDatenewmax = 2 * TclDatemaxdepth;  /* double table size */
1349       if (TclDatemaxdepth == YYMAXDEPTH)  /* first time growth */
1350       {
1351         char *newTclDates = (char *)YYNEW(int);
1352         char *newTclDatev = (char *)YYNEW(YYSTYPE);
1353         if (newTclDates != 0 && newTclDatev != 0)
1354         {
1355           TclDates = YYCOPY(newTclDates, TclDates, int);
1356           TclDatev = YYCOPY(newTclDatev, TclDatev, YYSTYPE);
1357         }
1358         else
1359           TclDatenewmax = 0;  /* failed */
1360       }
1361       else        /* not first time */
1362       {
1363         TclDates = YYENLARGE(TclDates, int);
1364         TclDatev = YYENLARGE(TclDatev, YYSTYPE);
1365         if (TclDates == 0 || TclDatev == 0)
1366           TclDatenewmax = 0;  /* failed */
1367       }
1368 #endif
1369       if (TclDatenewmax <= TclDatemaxdepth) /* tables not expanded */
1370       {
1371         TclDateerror( "yacc stack overflow" );
1372         YYABORT;
1373       }
1374       TclDatemaxdepth = TclDatenewmax;
1375 
1376       TclDate_ps = TclDates + TclDateps_index;
1377       TclDate_pv = TclDatev + TclDatepv_index;
1378       TclDatepvt = TclDatev + TclDatepvt_index;
1379     }
1380     *TclDate_ps = TclDate_state;
1381     *++TclDate_pv = TclDateval;
1382 
1383     /*
1384     ** we have a new state - find out what to do
1385     */
1386   TclDate_newstate:
1387     if ( ( TclDate_n = TclDatepact[ TclDate_state ] ) <= YYFLAG )
1388       goto TclDatedefault;    /* simple state */
1389 #if YYDEBUG
1390     /*
1391     ** if debugging, need to mark whether new token grabbed
1392     */
1393     TclDatetmp = TclDatechar < 0;
1394 #endif
1395     if ( ( TclDatechar < 0 ) && ( ( TclDatechar = YYLEX() ) < 0 ) )
1396       TclDatechar = 0;    /* reached EOF */
1397 #if YYDEBUG
1398     if ( TclDatedebug && TclDatetmp )
1399     {
1400       register int TclDate_i;
1401 
1402       printf( "Received token " );
1403       if ( TclDatechar == 0 )
1404         printf( "end-of-file\n" );
1405       else if ( TclDatechar < 0 )
1406         printf( "-none-\n" );
1407       else
1408       {
1409         for ( TclDate_i = 0; TclDatetoks[TclDate_i].t_val >= 0;
1410           TclDate_i++ )
1411         {
1412           if ( TclDatetoks[TclDate_i].t_val == TclDatechar )
1413             break;
1414         }
1415         printf( "%s\n", TclDatetoks[TclDate_i].t_name );
1416       }
1417     }
1418 #endif /* YYDEBUG */
1419     if ( ( ( TclDate_n += TclDatechar ) < 0 ) || ( TclDate_n >= YYLAST ) )
1420       goto TclDatedefault;
1421     if ( TclDatechk[ TclDate_n = TclDateact[ TclDate_n ] ] == TclDatechar ) /*valid shift*/
1422     {
1423       TclDatechar = -1;
1424       TclDateval = TclDatelval;
1425       TclDate_state = TclDate_n;
1426       if ( TclDateerrflag > 0 )
1427         TclDateerrflag--;
1428       goto TclDate_stack;
1429     }
1430 
1431   TclDatedefault:
1432     if ( ( TclDate_n = TclDatedef[ TclDate_state ] ) == -2 )
1433     {
1434 #if YYDEBUG
1435       TclDatetmp = TclDatechar < 0;
1436 #endif
1437       if ( ( TclDatechar < 0 ) && ( ( TclDatechar = YYLEX() ) < 0 ) )
1438         TclDatechar = 0;    /* reached EOF */
1439 #if YYDEBUG
1440       if ( TclDatedebug && TclDatetmp )
1441       {
1442         register int TclDate_i;
1443 
1444         printf( "Received token " );
1445         if ( TclDatechar == 0 )
1446           printf( "end-of-file\n" );
1447         else if ( TclDatechar < 0 )
1448           printf( "-none-\n" );
1449         else
1450         {
1451           for ( TclDate_i = 0;
1452             TclDatetoks[TclDate_i].t_val >= 0;
1453             TclDate_i++ )
1454           {
1455             if ( TclDatetoks[TclDate_i].t_val
1456               == TclDatechar )
1457             {
1458               break;
1459             }
1460           }
1461           printf( "%s\n", TclDatetoks[TclDate_i].t_name );
1462         }
1463       }
1464 #endif /* YYDEBUG */
1465       /*
1466       ** look through exception table
1467       */
1468       {
1469         register CONST int *TclDatexi = TclDateexca;
1470 
1471         while ( ( *TclDatexi != -1 ) ||
1472           ( TclDatexi[1] != TclDate_state ) )
1473         {
1474           TclDatexi += 2;
1475         }
1476         while ( ( *(TclDatexi += 2) >= 0 ) &&
1477           ( *TclDatexi != TclDatechar ) )
1478           ;
1479         if ( ( TclDate_n = TclDatexi[1] ) < 0 )
1480           YYACCEPT;
1481       }
1482     }
1483 
1484     /*
1485     ** check for syntax error
1486     */
1487     if ( TclDate_n == 0 ) /* have an error */
1488     {
1489       /* no worry about speed here! */
1490       switch ( TclDateerrflag )
1491       {
1492       case 0:   /* new error */
1493         TclDateerror( "syntax error" );
1494         goto skip_init;
1495         /*
1496         ** get globals into registers.
1497         ** we have a user generated syntax type error
1498         */
1499         TclDate_pv = TclDatepv;
1500         TclDate_ps = TclDateps;
1501         TclDate_state = TclDatestate;
1502       skip_init:
1503         TclDatenerrs++;
1504         /* FALLTHRU */
1505       case 1:
1506       case 2:   /* incompletely recovered error */
1507           /* try again... */
1508         TclDateerrflag = 3;
1509         /*
1510         ** find state where "error" is a legal
1511         ** shift action
1512         */
1513         while ( TclDate_ps >= TclDates )
1514         {
1515           TclDate_n = TclDatepact[ *TclDate_ps ] + YYERRCODE;
1516           if ( TclDate_n >= 0 && TclDate_n < YYLAST &&
1517             TclDatechk[TclDateact[TclDate_n]] == YYERRCODE)         {
1518             /*
1519             ** simulate shift of "error"
1520             */
1521             TclDate_state = TclDateact[ TclDate_n ];
1522             goto TclDate_stack;
1523           }
1524           /*
1525           ** current state has no shift on
1526           ** "error", pop stack
1527           */
1528 #if YYDEBUG
1529 # define _POP_ "Error recovery pops state %d, uncovers state %d\n"
1530           if ( TclDatedebug )
1531             printf( _POP_, *TclDate_ps,
1532               TclDate_ps[-1] );
1533 # undef _POP_
1534 #endif
1535           TclDate_ps--;
1536           TclDate_pv--;
1537         }
1538         /*
1539         ** there is no state on stack with "error" as
1540         ** a valid shift.  give up.
1541         */
1542         YYABORT;
1543       case 3:   /* no shift yet; eat a token */
1544 #if YYDEBUG
1545         /*
1546         ** if debugging, look up token in list of
1547         ** pairs.  0 and negative shouldn't occur,
1548         ** but since timing doesn't matter when
1549         ** debugging, it doesn't hurt to leave the
1550         ** tests here.
1551         */
1552         if ( TclDatedebug )
1553         {
1554           register int TclDate_i;
1555 
1556           printf( "Error recovery discards " );
1557           if ( TclDatechar == 0 )
1558             printf( "token end-of-file\n" );
1559           else if ( TclDatechar < 0 )
1560             printf( "token -none-\n" );
1561           else
1562           {
1563             for ( TclDate_i = 0;
1564               TclDatetoks[TclDate_i].t_val >= 0;
1565               TclDate_i++ )
1566             {
1567               if ( TclDatetoks[TclDate_i].t_val
1568                 == TclDatechar )
1569               {
1570                 break;
1571               }
1572             }
1573             printf( "token %s\n",
1574               TclDatetoks[TclDate_i].t_name );
1575           }
1576         }
1577 #endif /* YYDEBUG */
1578         if ( TclDatechar == 0 ) /* reached EOF. quit */
1579           YYABORT;
1580         TclDatechar = -1;
1581         goto TclDate_newstate;
1582       }
1583     }/* end if ( TclDate_n == 0 ) */
1584     /*
1585     ** reduction by production TclDate_n
1586     ** put stack tops, etc. so things right after switch
1587     */
1588 #if YYDEBUG
1589     /*
1590     ** if debugging, print the string that is the user's
1591     ** specification of the reduction which is just about
1592     ** to be done.
1593     */
1594     if ( TclDatedebug )
1595       printf( "Reduce by (%d) \"%s\"\n",
1596         TclDate_n, TclDatereds[ TclDate_n ] );
1597 #endif
1598     TclDatetmp = TclDate_n;     /* value to switch over */
1599     TclDatepvt = TclDate_pv;      /* $vars top of value stack */
1600     /*
1601     ** Look in goto table for next state
1602     ** Sorry about using TclDate_state here as temporary
1603     ** register variable, but why not, if it works...
1604     ** If TclDater2[ TclDate_n ] doesn't have the low order bit
1605     ** set, then there is no action to be done for
1606     ** this reduction.  So, no saving & unsaving of
1607     ** registers done.  The only difference between the
1608     ** code just after the if and the body of the if is
1609     ** the goto TclDate_stack in the body.  This way the test
1610     ** can be made before the choice of what to do is needed.
1611     */
1612     {
1613       /* length of production doubled with extra bit */
1614       register int TclDate_len = TclDater2[ TclDate_n ];
1615 
1616       if ( !( TclDate_len & 01 ) )
1617       {
1618         TclDate_len >>= 1;
1619         TclDateval = ( TclDate_pv -= TclDate_len )[1];  /* $$ = $1 */
1620         TclDate_state = TclDatepgo[ TclDate_n = TclDater1[ TclDate_n ] ] +
1621           *( TclDate_ps -= TclDate_len ) + 1;
1622         if ( TclDate_state >= YYLAST ||
1623           TclDatechk[ TclDate_state =
1624           TclDateact[ TclDate_state ] ] != -TclDate_n )
1625         {
1626           TclDate_state = TclDateact[ TclDatepgo[ TclDate_n ] ];
1627         }
1628         goto TclDate_stack;
1629       }
1630       TclDate_len >>= 1;
1631       TclDateval = ( TclDate_pv -= TclDate_len )[1];  /* $$ = $1 */
1632       TclDate_state = TclDatepgo[ TclDate_n = TclDater1[ TclDate_n ] ] +
1633         *( TclDate_ps -= TclDate_len ) + 1;
1634       if ( TclDate_state >= YYLAST ||
1635         TclDatechk[ TclDate_state = TclDateact[ TclDate_state ] ] != -TclDate_n )
1636       {
1637         TclDate_state = TclDateact[ TclDatepgo[ TclDate_n ] ];
1638       }
1639     }
1640           /* save until reenter driver code */
1641     TclDatestate = TclDate_state;
1642     TclDateps = TclDate_ps;
1643     TclDatepv = TclDate_pv;
1644   }
1645   /*
1646   ** code supplied by user is placed in this switch
1647   */
1648   switch( TclDatetmp )
1649   {
1650     
1651 case 3:{
1652             TclDateHaveTime++;
1653         } break;
1654 case 4:{
1655             TclDateHaveZone++;
1656         } break;
1657 case 5:{
1658             TclDateHaveDate++;
1659         } break;
1660 case 6:{
1661             TclDateHaveOrdinalMonth++;
1662         } break;
1663 case 7:{
1664             TclDateHaveDay++;
1665         } break;
1666 case 8:{
1667             TclDateHaveRel++;
1668         } break;
1669 case 9:{
1670       TclDateHaveTime++;
1671       TclDateHaveDate++;
1672   } break;
1673 case 10:{
1674       TclDateHaveTime++;
1675       TclDateHaveDate++;
1676       TclDateHaveRel++;
1677         } break;
1678 case 12:{
1679             TclDateHour = TclDatepvt[-1].Number;
1680             TclDateMinutes = 0;
1681             TclDateSeconds = 0;
1682             TclDateMeridian = TclDatepvt[-0].Meridian;
1683         } break;
1684 case 13:{
1685             TclDateHour = TclDatepvt[-3].Number;
1686             TclDateMinutes = TclDatepvt[-1].Number;
1687             TclDateSeconds = 0;
1688             TclDateMeridian = TclDatepvt[-0].Meridian;
1689         } break;
1690 case 14:{
1691             TclDateHour = TclDatepvt[-4].Number;
1692             TclDateMinutes = TclDatepvt[-2].Number;
1693             TclDateMeridian = MER24;
1694             TclDateDSTmode = DSToff;
1695             TclDateTimezone = (TclDatepvt[-0].Number % 100 + (TclDatepvt[-0].Number / 100) * 60);
1696         } break;
1697 case 15:{
1698             TclDateHour = TclDatepvt[-5].Number;
1699             TclDateMinutes = TclDatepvt[-3].Number;
1700             TclDateSeconds = TclDatepvt[-1].Number;
1701             TclDateMeridian = TclDatepvt[-0].Meridian;
1702         } break;
1703 case 16:{
1704             TclDateHour = TclDatepvt[-6].Number;
1705             TclDateMinutes = TclDatepvt[-4].Number;
1706             TclDateSeconds = TclDatepvt[-2].Number;
1707             TclDateMeridian = MER24;
1708             TclDateDSTmode = DSToff;
1709             TclDateTimezone = (TclDatepvt[-0].Number % 100 + (TclDatepvt[-0].Number / 100) * 60);
1710         } break;
1711 case 17:{
1712             TclDateTimezone = TclDatepvt[-1].Number;
1713             TclDateDSTmode = DSTon;
1714         } break;
1715 case 18:{
1716             TclDateTimezone = TclDatepvt[-0].Number;
1717             TclDateDSTmode = DSToff;
1718         } break;
1719 case 19:{
1720             TclDateTimezone = TclDatepvt[-0].Number;
1721             TclDateDSTmode = DSTon;
1722         } break;
1723 case 20:{
1724             TclDateDayOrdinal = 1;
1725             TclDateDayNumber = TclDatepvt[-0].Number;
1726         } break;
1727 case 21:{
1728             TclDateDayOrdinal = 1;
1729             TclDateDayNumber = TclDatepvt[-1].Number;
1730         } break;
1731 case 22:{
1732             TclDateDayOrdinal = TclDatepvt[-1].Number;
1733             TclDateDayNumber = TclDatepvt[-0].Number;
1734         } break;
1735 case 23:{
1736             TclDateDayOrdinal = TclDatepvt[-2].Number * TclDatepvt[-1].Number;
1737             TclDateDayNumber = TclDatepvt[-0].Number;
1738         } break;
1739 case 24:{
1740             TclDateDayOrdinal = 2;
1741             TclDateDayNumber = TclDatepvt[-0].Number;
1742         } break;
1743 case 25:{
1744             TclDateMonth = TclDatepvt[-2].Number;
1745             TclDateDay = TclDatepvt[-0].Number;
1746         } break;
1747 case 26:{
1748             TclDateMonth = TclDatepvt[-4].Number;
1749             TclDateDay = TclDatepvt[-2].Number;
1750             TclDateYear = TclDatepvt[-0].Number;
1751         } break;
1752 case 27:{
1753       TclDateYear = TclDatepvt[-0].Number / 10000;
1754       TclDateMonth = (TclDatepvt[-0].Number % 10000)/100;
1755       TclDateDay = TclDatepvt[-0].Number % 100;
1756   } break;
1757 case 28:{
1758       TclDateDay = TclDatepvt[-4].Number;
1759       TclDateMonth = TclDatepvt[-2].Number;
1760       TclDateYear = TclDatepvt[-0].Number;
1761   } break;
1762 case 29:{
1763             TclDateMonth = TclDatepvt[-2].Number;
1764             TclDateDay = TclDatepvt[-0].Number;
1765             TclDateYear = TclDatepvt[-4].Number;
1766         } break;
1767 case 30:{
1768             TclDateMonth = TclDatepvt[-1].Number;
1769             TclDateDay = TclDatepvt[-0].Number;
1770         } break;
1771 case 31:{
1772             TclDateMonth = TclDatepvt[-3].Number;
1773             TclDateDay = TclDatepvt[-2].Number;
1774             TclDateYear = TclDatepvt[-0].Number;
1775         } break;
1776 case 32:{
1777             TclDateMonth = TclDatepvt[-0].Number;
1778             TclDateDay = TclDatepvt[-1].Number;
1779         } break;
1780 case 33:{
1781       TclDateMonth = 1;
1782       TclDateDay = 1;
1783       TclDateYear = EPOCH;
1784   } break;
1785 case 34:{
1786             TclDateMonth = TclDatepvt[-1].Number;
1787             TclDateDay = TclDatepvt[-2].Number;
1788             TclDateYear = TclDatepvt[-0].Number;
1789         } break;
1790 case 35:{
1791       TclDateMonthOrdinal = 1;
1792       TclDateMonth = TclDatepvt[-0].Number;
1793   } break;
1794 case 36:{
1795       TclDateMonthOrdinal = TclDatepvt[-1].Number;
1796       TclDateMonth = TclDatepvt[-0].Number;
1797   } break;
1798 case 37:{
1799             if (TclDatepvt[-1].Number != HOUR(- 7)) YYABORT;
1800       TclDateYear = TclDatepvt[-2].Number / 10000;
1801       TclDateMonth = (TclDatepvt[-2].Number % 10000)/100;
1802       TclDateDay = TclDatepvt[-2].Number % 100;
1803       TclDateHour = TclDatepvt[-0].Number / 10000;
1804       TclDateMinutes = (TclDatepvt[-0].Number % 10000)/100;
1805       TclDateSeconds = TclDatepvt[-0].Number % 100;
1806         } break;
1807 case 38:{
1808             if (TclDatepvt[-5].Number != HOUR(- 7)) YYABORT;
1809       TclDateYear = TclDatepvt[-6].Number / 10000;
1810       TclDateMonth = (TclDatepvt[-6].Number % 10000)/100;
1811       TclDateDay = TclDatepvt[-6].Number % 100;
1812       TclDateHour = TclDatepvt[-4].Number;
1813       TclDateMinutes = TclDatepvt[-2].Number;
1814       TclDateSeconds = TclDatepvt[-0].Number;
1815         } break;
1816 case 39:{
1817       TclDateYear = TclDatepvt[-1].Number / 10000;
1818       TclDateMonth = (TclDatepvt[-1].Number % 10000)/100;
1819       TclDateDay = TclDatepvt[-1].Number % 100;
1820       TclDateHour = TclDatepvt[-0].Number / 10000;
1821       TclDateMinutes = (TclDatepvt[-0].Number % 10000)/100;
1822       TclDateSeconds = TclDatepvt[-0].Number % 100;
1823         } break;
1824 case 40:{
1825             /*
1826        * Offset computed year by -377 so that the returned years will
1827        * be in a range accessible with a 32 bit clock seconds value
1828        */
1829             TclDateYear = TclDatepvt[-2].Number/1000 + 2323 - 377;
1830             TclDateDay  = 1;
1831       TclDateMonth = 1;
1832       TclDateRelDay += ((TclDatepvt[-2].Number%1000)*(365 + IsLeapYear(TclDateYear)))/1000;
1833       TclDateRelSeconds += TclDatepvt[-0].Number * 144 * 60;
1834         } break;
1835 case 41:{
1836       TclDateRelSeconds *= -1;
1837       TclDateRelMonth *= -1;
1838       TclDateRelDay *= -1;
1839   } break;
1840 case 43:{ *TclDateRelPointer += TclDatepvt[-2].Number * TclDatepvt[-1].Number * TclDatepvt[-0].Number; } break;
1841 case 44:{ *TclDateRelPointer += TclDatepvt[-1].Number * TclDatepvt[-0].Number; } break;
1842 case 45:{ *TclDateRelPointer += TclDatepvt[-0].Number; } break;
1843 case 46:{ *TclDateRelPointer += TclDatepvt[-1].Number * TclDatepvt[-0].Number; } break;
1844 case 47:{ *TclDateRelPointer += TclDatepvt[-0].Number; } break;
1845 case 48:{ TclDateval.Number = -1; } break;
1846 case 49:{ TclDateval.Number =  1; } break;
1847 case 50:{ TclDateval.Number = TclDatepvt[-0].Number; TclDateRelPointer = &TclDateRelSeconds; } break;
1848 case 51:{ TclDateval.Number = TclDatepvt[-0].Number; TclDateRelPointer = &TclDateRelDay; } break;
1849 case 52:{ TclDateval.Number = TclDatepvt[-0].Number; TclDateRelPointer = &TclDateRelMonth; } break;
1850 case 53:{
1851   if (TclDateHaveTime && TclDateHaveDate && !TclDateHaveRel) {
1852       TclDateYear = TclDatepvt[-0].Number;
1853   } else {
1854       TclDateHaveTime++;
1855       if (TclDatepvt[-0].Number < 100) {
1856     TclDateHour = TclDatepvt[-0].Number;
1857     TclDateMinutes = 0;
1858       } else {
1859     TclDateHour = TclDatepvt[-0].Number / 100;
1860     TclDateMinutes = TclDatepvt[-0].Number % 100;
1861       }
1862       TclDateSeconds = 0;
1863       TclDateMeridian = MER24;
1864   }
1865     } break;
1866 case 54:{
1867             TclDateval.Meridian = MER24;
1868         } break;
1869 case 55:{
1870             TclDateval.Meridian = TclDatepvt[-0].Meridian;
1871         } break;
1872   }
1873   goto TclDatestack;    /* reset registers in driver code */
1874 }
int TclGetDate (char * p, Tcl_WideInt now, long zone, Tcl_WideInt * timePtr)

Definition at line 836 of file tclDate.c.
References Convert(), DSTmaybe, DSToff, MER24, NamedDay(), NamedMonth(), NULL, RelativeDay(), RelativeMonth(), TclDateDay, TclDateDayNumber, TclDateDayOrdinal, TclDateDSTmode, TclDateHaveDate, TclDateHaveDay, TclDateHaveOrdinalMonth, TclDateHaveRel, TclDateHaveTime, TclDateHaveZone, TclDateHour, TclDateInput, TclDateMeridian, TclDateMinutes, TclDateMonth, TclDateMonthOrdinal, TclDateparse(), TclDateRelDay, TclDateRelMonth, TclDateRelPointer, TclDateRelSeconds, TclDateSeconds, TclDateTimezone, TclDateYear, TclpGetDate(), and TM_YEAR_BASE.
Referenced by TCL_DECLARE_MUTEX().841 {
842     struct tm *tm;
843     time_t Start;
844     time_t Time;
845     time_t tod;
846     int thisyear;
847 
848     TclDateInput = p;
849     /* now has to be cast to a time_t for 64bit compliance */
850     Start = (time_t) now;
851     tm = TclpGetDate((TclpTime_t) &Start, (zone == -50000));
852     thisyear = tm->tm_year + TM_YEAR_BASE;
853     TclDateYear = thisyear;
854     TclDateMonth = tm->tm_mon + 1;
855     TclDateDay = tm->tm_mday;
856     TclDateTimezone = zone;
857     if (zone == -50000) {
858         TclDateDSTmode = DSToff;  /* assume GMT */
859         TclDateTimezone = 0;
860     } else {
861         TclDateDSTmode = DSTmaybe;
862     }
863     TclDateHour = 0;
864     TclDateMinutes = 0;
865     TclDateSeconds = 0;
866     TclDateMeridian = MER24;
867     TclDateRelSeconds = 0;
868     TclDateRelMonth = 0;
869     TclDateRelDay = 0;
870     TclDateRelPointer = NULL;
871 
872     TclDateHaveDate = 0;
873     TclDateHaveDay = 0;
874     TclDateHaveOrdinalMonth = 0;
875     TclDateHaveRel = 0;
876     TclDateHaveTime = 0;
877     TclDateHaveZone = 0;
878 
879     if (TclDateparse() || TclDateHaveTime > 1 || TclDateHaveZone > 1 || TclDateHaveDate > 1 ||
880       TclDateHaveDay > 1 || TclDateHaveOrdinalMonth > 1) {
881         return -1;
882     }
883     
884     if (TclDateHaveDate || TclDateHaveTime || TclDateHaveDay) {
885   if (TclDateYear < 0) {
886       TclDateYear = -TclDateYear;
887   }
888   /*
889    * The following line handles years that are specified using
890    * only two digits.  The line of code below implements a policy
891    * defined by the X/Open workgroup on the millinium rollover.
892    * Note: some of those dates may not actually be valid on some
893    * platforms.  The POSIX standard startes that the dates 70-99
894    * shall refer to 1970-1999 and 00-38 shall refer to 2000-2038.
895    * This later definition should work on all platforms.
896    */
897 
898   if (TclDateYear < 100) {
899       if (TclDateYear >= 69) {
900     TclDateYear += 1900;
901       } else {
902     TclDateYear += 2000;
903       }
904   }
905   if (Convert(TclDateMonth, TclDateDay, TclDateYear, TclDateHour, TclDateMinutes, TclDateSeconds,
906     TclDateMeridian, TclDateDSTmode, &Start) < 0) {
907             return -1;
908   }
909     } else {
910         Start = (time_t) now;
911         if (!TclDateHaveRel) {
912             Start -= ((tm->tm_hour * 60L * 60L) +
913         tm->tm_min * 60L) + tm->tm_sec;
914   }
915     }
916 
917     Start += TclDateRelSeconds;
918     if (RelativeMonth(Start, TclDateRelMonth, &Time) < 0) {
919         return -1;
920     }
921     Start += Time;
922 
923     if (RelativeDay(Start, TclDateRelDay, &Time) < 0) {
924   return -1;
925     }
926     Start += Time;
927     
928     if (TclDateHaveDay && !TclDateHaveDate) {
929         tod = NamedDay(Start, TclDateDayOrdinal, TclDateDayNumber);
930         Start += tod;
931     }
932 
933     if (TclDateHaveOrdinalMonth) {
934   tod = NamedMonth(Start, TclDateMonthOrdinal, TclDateMonth);
935   Start += tod;
936     }
937     
938     *timePtr = Start;
939     return 0;
940 }
static time_t ToSeconds (time_t Hours, time_t Minutes, time_t Seconds, MERIDIAN Meridian) [static]

Definition at line 399 of file tclDate.c.
References MER24, MERam, and MERpm.
Referenced by Convert().404 {
405     if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59)
406         return -1;
407     switch (Meridian) {
408     case MER24:
409         if (Hours < 0 || Hours > 23)
410             return -1;
411         return (Hours * 60L + Minutes) * 60L + Seconds;
412     case MERam:
413         if (Hours < 1 || Hours > 12)
414             return -1;
415         return ((Hours % 12) * 60L + Minutes) * 60L + Seconds;
416     case MERpm:
417         if (Hours < 1 || Hours > 12)
418             return -1;
419         return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds;
420     }
421     return -1;  /* Should never be reached */
422 }

Variable Documentation
TABLE MilitaryTable[] [static]
Initial value: {
    { "a",      tZONE,  HOUR(  1) },
    { "b",      tZONE,  HOUR(  2) },
    { "c",      tZONE,  HOUR(  3) },
    { "d",      tZONE,  HOUR(  4) },
    { "e",      tZONE,  HOUR(  5) },
    { "f",      tZONE,  HOUR(  6) },
    { "g",      tZONE,  HOUR(  7) },
    { "h",      tZONE,  HOUR(  8) },
    { "i",      tZONE,  HOUR(  9) },
    { "k",      tZONE,  HOUR( 10) },
    { "l",      tZONE,  HOUR( 11) },
    { "m",      tZONE,  HOUR( 12) },
    { "n",      tZONE,  HOUR(- 1) },
    { "o",      tZONE,  HOUR(- 2) },
    { "p",      tZONE,  HOUR(- 3) },
    { "q",      tZONE,  HOUR(- 4) },
    { "r",      tZONE,  HOUR(- 5) },
    { "s",      tZONE,  HOUR(- 6) },
    { "t",      tZONE,  HOUR(- 7) },
    { "u",      tZONE,  HOUR(- 8) },
    { "v",      tZONE,  HOUR(- 9) },
    { "w",      tZONE,  HOUR(-10) },
    { "x",      tZONE,  HOUR(-11) },
    { "y",      tZONE,  HOUR(-12) },
    { "z",      tZONE,  HOUR(  0) },
    { NULL }
}
Definition at line 358 of file tclDate.c.TABLE MonthDayTable[] [static]
Initial value: {
    { "january",        tMONTH,  1 },
    { "february",       tMONTH,  2 },
    { "march",          tMONTH,  3 },
    { "april",          tMONTH,  4 },
    { "may",            tMONTH,  5 },
    { "june",           tMONTH,  6 },
    { "july",           tMONTH,  7 },
    { "august",         tMONTH,  8 },
    { "september",      tMONTH,  9 },
    { "sept",           tMONTH,  9 },
    { "october",        tMONTH, 10 },
    { "november",       tMONTH, 11 },
    { "december",       tMONTH, 12 },
    { "sunday",         tDAY, 0 },
    { "monday",         tDAY, 1 },
    { "tuesday",        tDAY, 2 },
    { "tues",           tDAY, 2 },
    { "wednesday",      tDAY, 3 },
    { "wednes",         tDAY, 3 },
    { "thursday",       tDAY, 4 },
    { "thur",           tDAY, 4 },
    { "thurs",          tDAY, 4 },
    { "friday",         tDAY, 5 },
    { "saturday",       tDAY, 6 },
    { NULL }
}
Definition at line 194 of file tclDate.c.
Referenced by LookupWord().TABLE OtherTable[] [static]
Initial value: {
    { "tomorrow",       tDAY_UNIT,      1 },
    { "yesterday",      tDAY_UNIT,     -1 },
    { "today",          tDAY_UNIT,      0 },
    { "now",            tSEC_UNIT,      0 },
    { "last",           tUNUMBER,      -1 },
    { "this",           tSEC_UNIT,      0 },
    { "next",           tNEXT,          1 },

    { "ago",            tAGO,   1 },
    { "epoch",          tEPOCH,   0 },
    { "stardate",       tSTARDATE, 0},
    { NULL }
}
Definition at line 242 of file tclDate.c.int TclDate_TclDates[YYMAXDEPTH]

Definition at line 181 of file tclDate.c.YYSTYPE TclDate_TclDatev[YYMAXDEPTH]

Definition at line 182 of file tclDate.c.CONST TclDatetabelem TclDateact[] [static]
Initial value:{

    24,    40,    23,    36,    54,    81,    41,    28,    53,    26,
    37,    42,    58,    38,    56,    28,    27,    26,    28,    33,
    26,    32,    61,    50,    27,    80,    76,    27,    51,    75,
    74,    73,    30,    72,    71,    70,    69,    52,    49,    48,
    47,    45,    39,    62,    78,    46,    79,    68,    25,    65,
    60,    67,    66,    55,    44,    21,    63,    11,    10,     9,
     8,    35,     7,     6,     5,     4,     3,    43,     2,     1,
    20,     0,     0,     0,     0,     0,     0,     0,     0,     0,
     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
     0,    57,     0,     0,    59,    77,     0,     0,     0,     0,
     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
     0,     0,     0,     0,     0,    19,    14,     0,     0,     0,
    16,    28,    22,    26,     0,    12,    13,    17,     0,    15,
    27,    18,    31,     0,     0,    29,     0,    34,    28,     0,
    26,     0,     0,     0,     0,     0,     0,    27,     0,     0,
     0,     0,     0,     0,     0,     0,     0,     0,     0,    64,
    64 }
Definition at line 948 of file tclDate.c.int TclDatechar

Definition at line 1182 of file tclDate.c.int TclDatechar

Definition at line 1182 of file tclDate.c.CONST TclDatetabelem TclDatechk[] [static]
Initial value:{

-10000000,    -4,    -5,    -6,    -7,    -8,    -9,   -10,   -11,   -12,
   -13,   -14,   268,   269,   259,   272,   263,   270,   274,   258,
    -2,   -15,   265,    45,    43,    -1,   266,   273,   264,   261,
    58,   258,    47,    45,   263,    -1,   271,   269,   272,   268,
   258,   263,   268,    -1,    44,   268,   257,   268,   268,   268,
   263,   268,   268,   272,   268,    44,   263,    -1,   258,    -1,
    46,    -3,    45,    58,   261,    47,    45,    45,    58,   268,
   268,   268,   268,   268,   268,   268,   268,    -3,    45,    58,
   268,   268 }
Definition at line 1008 of file tclDate.c.time_t TclDateDay [static]

Definition at line 85 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().time_t TclDateDayNumber [static]

Definition at line 76 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().time_t TclDateDayOrdinal [static]

Definition at line 75 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().int TclDatedebug

Definition at line 1164 of file tclDate.c.CONST TclDatetabelem TclDatedef[] [static]
Initial value:{

     1,    -2,     2,     3,     4,     5,     6,     7,     8,     9,
    10,    11,    53,    18,    19,    27,     0,    33,     0,    20,
     0,    42,     0,    48,    49,    47,    50,    51,    52,    12,
     0,    22,     0,     0,    32,    44,    17,     0,    39,    30,
    24,    35,     0,    45,    21,     0,    41,     0,    54,    25,
     0,     0,    34,    37,     0,     0,    36,    46,    23,    43,
     0,    13,     0,     0,    55,     0,     0,     0,     0,    31,
    40,    14,    54,    26,    28,    29,     0,    15,     0,     0,
    16,    38 }
Definition at line 1019 of file tclDate.c.DSTMODE TclDateDSTmode [static]

Definition at line 74 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().int TclDateerrflag

Definition at line 1181 of file tclDate.c.int TclDateerrflag

Definition at line 1181 of file tclDate.c.CONST TclDatetabelem TclDateexca[] [static]
Initial value:{
-1, 1,
  0, -1,
  -2, 0,
  }
Definition at line 941 of file tclDate.c.int TclDateHaveDate [static]

Definition at line 78 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().int TclDateHaveDay [static]

Definition at line 79 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().int TclDateHaveOrdinalMonth [static]

Definition at line 80 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().int TclDateHaveRel [static]

Definition at line 81 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().int TclDateHaveTime [static]

Definition at line 82 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().int TclDateHaveZone [static]

Definition at line 83 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().time_t TclDateHour [static]

Definition at line 86 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().char* TclDateInput [static]

Definition at line 73 of file tclDate.c.
Referenced by TclDatelex(), and TclGetDate().YYSTYPE TclDatelval

Definition at line 174 of file tclDate.c.
Referenced by LookupWord(), TclDatelex(), and TclDateparse().int TclDatemaxdepth = YYMAXDEPTH [static]

Definition at line 187 of file tclDate.c.
Referenced by TclDateparse().MERIDIAN TclDateMeridian [static]

Definition at line 91 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().time_t TclDateMinutes [static]

Definition at line 87 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().time_t TclDateMonth [static]

Definition at line 88 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().time_t TclDateMonthOrdinal [static]

Definition at line 77 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().int TclDatenerrs

Definition at line 1180 of file tclDate.c.CONST TclDatetabelem TclDatepact[] [static]
Initial value:{

-10000000,   -43,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,
-10000000,-10000000,   -26,  -268,-10000000,  -259,  -226,-10000000,  -257,    10,
  -227,  -212,  -228,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,
  -229,-10000000,  -230,  -240,  -231,-10000000,-10000000,  -264,-10000000,     9,
-10000000,-10000000,  -249,-10000000,-10000000,  -246,-10000000,     4,    -2,     2,
     7,     6,-10000000,-10000000,   -11,  -232,-10000000,-10000000,-10000000,-10000000,
  -233,-10000000,  -234,  -235,-10000000,  -237,  -238,  -239,  -242,-10000000,
-10000000,-10000000,    -1,-10000000,-10000000,-10000000,   -12,-10000000,  -243,  -263,
-10000000,-10000000 }
Definition at line 977 of file tclDate.c.CONST TclDatetabelem TclDatepgo[] [static]
Initial value:{

     0,    48,    70,    22,    69,    68,    66,    65,    64,    63,
    62,    60,    59,    58,    57,    55 }
Definition at line 988 of file tclDate.c.int* TclDateps

Definition at line 1175 of file tclDate.c.YYSTYPE* TclDatepv

Definition at line 1174 of file tclDate.c.
Referenced by TclDateparse().CONST TclDatetabelem TclDater1[] [static]
Initial value:{

     0,     4,     4,     5,     5,     5,     5,     5,     5,     5,
     5,     5,     6,     6,     6,     6,     6,     7,     7,     7,
    10,    10,    10,    10,    10,     8,     8,     8,     8,     8,
     8,     8,     8,     8,     8,     9,     9,    12,    12,    12,
    13,    11,    11,    15,    15,    15,    15,    15,     2,     2,
     1,     1,     1,    14,     3,     3 }
Definition at line 992 of file tclDate.c.CONST TclDatetabelem TclDater2[] [static]
Initial value:{

     0,     0,     4,     3,     3,     3,     3,     3,     3,     3,
     3,     2,     5,     9,    11,    13,    15,     5,     3,     3,
     3,     5,     5,     7,     5,     7,    11,     3,    11,    11,
     5,     9,     5,     3,     7,     5,     7,     7,    15,     5,
     9,     5,     2,     7,     5,     5,     7,     3,     3,     3,
     3,     3,     3,     3,     1,     3 }
Definition at line 1000 of file tclDate.c.time_t TclDateRelDay [static]

Definition at line 93 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().time_t TclDateRelMonth [static]

Definition at line 92 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().time_t* TclDateRelPointer [static]

Definition at line 95 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().time_t TclDateRelSeconds [static]

Definition at line 94 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().int * TclDates = TclDate_TclDates

Definition at line 181 of file tclDate.c.
Referenced by TclDateparse().time_t TclDateSeconds [static]

Definition at line 89 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().int TclDatestate

Definition at line 1177 of file tclDate.c.time_t TclDateTimezone [static]

Definition at line 84 of file tclDate.c.
Referenced by Convert(), RelativeMonth(), TclDateparse(), and TclGetDate().int TclDatetmp

Definition at line 1178 of file tclDate.c.YYSTYPE * TclDatev = TclDate_TclDatev

Definition at line 182 of file tclDate.c.
Referenced by TclDateparse().YYSTYPE TclDateval

Definition at line 175 of file tclDate.c.
Referenced by TclDateparse().time_t TclDateYear [static]

Definition at line 90 of file tclDate.c.
Referenced by TclDateparse(), and TclGetDate().TABLE TimezoneTable[] [static]

Definition at line 274 of file tclDate.c.TABLE UnitsTable[] [static]
Initial value: {
    { "year",           tMONTH_UNIT,    12 },
    { "month",          tMONTH_UNIT,     1 },
    { "fortnight",      tDAY_UNIT,      14 },
    { "week",           tDAY_UNIT,       7 },
    { "day",            tDAY_UNIT,       1 },
    { "hour",           tSEC_UNIT, 60 * 60 },
    { "minute",         tSEC_UNIT,      60 },
    { "min",            tSEC_UNIT,      60 },
    { "second",         tSEC_UNIT,       1 },
    { "sec",            tSEC_UNIT,       1 },
    { NULL }
}
Definition at line 225 of file tclDate.c.

generic/tclDecls.h File Reference
Classes
struct TclStubHooks
struct TclStubs
Functions
EXTERN int Tcl_PkgProvideEx _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version, ClientData clientData))
EXTERN CONST84_RETURN char *Tcl_PkgRequireEx _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr))
EXTERN void Tcl_Panic _ANSI_ARGS_ (TCL_VARARGS(CONST char *, format))
EXTERN char *Tcl_Alloc _ANSI_ARGS_ ((unsigned int size))
EXTERN void Tcl_Free _ANSI_ARGS_ ((char *ptr))
EXTERN char *Tcl_Realloc _ANSI_ARGS_ ((char *ptr, unsigned int size))
EXTERN char *Tcl_DbCkalloc _ANSI_ARGS_ ((unsigned int size, CONST char *file, int line))
EXTERN int Tcl_DbCkfree _ANSI_ARGS_ ((char *ptr, CONST char *file, int line))
EXTERN char *Tcl_DbCkrealloc _ANSI_ARGS_ ((char *ptr, unsigned int size, CONST char *file, int line))
EXTERN void Tcl_CreateFileHandler _ANSI_ARGS_ ((int fd, int mask, Tcl_FileProc *proc, ClientData clientData))
EXTERN void Tcl_DeleteFileHandler _ANSI_ARGS_ ((int fd))
EXTERN void Tcl_SetTimer _ANSI_ARGS_ ((Tcl_Time *timePtr))
EXTERN void Tcl_Sleep _ANSI_ARGS_ ((int ms))
EXTERN int Tcl_AppendAllObjTypes _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
EXTERN void Tcl_AppendStringsToObj _ANSI_ARGS_ (TCL_VARARGS(Tcl_Obj *, objPtr))
EXTERN void Tcl_AppendToObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST char *bytes, int length))
EXTERN Tcl_Obj *Tcl_ConcatObj _ANSI_ARGS_ ((int objc, Tcl_Obj *CONST objv[]))
EXTERN int Tcl_ConvertToType _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_ObjType *typePtr))
EXTERN void Tcl_DbDecrRefCount _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST char *file, int line))
EXTERN Tcl_Obj *Tcl_DbNewBooleanObj _ANSI_ARGS_ ((int boolValue, CONST char *file, int line))
EXTERN Tcl_Obj *Tcl_DbNewByteArrayObj _ANSI_ARGS_ ((CONST unsigned char *bytes, int length, CONST char *file, int line))
EXTERN Tcl_Obj *Tcl_DbNewDoubleObj _ANSI_ARGS_ ((double doubleValue, CONST char *file, int line))
EXTERN Tcl_Obj *Tcl_DbNewListObj _ANSI_ARGS_ ((int objc, Tcl_Obj *CONST *objv, CONST char *file, int line))
EXTERN Tcl_Obj *Tcl_DbNewLongObj _ANSI_ARGS_ ((long longValue, CONST char *file, int line))
EXTERN Tcl_Obj *Tcl_DbNewObj _ANSI_ARGS_ ((CONST char *file, int line))
EXTERN Tcl_Obj *Tcl_DbNewStringObj _ANSI_ARGS_ ((CONST char *bytes, int length, CONST char *file, int line))
EXTERN Tcl_Obj *Tcl_DuplicateObj _ANSI_ARGS_ ((Tcl_Obj *objPtr))
EXTERN int Tcl_GetBoolean _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int *boolPtr))
EXTERN int Tcl_GetBooleanFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr))
EXTERN unsigned char *Tcl_GetByteArrayFromObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, int *lengthPtr))
EXTERN int Tcl_GetDouble _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, double *doublePtr))
EXTERN int Tcl_GetDoubleFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr))
EXTERN int Tcl_GetIndexFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char **tablePtr, CONST char *msg, int flags, int *indexPtr))
EXTERN int Tcl_GetInt _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int *intPtr))
EXTERN int Tcl_GetIntFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr))
EXTERN int Tcl_GetLongFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr))
EXTERN Tcl_ObjType *Tcl_GetObjType _ANSI_ARGS_ ((CONST char *typeName))
EXTERN int Tcl_ListObjAppendList _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr))
EXTERN int Tcl_ListObjAppendElement _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr))
EXTERN int Tcl_ListObjGetElements _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr))
EXTERN int Tcl_ListObjIndex _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr))
EXTERN int Tcl_ListObjLength _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr))
EXTERN int Tcl_ListObjReplace _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *CONST objv[]))
EXTERN Tcl_Obj *Tcl_NewBooleanObj _ANSI_ARGS_ ((int boolValue))
EXTERN Tcl_Obj *Tcl_NewByteArrayObj _ANSI_ARGS_ ((CONST unsigned char *bytes, int length))
EXTERN Tcl_Obj *Tcl_NewDoubleObj _ANSI_ARGS_ ((double doubleValue))
EXTERN Tcl_Obj *Tcl_NewIntObj _ANSI_ARGS_ ((int intValue))
EXTERN Tcl_Obj *Tcl_NewLongObj _ANSI_ARGS_ ((long longValue))
EXTERN Tcl_Obj *Tcl_NewObj _ANSI_ARGS_ ((void))
EXTERN Tcl_Obj *Tcl_NewStringObj _ANSI_ARGS_ ((CONST char *bytes, int length))
EXTERN void Tcl_SetBooleanObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, int boolValue))
EXTERN unsigned char *Tcl_SetByteArrayLength _ANSI_ARGS_ ((Tcl_Obj *objPtr, int length))
EXTERN void Tcl_SetByteArrayObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST unsigned char *bytes, int length))
EXTERN void Tcl_SetDoubleObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, double doubleValue))
EXTERN void Tcl_SetIntObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, int intValue))
EXTERN void Tcl_SetListObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, int objc, Tcl_Obj *CONST objv[]))
EXTERN void Tcl_SetLongObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, long longValue))
EXTERN void Tcl_AddErrorInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *message))
EXTERN void Tcl_AddObjErrorInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *message, int length))
EXTERN void Tcl_AllowExceptions _ANSI_ARGS_ ((Tcl_Interp *interp))
EXTERN void Tcl_AppendElement _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string))
EXTERN void Tcl_AppendResult _ANSI_ARGS_ (TCL_VARARGS(Tcl_Interp *, interp))
EXTERN Tcl_AsyncHandler Tcl_AsyncCreate _ANSI_ARGS_ ((Tcl_AsyncProc *proc, ClientData clientData))
EXTERN void Tcl_AsyncDelete _ANSI_ARGS_ ((Tcl_AsyncHandler async))
EXTERN int Tcl_AsyncInvoke _ANSI_ARGS_ ((Tcl_Interp *interp, int code))
EXTERN char Tcl_Backslash _ANSI_ARGS_ ((CONST char *src, int *readPtr))
EXTERN int Tcl_BadChannelOption _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *optionName, CONST char *optionList))
EXTERN void Tcl_CallWhenDeleted _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData))
EXTERN void Tcl_CancelIdleCall _ANSI_ARGS_ ((Tcl_IdleProc *idleProc, ClientData clientData))
EXTERN int Tcl_Close _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan))
EXTERN int Tcl_CommandComplete _ANSI_ARGS_ ((CONST char *cmd))
EXTERN char *Tcl_Concat _ANSI_ARGS_ ((int argc, CONST84 char *CONST *argv))
EXTERN int Tcl_ConvertElement _ANSI_ARGS_ ((CONST char *src, char *dst, int flags))
EXTERN int Tcl_ConvertCountedElement _ANSI_ARGS_ ((CONST char *src, int length, char *dst, int flags))
EXTERN int Tcl_CreateAlias _ANSI_ARGS_ ((Tcl_Interp *slave, CONST char *slaveCmd, Tcl_Interp *target, CONST char *targetCmd, int argc, CONST84 char *CONST *argv))
EXTERN int Tcl_CreateAliasObj _ANSI_ARGS_ ((Tcl_Interp *slave, CONST char *slaveCmd, Tcl_Interp *target, CONST char *targetCmd, int objc, Tcl_Obj *CONST objv[]))
EXTERN Tcl_Channel Tcl_CreateChannel _ANSI_ARGS_ ((Tcl_ChannelType *typePtr, CONST char *chanName, ClientData instanceData, int mask))
EXTERN void Tcl_CreateChannelHandler _ANSI_ARGS_ ((Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData))
EXTERN void Tcl_CreateCloseHandler _ANSI_ARGS_ ((Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData))
EXTERN Tcl_Command Tcl_CreateCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc))
EXTERN void Tcl_CreateEventSource _ANSI_ARGS_ ((Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData))
EXTERN void Tcl_CreateExitHandler _ANSI_ARGS_ ((Tcl_ExitProc *proc, ClientData clientData))
EXTERN void Tcl_CreateMathFunc _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData))
EXTERN Tcl_Command Tcl_CreateObjCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc))
EXTERN Tcl_Interp *Tcl_CreateSlave _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *slaveName, int isSafe))
EXTERN Tcl_TimerToken Tcl_CreateTimerHandler _ANSI_ARGS_ ((int milliseconds, Tcl_TimerProc *proc, ClientData clientData))
EXTERN Tcl_Trace Tcl_CreateTrace _ANSI_ARGS_ ((Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData))
EXTERN void Tcl_DeleteAssocData _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name))
EXTERN void Tcl_DeleteChannelHandler _ANSI_ARGS_ ((Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData))
EXTERN int Tcl_DeleteCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName))
EXTERN int Tcl_DeleteCommandFromToken _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Command command))
EXTERN void Tcl_DeleteEvents _ANSI_ARGS_ ((Tcl_EventDeleteProc *proc, ClientData clientData))
EXTERN void Tcl_DeleteHashEntry _ANSI_ARGS_ ((Tcl_HashEntry *entryPtr))
EXTERN void Tcl_DeleteHashTable _ANSI_ARGS_ ((Tcl_HashTable *tablePtr))
EXTERN void Tcl_DetachPids _ANSI_ARGS_ ((int numPids, Tcl_Pid *pidPtr))
EXTERN void Tcl_DeleteTimerHandler _ANSI_ARGS_ ((Tcl_TimerToken token))
EXTERN void Tcl_DeleteTrace _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Trace trace))
EXTERN int Tcl_DoOneEvent _ANSI_ARGS_ ((int flags))
EXTERN void Tcl_DoWhenIdle _ANSI_ARGS_ ((Tcl_IdleProc *proc, ClientData clientData))
EXTERN char *Tcl_DStringAppend _ANSI_ARGS_ ((Tcl_DString *dsPtr, CONST char *str, int length))
EXTERN char *Tcl_DStringAppendElement _ANSI_ARGS_ ((Tcl_DString *dsPtr, CONST char *string))
EXTERN void Tcl_DStringEndSublist _ANSI_ARGS_ ((Tcl_DString *dsPtr))
EXTERN void Tcl_DStringGetResult _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_DString *dsPtr))
EXTERN void Tcl_DStringSetLength _ANSI_ARGS_ ((Tcl_DString *dsPtr, int length))
EXTERN int Tcl_Eof _ANSI_ARGS_ ((Tcl_Channel chan))
EXTERN CONST84_RETURN char *Tcl_ErrnoMsg _ANSI_ARGS_ ((int err))
EXTERN int Tcl_EvalFile _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *fileName))
EXTERN void Tcl_EventuallyFree _ANSI_ARGS_ ((ClientData clientData, Tcl_FreeProc *freeProc))
EXTERN void Tcl_Exit _ANSI_ARGS_ ((int status))
EXTERN int Tcl_ExposeCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *hiddenCmdToken, CONST char *cmdName))
EXTERN int Tcl_ExprBoolean _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int *ptr))
EXTERN int Tcl_ExprBooleanObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr))
EXTERN int Tcl_ExprDouble _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, double *ptr))
EXTERN int Tcl_ExprDoubleObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr))
EXTERN int Tcl_ExprLong _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, long *ptr))
EXTERN int Tcl_ExprLongObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr))
EXTERN int Tcl_ExprObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr))
EXTERN void Tcl_FindExecutable _ANSI_ARGS_ ((CONST char *argv0))
EXTERN Tcl_HashEntry *Tcl_FirstHashEntry _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr))
EXTERN int Tcl_GetAlias _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr))
EXTERN int Tcl_GetAliasObj _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv))
EXTERN ClientData Tcl_GetAssocData _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_InterpDeleteProc **procPtr))
EXTERN Tcl_Channel Tcl_GetChannel _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *chanName, int *modePtr))
EXTERN int Tcl_GetChannelHandle _ANSI_ARGS_ ((Tcl_Channel chan, int direction, ClientData *handlePtr))
EXTERN int Tcl_GetChannelOption _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, Tcl_DString *dsPtr))
EXTERN int Tcl_GetCommandInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, Tcl_CmdInfo *infoPtr))
EXTERN int Tcl_GetInterpPath _ANSI_ARGS_ ((Tcl_Interp *askInterp, Tcl_Interp *slaveInterp))
EXTERN int Tcl_GetOpenFile _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int forWriting, int checkUsage, ClientData *filePtr))
EXTERN Tcl_PathType Tcl_GetPathType _ANSI_ARGS_ ((CONST char *path))
EXTERN int Tcl_Gets _ANSI_ARGS_ ((Tcl_Channel chan, Tcl_DString *dsPtr))
EXTERN int Tcl_GetsObj _ANSI_ARGS_ ((Tcl_Channel chan, Tcl_Obj *objPtr))
EXTERN Tcl_Interp *Tcl_GetSlave _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *slaveName))
EXTERN Tcl_Channel Tcl_GetStdChannel _ANSI_ARGS_ ((int type))
EXTERN CONST84_RETURN char *Tcl_GetVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags))
EXTERN CONST84_RETURN char *Tcl_GetVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags))
EXTERN int Tcl_GlobalEval _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *command))
EXTERN int Tcl_HideCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, CONST char *hiddenCmdToken))
EXTERN void Tcl_InitHashTable _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, int keyType))
EXTERN char *Tcl_JoinPath _ANSI_ARGS_ ((int argc, CONST84 char *CONST *argv, Tcl_DString *resultPtr))
EXTERN int Tcl_LinkVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, char *addr, int type))
EXTERN Tcl_Channel Tcl_MakeFileChannel _ANSI_ARGS_ ((ClientData handle, int mode))
EXTERN Tcl_Channel Tcl_MakeTcpClientChannel _ANSI_ARGS_ ((ClientData tcpSocket))
EXTERN Tcl_HashEntry *Tcl_NextHashEntry _ANSI_ARGS_ ((Tcl_HashSearch *searchPtr))
EXTERN void Tcl_NotifyChannel _ANSI_ARGS_ ((Tcl_Channel channel, int mask))
EXTERN Tcl_Obj *Tcl_ObjGetVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags))
EXTERN Tcl_Obj *Tcl_ObjSetVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags))
EXTERN Tcl_Channel Tcl_OpenCommandChannel _ANSI_ARGS_ ((Tcl_Interp *interp, int argc, CONST84 char **argv, int flags))
EXTERN Tcl_Channel Tcl_OpenFileChannel _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *fileName, CONST char *modeString, int permissions))
EXTERN Tcl_Channel Tcl_OpenTcpClient _ANSI_ARGS_ ((Tcl_Interp *interp, int port, CONST char *address, CONST char *myaddr, int myport, int async))
EXTERN Tcl_Channel Tcl_OpenTcpServer _ANSI_ARGS_ ((Tcl_Interp *interp, int port, CONST char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData))
EXTERN void Tcl_Preserve _ANSI_ARGS_ ((ClientData data))
EXTERN void Tcl_PrintDouble _ANSI_ARGS_ ((Tcl_Interp *interp, double value, char *dst))
EXTERN int Tcl_PutEnv _ANSI_ARGS_ ((CONST char *string))
EXTERN void Tcl_QueueEvent _ANSI_ARGS_ ((Tcl_Event *evPtr, Tcl_QueuePosition position))
EXTERN int Tcl_Read _ANSI_ARGS_ ((Tcl_Channel chan, char *bufPtr, int toRead))
EXTERN int Tcl_RecordAndEval _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmd, int flags))
EXTERN int Tcl_RecordAndEvalObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags))
EXTERN void Tcl_RegisterObjType _ANSI_ARGS_ ((Tcl_ObjType *typePtr))
EXTERN int Tcl_RegExpExec _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_RegExp regexp, CONST char *str, CONST char *start))
EXTERN int Tcl_RegExpMatch _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, CONST char *pattern))
EXTERN void Tcl_RegExpRange _ANSI_ARGS_ ((Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr))
EXTERN void Tcl_Release _ANSI_ARGS_ ((ClientData clientData))
EXTERN int Tcl_ScanElement _ANSI_ARGS_ ((CONST char *str, int *flagPtr))
EXTERN int Tcl_ScanCountedElement _ANSI_ARGS_ ((CONST char *str, int length, int *flagPtr))
EXTERN int Tcl_SeekOld _ANSI_ARGS_ ((Tcl_Channel chan, int offset, int mode))
EXTERN void Tcl_SetAssocData _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_InterpDeleteProc *proc, ClientData clientData))
EXTERN void Tcl_SetChannelBufferSize _ANSI_ARGS_ ((Tcl_Channel chan, int sz))
EXTERN int Tcl_SetChannelOption _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, CONST char *newValue))
EXTERN int Tcl_SetCommandInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, CONST Tcl_CmdInfo *infoPtr))
EXTERN void Tcl_SetPanicProc _ANSI_ARGS_ ((Tcl_PanicProc *panicProc))
EXTERN int Tcl_SetRecursionLimit _ANSI_ARGS_ ((Tcl_Interp *interp, int depth))
EXTERN void Tcl_SetResult _ANSI_ARGS_ ((Tcl_Interp *interp, char *str, Tcl_FreeProc *freeProc))
EXTERN int Tcl_SetServiceMode _ANSI_ARGS_ ((int mode))
EXTERN void Tcl_SetObjErrorCode _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *errorObjPtr))
EXTERN void Tcl_SetObjResult _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *resultObjPtr))
EXTERN void Tcl_SetStdChannel _ANSI_ARGS_ ((Tcl_Channel channel, int type))
EXTERN CONST84_RETURN char *Tcl_SetVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, CONST char *newValue, int flags))
EXTERN CONST84_RETURN char *Tcl_SetVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, CONST char *newValue, int flags))
EXTERN CONST84_RETURN char *Tcl_SignalId _ANSI_ARGS_ ((int sig))
EXTERN int Tcl_SplitList _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *listStr, int *argcPtr, CONST84 char ***argvPtr))
EXTERN void Tcl_SplitPath _ANSI_ARGS_ ((CONST char *path, int *argcPtr, CONST84 char ***argvPtr))
EXTERN void Tcl_StaticPackage _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc))
EXTERN int Tcl_StringMatch _ANSI_ARGS_ ((CONST char *str, CONST char *pattern))
EXTERN int Tcl_TraceVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData))
EXTERN int Tcl_TraceVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData))
EXTERN char *Tcl_TranslateFileName _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_DString *bufferPtr))
EXTERN int Tcl_Ungets _ANSI_ARGS_ ((Tcl_Channel chan, CONST char *str, int len, int atHead))
EXTERN void Tcl_UnlinkVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName))
EXTERN int Tcl_UpVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *frameName, CONST char *varName, CONST char *localName, int flags))
EXTERN int Tcl_UpVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *frameName, CONST char *part1, CONST char *part2, CONST char *localName, int flags))
EXTERN ClientData Tcl_VarTraceInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData))
EXTERN ClientData Tcl_VarTraceInfo2 _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData))
EXTERN int Tcl_Write _ANSI_ARGS_ ((Tcl_Channel chan, CONST char *s, int slen))
EXTERN void Tcl_WrongNumArgs _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], CONST char *message))
EXTERN int Tcl_DumpActiveMemory _ANSI_ARGS_ ((CONST char *fileName))
EXTERN void Tcl_AppendResultVA _ANSI_ARGS_ ((Tcl_Interp *interp, va_list argList))
EXTERN void Tcl_AppendStringsToObjVA _ANSI_ARGS_ ((Tcl_Obj *objPtr, va_list argList))
EXTERN CONST84_RETURN char *Tcl_ParseVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, CONST84 char **termPtr))
EXTERN CONST84_RETURN char *Tcl_PkgPresent _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version, int exact))
EXTERN int Tcl_PkgProvide _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version))
EXTERN Tcl_Pid Tcl_WaitPid _ANSI_ARGS_ ((Tcl_Pid pid, int *statPtr, int options))
EXTERN void Tcl_PanicVA _ANSI_ARGS_ ((CONST char *format, va_list argList))
EXTERN void Tcl_GetVersion _ANSI_ARGS_ ((int *major, int *minor, int *patchLevel, int *type))
EXTERN Tcl_Channel Tcl_StackChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan))
EXTERN void Tcl_SetMainLoop _ANSI_ARGS_ ((Tcl_MainLoopProc *proc))
EXTERN void Tcl_AppendObjToObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr))
EXTERN Tcl_Encoding Tcl_CreateEncoding _ANSI_ARGS_ ((Tcl_EncodingType *typePtr))
EXTERN void Tcl_DiscardResult _ANSI_ARGS_ ((Tcl_SavedResult *statePtr))
EXTERN int Tcl_EvalEx _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *script, int numBytes, int flags))
EXTERN int Tcl_EvalObjv _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags))
EXTERN int Tcl_EvalObjEx _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int flags))
EXTERN int Tcl_ExternalToUtf _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Encoding encoding, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr))
EXTERN char *Tcl_ExternalToUtfDString _ANSI_ARGS_ ((Tcl_Encoding encoding, CONST char *src, int srcLen, Tcl_DString *dsPtr))
EXTERN void Tcl_FreeEncoding _ANSI_ARGS_ ((Tcl_Encoding encoding))
EXTERN int Tcl_GetIndexFromObjStruct _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, CONST VOID *tablePtr, int offset, CONST char *msg, int flags, int *indexPtr))
EXTERN VOID *Tcl_GetThreadData _ANSI_ARGS_ ((Tcl_ThreadDataKey *keyPtr, int size))
EXTERN void Tcl_MutexLock _ANSI_ARGS_ ((Tcl_Mutex *mutexPtr))
EXTERN void Tcl_ConditionNotify _ANSI_ARGS_ ((Tcl_Condition *condPtr))
EXTERN void Tcl_ConditionWait _ANSI_ARGS_ ((Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, Tcl_Time *timePtr))
EXTERN int Tcl_NumUtfChars _ANSI_ARGS_ ((CONST char *src, int len))
EXTERN int Tcl_ReadChars _ANSI_ARGS_ ((Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag))
EXTERN void Tcl_RestoreResult _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_SavedResult *statePtr))
EXTERN Tcl_Obj *Tcl_SetVar2Ex _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, Tcl_Obj *newValuePtr, int flags))
EXTERN void Tcl_ThreadAlert _ANSI_ARGS_ ((Tcl_ThreadId threadId))
EXTERN void Tcl_ThreadQueueEvent _ANSI_ARGS_ ((Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position))
EXTERN Tcl_UniChar Tcl_UniCharAtIndex _ANSI_ARGS_ ((CONST char *src, int index))
EXTERN Tcl_UniChar Tcl_UniCharToLower _ANSI_ARGS_ ((int ch))
EXTERN int Tcl_UniCharToUtf _ANSI_ARGS_ ((int ch, char *buf))
EXTERN int Tcl_UtfBackslash _ANSI_ARGS_ ((CONST char *src, int *readPtr, char *dst))
EXTERN CONST84_RETURN char *Tcl_UtfFindFirst _ANSI_ARGS_ ((CONST char *src, int ch))
EXTERN CONST84_RETURN char *Tcl_UtfPrev _ANSI_ARGS_ ((CONST char *src, CONST char *start))
EXTERN int Tcl_UtfToLower _ANSI_ARGS_ ((char *src))
EXTERN int Tcl_UtfToUniChar _ANSI_ARGS_ ((CONST char *src, Tcl_UniChar *chPtr))
EXTERN int Tcl_WriteChars _ANSI_ARGS_ ((Tcl_Channel chan, CONST char *src, int srcLen))
EXTERN int Tcl_UniCharLen _ANSI_ARGS_ ((CONST Tcl_UniChar *str))
EXTERN int Tcl_UniCharNcmp _ANSI_ARGS_ ((CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct, unsigned long n))
EXTERN char *Tcl_UniCharToUtfDString _ANSI_ARGS_ ((CONST Tcl_UniChar *string, int numChars, Tcl_DString *dsPtr))
EXTERN Tcl_UniChar *Tcl_UtfToUniCharDString _ANSI_ARGS_ ((CONST char *string, int length, Tcl_DString *dsPtr))
EXTERN Tcl_RegExp Tcl_GetRegExpFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *patObj, int flags))
EXTERN Tcl_Obj *Tcl_EvalTokens _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Token *tokenPtr, int count))
EXTERN void Tcl_FreeParse _ANSI_ARGS_ ((Tcl_Parse *parsePtr))
EXTERN void Tcl_LogCommandInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *script, CONST char *command, int length))
EXTERN int Tcl_ParseBraces _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr))
EXTERN int Tcl_ParseCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string, int numBytes, int nested, Tcl_Parse *parsePtr))
EXTERN int Tcl_ParseExpr _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr))
EXTERN int Tcl_ParseVarName _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr, int append))
EXTERN char *Tcl_GetCwd _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_DString *cwdPtr))
EXTERN int Tcl_Chdir _ANSI_ARGS_ ((CONST char *dirName))
EXTERN int Tcl_Access _ANSI_ARGS_ ((CONST char *path, int mode))
EXTERN int Tcl_Stat _ANSI_ARGS_ ((CONST char *path, struct stat *bufPtr))
EXTERN int Tcl_UtfNcmp _ANSI_ARGS_ ((CONST char *s1, CONST char *s2, unsigned long n))
EXTERN int Tcl_StringCaseMatch _ANSI_ARGS_ ((CONST char *str, CONST char *pattern, int nocase))
EXTERN int Tcl_RegExpExecObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *objPtr, int offset, int nmatches, int flags))
EXTERN void Tcl_RegExpGetInfo _ANSI_ARGS_ ((Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr))
EXTERN Tcl_Obj *Tcl_NewUnicodeObj _ANSI_ARGS_ ((CONST Tcl_UniChar *unicode, int numChars))
EXTERN void Tcl_SetUnicodeObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int numChars))
EXTERN Tcl_UniChar Tcl_GetUniChar _ANSI_ARGS_ ((Tcl_Obj *objPtr, int index))
EXTERN Tcl_Obj *Tcl_GetRange _ANSI_ARGS_ ((Tcl_Obj *objPtr, int first, int last))
EXTERN void Tcl_AppendUnicodeToObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int length))
EXTERN int Tcl_RegExpMatchObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Obj *patternObj))
EXTERN void Tcl_SetNotifier _ANSI_ARGS_ ((Tcl_NotifierProcs *notifierProcPtr))
EXTERN int Tcl_GetChannelNamesEx _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *pattern))
EXTERN int Tcl_ProcObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
EXTERN void Tcl_MutexFinalize _ANSI_ARGS_ ((Tcl_Mutex *mutex))
EXTERN int Tcl_CreateThread _ANSI_ARGS_ ((Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags))
EXTERN int Tcl_ReadRaw _ANSI_ARGS_ ((Tcl_Channel chan, char *dst, int bytesToRead))
EXTERN CONST84_RETURN char *Tcl_ChannelName _ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
EXTERN int Tcl_JoinThread _ANSI_ARGS_ ((Tcl_ThreadId threadId, int *result))
EXTERN int Tcl_IsChannelShared _ANSI_ARGS_ ((Tcl_Channel channel))
EXTERN int Tcl_IsChannelRegistered _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel channel))
EXTERN int Tcl_IsChannelExisting _ANSI_ARGS_ ((CONST char *channelName))
EXTERN int Tcl_UniCharCaseMatch _ANSI_ARGS_ ((CONST Tcl_UniChar *ustr, CONST Tcl_UniChar *pattern, int nocase))
EXTERN Tcl_HashEntry *Tcl_FindHashEntry _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, CONST char *key))
EXTERN Tcl_HashEntry *Tcl_CreateHashEntry _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, CONST char *key, int *newPtr))
EXTERN void Tcl_InitCustomHashTable _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, int keyType, Tcl_HashKeyType *typePtr))
EXTERN ClientData Tcl_CommandTraceInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData))
EXTERN int Tcl_TraceCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData))
EXTERN int Tcl_GetMathFuncInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr))
EXTERN int Tcl_FSCopyFile _ANSI_ARGS_ ((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr))
EXTERN int Tcl_FSCopyDirectory _ANSI_ARGS_ ((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr))
EXTERN int Tcl_FSLoadFile _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *sym1, CONST char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr))
EXTERN int Tcl_FSMatchInDirectory _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types))
EXTERN Tcl_Obj *Tcl_FSLink _ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction))
EXTERN int Tcl_FSRemoveDirectory _ANSI_ARGS_ ((Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr))
EXTERN int Tcl_FSLstat _ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_StatBuf *buf))
EXTERN int Tcl_FSUtime _ANSI_ARGS_ ((Tcl_Obj *pathPtr, struct utimbuf *tval))
EXTERN int Tcl_FSFileAttrsGet _ANSI_ARGS_ ((Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef))
EXTERN int Tcl_FSFileAttrsSet _ANSI_ARGS_ ((Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr))
EXTERN CONST char **Tcl_FSFileAttrStrings _ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef))
EXTERN Tcl_Channel Tcl_FSOpenFileChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *modeString, int permissions))
EXTERN Tcl_Obj *Tcl_FSJoinPath _ANSI_ARGS_ ((Tcl_Obj *listObj, int elements))
EXTERN Tcl_Obj *Tcl_FSSplitPath _ANSI_ARGS_ ((Tcl_Obj *pathPtr, int *lenPtr))
EXTERN int Tcl_FSEqualPaths _ANSI_ARGS_ ((Tcl_Obj *firstPtr, Tcl_Obj *secondPtr))
EXTERN Tcl_Obj *Tcl_FSGetNormalizedPath _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathObjPtr))
EXTERN Tcl_Obj *Tcl_FSJoinToPath _ANSI_ARGS_ ((Tcl_Obj *basePtr, int objc, Tcl_Obj *CONST objv[]))
EXTERN ClientData Tcl_FSGetInternalRep _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr, Tcl_Filesystem *fsPtr))
EXTERN int Tcl_FSEvalFile _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *fileName))
EXTERN Tcl_Obj *Tcl_FSNewNativePath _ANSI_ARGS_ ((Tcl_Filesystem *fromFilesystem, ClientData clientData))
EXTERN CONST char *Tcl_FSGetNativePath _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr))
EXTERN int Tcl_FSRegister _ANSI_ARGS_ ((ClientData clientData, Tcl_Filesystem *fsPtr))
EXTERN int Tcl_FSUnregister _ANSI_ARGS_ ((Tcl_Filesystem *fsPtr))
EXTERN void Tcl_GetTime _ANSI_ARGS_ ((Tcl_Time *timeBuf))
EXTERN Tcl_Trace Tcl_CreateObjTrace _ANSI_ARGS_ ((Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc))
EXTERN int Tcl_GetCommandInfoFromToken _ANSI_ARGS_ ((Tcl_Command token, Tcl_CmdInfo *infoPtr))
EXTERN int Tcl_SetCommandInfoFromToken _ANSI_ARGS_ ((Tcl_Command token, CONST Tcl_CmdInfo *infoPtr))
EXTERN Tcl_Obj *Tcl_DbNewWideIntObj _ANSI_ARGS_ ((Tcl_WideInt wideValue, CONST char *file, int line))
EXTERN int Tcl_GetWideIntFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr))
EXTERN Tcl_Obj *Tcl_NewWideIntObj _ANSI_ARGS_ ((Tcl_WideInt wideValue))
EXTERN void Tcl_SetWideIntObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, Tcl_WideInt wideValue))
EXTERN Tcl_WideInt Tcl_Seek _ANSI_ARGS_ ((Tcl_Channel chan, Tcl_WideInt offset, int mode))
EXTERN int Tcl_PkgRequireProc _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, int objc, Tcl_Obj *CONST objv[], ClientData *clientDataPtr))
Variables
TclStubs * tclStubsPtr

Function Documentation
EXTERN int Tcl_PkgRequireProc _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, int objc, Tcl_Obj *CONST objv[], ClientData *clientDataPtr))
EXTERN Tcl_WideInt Tcl_Seek _ANSI_ARGS_ ((Tcl_Channel chan, Tcl_WideInt offset, int mode))
EXTERN void Tcl_SetWideIntObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, Tcl_WideInt wideValue))
EXTERN Tcl_Obj* Tcl_NewWideIntObj _ANSI_ARGS_ ((Tcl_WideInt wideValue))
EXTERN int Tcl_GetWideIntFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr))
EXTERN Tcl_Obj* Tcl_DbNewWideIntObj _ANSI_ARGS_ ((Tcl_WideInt wideValue, CONST char *file, int line))
EXTERN int Tcl_SetCommandInfoFromToken _ANSI_ARGS_ ((Tcl_Command token, CONST Tcl_CmdInfo *infoPtr))
EXTERN int Tcl_GetCommandInfoFromToken _ANSI_ARGS_ ((Tcl_Command token, Tcl_CmdInfo *infoPtr))
EXTERN Tcl_Trace Tcl_CreateObjTrace _ANSI_ARGS_ ((Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc))
EXTERN void Tcl_GetTime _ANSI_ARGS_ ((Tcl_Time *timeBuf))
EXTERN int Tcl_FSUnregister _ANSI_ARGS_ ((Tcl_Filesystem *fsPtr))
EXTERN int Tcl_FSRegister _ANSI_ARGS_ ((ClientData clientData, Tcl_Filesystem *fsPtr))
EXTERN CONST char* Tcl_FSGetNativePath _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr))
EXTERN Tcl_Obj* Tcl_FSNewNativePath _ANSI_ARGS_ ((Tcl_Filesystem *fromFilesystem, ClientData clientData))
EXTERN int Tcl_FSEvalFile _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *fileName))
EXTERN ClientData Tcl_FSGetInternalRep _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr, Tcl_Filesystem *fsPtr))
EXTERN Tcl_Obj* Tcl_FSJoinToPath _ANSI_ARGS_ ((Tcl_Obj *basePtr, int objc, Tcl_Obj *CONST objv[]))
EXTERN Tcl_Obj* Tcl_FSGetNormalizedPath _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathObjPtr))
EXTERN int Tcl_FSEqualPaths _ANSI_ARGS_ ((Tcl_Obj *firstPtr, Tcl_Obj *secondPtr))
EXTERN Tcl_Obj* Tcl_FSSplitPath _ANSI_ARGS_ ((Tcl_Obj *pathPtr, int *lenPtr))
EXTERN Tcl_Obj* Tcl_FSJoinPath _ANSI_ARGS_ ((Tcl_Obj *listObj, int elements))
EXTERN Tcl_Channel Tcl_FSOpenFileChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *modeString, int permissions))
EXTERN CONST char** Tcl_FSFileAttrStrings _ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef))
EXTERN int Tcl_FSFileAttrsSet _ANSI_ARGS_ ((Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr))
EXTERN int Tcl_FSFileAttrsGet _ANSI_ARGS_ ((Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef))
EXTERN int Tcl_FSUtime _ANSI_ARGS_ ((Tcl_Obj *pathPtr, struct utimbuf *tval))
EXTERN int Tcl_FSLstat _ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_StatBuf *buf))
EXTERN int Tcl_FSRemoveDirectory _ANSI_ARGS_ ((Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr))
EXTERN Tcl_Obj* Tcl_FSLink _ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction))
EXTERN int Tcl_FSMatchInDirectory _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types))
EXTERN int Tcl_FSLoadFile _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *sym1, CONST char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr))
EXTERN int Tcl_FSCopyDirectory _ANSI_ARGS_ ((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr))
EXTERN int Tcl_FSCopyFile _ANSI_ARGS_ ((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr))
EXTERN int Tcl_GetMathFuncInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr))
EXTERN int Tcl_TraceCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData))
EXTERN ClientData Tcl_CommandTraceInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData))
EXTERN void Tcl_InitCustomHashTable _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, int keyType, Tcl_HashKeyType *typePtr))
EXTERN Tcl_HashEntry* Tcl_CreateHashEntry _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, CONST char *key, int *newPtr))
EXTERN Tcl_HashEntry* Tcl_FindHashEntry _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, CONST char *key))
EXTERN int Tcl_UniCharCaseMatch _ANSI_ARGS_ ((CONST Tcl_UniChar *ustr, CONST Tcl_UniChar *pattern, int nocase))
EXTERN int Tcl_IsChannelExisting _ANSI_ARGS_ ((CONST char *channelName))
EXTERN int Tcl_IsChannelRegistered _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel channel))
EXTERN int Tcl_IsChannelShared _ANSI_ARGS_ ((Tcl_Channel channel))
EXTERN int Tcl_JoinThread _ANSI_ARGS_ ((Tcl_ThreadId threadId, int *result))
EXTERN CONST84_RETURN char* Tcl_ChannelName _ANSI_ARGS_ ((Tcl_ChannelType *chanTypePtr))
EXTERN int Tcl_ReadRaw _ANSI_ARGS_ ((Tcl_Channel chan, char *dst, int bytesToRead))
EXTERN int Tcl_CreateThread _ANSI_ARGS_ ((Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags))
EXTERN void Tcl_MutexFinalize _ANSI_ARGS_ ((Tcl_Mutex *mutex))
EXTERN int Tcl_ProcObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
EXTERN int Tcl_GetChannelNamesEx _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *pattern))
EXTERN void Tcl_SetNotifier _ANSI_ARGS_ ((Tcl_NotifierProcs *notifierProcPtr))
EXTERN int Tcl_RegExpMatchObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Obj *patternObj))
EXTERN void Tcl_AppendUnicodeToObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int length))
EXTERN Tcl_Obj* Tcl_GetRange _ANSI_ARGS_ ((Tcl_Obj *objPtr, int first, int last))
EXTERN Tcl_UniChar Tcl_GetUniChar _ANSI_ARGS_ ((Tcl_Obj *objPtr, int index))
EXTERN void Tcl_SetUnicodeObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int numChars))
EXTERN Tcl_Obj* Tcl_NewUnicodeObj _ANSI_ARGS_ ((CONST Tcl_UniChar *unicode, int numChars))
EXTERN void Tcl_RegExpGetInfo _ANSI_ARGS_ ((Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr))
EXTERN int Tcl_RegExpExecObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *objPtr, int offset, int nmatches, int flags))
EXTERN int Tcl_StringCaseMatch _ANSI_ARGS_ ((CONST char *str, CONST char *pattern, int nocase))
EXTERN int Tcl_UtfNcmp _ANSI_ARGS_ ((CONST char *s1, CONST char *s2, unsigned long n))
EXTERN int Tcl_Stat _ANSI_ARGS_ ((CONST char *path, struct stat *bufPtr))
EXTERN int Tcl_Access _ANSI_ARGS_ ((CONST char *path, int mode))
EXTERN int Tcl_Chdir _ANSI_ARGS_ ((CONST char *dirName))
EXTERN char* Tcl_GetCwd _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_DString *cwdPtr))
EXTERN int Tcl_ParseVarName _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr, int append))
EXTERN int Tcl_ParseExpr _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr))
EXTERN int Tcl_ParseCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string, int numBytes, int nested, Tcl_Parse *parsePtr))
EXTERN int Tcl_ParseBraces _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr))
EXTERN void Tcl_LogCommandInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *script, CONST char *command, int length))
EXTERN void Tcl_FreeParse _ANSI_ARGS_ ((Tcl_Parse *parsePtr))
EXTERN Tcl_Obj* Tcl_EvalTokens _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Token *tokenPtr, int count))
EXTERN Tcl_RegExp Tcl_GetRegExpFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *patObj, int flags))
EXTERN Tcl_UniChar* Tcl_UtfToUniCharDString _ANSI_ARGS_ ((CONST char *string, int length, Tcl_DString *dsPtr))
EXTERN char* Tcl_UniCharToUtfDString _ANSI_ARGS_ ((CONST Tcl_UniChar *string, int numChars, Tcl_DString *dsPtr))
EXTERN int Tcl_UniCharNcmp _ANSI_ARGS_ ((CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct, unsigned long n))
EXTERN int Tcl_UniCharLen _ANSI_ARGS_ ((CONST Tcl_UniChar *str))
EXTERN int Tcl_WriteChars _ANSI_ARGS_ ((Tcl_Channel chan, CONST char *src, int srcLen))
EXTERN int Tcl_UtfToUniChar _ANSI_ARGS_ ((CONST char *src, Tcl_UniChar *chPtr))
EXTERN int Tcl_UtfToLower _ANSI_ARGS_ ((char *src))
EXTERN CONST84_RETURN char* Tcl_UtfPrev _ANSI_ARGS_ ((CONST char *src, CONST char *start))
EXTERN CONST84_RETURN char* Tcl_UtfFindFirst _ANSI_ARGS_ ((CONST char *src, int ch))
EXTERN int Tcl_UtfBackslash _ANSI_ARGS_ ((CONST char *src, int *readPtr, char *dst))
EXTERN int Tcl_UniCharToUtf _ANSI_ARGS_ ((int ch, char *buf))
EXTERN Tcl_UniChar Tcl_UniCharToLower _ANSI_ARGS_ ((int ch))
EXTERN Tcl_UniChar Tcl_UniCharAtIndex _ANSI_ARGS_ ((CONST char *src, int index))
EXTERN void Tcl_ThreadQueueEvent _ANSI_ARGS_ ((Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position))
EXTERN void Tcl_ThreadAlert _ANSI_ARGS_ ((Tcl_ThreadId threadId))
EXTERN Tcl_Obj* Tcl_SetVar2Ex _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, Tcl_Obj *newValuePtr, int flags))
EXTERN void Tcl_RestoreResult _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_SavedResult *statePtr))
EXTERN int Tcl_ReadChars _ANSI_ARGS_ ((Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag))
EXTERN int Tcl_NumUtfChars _ANSI_ARGS_ ((CONST char *src, int len))
EXTERN void Tcl_ConditionWait _ANSI_ARGS_ ((Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, Tcl_Time *timePtr))
EXTERN void Tcl_ConditionNotify _ANSI_ARGS_ ((Tcl_Condition *condPtr))
EXTERN void Tcl_MutexLock _ANSI_ARGS_ ((Tcl_Mutex *mutexPtr))
EXTERN VOID* Tcl_GetThreadData _ANSI_ARGS_ ((Tcl_ThreadDataKey *keyPtr, int size))
EXTERN int Tcl_GetIndexFromObjStruct _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, CONST VOID *tablePtr, int offset, CONST char *msg, int flags, int *indexPtr))
EXTERN void Tcl_FreeEncoding _ANSI_ARGS_ ((Tcl_Encoding encoding))
EXTERN char* Tcl_ExternalToUtfDString _ANSI_ARGS_ ((Tcl_Encoding encoding, CONST char *src, int srcLen, Tcl_DString *dsPtr))
EXTERN int Tcl_ExternalToUtf _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Encoding encoding, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr))
EXTERN int Tcl_EvalObjEx _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int flags))
EXTERN int Tcl_EvalObjv _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags))
EXTERN int Tcl_EvalEx _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *script, int numBytes, int flags))
EXTERN void Tcl_DiscardResult _ANSI_ARGS_ ((Tcl_SavedResult *statePtr))
EXTERN Tcl_Encoding Tcl_CreateEncoding _ANSI_ARGS_ ((Tcl_EncodingType *typePtr))
EXTERN void Tcl_AppendObjToObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr))
EXTERN void Tcl_SetMainLoop _ANSI_ARGS_ ((Tcl_MainLoopProc *proc))
EXTERN Tcl_Channel Tcl_StackChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan))
EXTERN void Tcl_GetVersion _ANSI_ARGS_ ((int *major, int *minor, int *patchLevel, int *type))
EXTERN void Tcl_PanicVA _ANSI_ARGS_ ((CONST char *format, va_list argList))
EXTERN Tcl_Pid Tcl_WaitPid _ANSI_ARGS_ ((Tcl_Pid pid, int *statPtr, int options))
EXTERN int Tcl_PkgProvide _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version))
EXTERN CONST84_RETURN char* Tcl_PkgPresent _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version, int exact))
EXTERN CONST84_RETURN char* Tcl_ParseVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, CONST84 char **termPtr))
EXTERN void Tcl_AppendStringsToObjVA _ANSI_ARGS_ ((Tcl_Obj *objPtr, va_list argList))
EXTERN void Tcl_AppendResultVA _ANSI_ARGS_ ((Tcl_Interp *interp, va_list argList))
EXTERN int Tcl_DumpActiveMemory _ANSI_ARGS_ ((CONST char *fileName))
EXTERN void Tcl_WrongNumArgs _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], CONST char *message))
EXTERN int Tcl_Write _ANSI_ARGS_ ((Tcl_Channel chan, CONST char *s, int slen))
EXTERN ClientData Tcl_VarTraceInfo2 _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData))
EXTERN ClientData Tcl_VarTraceInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData))
EXTERN int Tcl_UpVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *frameName, CONST char *part1, CONST char *part2, CONST char *localName, int flags))
EXTERN int Tcl_UpVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *frameName, CONST char *varName, CONST char *localName, int flags))
EXTERN void Tcl_UnlinkVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName))
EXTERN int Tcl_Ungets _ANSI_ARGS_ ((Tcl_Channel chan, CONST char *str, int len, int atHead))
EXTERN char* Tcl_TranslateFileName _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_DString *bufferPtr))
EXTERN int Tcl_TraceVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData))
EXTERN int Tcl_TraceVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData))
EXTERN int Tcl_StringMatch _ANSI_ARGS_ ((CONST char *str, CONST char *pattern))
EXTERN void Tcl_StaticPackage _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc))
EXTERN void Tcl_SplitPath _ANSI_ARGS_ ((CONST char *path, int *argcPtr, CONST84 char ***argvPtr))
EXTERN int Tcl_SplitList _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *listStr, int *argcPtr, CONST84 char ***argvPtr))
EXTERN CONST84_RETURN char* Tcl_SignalId _ANSI_ARGS_ ((int sig))
EXTERN CONST84_RETURN char* Tcl_SetVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, CONST char *newValue, int flags))
EXTERN CONST84_RETURN char* Tcl_SetVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, CONST char *newValue, int flags))
EXTERN void Tcl_SetStdChannel _ANSI_ARGS_ ((Tcl_Channel channel, int type))
EXTERN void Tcl_SetObjResult _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *resultObjPtr))
EXTERN void Tcl_SetObjErrorCode _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *errorObjPtr))
EXTERN int Tcl_SetServiceMode _ANSI_ARGS_ ((int mode))
EXTERN void Tcl_SetResult _ANSI_ARGS_ ((Tcl_Interp *interp, char *str, Tcl_FreeProc *freeProc))
EXTERN int Tcl_SetRecursionLimit _ANSI_ARGS_ ((Tcl_Interp *interp, int depth))
EXTERN void Tcl_SetPanicProc _ANSI_ARGS_ ((Tcl_PanicProc *panicProc))
EXTERN int Tcl_SetCommandInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, CONST Tcl_CmdInfo *infoPtr))
EXTERN int Tcl_SetChannelOption _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, CONST char *newValue))
EXTERN void Tcl_SetChannelBufferSize _ANSI_ARGS_ ((Tcl_Channel chan, int sz))
EXTERN void Tcl_SetAssocData _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_InterpDeleteProc *proc, ClientData clientData))
EXTERN int Tcl_SeekOld _ANSI_ARGS_ ((Tcl_Channel chan, int offset, int mode))
EXTERN int Tcl_ScanCountedElement _ANSI_ARGS_ ((CONST char *str, int length, int *flagPtr))
EXTERN int Tcl_ScanElement _ANSI_ARGS_ ((CONST char *str, int *flagPtr))
EXTERN void Tcl_Release _ANSI_ARGS_ ((ClientData clientData))
EXTERN void Tcl_RegExpRange _ANSI_ARGS_ ((Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr))
EXTERN int Tcl_RegExpMatch _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, CONST char *pattern))
EXTERN int Tcl_RegExpExec _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_RegExp regexp, CONST char *str, CONST char *start))
EXTERN void Tcl_RegisterObjType _ANSI_ARGS_ ((Tcl_ObjType *typePtr))
EXTERN int Tcl_RecordAndEvalObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags))
EXTERN int Tcl_RecordAndEval _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmd, int flags))
EXTERN int Tcl_Read _ANSI_ARGS_ ((Tcl_Channel chan, char *bufPtr, int toRead))
EXTERN void Tcl_QueueEvent _ANSI_ARGS_ ((Tcl_Event *evPtr, Tcl_QueuePosition position))
EXTERN int Tcl_PutEnv _ANSI_ARGS_ ((CONST char *string))
EXTERN void Tcl_PrintDouble _ANSI_ARGS_ ((Tcl_Interp *interp, double value, char *dst))
EXTERN void Tcl_Preserve _ANSI_ARGS_ ((ClientData data))
EXTERN Tcl_Channel Tcl_OpenTcpServer _ANSI_ARGS_ ((Tcl_Interp *interp, int port, CONST char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData))
EXTERN Tcl_Channel Tcl_OpenTcpClient _ANSI_ARGS_ ((Tcl_Interp *interp, int port, CONST char *address, CONST char *myaddr, int myport, int async))
EXTERN Tcl_Channel Tcl_OpenFileChannel _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *fileName, CONST char *modeString, int permissions))
EXTERN Tcl_Channel Tcl_OpenCommandChannel _ANSI_ARGS_ ((Tcl_Interp *interp, int argc, CONST84 char **argv, int flags))
EXTERN Tcl_Obj* Tcl_ObjSetVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags))
EXTERN Tcl_Obj* Tcl_ObjGetVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags))
EXTERN void Tcl_NotifyChannel _ANSI_ARGS_ ((Tcl_Channel channel, int mask))
EXTERN Tcl_HashEntry* Tcl_NextHashEntry _ANSI_ARGS_ ((Tcl_HashSearch *searchPtr))
EXTERN Tcl_Channel Tcl_MakeTcpClientChannel _ANSI_ARGS_ ((ClientData tcpSocket))
EXTERN Tcl_Channel Tcl_MakeFileChannel _ANSI_ARGS_ ((ClientData handle, int mode))
EXTERN int Tcl_LinkVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, char *addr, int type))
EXTERN char* Tcl_JoinPath _ANSI_ARGS_ ((int argc, CONST84 char *CONST *argv, Tcl_DString *resultPtr))
EXTERN void Tcl_InitHashTable _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, int keyType))
EXTERN int Tcl_HideCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, CONST char *hiddenCmdToken))
EXTERN int Tcl_GlobalEval _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *command))
EXTERN CONST84_RETURN char* Tcl_GetVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags))
EXTERN CONST84_RETURN char* Tcl_GetVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags))
EXTERN Tcl_Channel Tcl_GetStdChannel _ANSI_ARGS_ ((int type))
EXTERN Tcl_Interp* Tcl_GetSlave _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *slaveName))
EXTERN int Tcl_GetsObj _ANSI_ARGS_ ((Tcl_Channel chan, Tcl_Obj *objPtr))
EXTERN int Tcl_Gets _ANSI_ARGS_ ((Tcl_Channel chan, Tcl_DString *dsPtr))
EXTERN Tcl_PathType Tcl_GetPathType _ANSI_ARGS_ ((CONST char *path))
EXTERN int Tcl_GetOpenFile _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int forWriting, int checkUsage, ClientData *filePtr))
EXTERN int Tcl_GetInterpPath _ANSI_ARGS_ ((Tcl_Interp *askInterp, Tcl_Interp *slaveInterp))
EXTERN int Tcl_GetCommandInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, Tcl_CmdInfo *infoPtr))
EXTERN int Tcl_GetChannelOption _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, Tcl_DString *dsPtr))
EXTERN int Tcl_GetChannelHandle _ANSI_ARGS_ ((Tcl_Channel chan, int direction, ClientData *handlePtr))
EXTERN Tcl_Channel Tcl_GetChannel _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *chanName, int *modePtr))
EXTERN ClientData Tcl_GetAssocData _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_InterpDeleteProc **procPtr))
EXTERN int Tcl_GetAliasObj _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv))
EXTERN int Tcl_GetAlias _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr))
EXTERN Tcl_HashEntry* Tcl_FirstHashEntry _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr))
EXTERN void Tcl_FindExecutable _ANSI_ARGS_ ((CONST char *argv0))
EXTERN int Tcl_ExprObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr))
EXTERN int Tcl_ExprLongObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr))
EXTERN int Tcl_ExprLong _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, long *ptr))
EXTERN int Tcl_ExprDoubleObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr))
EXTERN int Tcl_ExprDouble _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, double *ptr))
EXTERN int Tcl_ExprBooleanObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr))
EXTERN int Tcl_ExprBoolean _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int *ptr))
EXTERN int Tcl_ExposeCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *hiddenCmdToken, CONST char *cmdName))
EXTERN void Tcl_Exit _ANSI_ARGS_ ((int status))
EXTERN void Tcl_EventuallyFree _ANSI_ARGS_ ((ClientData clientData, Tcl_FreeProc *freeProc))
EXTERN int Tcl_EvalFile _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *fileName))
EXTERN CONST84_RETURN char* Tcl_ErrnoMsg _ANSI_ARGS_ ((int err))
EXTERN int Tcl_Eof _ANSI_ARGS_ ((Tcl_Channel chan))
EXTERN void Tcl_DStringSetLength _ANSI_ARGS_ ((Tcl_DString *dsPtr, int length))
EXTERN void Tcl_DStringGetResult _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_DString *dsPtr))
EXTERN void Tcl_DStringEndSublist _ANSI_ARGS_ ((Tcl_DString *dsPtr))
EXTERN char* Tcl_DStringAppendElement _ANSI_ARGS_ ((Tcl_DString *dsPtr, CONST char *string))
EXTERN char* Tcl_DStringAppend _ANSI_ARGS_ ((Tcl_DString *dsPtr, CONST char *str, int length))
EXTERN void Tcl_DoWhenIdle _ANSI_ARGS_ ((Tcl_IdleProc *proc, ClientData clientData))
EXTERN int Tcl_DoOneEvent _ANSI_ARGS_ ((int flags))
EXTERN void Tcl_DeleteTrace _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Trace trace))
EXTERN void Tcl_DeleteTimerHandler _ANSI_ARGS_ ((Tcl_TimerToken token))
EXTERN void Tcl_DetachPids _ANSI_ARGS_ ((int numPids, Tcl_Pid *pidPtr))
EXTERN void Tcl_DeleteHashTable _ANSI_ARGS_ ((Tcl_HashTable *tablePtr))
EXTERN void Tcl_DeleteHashEntry _ANSI_ARGS_ ((Tcl_HashEntry *entryPtr))
EXTERN void Tcl_DeleteEvents _ANSI_ARGS_ ((Tcl_EventDeleteProc *proc, ClientData clientData))
EXTERN int Tcl_DeleteCommandFromToken _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Command command))
EXTERN int Tcl_DeleteCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName))
EXTERN void Tcl_DeleteChannelHandler _ANSI_ARGS_ ((Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData))
EXTERN void Tcl_DeleteAssocData _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name))
EXTERN Tcl_Trace Tcl_CreateTrace _ANSI_ARGS_ ((Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData))
EXTERN Tcl_TimerToken Tcl_CreateTimerHandler _ANSI_ARGS_ ((int milliseconds, Tcl_TimerProc *proc, ClientData clientData))
EXTERN Tcl_Interp* Tcl_CreateSlave _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *slaveName, int isSafe))
EXTERN Tcl_Command Tcl_CreateObjCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc))
EXTERN void Tcl_CreateMathFunc _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData))
EXTERN void Tcl_CreateExitHandler _ANSI_ARGS_ ((Tcl_ExitProc *proc, ClientData clientData))
EXTERN void Tcl_CreateEventSource _ANSI_ARGS_ ((Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData))
EXTERN Tcl_Command Tcl_CreateCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc))
EXTERN void Tcl_CreateCloseHandler _ANSI_ARGS_ ((Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData))
EXTERN void Tcl_CreateChannelHandler _ANSI_ARGS_ ((Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData))
EXTERN Tcl_Channel Tcl_CreateChannel _ANSI_ARGS_ ((Tcl_ChannelType *typePtr, CONST char *chanName, ClientData instanceData, int mask))
EXTERN int Tcl_CreateAliasObj _ANSI_ARGS_ ((Tcl_Interp *slave, CONST char *slaveCmd, Tcl_Interp *target, CONST char *targetCmd, int objc, Tcl_Obj *CONST objv[]))
EXTERN int Tcl_CreateAlias _ANSI_ARGS_ ((Tcl_Interp *slave, CONST char *slaveCmd, Tcl_Interp *target, CONST char *targetCmd, int argc, CONST84 char *CONST *argv))
EXTERN int Tcl_ConvertCountedElement _ANSI_ARGS_ ((CONST char *src, int length, char *dst, int flags))
EXTERN int Tcl_ConvertElement _ANSI_ARGS_ ((CONST char *src, char *dst, int flags))
EXTERN char* Tcl_Concat _ANSI_ARGS_ ((int argc, CONST84 char *CONST *argv))
EXTERN int Tcl_CommandComplete _ANSI_ARGS_ ((CONST char *cmd))
EXTERN int Tcl_Close _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan))
EXTERN void Tcl_CancelIdleCall _ANSI_ARGS_ ((Tcl_IdleProc *idleProc, ClientData clientData))
EXTERN void Tcl_CallWhenDeleted _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData))
EXTERN int Tcl_BadChannelOption _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *optionName, CONST char *optionList))
EXTERN char Tcl_Backslash _ANSI_ARGS_ ((CONST char *src, int *readPtr))
EXTERN int Tcl_AsyncInvoke _ANSI_ARGS_ ((Tcl_Interp *interp, int code))
EXTERN void Tcl_AsyncDelete _ANSI_ARGS_ ((Tcl_AsyncHandler async))
EXTERN Tcl_AsyncHandler Tcl_AsyncCreate _ANSI_ARGS_ ((Tcl_AsyncProc *proc, ClientData clientData))
EXTERN void Tcl_AppendResult _ANSI_ARGS_ (TCL_VARARGS(Tcl_Interp *, interp))
EXTERN void Tcl_AppendElement _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string))
EXTERN void Tcl_AllowExceptions _ANSI_ARGS_ ((Tcl_Interp *interp))
EXTERN void Tcl_AddObjErrorInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *message, int length))
EXTERN void Tcl_AddErrorInfo _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *message))
EXTERN void Tcl_SetLongObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, long longValue))
EXTERN void Tcl_SetListObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, int objc, Tcl_Obj *CONST objv[]))
EXTERN void Tcl_SetIntObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, int intValue))
EXTERN void Tcl_SetDoubleObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, double doubleValue))
EXTERN void Tcl_SetByteArrayObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST unsigned char *bytes, int length))
EXTERN unsigned char* Tcl_SetByteArrayLength _ANSI_ARGS_ ((Tcl_Obj *objPtr, int length))
EXTERN void Tcl_SetBooleanObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, int boolValue))
EXTERN Tcl_Obj* Tcl_NewStringObj _ANSI_ARGS_ ((CONST char *bytes, int length))
EXTERN Tcl_Obj* Tcl_NewObj _ANSI_ARGS_ ((void))
EXTERN Tcl_Obj* Tcl_NewLongObj _ANSI_ARGS_ ((long longValue))
EXTERN Tcl_Obj* Tcl_NewIntObj _ANSI_ARGS_ ((int intValue))
EXTERN Tcl_Obj* Tcl_NewDoubleObj _ANSI_ARGS_ ((double doubleValue))
EXTERN Tcl_Obj* Tcl_NewByteArrayObj _ANSI_ARGS_ ((CONST unsigned char *bytes, int length))
EXTERN Tcl_Obj* Tcl_NewBooleanObj _ANSI_ARGS_ ((int boolValue))
EXTERN int Tcl_ListObjReplace _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *CONST objv[]))
EXTERN int Tcl_ListObjLength _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr))
EXTERN int Tcl_ListObjIndex _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr))
EXTERN int Tcl_ListObjGetElements _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr))
EXTERN int Tcl_ListObjAppendElement _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr))
EXTERN int Tcl_ListObjAppendList _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr))
EXTERN Tcl_ObjType* Tcl_GetObjType _ANSI_ARGS_ ((CONST char *typeName))
EXTERN int Tcl_GetLongFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr))
EXTERN int Tcl_GetIntFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr))
EXTERN int Tcl_GetInt _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int *intPtr))
EXTERN int Tcl_GetIndexFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char **tablePtr, CONST char *msg, int flags, int *indexPtr))
EXTERN int Tcl_GetDoubleFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr))
EXTERN int Tcl_GetDouble _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, double *doublePtr))
EXTERN unsigned char* Tcl_GetByteArrayFromObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, int *lengthPtr))
EXTERN int Tcl_GetBooleanFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr))
EXTERN int Tcl_GetBoolean _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int *boolPtr))
EXTERN Tcl_Obj* Tcl_DuplicateObj _ANSI_ARGS_ ((Tcl_Obj *objPtr))
EXTERN Tcl_Obj* Tcl_DbNewStringObj _ANSI_ARGS_ ((CONST char *bytes, int length, CONST char *file, int line))
EXTERN Tcl_Obj* Tcl_DbNewObj _ANSI_ARGS_ ((CONST char *file, int line))
EXTERN Tcl_Obj* Tcl_DbNewLongObj _ANSI_ARGS_ ((long longValue, CONST char *file, int line))
EXTERN Tcl_Obj* Tcl_DbNewListObj _ANSI_ARGS_ ((int objc, Tcl_Obj *CONST *objv, CONST char *file, int line))
EXTERN Tcl_Obj* Tcl_DbNewDoubleObj _ANSI_ARGS_ ((double doubleValue, CONST char *file, int line))
EXTERN Tcl_Obj* Tcl_DbNewByteArrayObj _ANSI_ARGS_ ((CONST unsigned char *bytes, int length, CONST char *file, int line))
EXTERN Tcl_Obj* Tcl_DbNewBooleanObj _ANSI_ARGS_ ((int boolValue, CONST char *file, int line))
EXTERN void Tcl_DbDecrRefCount _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST char *file, int line))
EXTERN int Tcl_ConvertToType _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_ObjType *typePtr))
EXTERN Tcl_Obj* Tcl_ConcatObj _ANSI_ARGS_ ((int objc, Tcl_Obj *CONST objv[]))
EXTERN void Tcl_AppendToObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST char *bytes, int length))
EXTERN void Tcl_AppendStringsToObj _ANSI_ARGS_ (TCL_VARARGS(Tcl_Obj *, objPtr))
EXTERN int Tcl_AppendAllObjTypes _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
EXTERN void Tcl_Sleep _ANSI_ARGS_ ((int ms))
EXTERN void Tcl_SetTimer _ANSI_ARGS_ ((Tcl_Time *timePtr))
EXTERN void Tcl_DeleteFileHandler _ANSI_ARGS_ ((int fd))
EXTERN void Tcl_CreateFileHandler _ANSI_ARGS_ ((int fd, int mask, Tcl_FileProc *proc, ClientData clientData))
EXTERN char* Tcl_DbCkrealloc _ANSI_ARGS_ ((char *ptr, unsigned int size, CONST char *file, int line))
EXTERN int Tcl_DbCkfree _ANSI_ARGS_ ((char *ptr, CONST char *file, int line))
EXTERN char* Tcl_DbCkalloc _ANSI_ARGS_ ((unsigned int size, CONST char *file, int line))
EXTERN char* Tcl_Realloc _ANSI_ARGS_ ((char *ptr, unsigned int size))
EXTERN void Tcl_Free _ANSI_ARGS_ ((char *ptr))
EXTERN char* Tcl_Alloc _ANSI_ARGS_ ((unsigned int size))
EXTERN void Tcl_Panic _ANSI_ARGS_ (TCL_VARARGS(CONST char *, format))
EXTERN CONST84_RETURN char* Tcl_PkgRequireEx _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr))
EXTERN int Tcl_PkgProvideEx _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, CONST char *version, ClientData clientData))

Variable Documentation
TclStubs* tclStubsPtr

Definition at line 36 of file tclStubLib.c.
Referenced by Tcl_InitStubs().

generic/tclEncoding.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Classes
struct TableEncodingData
struct EscapeSubTable
struct EscapeEncodingData
Defines
#define ENCODING_SINGLEBYTE  0
#define ENCODING_DOUBLEBYTE  1
#define ENCODING_MULTIBYTE  2
#define ENCODING_ESCAPE  3
#define PAGESIZE  (256 * sizeof(unsigned short))
Functions
typedef size_t (LengthProc)
TCL_DECLARE_MUTEX (encodingMutex)
int TclGetEncodingFromObj (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr)
static void FreeEncodingIntRep (Tcl_Obj *objPtr)
static void DupEncodingIntRep (Tcl_Obj *srcPtr, Tcl_Obj *dupPtr)
void TclInitEncodingSubsystem ()
void TclFinalizeEncodingSubsystem ()
CONST char * Tcl_GetDefaultEncodingDir ()
void Tcl_SetDefaultEncodingDir (CONST char *path)
Tcl_Encoding Tcl_GetEncoding (Tcl_Interp *interp, CONST char *name)
void Tcl_FreeEncoding (Tcl_Encoding encoding)
static void FreeEncoding (Tcl_Encoding encoding)
CONST char * Tcl_GetEncodingName (Tcl_Encoding encoding)
void Tcl_GetEncodingNames (Tcl_Interp *interp)
int Tcl_SetSystemEncoding (Tcl_Interp *interp, CONST char *name)
Tcl_Encoding Tcl_CreateEncoding (Tcl_EncodingType *typePtr)
char * Tcl_ExternalToUtfDString (Tcl_Encoding encoding, CONST char *src, int srcLen, Tcl_DString *dstPtr)
int Tcl_ExternalToUtf (Tcl_Interp *interp, Tcl_Encoding encoding, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
char * Tcl_UtfToExternalDString (Tcl_Encoding encoding, CONST char *src, int srcLen, Tcl_DString *dstPtr)
int Tcl_UtfToExternal (Tcl_Interp *interp, Tcl_Encoding encoding, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
void Tcl_FindExecutable (CONST char *argv0)
static Tcl_Encoding LoadEncodingFile (Tcl_Interp *interp, CONST char *name)
static Tcl_Channel OpenEncodingFile (CONST char *dir, CONST char *name)
static Tcl_Encoding LoadTableEncoding (Tcl_Interp *interp, CONST char *name, int type, Tcl_Channel chan)
static Tcl_Encoding LoadEscapeEncoding (CONST char *name, Tcl_Channel chan)
static int BinaryProc (ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
static int UtfIntToUtfExtProc (ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
static int UtfExtToUtfIntProc (ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
static int UtfToUtfProc (ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr, int pureNullMode)
static int UnicodeToUtfProc (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 (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 (ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
static int TableFromUtfProc (ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
static void TableFreeProc (ClientData clientData)
static int EscapeToUtfProc (ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
static int EscapeFromUtfProc (ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
static void EscapeFreeProc (ClientData clientData)
static Encoding * GetTableEncoding (EscapeEncodingData *dataPtr, int state)
static size_t unilen (CONST char *src)
static int TclFindEncodings (CONST char *argv0)
Variables
Encoding
char * tclDefaultEncodingDir = NULL
static int encodingsInitialized = 0
static Tcl_HashTable encodingTable

Define Documentation
#define ENCODING_DOUBLEBYTE  1

Definition at line 134 of file tclEncoding.c.
Referenced by LoadEncodingFile(), and LoadTableEncoding().#define ENCODING_ESCAPE  3

Definition at line 136 of file tclEncoding.c.#define ENCODING_MULTIBYTE  2

Definition at line 135 of file tclEncoding.c.
Referenced by LoadEncodingFile().#define ENCODING_SINGLEBYTE  0

Definition at line 133 of file tclEncoding.c.
Referenced by LoadEncodingFile().#define PAGESIZE  (256 * sizeof(unsigned short))

Referenced by LoadTableEncoding().
Function Documentation
static int BinaryProc (ClientData clientData, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr) [static]

Definition at line 1846 of file tclEncoding.c.
References size_t(), TCL_CONVERT_NOSPACE, TCL_OK, and TCL_UTF_MAX.
Referenced by TclInitEncodingSubsystem().1869 {
1870     int result;
1871 
1872     result = TCL_OK;
1873     dstLen -= TCL_UTF_MAX - 1;
1874     if (dstLen < 0) {
1875   dstLen = 0;
1876     }
1877     if (srcLen > dstLen) {
1878   srcLen = dstLen;
1879   result = TCL_CONVERT_NOSPACE;
1880     }
1881 
1882     *srcReadPtr = srcLen;
1883     *dstWrotePtr = srcLen;
1884     *dstCharsPtr = srcLen;
1885     memcpy((void *) dst, (void *) src, (size_t) srcLen);
1886     return result;
1887 }
static void DupEncodingIntRep (Tcl_Obj * srcPtr, Tcl_Obj * dupPtr) [static]

Definition at line 323 of file tclEncoding.c.
References Tcl_Obj::internalRep, NULL, Tcl_Obj::otherValuePtr, Tcl_GetEncoding(), and VOID.
Referenced by TCL_DECLARE_MUTEX().326 {
327     dupPtr->internalRep.otherValuePtr = (VOID *)
328       Tcl_GetEncoding(NULL, srcPtr->bytes);
329 }
static void EscapeFreeProc (ClientData clientData) [static]

Definition at line 2983 of file tclEncoding.c.
References ckfree, EscapeSubTable::encodingPtr, FreeEncoding(), NULL, EscapeEncodingData::numSubTables, and EscapeEncodingData::subTables.2985 {
2986     EscapeEncodingData *dataPtr;
2987     EscapeSubTable *subTablePtr;
2988     int i;
2989 
2990     dataPtr = (EscapeEncodingData *) clientData;
2991     if (dataPtr == NULL) {
2992   return;
2993     }
2994     subTablePtr = dataPtr->subTables;
2995     for (i = 0; i < dataPtr->numSubTables; i++) {
2996   FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
2997   subTablePtr++;
2998     }
2999     ckfree((char *) dataPtr);
3000 }
static int EscapeFromUtfProc (ClientData clientData, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr) [static]

Definition at line 2779 of file tclEncoding.c.
References CONST, Encoding, TableEncodingData::fallback, EscapeEncodingData::final, EscapeEncodingData::finalLen, TableEncodingData::fromUnicode, GetTableEncoding(), EscapeEncodingData::init, EscapeEncodingData::initLen, EscapeEncodingData::numSubTables, TableEncodingData::prefixBytes, EscapeSubTable::sequence, EscapeSubTable::sequenceLen, size_t(), EscapeEncodingData::subTables, TCL_CONVERT_MULTIBYTE, TCL_CONVERT_NOSPACE, TCL_CONVERT_UNKNOWN, TCL_ENCODING_END, TCL_ENCODING_START, TCL_ENCODING_STOPONERROR, TCL_OK, TCL_UTF_MAX, Tcl_UtfCharComplete(), TclUtfToUniChar, VOID, and word().2806 {
2807     EscapeEncodingData *dataPtr;
2808     Encoding *encodingPtr;
2809     CONST char *srcStart, *srcEnd, *srcClose;
2810     char *dstStart, *dstEnd;
2811     int state, result, numChars;
2812     TableEncodingData *tableDataPtr;
2813     char *tablePrefixBytes;
2814     unsigned short **tableFromUnicode;
2815     
2816     result = TCL_OK;    
2817 
2818     dataPtr = (EscapeEncodingData *) clientData;
2819 
2820     srcStart = src;
2821     srcEnd = src + srcLen;
2822     srcClose = srcEnd;
2823     if ((flags & TCL_ENCODING_END) == 0) {
2824   srcClose -= TCL_UTF_MAX;
2825     }
2826 
2827     dstStart = dst;
2828     dstEnd = dst + dstLen - 1;
2829 
2830     /*
2831      * RFC1468 states that the text starts in ASCII, and switches to Japanese
2832      * characters, and that the text must end in ASCII. [Patch #474358]
2833      */
2834 
2835     if (flags & TCL_ENCODING_START) {
2836   state = 0;
2837   if (dst + dataPtr->initLen > dstEnd) {
2838       *srcReadPtr = 0;
2839       *dstWrotePtr = 0;
2840       return TCL_CONVERT_NOSPACE;
2841   }
2842   memcpy((VOID *) dst, (VOID *) dataPtr->init,
2843     (size_t) dataPtr->initLen);
2844   dst += dataPtr->initLen;
2845     } else {
2846         state = (int) *statePtr;
2847     }
2848 
2849     encodingPtr = GetTableEncoding(dataPtr, state);
2850     tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
2851     tablePrefixBytes = tableDataPtr->prefixBytes;
2852     tableFromUnicode = tableDataPtr->fromUnicode;
2853 
2854     for (numChars = 0; src < srcEnd; numChars++) {
2855   unsigned int len;
2856   int word;
2857   Tcl_UniChar ch;
2858   
2859   if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
2860       /*
2861        * If there is more string to follow, this will ensure that the
2862        * last UTF-8 character in the source buffer hasn't been cut off.
2863        */
2864 
2865       result = TCL_CONVERT_MULTIBYTE;
2866       break;
2867   }
2868   len = TclUtfToUniChar(src, &ch);
2869   word = tableFromUnicode[(ch >> 8)][ch & 0xff];
2870 
2871   if ((word == 0) && (ch != 0)) {
2872       int oldState;
2873       EscapeSubTable *subTablePtr;
2874       
2875       oldState = state;
2876       for (state = 0; state < dataPtr->numSubTables; state++) {
2877     encodingPtr = GetTableEncoding(dataPtr, state);
2878     tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
2879         word = tableDataPtr->fromUnicode[(ch >> 8)][ch & 0xff];
2880     if (word != 0) {
2881         break;
2882     }
2883       }
2884 
2885       if (word == 0) {
2886     state = oldState;
2887     if (flags & TCL_ENCODING_STOPONERROR) {
2888         result = TCL_CONVERT_UNKNOWN;
2889         break;
2890     }
2891     encodingPtr = GetTableEncoding(dataPtr, state);
2892     tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
2893     word = tableDataPtr->fallback;
2894       } 
2895       
2896       tablePrefixBytes = tableDataPtr->prefixBytes;
2897       tableFromUnicode = tableDataPtr->fromUnicode;
2898 
2899       /*
2900        * The state variable has the value of oldState when word is 0.
2901        * In this case, the escape sequense should not be copied to dst 
2902        * because the current character set is not changed.
2903        */
2904       if (state != oldState) {
2905     subTablePtr = &dataPtr->subTables[state];
2906     if ((dst + subTablePtr->sequenceLen) > dstEnd) {
2907         /*
2908          * If there is no space to write the escape sequence, the
2909          * state variable must be changed to the value of oldState
2910          * variable because this escape sequence must be written
2911          * in the next conversion.
2912          */
2913         state = oldState;
2914         result = TCL_CONVERT_NOSPACE;
2915         break;
2916     }
2917     memcpy((VOID *) dst, (VOID *) subTablePtr->sequence,
2918       (size_t) subTablePtr->sequenceLen);
2919     dst += subTablePtr->sequenceLen;
2920       }
2921   }
2922 
2923   if (tablePrefixBytes[(word >> 8)] != 0) {
2924       if (dst + 1 > dstEnd) {
2925     result = TCL_CONVERT_NOSPACE;
2926     break;
2927       }
2928       dst[0] = (char) (word >> 8);
2929       dst[1] = (char) word;
2930       dst += 2;
2931   } else {
2932       if (dst > dstEnd) {
2933     result = TCL_CONVERT_NOSPACE;
2934     break;
2935       }
2936       dst[0] = (char) word;
2937       dst++;
2938   } 
2939   src += len;
2940     }
2941 
2942     if ((result == TCL_OK) && (flags & TCL_ENCODING_END)) {
2943   unsigned int len = dataPtr->subTables[0].sequenceLen;
2944   if (dst + dataPtr->finalLen + (state?len:0) > dstEnd) {
2945       result = TCL_CONVERT_NOSPACE;
2946   } else {
2947       if (state) {
2948     memcpy((VOID *) dst, (VOID *) dataPtr->subTables[0].sequence,
2949       (size_t) len);
2950     dst += len;
2951       }
2952       memcpy((VOID *) dst, (VOID *) dataPtr->final,
2953         (size_t) dataPtr->finalLen);
2954       dst += dataPtr->finalLen;
2955   }
2956     }
2957 
2958     *statePtr = (Tcl_EncodingState) state;
2959     *srcReadPtr = src - srcStart;
2960     *dstWrotePtr = dst - dstStart;
2961     *dstCharsPtr = numChars;
2962     return result;
2963 }
static int EscapeToUtfProc (ClientData clientData, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr) [static]

Definition at line 2569 of file tclEncoding.c.
References CONST, Encoding, EscapeEncodingData::final, EscapeEncodingData::finalLen, EscapeEncodingData::init, EscapeEncodingData::initLen, longest(), memcmp(), NULL, EscapeEncodingData::numSubTables, EscapeEncodingData::prefixBytes, EscapeSubTable::sequence, EscapeSubTable::sequenceLen, EscapeEncodingData::subTables, TCL_CONVERT_MULTIBYTE, TCL_CONVERT_NOSPACE, TCL_CONVERT_SYNTAX, TCL_ENCODING_END, TCL_ENCODING_START, TCL_ENCODING_STOPONERROR, TCL_OK, and TCL_UTF_MAX.2596 {
2597     EscapeEncodingData *dataPtr;
2598     char *prefixBytes, *tablePrefixBytes;
2599     unsigned short **tableToUnicode;
2600     Encoding *encodingPtr;
2601     int state, result, numChars;
2602     CONST char *srcStart, *srcEnd;
2603     char *dstStart, *dstEnd;
2604 
2605     result = TCL_OK;
2606 
2607     tablePrefixBytes = NULL;  /* lint. */
2608     tableToUnicode = NULL;  /* lint. */
2609 
2610     dataPtr = (EscapeEncodingData *) clientData;
2611     prefixBytes = dataPtr->prefixBytes;
2612     encodingPtr = NULL;
2613 
2614     srcStart = src;
2615     srcEnd = src + srcLen;
2616 
2617     dstStart = dst;
2618     dstEnd = dst + dstLen - TCL_UTF_MAX;
2619 
2620     state = (int) *statePtr;
2621     if (flags & TCL_ENCODING_START) {
2622   state = 0;
2623     }
2624 
2625     for (numChars = 0; src < srcEnd; ) {
2626   int byte, hi, lo, ch;
2627 
2628         if (dst > dstEnd) {
2629             result = TCL_CONVERT_NOSPACE;
2630             break;
2631         }
2632   byte = *((unsigned char *) src);
2633   if (prefixBytes[byte]) {
2634       unsigned int left, len, longest;
2635       int checked, i;
2636       EscapeSubTable *subTablePtr;
2637       
2638       /*
2639        * Saw the beginning of an escape sequence. 
2640        */
2641        
2642       left = srcEnd - src;
2643       len = dataPtr->initLen;
2644       longest = len;
2645       checked = 0;
2646       if (len <= left) {
2647     checked++;
2648     if ((len > 0) && 
2649       (memcmp(src, dataPtr->init, len) == 0)) {
2650         /*
2651          * If we see initialization string, skip it, even if we're
2652          * not at the beginning of the buffer. 
2653          */
2654          
2655         src += len;
2656         continue;
2657     }
2658       }
2659       len = dataPtr->finalLen;
2660       if (len > longest) {
2661     longest = len;
2662       }
2663       if (len <= left) {
2664     checked++;
2665     if ((len > 0) && 
2666       (memcmp(src, dataPtr->final, len) == 0)) {
2667         /*
2668          * If we see finalization string, skip it, even if we're
2669          * not at the end of the buffer. 
2670          */
2671          
2672         src += len;
2673         continue;
2674     }
2675       }
2676       subTablePtr = dataPtr->subTables;
2677       for (i = 0; i < dataPtr->numSubTables; i++) {
2678     len = subTablePtr->sequenceLen;
2679     if (len > longest) {
2680         longest = len;
2681     }
2682     if (len <= left) {
2683         checked++;
2684         if ((len > 0) && 
2685           (memcmp(src, subTablePtr->sequence, len) == 0)) {
2686       state = i;
2687       encodingPtr = NULL;
2688       subTablePtr = NULL;
2689       src += len;
2690       break;
2691         }
2692     }
2693     subTablePtr++;
2694       }
2695       if (subTablePtr == NULL) {
2696     /*
2697      * A match was found, the escape sequence was consumed, and
2698      * the state was updated.
2699      */
2700 
2701     continue;
2702       }
2703 
2704       /*
2705        * We have a split-up or unrecognized escape sequence.  If we
2706        * checked all the sequences, then it's a syntax error,
2707        * otherwise we need more bytes to determine a match.
2708        */
2709 
2710       if ((checked == dataPtr->numSubTables + 2)
2711         || (flags & TCL_ENCODING_END)) {
2712     if ((flags & TCL_ENCODING_STOPONERROR) == 0) {
2713         /*
2714          * Skip the unknown escape sequence.
2715          */
2716 
2717         src += longest;
2718         continue;
2719     }
2720     result = TCL_CONVERT_SYNTAX;
2721       } else {
2722     result = TCL_CONVERT_MULTIBYTE;
2723       }
2724       break;
2725   }
2726 
2727   if (encodingPtr == NULL) {
2728       TableEncodingData *tableDataPtr;
2729 
2730       encodingPtr = GetTableEncoding(dataPtr, state);
2731       tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
2732       tablePrefixBytes = tableDataPtr->prefixBytes;
2733       tableToUnicode = tableDataPtr->toUnicode;
2734   }
2735   if (tablePrefixBytes[byte]) {
2736       src++;
2737       if (src >= srcEnd) {
2738     src--;
2739     result = TCL_CONVERT_MULTIBYTE;
2740     break;
2741       }
2742       hi = byte;
2743       lo = *((unsigned char *) src);
2744   } else {
2745       hi = 0;
2746       lo = byte;
2747   }
2748   ch = tableToUnicode[hi][lo];
2749   dst += Tcl_UniCharToUtf(ch, dst);
2750   src++;
2751   numChars++;
2752     }
2753 
2754     *statePtr = (Tcl_EncodingState) state;
2755     *srcReadPtr = src - srcStart;
2756     *dstWrotePtr = dst - dstStart;
2757     *dstCharsPtr = numChars;
2758     return result;
2759 }
static void FreeEncoding (Tcl_Encoding encoding) [static]

Definition at line 569 of file tclEncoding.c.
References ckfree, Encoding, NULL, and Tcl_DeleteHashEntry().
Referenced by EscapeFreeProc(), Tcl_FreeEncoding(), Tcl_SetSystemEncoding(), and TclFinalizeEncodingSubsystem().571 {
572     Encoding *encodingPtr;
573     
574     encodingPtr = (Encoding *) encoding;
575     if (encodingPtr == NULL) {
576   return;
577     }
578     encodingPtr->refCount--;
579     if (encodingPtr->refCount == 0) {
580   if (encodingPtr->freeProc != NULL) {
581       (*encodingPtr->freeProc)(encodingPtr->clientData);
582   }
583   if (encodingPtr->hPtr != NULL) {
584       Tcl_DeleteHashEntry(encodingPtr->hPtr);
585   }
586   ckfree((char *) encodingPtr->name);
587   ckfree((char *) encodingPtr);
588     }
589 }
static void FreeEncodingIntRep (Tcl_Obj * objPtr) [static]

Definition at line 307 of file tclEncoding.c.
References Tcl_FreeEncoding().
Referenced by TCL_DECLARE_MUTEX().309 {
310     Tcl_FreeEncoding((Tcl_Encoding) objPtr->internalRep.otherValuePtr);
311 }
static Encoding* GetTableEncoding (EscapeEncodingData * dataPtr, int state) [static]

Definition at line 3023 of file tclEncoding.c.
References Encoding, EscapeSubTable::encodingPtr, EscapeSubTable::name, NULL, panic, TableToUtfProc(), and Tcl_GetEncoding().
Referenced by EscapeFromUtfProc().3026 {
3027     EscapeSubTable *subTablePtr;
3028     Encoding *encodingPtr;
3029     
3030     subTablePtr = &dataPtr->subTables[state];
3031     encodingPtr = subTablePtr->encodingPtr;
3032     if (encodingPtr == NULL) {
3033   /*
3034    * Now that escape encodings load their sub-encodings first, and
3035    * fail to load if any sub-encodings are missing, this branch should
3036    * never happen.  
3037    */
3038   encodingPtr = (Encoding *) Tcl_GetEncoding(NULL, subTablePtr->name);
3039   if ((encodingPtr == NULL) 
3040     || (encodingPtr->toUtfProc != TableToUtfProc)) {
3041       panic("EscapeToUtfProc: invalid sub table");
3042   }
3043   subTablePtr->encodingPtr = encodingPtr;
3044     }
3045     return encodingPtr;
3046 }
static Tcl_Encoding LoadEncodingFile (Tcl_Interp * interp, CONST char * name) [static]

Definition at line 1290 of file tclEncoding.c.
References ENCODING_DOUBLEBYTE, ENCODING_MULTIBYTE, ENCODING_SINGLEBYTE, LoadEscapeEncoding(), LoadTableEncoding(), NULL, OpenEncodingFile(), Tcl_Close(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, Tcl_Gets(), Tcl_GetString(), Tcl_ListObjGetElements(), Tcl_SetChannelOption(), and TclGetLibraryPath().
Referenced by Tcl_GetEncoding().1294 {
1295     int objc, i, ch;
1296     Tcl_Obj **objv;
1297     Tcl_Obj *pathPtr;
1298     Tcl_Channel chan;
1299     Tcl_Encoding encoding;
1300 
1301     pathPtr = TclGetLibraryPath();
1302     if (pathPtr == NULL) {
1303   goto unknown;
1304     }
1305     objc = 0;
1306     Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
1307 
1308     chan = NULL;
1309     for (i = 0; i < objc; i++) {
1310   chan = OpenEncodingFile(Tcl_GetString(objv[i]), name);
1311   if (chan != NULL) {
1312       break;
1313   }
1314     }
1315 
1316     if (chan == NULL) {
1317   goto unknown;
1318     }
1319 
1320     Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
1321 
1322     while (1) {
1323   Tcl_DString ds;
1324 
1325   Tcl_DStringInit(&ds);
1326   Tcl_Gets(chan, &ds);
1327   ch = Tcl_DStringValue(&ds)[0];
1328   Tcl_DStringFree(&ds);
1329   if (ch != '#') {
1330       break;
1331   }
1332     }
1333 
1334     encoding = NULL;
1335     switch (ch) {
1336   case 'S': {
1337       encoding = LoadTableEncoding(interp, name, ENCODING_SINGLEBYTE,
1338         chan);
1339       break;
1340   }
1341   case 'D': {
1342       encoding = LoadTableEncoding(interp, name, ENCODING_DOUBLEBYTE,
1343         chan);
1344       break;
1345   }
1346   case 'M': {
1347       encoding = LoadTableEncoding(interp, name, ENCODING_MULTIBYTE,
1348         chan);
1349       break;
1350   }
1351   case 'E': {
1352       encoding = LoadEscapeEncoding(name, chan);
1353       break;
1354   }
1355     }
1356     if ((encoding == NULL) && (interp != NULL)) {
1357   Tcl_AppendResult(interp, "invalid encoding file \"", name, "\"", NULL);
1358   if (ch == 'E') {
1359       Tcl_AppendResult(interp, " or missing sub-encoding", NULL);
1360   }
1361     }
1362     Tcl_Close(NULL, chan);
1363     return encoding;
1364 
1365     unknown:
1366     if (interp != NULL) {
1367   Tcl_AppendResult(interp, "unknown encoding \"", name, "\"", NULL);
1368     }
1369     return NULL;
1370 }
static Tcl_Encoding LoadEscapeEncoding (CONST char * name, Tcl_Channel chan) [static]

Definition at line 1724 of file tclEncoding.c.
References ckalloc, ckfree, CONST, Encoding, EscapeSubTable::encodingPtr, EscapeEncodingData::final, EscapeEncodingData::finalLen, EscapeEncodingData::init, init, EscapeEncodingData::initLen, EscapeSubTable::name, NULL, EscapeEncodingData::numSubTables, EscapeEncodingData::prefixBytes, EscapeSubTable::sequence, EscapeSubTable::sequenceLen, size_t(), EscapeEncodingData::subTables, TableToUtfProc(), Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringValue, Tcl_GetEncoding(), Tcl_Gets(), TCL_OK, Tcl_SplitList(), UCHAR, and VOID.
Referenced by LoadEncodingFile().1727 {
1728     int i, missingSubEncoding = 0;
1729     unsigned int size;
1730     Tcl_DString escapeData;
1731     char init[16], final[16];
1732     EscapeEncodingData *dataPtr;
1733     Tcl_EncodingType type;
1734 
1735     init[0] = '\0';
1736     final[0] = '\0';
1737     Tcl_DStringInit(&escapeData);
1738 
1739     while (1) {
1740   int argc;
1741   CONST char **argv;
1742   char *line;
1743   Tcl_DString lineString;
1744   
1745   Tcl_DStringInit(&lineString);
1746   if (Tcl_Gets(chan, &lineString) < 0) {
1747       break;
1748   }
1749   line = Tcl_DStringValue(&lineString);
1750         if (Tcl_SplitList(NULL, line, &argc, &argv) != TCL_OK) {
1751       continue;
1752   }
1753   if (argc >= 2) {
1754       if (strcmp(argv[0], "name") == 0) {
1755     ;
1756       } else if (strcmp(argv[0], "init") == 0) {
1757     strncpy(init, argv[1], sizeof(init));
1758     init[sizeof(init) - 1] = '\0';
1759       } else if (strcmp(argv[0], "final") == 0) {
1760     strncpy(final, argv[1], sizeof(final));
1761     final[sizeof(final) - 1] = '\0';
1762       } else {
1763     EscapeSubTable est;
1764 
1765     strncpy(est.sequence, argv[1], sizeof(est.sequence));
1766     est.sequence[sizeof(est.sequence) - 1] = '\0';
1767     est.sequenceLen = strlen(est.sequence);
1768 
1769     strncpy(est.name, argv[0], sizeof(est.name));
1770     est.name[sizeof(est.name) - 1] = '\0';
1771 
1772     /*
1773      * Load the subencodings first so we're never stuck
1774      * trying to use a half-loaded system encoding to
1775      * open/read a *.enc file.
1776      */
1777 
1778     est.encodingPtr = (Encoding *) Tcl_GetEncoding(NULL, est.name);
1779     if ((est.encodingPtr == NULL) 
1780       || (est.encodingPtr->toUtfProc != TableToUtfProc)) {
1781         missingSubEncoding = 1;
1782     }
1783     Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est));
1784       }
1785   }
1786   ckfree((char *) argv);
1787   Tcl_DStringFree(&lineString);
1788     }
1789     if (missingSubEncoding) {
1790   Tcl_DStringFree(&escapeData);
1791   return NULL;
1792     }
1793 
1794     size = sizeof(EscapeEncodingData)
1795       - sizeof(EscapeSubTable) + Tcl_DStringLength(&escapeData);
1796     dataPtr = (EscapeEncodingData *) ckalloc(size);
1797     dataPtr->initLen = strlen(init);
1798     strcpy(dataPtr->init, init);
1799     dataPtr->finalLen = strlen(final);
1800     strcpy(dataPtr->final, final);
1801     dataPtr->numSubTables = Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
1802     memcpy((VOID *) dataPtr->subTables, (VOID *) Tcl_DStringValue(&escapeData),
1803       (size_t) Tcl_DStringLength(&escapeData));
1804     Tcl_DStringFree(&escapeData);
1805 
1806     memset(dataPtr->prefixBytes, 0, sizeof(dataPtr->prefixBytes));
1807     for (i = 0; i < dataPtr->numSubTables; i++) {
1808   dataPtr->prefixBytes[UCHAR(dataPtr->subTables[i].sequence[0])] = 1;
1809     }
1810     if (dataPtr->init[0] != '\0') {
1811   dataPtr->prefixBytes[UCHAR(dataPtr->init[0])] = 1;
1812     }
1813     if (dataPtr->final[0] != '\0') {
1814   dataPtr->prefixBytes[UCHAR(dataPtr->final[0])] = 1;
1815     }
1816 
1817     type.encodingName = name;
1818     type.toUtfProc  = EscapeToUtfProc;
1819     type.fromUtfProc    = EscapeFromUtfProc;
1820     type.freeProc = EscapeFreeProc;
1821     type.nullSize = 1;
1822     type.clientData = (ClientData) dataPtr;
1823 
1824     return Tcl_CreateEncoding(&type);
1825 }
static Tcl_Encoding LoadTableEncoding (Tcl_Interp * interp, CONST char * name, int type, Tcl_Channel chan) [static]

Definition at line 1443 of file tclEncoding.c.
References ckalloc, ENCODING_DOUBLEBYTE, TableEncodingData::fallback, NULL, PAGESIZE, TableEncodingData::prefixBytes, strtol(), Tcl_DecrRefCount, Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, Tcl_GetObjResult(), Tcl_Gets(), Tcl_GetString(), Tcl_NewObj(), Tcl_ReadChars(), Tcl_ResetResult(), and TableEncodingData::toUnicode.
Referenced by LoadEncodingFile().1448 {
1449     Tcl_DString lineString;
1450     Tcl_Obj *objPtr;
1451     char *line;
1452     int i, hi, lo, numPages, symbol, fallback;
1453     unsigned char used[256];
1454     unsigned int size;
1455     TableEncodingData *dataPtr;
1456     unsigned short *pageMemPtr;
1457     Tcl_EncodingType encType;
1458 
1459     /*
1460      * Speed over memory. Use a full 256 character table to decode hex
1461      * sequences in the encoding files.
1462      */
1463 
1464     static char staticHex[] = {
1465       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*   0 ...  15 */
1466       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*  16 ...  31 */
1467       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*  32 ...  47 */
1468       0,  1,  2,  3,  4,  5,  6, 7, 8, 9, 0, 0, 0, 0, 0, 0, /*  48 ...  63 */
1469       0, 10, 11, 12, 13, 14, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*  64 ...  79 */
1470       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*  80 ...  95 */
1471       0, 10, 11, 12, 13, 14, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, /*  96 ... 111 */
1472       0,  1,  2,  3,  4,  5,  6, 7, 8, 9, 0, 0, 0, 0, 0, 0, /* 112 ... 127 */
1473       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 128 ... 143 */
1474       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 144 ... 159 */
1475       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 160 ... 175 */
1476       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 176 ... 191 */
1477       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 192 ... 207 */
1478       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 208 ... 223 */
1479       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 224 ... 239 */
1480       0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 240 ... 255 */
1481     };
1482 
1483     Tcl_DStringInit(&lineString);
1484     Tcl_Gets(chan, &lineString);
1485     line = Tcl_DStringValue(&lineString);
1486 
1487     fallback = (int) strtol(line, &line, 16);
1488     symbol = (int) strtol(line, &line, 10);
1489     numPages = (int) strtol(line, &line, 10);
1490     Tcl_DStringFree(&lineString);
1491 
1492     if (numPages < 0) {
1493   numPages = 0;
1494     } else if (numPages > 256) {
1495   numPages = 256;
1496     }
1497 
1498     memset(used, 0, sizeof(used));
1499 
1500 #undef PAGESIZE
1501 #define PAGESIZE    (256 * sizeof(unsigned short))
1502 
1503     dataPtr = (TableEncodingData *) ckalloc(sizeof(TableEncodingData));
1504     memset(dataPtr, 0, sizeof(TableEncodingData));
1505 
1506     dataPtr->fallback = fallback;
1507 
1508     /*
1509      * Read the table that maps characters to Unicode.  Performs a single
1510      * malloc to get the memory for the array and all the pages needed by
1511      * the array.
1512      */
1513 
1514     size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
1515     dataPtr->toUnicode = (unsigned short **) ckalloc(size);
1516     memset(dataPtr->toUnicode, 0, size);
1517     pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256);
1518 
1519     if (interp == NULL) {
1520   objPtr = Tcl_NewObj();
1521     } else {
1522   objPtr = Tcl_GetObjResult(interp);
1523     }
1524     for (i = 0; i < numPages; i++) {
1525   int ch;
1526   char *p;
1527 
1528   Tcl_ReadChars(chan, objPtr, 3 + 16 * (16 * 4 + 1), 0);
1529   p = Tcl_GetString(objPtr);
1530   hi = (staticHex[(unsigned int)p[0]] << 4) + staticHex[(unsigned int)p[1]];
1531   dataPtr->toUnicode[hi] = pageMemPtr;
1532   p += 2;
1533   for (lo = 0; lo < 256; lo++) {
1534       if ((lo & 0x0f) == 0) {
1535     p++;
1536       }
1537       ch = (staticHex[(unsigned int)p[0]] << 12) + (staticHex[(unsigned int)p[1]] << 8)
1538     + (staticHex[(unsigned int)p[2]] << 4) + staticHex[(unsigned int)p[3]];
1539       if (ch != 0) {
1540     used[ch >> 8] = 1;
1541       }
1542       *pageMemPtr = (unsigned short) ch;
1543       pageMemPtr++;
1544       p += 4;
1545   }
1546     }
1547     if (interp == NULL) {
1548   Tcl_DecrRefCount(objPtr);
1549     } else {
1550   Tcl_ResetResult(interp);
1551     }
1552   
1553     if (type == ENCODING_DOUBLEBYTE) {
1554   memset(dataPtr->prefixBytes, 1, sizeof(dataPtr->prefixBytes));
1555     } else {
1556   for (hi = 1; hi < 256; hi++) {
1557       if (dataPtr->toUnicode[hi] != NULL) {
1558     dataPtr->prefixBytes[hi] = 1;
1559       }
1560   }
1561     }
1562 
1563     /*
1564      * Invert toUnicode array to produce the fromUnicode array.  Performs a
1565      * single malloc to get the memory for the array and all the pages
1566      * needed by the array.  While reading in the toUnicode array, we
1567      * remembered what pages that would be needed for the fromUnicode array.
1568      */
1569 
1570     if (symbol) {
1571   used[0] = 1;
1572     }
1573     numPages = 0;
1574     for (hi = 0; hi < 256; hi++) {
1575   if (used[hi]) {
1576       numPages++;
1577   }
1578     }
1579     size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
1580     dataPtr->fromUnicode = (unsigned short **) ckalloc(size);
1581     memset(dataPtr->fromUnicode, 0, size);
1582     pageMemPtr = (unsigned short *) (dataPtr->fromUnicode + 256);
1583 
1584     for (hi = 0; hi < 256; hi++) {
1585   if (dataPtr->toUnicode[hi] == NULL) {
1586       dataPtr->toUnicode[hi] = emptyPage;
1587   } else {
1588       for (lo = 0; lo < 256; lo++) {
1589     int ch;
1590 
1591     ch = dataPtr->toUnicode[hi][lo];
1592     if (ch != 0) {
1593         unsigned short *page;
1594         
1595         page = dataPtr->fromUnicode[ch >> 8];
1596         if (page == NULL) {
1597       page = pageMemPtr;
1598       pageMemPtr += 256;
1599       dataPtr->fromUnicode[ch >> 8] = page;
1600         }
1601         page[ch & 0xff] = (unsigned short) ((hi << 8) + lo);
1602     }
1603       }
1604   }
1605     }
1606     if (type == ENCODING_MULTIBYTE) {
1607   /*
1608    * If multibyte encodings don't have a backslash character, define
1609    * one.  Otherwise, on Windows, native file names won't work because
1610    * the backslash in the file name will map to the unknown character
1611    * (question mark) when converting from UTF-8 to external encoding.
1612    */
1613 
1614   if (dataPtr->fromUnicode[0] != NULL) {
1615       if (dataPtr->fromUnicode[0]['\\'] == '\0') {
1616     dataPtr->fromUnicode[0]['\\'] = '\\';
1617       }
1618   }
1619     }
1620     if (symbol) {
1621   unsigned short *page;
1622   
1623   /*
1624    * Make a special symbol encoding that not only maps the symbol
1625    * characters from their Unicode code points down into page 0, but
1626    * also ensure that the characters on page 0 map to themselves.
1627    * This is so that a symbol font can be used to display a simple
1628    * string like "abcd" and have alpha, beta, chi, delta show up,
1629    * rather than have "unknown" chars show up because strictly
1630    * speaking the symbol font doesn't have glyphs for those low ascii
1631    * chars.
1632    */
1633 
1634   page = dataPtr->fromUnicode[0];
1635   if (page == NULL) {
1636       page = pageMemPtr;
1637       dataPtr->fromUnicode[0] = page;
1638   }
1639   for (lo = 0; lo < 256; lo++) {
1640       if (dataPtr->toUnicode[0][lo] != 0) {
1641     page[lo] = (unsigned short) lo;
1642       }
1643   }
1644     }
1645     for (hi = 0; hi < 256; hi++) {
1646   if (dataPtr->fromUnicode[hi] == NULL) {
1647       dataPtr->fromUnicode[hi] = emptyPage;
1648   }
1649     }
1650     /*
1651      * For trailing 'R'everse encoding, see [Patch #689341]
1652      */
1653     Tcl_DStringInit(&lineString);
1654     do {
1655   int len;
1656   /* skip leading empty lines */
1657   while ((len = Tcl_Gets(chan, &lineString)) == 0)
1658       ;
1659   if (len < 0) {
1660       break;
1661   }
1662   line = Tcl_DStringValue(&lineString);
1663   if (line[0] != 'R') {
1664       break;
1665   }
1666   for (Tcl_DStringSetLength(&lineString, 0);
1667        (len = Tcl_Gets(chan, &lineString)) >= 0;
1668        Tcl_DStringSetLength(&lineString, 0)) {
1669       unsigned char* p;
1670       int to, from;
1671       if (len < 5) {
1672     continue;
1673       }
1674       p = (unsigned char*) Tcl_DStringValue(&lineString);
1675       to = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8)
1676     + (staticHex[p[2]] << 4) + staticHex[p[3]];
1677       if (to == 0) {
1678         continue;
1679       }
1680       for (p += 5, len -= 5; len >= 0 && *p; p += 5, len -= 5) {
1681     from = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8)
1682       + (staticHex[p[2]] << 4) + staticHex[p[3]];
1683         if (from == 0) {
1684         continue;
1685     }
1686     dataPtr->fromUnicode[from >> 8][from & 0xff] = to;
1687       }
1688   }
1689     } while (0);
1690     Tcl_DStringFree(&lineString);
1691 
1692     encType.encodingName    = name;
1693     encType.toUtfProc     = TableToUtfProc;
1694     encType.fromUtfProc     = TableFromUtfProc;
1695     encType.freeProc      = TableFreeProc;
1696     encType.nullSize      = (type == ENCODING_DOUBLEBYTE) ? 2 : 1;
1697     encType.clientData      = (ClientData) dataPtr;
1698     return Tcl_CreateEncoding(&encType);
1699 }
static Tcl_Channel OpenEncodingFile (CONST char * dir, CONST char * name) [static]

Definition at line 1390 of file tclEncoding.c.
References CONST, NULL, Tcl_DecrRefCount, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_FSOpenFileChannel(), Tcl_IncrRefCount, Tcl_JoinPath(), and Tcl_NewStringObj().
Referenced by LoadEncodingFile().1394 {
1395     CONST char *argv[3];
1396     Tcl_DString pathString;
1397     CONST char *path;
1398     Tcl_Channel chan;
1399     Tcl_Obj *pathPtr;
1400     
1401     argv[0] = dir;
1402     argv[1] = "encoding";
1403     argv[2] = name;
1404 
1405     Tcl_DStringInit(&pathString);
1406     Tcl_JoinPath(3, argv, &pathString);
1407     path = Tcl_DStringAppend(&pathString, ".enc", -1);
1408     pathPtr = Tcl_NewStringObj(path,-1);
1409 
1410     Tcl_IncrRefCount(pathPtr);
1411     chan = Tcl_FSOpenFileChannel(NULL, pathPtr, "r", 0);
1412     Tcl_DecrRefCount(pathPtr);
1413 
1414     Tcl_DStringFree(&pathString);
1415 
1416     return chan;
1417 }
typedef size_t (LengthProc)

Definition at line 17 of file tclEncoding.c.
Referenced by AliasObjCmd(), AppendUnicodeToUnicodeRep(), AppendUtfToUtfRep(), BinaryProc(), BroadcastValue(), CallTraceProcedure(), cbrdissect(), cclass(), compact(), compile(), CompileRegexp(), ConsoleInputProc(), ConsoleOutputProc(), CopyAndTranslateBuffer(), CopyBuffer(), CopyFile(), CreateSocketAddress(), DoRenameFile(), DoWrite(), DupByteArrayInternalRep(), DupStringInternalRep(), element(), EnterCmdStartData(), EscapeFromUtfProc(), exec(), ExpandLocalLiteralArray(), FileInputProc(), FileOutputProc(), FillUnicodeRep(), FilterInputBytes(), freecm(), freecolor(), GetLexeme(), GetPathType(), getSortedHashKeys(), GrowEvaluationStack(), LoadEscapeEncoding(), moresubs(), NativeCreateNativeRep(), newcolor(), newcvec(), newdfa(), ParseCondExpr(), ParsePrimaryExpr(), parseqatom(), ParseSearchId(), PipeInputProc(), PipeOutputProc(), PrependSubExprTokens(), ReadChars(), regcomp(), regexec(), RegExpExecUniChar(), ReplaceString(), ResultAdd(), ResultCopy(), SerialGetOptionProc(), SerialOutputProc(), SerialSetOptionProc(), SetArraySearchObj(), SetBooleanFromAny(), SetEndOffsetFromAny(), SetListFromAny(), StdIOInput(), StdIOOutput(), subset(), Tcl_AttemptSetObjLength(), Tcl_BackgroundError(), Tcl_BinaryObjCmd(), Tcl_Concat(), TCL_DECLARE_MUTEX(), Tcl_DStringAppend(), Tcl_DStringAppendElement(), Tcl_DStringSetLength(), Tcl_EvalTokensStandard(), Tcl_FormatObjCmd(), Tcl_FSGetTranslatedStringPath(), Tcl_FSRemoveDirectory(), Tcl_GetBoolean(), Tcl_GetChannelOption(), Tcl_GetsObj(), Tcl_GetThreadData(), Tcl_IsChannelExisting(), Tcl_LappendObjCmd(), Tcl_ListObjAppendElement(), Tcl_ListObjReplace(), Tcl_LsearchObjCmd(), Tcl_MacConvertTextResource(), Tcl_NewUnicodeObj(), Tcl_ParseVarName(), Tcl_PutsObjCmd(), Tcl_RegExpRange(), Tcl_ScanObjCmd(), Tcl_SetByteArrayLength(), Tcl_SetByteArrayObj(), Tcl_SetChannelOption(), Tcl_SetObjLength(), Tcl_SetUnicodeObj(), Tcl_SplitList(), Tcl_SplitPath(), Tcl_StringObjCmd(), Tcl_UtfToLower(), Tcl_UtfToTitle(), Tcl_UtfToUpper(), TclAllocateFreeObjects(), TclCompileStringCmd(), TclCreateAuxData(), TclCreateExceptRange(), TclCreateExecEnv(), TclCreateProc(), TclExecuteByteCode(), TclExpandCodeArray(), TclExpandJumpFixupArray(), TclExpandTokenArray(), TclFindCompiledLocal(), TclInitByteCodeObj(), TclMacUnRegisterResourceFork(), TclNativeDupInternalRep(), TclParseBackslash(), TclpCreateProcess(), TclpFindVariable(), TclpGetTZName(), TclpThreadCreate(), TclRegError(), TclRegExpRangeUniChar(), TclResetShadowedCmdRefs(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), TclUnsetEnv(), TcpGetOptionProc(), TcpInputProc(), TcpOutputProc(), TestChannelCmd(), TestsetplatformCmd(), TraceVarProc(), TranslateInputEOL(), UpdateStringOfByteArray(), WriteChars(), and zapsubs().24                         {
25     char *name;     /* Name of encoding.  Malloced because (1)
26          * hash table entry that owns this encoding
27          * may be freed prior to this encoding being
28          * freed, (2) string passed in the
29          * Tcl_EncodingType structure may not be
30          * persistent. */
31     Tcl_EncodingConvertProc *toUtfProc;
32         /* Procedure to convert from external
33          * encoding into UTF-8. */
34     Tcl_EncodingConvertProc *fromUtfProc;
35         /* Procedure to convert from UTF-8 into
36          * external encoding. */
37     Tcl_EncodingFreeProc *freeProc;
38         /* If non-NULL, procedure to call when this
39          * encoding is deleted. */
40     int nullSize;   /* Number of 0x00 bytes that signify
41          * end-of-string in this encoding.  This
42          * number is used to determine the source
43          * string length when the srcLen argument is
44          * negative.  This number can be 1 or 2. */
45     ClientData clientData;  /* Arbitrary value associated with encoding
46          * type.  Passed to conversion procedures. */
47     LengthProc *lengthProc; /* Function to compute length of
48          * null-terminated strings in this encoding.
49          * If nullSize is 1, this is strlen; if
50          * nullSize is 2, this is a function that
51          * returns the number of bytes in a 0x0000
52          * terminated string. */
53     int refCount;   /* Number of uses of this structure. */
54     Tcl_HashEntry *hPtr;  /* Hash table entry that owns this encoding. */
55 } Encoding;
static void TableFreeProc (ClientData clientData) [static]

Definition at line 2535 of file tclEncoding.c.
References ckfree, TableEncodingData::fromUnicode, and TableEncodingData::toUnicode.2538 {
2539     TableEncodingData *dataPtr;
2540 
2541     /*
2542      * Make sure we aren't freeing twice on shutdown.  [Bug #219314]
2543      */
2544 
2545     dataPtr = (TableEncodingData *) clientData;
2546     ckfree((char *) dataPtr->toUnicode);
2547     ckfree((char *) dataPtr->fromUnicode);
2548     ckfree((char *) dataPtr);
2549 }
static int TableFromUtfProc (ClientData clientData, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr) [static]

Definition at line 2412 of file tclEncoding.c.
References CONST, TableEncodingData::fallback, TableEncodingData::fromUnicode, TableEncodingData::prefixBytes, TCL_CONVERT_MULTIBYTE, TCL_CONVERT_NOSPACE, TCL_CONVERT_UNKNOWN, TCL_ENCODING_END, TCL_ENCODING_STOPONERROR, TCL_OK, TCL_UTF_MAX, Tcl_UtfCharComplete(), TclUtfToUniChar, and word().2439 {
2440     CONST char *srcStart, *srcEnd, *srcClose;
2441     char *dstStart, *dstEnd, *prefixBytes;
2442     Tcl_UniChar ch;
2443     int result, len, word, numChars;
2444     TableEncodingData *dataPtr;
2445     unsigned short **fromUnicode;
2446     
2447     result = TCL_OK;    
2448 
2449     dataPtr = (TableEncodingData *) clientData;
2450     prefixBytes = dataPtr->prefixBytes;
2451     fromUnicode = dataPtr->fromUnicode;
2452     
2453     srcStart = src;
2454     srcEnd = src + srcLen;
2455     srcClose = srcEnd;
2456     if ((flags & TCL_ENCODING_END) == 0) {
2457   srcClose -= TCL_UTF_MAX;
2458     }
2459 
2460     dstStart = dst;
2461     dstEnd = dst + dstLen - 1;
2462 
2463     for (numChars = 0; src < srcEnd; numChars++) {
2464   if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
2465       /*
2466        * If there is more string to follow, this will ensure that the
2467        * last UTF-8 character in the source buffer hasn't been cut off.
2468        */
2469 
2470       result = TCL_CONVERT_MULTIBYTE;
2471       break;
2472   }
2473   len = TclUtfToUniChar(src, &ch);
2474 
2475 #if TCL_UTF_MAX > 3
2476   /*
2477    * This prevents a crash condition.  More evaluation is required
2478    * for full support of int Tcl_UniChar. [Bug 1004065]
2479    */
2480   if (ch & 0xffff0000) {
2481       word = 0;
2482   } else
2483 #endif
2484       word = fromUnicode[(ch >> 8)][ch & 0xff];
2485 
2486   if ((word == 0) && (ch != 0)) {
2487       if (flags & TCL_ENCODING_STOPONERROR) {
2488     result = TCL_CONVERT_UNKNOWN;
2489     break;
2490       }
2491       word = dataPtr->fallback; 
2492   }
2493   if (prefixBytes[(word >> 8)] != 0) {
2494       if (dst + 1 > dstEnd) {
2495     result = TCL_CONVERT_NOSPACE;
2496     break;
2497       }
2498       dst[0] = (char) (word >> 8);
2499       dst[1] = (char) word;
2500       dst += 2;
2501   } else {
2502       if (dst > dstEnd) {
2503     result = TCL_CONVERT_NOSPACE;
2504     break;
2505       }
2506       dst[0] = (char) word;
2507       dst++;
2508   } 
2509   src += len;
2510     }
2511     *srcReadPtr = src - srcStart;
2512     *dstWrotePtr = dst - dstStart;
2513     *dstCharsPtr = numChars;
2514     return result;
2515 }
static int TableToUtfProc (ClientData clientData, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr) [static]

Definition at line 2303 of file tclEncoding.c.
References CONST, TableEncodingData::prefixBytes, TCL_CONVERT_MULTIBYTE, TCL_CONVERT_NOSPACE, TCL_CONVERT_SYNTAX, TCL_ENCODING_STOPONERROR, TCL_OK, Tcl_UniCharToUtf(), TCL_UTF_MAX, and TableEncodingData::toUnicode.
Referenced by GetTableEncoding(), and LoadEscapeEncoding().2330 {
2331     CONST char *srcStart, *srcEnd;
2332     char *dstEnd, *dstStart, *prefixBytes;
2333     int result, byte, numChars;
2334     Tcl_UniChar ch;
2335     unsigned short **toUnicode;
2336     unsigned short *pageZero;
2337     TableEncodingData *dataPtr;
2338     
2339     srcStart = src;
2340     srcEnd = src + srcLen;
2341 
2342     dstStart = dst;
2343     dstEnd = dst + dstLen - TCL_UTF_MAX;
2344 
2345     dataPtr = (TableEncodingData *) clientData;
2346     toUnicode = dataPtr->toUnicode;
2347     prefixBytes = dataPtr->prefixBytes;
2348     pageZero = toUnicode[0];
2349 
2350     result = TCL_OK;
2351     for (numChars = 0; src < srcEnd; numChars++) {
2352         if (dst > dstEnd) {
2353             result = TCL_CONVERT_NOSPACE;
2354             break;
2355         }
2356   byte = *((unsigned char *) src);
2357   if (prefixBytes[byte]) {
2358       src++;
2359       if (src >= srcEnd) {
2360     src--;
2361     result = TCL_CONVERT_MULTIBYTE;
2362     break;
2363       }
2364       ch = toUnicode[byte][*((unsigned char *) src)];
2365   } else {
2366       ch = pageZero[byte];
2367   }
2368   if ((ch == 0) && (byte != 0)) {
2369       if (flags & TCL_ENCODING_STOPONERROR) {
2370     result = TCL_CONVERT_SYNTAX;
2371     break;
2372       }
2373       if (prefixBytes[byte]) {
2374     src--;
2375       }
2376       ch = (Tcl_UniChar) byte;
2377   }
2378   /*
2379    * Special case for 1-byte utf chars for speed.
2380    */
2381   if (ch && ch < 0x80) {
2382       *dst++ = (char) ch;
2383   } else {
2384       dst += Tcl_UniCharToUtf(ch, dst);
2385   }
2386         src++;
2387     }
2388     *srcReadPtr = src - srcStart;
2389     *dstWrotePtr = dst - dstStart;
2390     *dstCharsPtr = numChars;
2391     return result;
2392 }
Tcl_Encoding Tcl_CreateEncoding (Tcl_EncodingType * typePtr)

Definition at line 820 of file tclEncoding.c.
References ckalloc, Encoding, encodingTable, NULL, Tcl_CreateHashEntry, Tcl_GetHashValue, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_SetHashValue, and unilen().
Referenced by TclInitEncodingSubsystem(), and TestencodingObjCmd().822 {
823     Tcl_HashEntry *hPtr;
824     int new;
825     Encoding *encodingPtr;
826     char *name;
827 
828     Tcl_MutexLock(&encodingMutex);
829     hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &new);
830     if (new == 0) {
831   /*
832    * Remove old encoding from hash table, but don't delete it until
833    * last reference goes away.
834    */
835    
836   encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
837   encodingPtr->hPtr = NULL;
838     }
839 
840     name = ckalloc((unsigned) strlen(typePtr->encodingName) + 1);
841     
842     encodingPtr = (Encoding *) ckalloc(sizeof(Encoding));
843     encodingPtr->name   = strcpy(name, typePtr->encodingName);
844     encodingPtr->toUtfProc  = typePtr->toUtfProc;
845     encodingPtr->fromUtfProc  = typePtr->fromUtfProc;
846     encodingPtr->freeProc = typePtr->freeProc;
847     encodingPtr->nullSize = typePtr->nullSize;
848     encodingPtr->clientData = typePtr->clientData;
849     if (typePtr->nullSize == 1) {
850   encodingPtr->lengthProc = (LengthProc *) strlen;
851     } else {
852   encodingPtr->lengthProc = (LengthProc *) unilen;
853     }
854     encodingPtr->refCount = 1;
855     encodingPtr->hPtr   = hPtr;
856     Tcl_SetHashValue(hPtr, encodingPtr);
857 
858     Tcl_MutexUnlock(&encodingMutex);
859 
860     return (Tcl_Encoding) encodingPtr;
861 }
TCL_DECLARE_MUTEX (encodingMutex)

Definition at line 154 of file tclEncoding.c.
References DupEncodingIntRep(), FreeEncodingIntRep(), and NULL.251                                   {
252     "encoding", FreeEncodingIntRep, DupEncodingIntRep, NULL, NULL
253 };
int Tcl_ExternalToUtf (Tcl_Interp * interp, Tcl_Encoding encoding, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr)

Definition at line 954 of file tclEncoding.c.
References Encoding, NULL, TCL_ENCODING_END, and TCL_ENCODING_START.
Referenced by FilterInputBytes(), ReadChars(), TCL_DECLARE_MUTEX(), Tcl_GetsObj(), and TclpGetTZName().983 {
984     Encoding *encodingPtr;
985     int result, srcRead, dstWrote, dstChars;
986     Tcl_EncodingState state;
987     
988     if (encoding == NULL) {
989   encoding = systemEncoding;
990     }
991     encodingPtr = (Encoding *) encoding;
992 
993     if (src == NULL) {
994   srcLen = 0;
995     } else if (srcLen < 0) {
996   srcLen = (*encodingPtr->lengthProc)(src);
997     }
998     if (statePtr == NULL) {
999   flags |= TCL_ENCODING_START | TCL_ENCODING_END;
1000   statePtr = &state;
1001     }
1002     if (srcReadPtr == NULL) {
1003   srcReadPtr = &srcRead;
1004     }
1005     if (dstWrotePtr == NULL) {
1006   dstWrotePtr = &dstWrote;
1007     }
1008     if (dstCharsPtr == NULL) {
1009   dstCharsPtr = &dstChars;
1010     }
1011 
1012     /*
1013      * If there are any null characters in the middle of the buffer, they will
1014      * converted to the UTF-8 null character (\xC080).  To get the actual 
1015      * \0 at the end of the destination buffer, we need to append it manually.
1016      */
1017 
1018     dstLen--;
1019     result = (*encodingPtr->toUtfProc)(encodingPtr->clientData, src, srcLen,
1020       flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
1021       dstCharsPtr);
1022     dst[*dstWrotePtr] = '\0';
1023     return result;
1024 }
char* Tcl_ExternalToUtfDString (Tcl_Encoding encoding, CONST char * src, int srcLen, Tcl_DString * dstPtr)

Definition at line 885 of file tclEncoding.c.
References Encoding, NULL, Tcl_DString::spaceAvl, TCL_CONVERT_NOSPACE, Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringSetLength(), Tcl_DStringValue, TCL_ENCODING_END, and TCL_ENCODING_START.
Referenced by AppendSystemError(), DoCopyDirectory(), DoRemoveDirectory(), FormatClock(), GetGroupAttribute(), GetOwnerAttribute(), Tcl_EncodingObjCmd(), Tcl_FindExecutable(), Tcl_MacConvertTextResource(), Tcl_Main(), Tcl_PutEnv(), Tcl_ResourceObjCmd(), Tcl_WinTCharToUtf(), TclFindEncodings(), TclGetEnv(), TclpFindExecutable(), TclpFindVariable(), TclpGetCwd(), TclpGetUserHome(), TclpInitLibraryPath(), TclpMatchInDirectory(), TclpNativeToNormalized(), TclpObjListVolumes(), TclpObjNormalizePath(), TclpReadlink(), TclpSetInitialEncodings(), TclpSetVariables(), TclSetEnv(), TcpGetOptionProc(), TraversalCopy(), TraversalDelete(), and TraverseUnixTree().893 {
894     char *dst;
895     Tcl_EncodingState state;
896     Encoding *encodingPtr;
897     int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars;
898 
899     Tcl_DStringInit(dstPtr);
900     dst = Tcl_DStringValue(dstPtr);
901     dstLen = dstPtr->spaceAvl - 1;
902     
903     if (encoding == NULL) {
904   encoding = systemEncoding;
905     }
906     encodingPtr = (Encoding *) encoding;
907 
908     if (src == NULL) {
909   srcLen = 0;
910     } else if (srcLen < 0) {
911   srcLen = (*encodingPtr->lengthProc)(src);
912     }
913     flags = TCL_ENCODING_START | TCL_ENCODING_END;
914     while (1) {
915   result = (*encodingPtr->toUtfProc)(encodingPtr->clientData, src,
916     srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
917     &dstChars);
918   soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
919   if (result != TCL_CONVERT_NOSPACE) {
920       Tcl_DStringSetLength(dstPtr, soFar);
921       return Tcl_DStringValue(dstPtr);
922   }
923   flags &= ~TCL_ENCODING_START;
924   src += srcRead;
925   srcLen -= srcRead;
926   if (Tcl_DStringLength(dstPtr) == 0) {
927       Tcl_DStringSetLength(dstPtr, dstLen);
928   }
929   Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1);
930   dst = Tcl_DStringValue(dstPtr) + soFar;
931   dstLen = Tcl_DStringLength(dstPtr) - soFar - 1;
932     }
933 }
void Tcl_FindExecutable (CONST char * argv0)

Definition at line 1210 of file tclEncoding.c.
References ckalloc, ckfree, CONST, NULL, Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, Tcl_ExternalToUtfDString(), Tcl_UtfToExternalDString(), tclExecutableName, TclFindEncodings(), TclInitSubsystems(), TclpFindExecutable(), and void().
Referenced by Tcl_Main(), and TestfindexecutableCmd().1213 {
1214     int mustCleanUtf;
1215     CONST char *name;
1216     Tcl_DString buffer, nameString;
1217 
1218     TclInitSubsystems(argv0);
1219 
1220     if (argv0 == NULL) {
1221   goto done;
1222     }
1223     if (tclExecutableName != NULL) {
1224   ckfree(tclExecutableName);
1225   tclExecutableName = NULL;
1226     }
1227     if ((name = TclpFindExecutable(argv0)) == NULL) {
1228   goto done;
1229     }
1230 
1231     /*
1232      * The value returned from TclpNameOfExecutable is a UTF string that
1233      * is possibly dirty depending on when it was initialized.
1234      * TclFindEncodings will indicate whether we must "clean" the UTF (as
1235      * reported by the underlying system).  To assure that the UTF string
1236      * is a properly encoded native string for this system, convert the
1237      * UTF string to the default native encoding before the default
1238      * encoding is initialized.  Then, convert it back to UTF after the
1239      * system encoding is loaded.
1240      */
1241     
1242     Tcl_UtfToExternalDString(NULL, name, -1, &buffer);
1243     mustCleanUtf = TclFindEncodings(argv0);
1244 
1245     /*
1246      * Now it is OK to convert the native string back to UTF and set
1247      * the value of the tclExecutableName.
1248      */
1249     
1250     if (mustCleanUtf) {
1251   Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&buffer), -1,
1252     &nameString);
1253   tclExecutableName = (char *)
1254       ckalloc((unsigned) (Tcl_DStringLength(&nameString) + 1));
1255   strcpy(tclExecutableName, Tcl_DStringValue(&nameString));
1256 
1257   Tcl_DStringFree(&nameString);
1258     } else {
1259   tclExecutableName = (char *) ckalloc((unsigned) (strlen(name) + 1));
1260   strcpy(tclExecutableName, name);
1261     }
1262     Tcl_DStringFree(&buffer);
1263     return;
1264   
1265     done:
1266     (void) TclFindEncodings(argv0);
1267 }
void Tcl_FreeEncoding (Tcl_Encoding encoding)

Definition at line 542 of file tclEncoding.c.
References FreeEncoding(), Tcl_MutexLock, and Tcl_MutexUnlock.
Referenced by AppendSystemError(), CloseChannel(), FreeEncodingIntRep(), Tcl_EncodingObjCmd(), Tcl_SetChannelOption(), TclpGetTZName(), TclWinEncodingsCleanup(), TclWinResetInterfaceEncodings(), TclWinSetInterfaces(), and TestencodingObjCmd().544 {
545     Tcl_MutexLock(&encodingMutex);
546     FreeEncoding(encoding);
547     Tcl_MutexUnlock(&encodingMutex);
548 }
CONST char* Tcl_GetDefaultEncodingDir ()

Definition at line 445 of file tclEncoding.c.
References tclDefaultEncodingDir.
Referenced by TclpInitLibraryPath().446 {
447     return tclDefaultEncodingDir;
448 }
Tcl_Encoding Tcl_GetEncoding (Tcl_Interp * interp, CONST char * name)

Definition at line 497 of file tclEncoding.c.
References Encoding, encodingTable, LoadEncodingFile(), NULL, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_MutexLock, and Tcl_MutexUnlock.
Referenced by AppendSystemError(), DupEncodingIntRep(), GetTableEncoding(), LoadEscapeEncoding(), Tcl_CreateChannel(), Tcl_EncodingObjCmd(), Tcl_GetsObj(), Tcl_SetChannelOption(), Tcl_SetSystemEncoding(), TclGetEncodingFromObj(), TclInitEncodingSubsystem(), TclpGetTZName(), TclpSetInitialEncodings(), TclWinSetInterfaces(), and TestencodingObjCmd().500 {
501     Tcl_HashEntry *hPtr;
502     Encoding *encodingPtr;
503 
504     Tcl_MutexLock(&encodingMutex);
505     if (name == NULL) {
506   encodingPtr = (Encoding *) systemEncoding;
507   encodingPtr->refCount++;
508   Tcl_MutexUnlock(&encodingMutex);
509   return systemEncoding;
510     }
511 
512     hPtr = Tcl_FindHashEntry(&encodingTable, name);
513     if (hPtr != NULL) {
514   encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
515   encodingPtr->refCount++;
516   Tcl_MutexUnlock(&encodingMutex);
517   return (Tcl_Encoding) encodingPtr;
518     }
519     Tcl_MutexUnlock(&encodingMutex);
520     return LoadEncodingFile(interp, name);
521 }
CONST char* Tcl_GetEncodingName (Tcl_Encoding encoding)

Definition at line 609 of file tclEncoding.c.
References Encoding, and NULL.
Referenced by Tcl_CreateChannel(), Tcl_EncodingObjCmd(), Tcl_GetChannelOption(), and TclpSetInitialEncodings().611 {
612     Encoding *encodingPtr;
613 
614     if (encoding == NULL) {
615   encoding = systemEncoding;
616     }
617     encodingPtr = (Encoding *) encoding;
618     return encodingPtr->name;
619 }
void Tcl_GetEncodingNames (Tcl_Interp * interp)

Definition at line 640 of file tclEncoding.c.
References Encoding, encodingTable, NULL, Tcl_CreateHashEntry, Tcl_DecrRefCount, Tcl_DeleteHashTable(), Tcl_FirstHashEntry(), Tcl_FSJoinToPath(), Tcl_GetHashKey, Tcl_GetHashValue, Tcl_GetObjResult(), Tcl_GetStringFromObj(), TCL_GLOBMODE_TAILS, Tcl_IncrRefCount, Tcl_InitHashTable(), Tcl_ListObjAppendElement(), Tcl_ListObjGetElements(), Tcl_MutexLock, Tcl_MutexUnlock, Tcl_NewStringObj(), Tcl_NextHashEntry(), TCL_OK, Tcl_ResetResult(), TCL_STRING_KEYS, TclGetLibraryPath(), and TclGlob().
Referenced by Tcl_EncodingObjCmd().642 {
643     Tcl_HashSearch search;
644     Tcl_HashEntry *hPtr;
645     Tcl_Obj *pathPtr, *resultPtr;
646     int dummy;
647 
648     Tcl_HashTable table;
649 
650     Tcl_MutexLock(&encodingMutex);
651     Tcl_InitHashTable(&table, TCL_STRING_KEYS);
652     hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
653     while (hPtr != NULL) {
654   Encoding *encodingPtr;
655   
656   encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
657   Tcl_CreateHashEntry(&table, encodingPtr->name, &dummy);
658   hPtr = Tcl_NextHashEntry(&search);
659     }
660     Tcl_MutexUnlock(&encodingMutex);
661 
662     pathPtr = TclGetLibraryPath();
663     if (pathPtr != NULL) {
664   int i, objc;
665   Tcl_Obj **objv;
666   char globArgString[10];
667   Tcl_Obj* encodingObj = Tcl_NewStringObj("encoding",-1);
668   Tcl_IncrRefCount(encodingObj);
669   
670   objc = 0;
671   Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
672 
673   for (i = 0; i < objc; i++) {
674       Tcl_Obj *searchIn;
675       
676       /* 
677        * Construct the path from the element of pathPtr,
678        * joined with 'encoding'.
679        */
680       searchIn = Tcl_FSJoinToPath(objv[i],1,&encodingObj);
681       Tcl_IncrRefCount(searchIn);
682       Tcl_ResetResult(interp);
683 
684       /*
685        * TclGlob() changes the contents of globArgString, which causes
686        * a segfault if we pass in a pointer to non-writeable memory.
687        * TclGlob() puts its results directly into interp.
688        */
689 
690       strcpy(globArgString, "*.enc");
691       /* 
692        * The GLOBMODE_TAILS flag returns just the tail of each file
693        * which is the encoding name with a .enc extension 
694        */
695       if ((TclGlob(interp, globArgString, searchIn, 
696        TCL_GLOBMODE_TAILS, NULL) == TCL_OK)) {
697     int objc2 = 0;
698     Tcl_Obj **objv2;
699     int j;
700 
701     Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp), &objc2,
702       &objv2);
703 
704     for (j = 0; j < objc2; j++) {
705         int length;
706         char *string;
707         string = Tcl_GetStringFromObj(objv2[j], &length);
708         length -= 4;
709         if (length > 0) {
710       string[length] = '\0';
711       Tcl_CreateHashEntry(&table, string, &dummy);
712       string[length] = '.';
713         }
714     }
715       }
716       Tcl_DecrRefCount(searchIn);
717   }
718   Tcl_DecrRefCount(encodingObj);
719     }
720 
721     /*
722      * Clear any values placed in the result by globbing.
723      */
724 
725     Tcl_ResetResult(interp);
726     resultPtr = Tcl_GetObjResult(interp);
727 
728     hPtr = Tcl_FirstHashEntry(&table, &search);
729     while (hPtr != NULL) {
730   Tcl_Obj *strPtr;
731 
732   strPtr = Tcl_NewStringObj(Tcl_GetHashKey(&table, hPtr), -1);
733   Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
734   hPtr = Tcl_NextHashEntry(&search);
735     }
736     Tcl_DeleteHashTable(&table);
737 }
void Tcl_SetDefaultEncodingDir (CONST char * path)

Definition at line 464 of file tclEncoding.c.
References ckalloc, and tclDefaultEncodingDir.466 {
467     tclDefaultEncodingDir = (char *)ckalloc((unsigned) strlen(path) + 1);
468     strcpy(tclDefaultEncodingDir, path);
469 }
int Tcl_SetSystemEncoding (Tcl_Interp * interp, CONST char * name)

Definition at line 764 of file tclEncoding.c.
References Encoding, FreeEncoding(), NULL, TCL_ERROR, Tcl_GetEncoding(), Tcl_MutexLock, Tcl_MutexUnlock, and TCL_OK.
Referenced by Tcl_EncodingObjCmd(), and TclpSetInitialEncodings().768 {
769     Tcl_Encoding encoding;
770     Encoding *encodingPtr;
771 
772     if (name == NULL) {
773   Tcl_MutexLock(&encodingMutex);
774   encoding = defaultEncoding;
775   encodingPtr = (Encoding *) encoding;
776   encodingPtr->refCount++;
777   Tcl_MutexUnlock(&encodingMutex);
778     } else {
779   encoding = Tcl_GetEncoding(interp, name);
780   if (encoding == NULL) {
781       return TCL_ERROR;
782   }
783     }
784 
785     Tcl_MutexLock(&encodingMutex);
786     FreeEncoding(systemEncoding);
787     systemEncoding = encoding;
788     Tcl_MutexUnlock(&encodingMutex);
789 
790     return TCL_OK;
791 }
int Tcl_UtfToExternal (Tcl_Interp * interp, Tcl_Encoding encoding, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr)

Definition at line 1120 of file tclEncoding.c.
References Encoding, NULL, TCL_ENCODING_END, and TCL_ENCODING_START.
Referenced by _fmt(), and WriteChars().1149 {
1150     Encoding *encodingPtr;
1151     int result, srcRead, dstWrote, dstChars;
1152     Tcl_EncodingState state;
1153     
1154     if (encoding == NULL) {
1155   encoding = systemEncoding;
1156     }
1157     encodingPtr = (Encoding *) encoding;
1158 
1159     if (src == NULL) {
1160   srcLen = 0;
1161     } else if (srcLen < 0) {
1162   srcLen = strlen(src);
1163     }
1164     if (statePtr == NULL) {
1165   flags |= TCL_ENCODING_START | TCL_ENCODING_END;
1166   statePtr = &state;
1167     }
1168     if (srcReadPtr == NULL) {
1169   srcReadPtr = &srcRead;
1170     }
1171     if (dstWrotePtr == NULL) {
1172   dstWrotePtr = &dstWrote;
1173     }
1174     if (dstCharsPtr == NULL) {
1175   dstCharsPtr = &dstChars;
1176     }
1177 
1178     dstLen -= encodingPtr->nullSize;
1179     result = (*encodingPtr->fromUtfProc)(encodingPtr->clientData, src, srcLen,
1180       flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
1181       dstCharsPtr);
1182     if (encodingPtr->nullSize == 2) {
1183   dst[*dstWrotePtr + 1] = '\0';
1184     }
1185     dst[*dstWrotePtr] = '\0';
1186     
1187     return result;
1188 }
char* Tcl_UtfToExternalDString (Tcl_Encoding encoding, CONST char * src, int srcLen, Tcl_DString * dstPtr)

Definition at line 1048 of file tclEncoding.c.
References Encoding, NULL, Tcl_DString::spaceAvl, TCL_CONVERT_NOSPACE, Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringSetLength(), Tcl_DStringValue, TCL_ENCODING_END, and TCL_ENCODING_START.
Referenced by CreateSocketAddress(), DoRemoveDirectory(), FormatClock(), NativeCreateNativeRep(), prepareScriptData(), SetGroupAttribute(), SetOwnerAttribute(), Tcl_EncodingObjCmd(), Tcl_FindExecutable(), Tcl_MacEvalResource(), Tcl_MacFindResource(), Tcl_ResourceObjCmd(), Tcl_SourceRCFile(), Tcl_WinUtfToTChar(), TclFindEncodings(), tclOSALoad(), tclOSAStore(), TclpCreateProcess(), TclpCreateTempFile(), TclpDlopen(), TclpFindSymbol(), TclpGetUserHome(), TclpMatchInDirectory(), TclpObjCopyDirectory(), TclpObjNormalizePath(), TclpObjRemoveDirectory(), TclpOpenFile(), TclpReadlink(), TclSetEnv(), TclSockGetPort(), and TclUnsetEnv().1056 {
1057     char *dst;
1058     Tcl_EncodingState state;
1059     Encoding *encodingPtr;
1060     int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars;
1061     
1062     Tcl_DStringInit(dstPtr);
1063     dst = Tcl_DStringValue(dstPtr);
1064     dstLen = dstPtr->spaceAvl - 1;
1065 
1066     if (encoding == NULL) {
1067   encoding = systemEncoding;
1068     }
1069     encodingPtr = (Encoding *) encoding;
1070 
1071     if (src == NULL) {
1072   srcLen = 0;
1073     } else if (srcLen < 0) {
1074   srcLen = strlen(src);
1075     }
1076     flags = TCL_ENCODING_START | TCL_ENCODING_END;
1077     while (1) {
1078   result = (*encodingPtr->fromUtfProc)(encodingPtr->clientData, src,
1079     srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
1080     &dstChars);
1081   soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
1082   if (result != TCL_CONVERT_NOSPACE) {
1083       if (encodingPtr->nullSize == 2) {
1084           Tcl_DStringSetLength(dstPtr, soFar + 1);
1085       }
1086       Tcl_DStringSetLength(dstPtr, soFar);
1087       return Tcl_DStringValue(dstPtr);
1088   }
1089   flags &= ~TCL_ENCODING_START;
1090   src += srcRead;
1091   srcLen -= srcRead;
1092   if (Tcl_DStringLength(dstPtr) == 0) {
1093       Tcl_DStringSetLength(dstPtr, dstLen);
1094   }
1095   Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1);
1096   dst = Tcl_DStringValue(dstPtr) + soFar;
1097   dstLen = Tcl_DStringLength(dstPtr) - soFar - 1;
1098     }
1099 }
void TclFinalizeEncodingSubsystem ()

Definition at line 408 of file tclEncoding.c.
References encodingsInitialized, encodingTable, FreeEncoding(), NULL, Tcl_DeleteHashTable(), Tcl_FirstHashEntry(), Tcl_GetHashValue, Tcl_MutexLock, and Tcl_MutexUnlock.
Referenced by Tcl_Finalize().409 {
410     Tcl_HashSearch search;
411     Tcl_HashEntry *hPtr;
412 
413     Tcl_MutexLock(&encodingMutex);
414     encodingsInitialized  = 0;
415     FreeEncoding(systemEncoding);
416     hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
417     while (hPtr != NULL) {
418   /*
419    * Call FreeEncoding instead of doing it directly to handle refcounts
420    * like escape encodings use.  [Bug #524674]
421    * Make sure to call Tcl_FirstHashEntry repeatedly so that all
422    * encodings are eventually cleaned up.
423    */
424   FreeEncoding((Tcl_Encoding) Tcl_GetHashValue(hPtr));
425   hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
426     }
427     Tcl_DeleteHashTable(&encodingTable);
428     Tcl_MutexUnlock(&encodingMutex);
429 }
static int TclFindEncodings (CONST char * argv0) [static]

Definition at line 3100 of file tclEncoding.c.
References encodingsInitialized, NULL, Tcl_DStringFree(), Tcl_DStringValue, Tcl_ExternalToUtfDString(), Tcl_GetString(), Tcl_NewStringObj(), Tcl_UtfToExternalDString(), TclGetLibraryPath(), TclpFindExecutable(), TclpInitLibraryPath(), TclpInitLock(), TclpInitUnlock(), TclpSetInitialEncodings(), and TclSetLibraryPath().
Referenced by Tcl_FindExecutable().3103 {
3104     int mustCleanUtf = 0;
3105 
3106     if (encodingsInitialized == 0) {
3107   /* 
3108    * Double check inside the mutex.  There may be calls
3109    * back into this routine from some of the procedures below.
3110    */
3111 
3112   TclpInitLock();
3113   if (encodingsInitialized == 0) {
3114       char *native;
3115       Tcl_Obj *pathPtr;
3116       Tcl_DString libPath, buffer;
3117 
3118       /*
3119        * Have to set this bit here to avoid deadlock with the
3120        * routines below us that call into TclInitSubsystems.
3121        */
3122 
3123       encodingsInitialized = 1;
3124 
3125       native = TclpFindExecutable(argv0);
3126       mustCleanUtf = TclpInitLibraryPath(native);
3127 
3128       /*
3129        * The library path was set in the TclpInitLibraryPath routine.
3130        * The string set is a dirty UTF string.  To preserve the value
3131        * convert the UTF string back to native before setting the new
3132        * default encoding.
3133        */
3134 
3135       pathPtr = TclGetLibraryPath();
3136       if ((pathPtr != NULL) && mustCleanUtf) {
3137     Tcl_UtfToExternalDString(NULL, Tcl_GetString(pathPtr), -1,
3138       &libPath);
3139       }
3140 
3141       TclpSetInitialEncodings();
3142 
3143       /*
3144        * Now convert the native string back to UTF.
3145        */
3146 
3147       if ((pathPtr != NULL) && mustCleanUtf) {
3148     Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&libPath), -1,
3149       &buffer);
3150     pathPtr = Tcl_NewStringObj(Tcl_DStringValue(&buffer), -1);
3151     TclSetLibraryPath(pathPtr);
3152 
3153     Tcl_DStringFree(&libPath);
3154     Tcl_DStringFree(&buffer);
3155       }
3156   }
3157   TclpInitUnlock();
3158     }
3159 
3160     return mustCleanUtf;
3161 }
int TclGetEncodingFromObj (Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_Encoding * encodingPtr)

Definition at line 275 of file tclEncoding.c.
References CONST, Tcl_ObjType::freeIntRepProc, Tcl_Obj::internalRep, NULL, Tcl_Obj::otherValuePtr, TCL_ERROR, Tcl_GetEncoding(), Tcl_GetString(), TCL_OK, Tcl_Obj::typePtr, and VOID.
Referenced by Tcl_EncodingObjCmd().279 {
280     CONST char *name = Tcl_GetString(objPtr);
281     if (objPtr->typePtr != &EncodingType) {
282   Tcl_Encoding encoding = Tcl_GetEncoding(interp, name);
283 
284   if (encoding == NULL) {
285       return TCL_ERROR;
286   }
287   if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) {
288       objPtr->typePtr->freeIntRepProc(objPtr);
289   }
290   objPtr->internalRep.otherValuePtr = (VOID *) encoding;
291   objPtr->typePtr = &EncodingType;
292     }
293     *encodingPtr = Tcl_GetEncoding(NULL, name);
294     return TCL_OK;
295 }
void TclInitEncodingSubsystem ()

Definition at line 349 of file tclEncoding.c.
References BinaryProc(), Tcl_EncodingType::clientData, Tcl_EncodingType::encodingName, encodingTable, Tcl_EncodingType::freeProc, Tcl_EncodingType::fromUtfProc, NULL, Tcl_EncodingType::nullSize, Tcl_CreateEncoding(), Tcl_GetEncoding(), Tcl_InitHashTable(), Tcl_MutexLock, Tcl_MutexUnlock, TCL_STRING_KEYS, Tcl_EncodingType::toUtfProc, UnicodeToUtfProc(), UtfExtToUtfIntProc(), UtfIntToUtfExtProc(), and UtfToUnicodeProc().
Referenced by TclInitSubsystems().350 {
351     Tcl_EncodingType type;
352 
353     Tcl_MutexLock(&encodingMutex);
354     Tcl_InitHashTable(&encodingTable, TCL_STRING_KEYS);
355     Tcl_MutexUnlock(&encodingMutex);
356     
357     /*
358      * Create a few initial encodings.  Note that the UTF-8 to UTF-8 
359      * translation is not a no-op, because it will turn a stream of
360      * improperly formed UTF-8 into a properly formed stream.
361      */
362 
363     type.encodingName = "identity";
364     type.toUtfProc  = BinaryProc;
365     type.fromUtfProc  = BinaryProc;
366     type.freeProc = NULL;
367     type.nullSize = 1;
368     type.clientData = NULL;
369 
370     defaultEncoding = Tcl_CreateEncoding(&type);
371     systemEncoding  = Tcl_GetEncoding(NULL, type.encodingName);
372 
373     type.encodingName = "utf-8";
374     type.toUtfProc  = UtfExtToUtfIntProc;
375     type.fromUtfProc  = UtfIntToUtfExtProc;
376     type.freeProc = NULL;
377     type.nullSize = 1;
378     type.clientData = NULL;
379     Tcl_CreateEncoding(&type);
380 
381     type.encodingName   = "unicode";
382     type.toUtfProc  = UnicodeToUtfProc;
383     type.fromUtfProc    = UtfToUnicodeProc;
384     type.freeProc = NULL;
385     type.nullSize = 2;
386     type.clientData = NULL;
387     Tcl_CreateEncoding(&type);
388 }
static int UnicodeToUtfProc (ClientData clientData, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr) [static]

Definition at line 2123 of file tclEncoding.c.
References CONST, TCL_CONVERT_MULTIBYTE, TCL_CONVERT_NOSPACE, TCL_OK, Tcl_UniCharToUtf(), and TCL_UTF_MAX.
Referenced by TclInitEncodingSubsystem().2149 {
2150     CONST char *srcStart, *srcEnd;
2151     char *dstEnd, *dstStart;
2152     int result, numChars;
2153     Tcl_UniChar ch;
2154 
2155     result = TCL_OK;
2156     if ((srcLen % sizeof(Tcl_UniChar)) != 0) {
2157   result = TCL_CONVERT_MULTIBYTE;
2158   srcLen /= sizeof(Tcl_UniChar);
2159   srcLen *= sizeof(Tcl_UniChar);
2160     }
2161 
2162     srcStart = src;
2163     srcEnd = src + srcLen;
2164 
2165     dstStart = dst;
2166     dstEnd = dst + dstLen - TCL_UTF_MAX;
2167 
2168     for (numChars = 0; src < srcEnd; numChars++) {
2169   if (dst > dstEnd) {
2170       result = TCL_CONVERT_NOSPACE;
2171       break;
2172   }
2173   /*
2174    * Special case for 1-byte utf chars for speed.  Make sure we
2175    * work with Tcl_UniChar-size data.
2176    */
2177   ch = *(Tcl_UniChar *)src;
2178   if (ch && ch < 0x80) {
2179       *dst++ = (ch & 0xFF);
2180   } else {
2181       dst += Tcl_UniCharToUtf(ch, dst);
2182   }
2183   src += sizeof(Tcl_UniChar);
2184     }
2185 
2186     *srcReadPtr = src - srcStart;
2187     *dstWrotePtr = dst - dstStart;
2188     *dstCharsPtr = numChars;
2189     return result;
2190 }
static size_t unilen (CONST char * src) [static]

Definition at line 3067 of file tclEncoding.c.
Referenced by Tcl_CreateEncoding().3069 {
3070     unsigned short *p;
3071 
3072     p = (unsigned short *) src;
3073     while (*p != 0x0000) {
3074   p++;
3075     }
3076     return (char *) p - src;
3077 }
static int UtfExtToUtfIntProc (ClientData clientData, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr) [static]

Definition at line 1957 of file tclEncoding.c.
References UtfToUtfProc().
Referenced by TclInitEncodingSubsystem().1983 {
1984     return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
1985       srcReadPtr, dstWrotePtr, dstCharsPtr, 0);
1986 }
static int UtfIntToUtfExtProc (ClientData clientData, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr) [static]

Definition at line 1908 of file tclEncoding.c.
References UtfToUtfProc().
Referenced by TclInitEncodingSubsystem().1934 {
1935     return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
1936       srcReadPtr, dstWrotePtr, dstCharsPtr, 1);
1937 }
static int UtfToUnicodeProc (ClientData clientData, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr) [static]

Definition at line 2209 of file tclEncoding.c.
References CONST, TCL_CONVERT_MULTIBYTE, TCL_CONVERT_NOSPACE, TCL_ENCODING_END, TCL_OK, TCL_UTF_MAX, Tcl_UtfCharComplete(), and TclUtfToUniChar.
Referenced by TclInitEncodingSubsystem().2235 {
2236     CONST char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
2237     int result, numChars;
2238     Tcl_UniChar ch;
2239 
2240     srcStart = src;
2241     srcEnd = src + srcLen;
2242     srcClose = srcEnd;
2243     if ((flags & TCL_ENCODING_END) == 0) {
2244   srcClose -= TCL_UTF_MAX;
2245     }
2246 
2247     dstStart = dst;
2248     dstEnd   = dst + dstLen - sizeof(Tcl_UniChar);
2249 
2250     result = TCL_OK;
2251     for (numChars = 0; src < srcEnd; numChars++) {
2252   if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
2253       /*
2254        * If there is more string to follow, this will ensure that the
2255        * last UTF-8 character in the source buffer hasn't been cut off.
2256        */
2257 
2258       result = TCL_CONVERT_MULTIBYTE;
2259       break;
2260   }
2261   if (dst > dstEnd) {
2262       result = TCL_CONVERT_NOSPACE;
2263       break;
2264         }
2265   src += TclUtfToUniChar(src, &ch);
2266   /*
2267    * Need to handle this in a way that won't cause misalignment
2268    * by casting dst to a Tcl_UniChar. [Bug 1122671]
2269    * XXX: This hard-codes the assumed size of Tcl_UniChar as 2.
2270    */
2271 #ifdef WORDS_BIGENDIAN
2272   *dst++ = (ch >> 8);
2273   *dst++ = (ch & 0xFF);
2274 #else
2275   *dst++ = (ch & 0xFF);
2276   *dst++ = (ch >> 8);
2277 #endif
2278     }
2279     *srcReadPtr = src - srcStart;
2280     *dstWrotePtr = dst - dstStart;
2281     *dstCharsPtr = numChars;
2282     return result;
2283 }
static int UtfToUtfProc (ClientData clientData, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr, int pureNullMode) [static]

Definition at line 2007 of file tclEncoding.c.
References CONST, TCL_CONVERT_MULTIBYTE, TCL_CONVERT_NOSPACE, TCL_ENCODING_END, TCL_OK, Tcl_UniCharToUtf(), TCL_UTF_MAX, Tcl_UtfCharComplete(), Tcl_UtfToUniChar(), and UCHAR.
Referenced by UtfExtToUtfIntProc(), and UtfIntToUtfExtProc().2037 {
2038     CONST char *srcStart, *srcEnd, *srcClose;
2039     char *dstStart, *dstEnd;
2040     int result, numChars;
2041     Tcl_UniChar ch;
2042 
2043     result = TCL_OK;
2044     
2045     srcStart = src;
2046     srcEnd = src + srcLen;
2047     srcClose = srcEnd;
2048     if ((flags & TCL_ENCODING_END) == 0) {
2049   srcClose -= TCL_UTF_MAX;
2050     }
2051 
2052     dstStart = dst;
2053     dstEnd = dst + dstLen - TCL_UTF_MAX;
2054 
2055     for (numChars = 0; src < srcEnd; numChars++) {
2056   if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
2057       /*
2058        * If there is more string to follow, this will ensure that the
2059        * last UTF-8 character in the source buffer hasn't been cut off.
2060        */
2061 
2062       result = TCL_CONVERT_MULTIBYTE;
2063       break;
2064   }
2065   if (dst > dstEnd) {
2066       result = TCL_CONVERT_NOSPACE;
2067       break;
2068   }
2069   if (UCHAR(*src) < 0x80 &&
2070       !(UCHAR(*src) == 0 && pureNullMode == 0)) {
2071       /*
2072        * Copy 7bit chatacters, but skip null-bytes when we are
2073        * in input mode, so that they get converted to 0xc080.
2074        */
2075       *dst++ = *src++;
2076   } else if (pureNullMode == 1 &&
2077        UCHAR(*src) == 0xc0 &&
2078        UCHAR(*(src+1)) == 0x80) {
2079       /* 
2080        * Convert 0xc080 to real nulls when we are in output mode.
2081        */
2082       *dst++ = 0;
2083       src += 2;
2084   } else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
2085       /* Always check before using Tcl_UtfToUniChar. Not doing
2086        * can so cause it run beyond the endof the buffer!  If we
2087        * * happen such an incomplete char its byts are made to *
2088        * represent themselves.
2089        */
2090 
2091       ch = (Tcl_UniChar) *src;
2092       src += 1;
2093       dst += Tcl_UniCharToUtf(ch, dst);
2094   } else {
2095       src += Tcl_UtfToUniChar(src, &ch);
2096       dst += Tcl_UniCharToUtf(ch, dst);
2097   }
2098     }
2099 
2100     *srcReadPtr  = src - srcStart;
2101     *dstWrotePtr = dst - dstStart;
2102     *dstCharsPtr = numChars;
2103     return result;
2104 }

Variable Documentation
Encoding

Definition at line 55 of file tclEncoding.c.
Referenced by EscapeFromUtfProc(), EscapeToUtfProc(), FreeEncoding(), GetTableEncoding(), LoadEscapeEncoding(), Tcl_CreateEncoding(), Tcl_ExternalToUtf(), Tcl_ExternalToUtfDString(), Tcl_GetEncoding(), Tcl_GetEncodingName(), Tcl_GetEncodingNames(), Tcl_SetSystemEncoding(), Tcl_UtfToExternal(), and Tcl_UtfToExternalDString().int encodingsInitialized = 0 [static]

Definition at line 146 of file tclEncoding.c.
Referenced by TclFinalizeEncodingSubsystem(), and TclFindEncodings().Tcl_HashTable encodingTable [static]

Definition at line 153 of file tclEncoding.c.
Referenced by Tcl_CreateEncoding(), Tcl_GetEncoding(), Tcl_GetEncodingNames(), TclFinalizeEncodingSubsystem(), and TclInitEncodingSubsystem().char* tclDefaultEncodingDir = NULL

Definition at line 144 of file tclEncoding.c.
Referenced by Tcl_Finalize(), Tcl_GetDefaultEncodingDir(), Tcl_SetDefaultEncodingDir(), TestgetdefencdirCmd(), and TestsetdefencdirCmd().

generic/tclEnv.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Functions
TCL_DECLARE_MUTEX (envMutex)
void TclSetEnv (CONST char *name, CONST char *value)
int Tcl_PutEnv (CONST char *string)
void TclUnsetEnv (CONST char *name)
CONST char * TclGetEnv (CONST char *name, Tcl_DString *valuePtr)
static char * EnvTraceProc (ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags)
static void ReplaceString (CONST char *oldStr, char *newStr)
void TclFinalizeEnvironment ()

Function Documentation
static char* EnvTraceProc (ClientData clientData, Tcl_Interp * interp, CONST char * name1, CONST char * name2, int flags) [static]

Definition at line 546 of file tclEnv.c.
References CONST, Tcl_DStringFree(), Tcl_GetVar2(), TCL_GLOBAL_ONLY, Tcl_SetVar2(), TCL_TRACE_ARRAY, TCL_TRACE_READS, TCL_TRACE_UNSETS, TCL_TRACE_WRITES, TclGetEnv(), TclSetEnv(), and TclUnsetEnv().554 {
555     /*
556      * For array traces, let TclSetupEnv do all the work.
557      */
558 
559     if (flags & TCL_TRACE_ARRAY) {
560   TclSetupEnv(interp);
561   return NULL;
562     }
563 
564     /*
565      * If name2 is NULL, then return and do nothing.
566      */
567      
568     if (name2 == NULL) {
569   return NULL;
570     }
571 
572     /*
573      * If a value is being set, call TclSetEnv to do all of the work.
574      */
575 
576     if (flags & TCL_TRACE_WRITES) {
577   CONST char *value;
578   
579   value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY);
580   TclSetEnv(name2, value);
581     }
582 
583     /*
584      * If a value is being read, call TclGetEnv to do all of the work.
585      */
586 
587     if (flags & TCL_TRACE_READS) {
588   Tcl_DString valueString;
589   CONST char *value;
590 
591   value = TclGetEnv(name2, &valueString);
592   if (value == NULL) {
593       return "no such variable";
594   }
595   Tcl_SetVar2(interp, name1, name2, value, 0);
596   Tcl_DStringFree(&valueString);
597     }
598 
599     /*
600      * For unset traces, let TclUnsetEnv do all the work.
601      */
602 
603     if (flags & TCL_TRACE_UNSETS) {
604   TclUnsetEnv(name2);
605     }
606     return NULL;
607 }
static void ReplaceString (CONST char * oldStr, char * newStr) [static]

Definition at line 628 of file tclEnv.c.
References ckalloc, ckfree, size_t(), and VOID.
Referenced by TclSetEnv(), and TclUnsetEnv().631 {
632     int i;
633     char **newCache;
634 
635     /*
636      * Check to see if the old value was allocated by Tcl.  If so,
637      * it needs to be deallocated to avoid memory leaks.  Note that this
638      * algorithm is O(n), not O(1).  This will result in n-squared behavior
639      * if lots of environment changes are being made.
640      */
641 
642     for (i = 0; i < cacheSize; i++) {
643   if ((environCache[i] == oldStr) || (environCache[i] == NULL)) {
644       break;
645   }
646     }
647     if (i < cacheSize) {
648   /*
649    * Replace or delete the old value.
650    */
651 
652   if (environCache[i]) {
653       ckfree(environCache[i]);
654   }
655 
656   if (newStr) {
657       environCache[i] = newStr;
658   } else {
659       for (; i < cacheSize-1; i++) {
660     environCache[i] = environCache[i+1];
661       }
662       environCache[cacheSize-1] = NULL;
663   }
664     } else {
665         int allocatedSize = (cacheSize + 5) * sizeof(char *);
666 
667   /*
668    * We need to grow the cache in order to hold the new string.
669    */
670 
671   newCache = (char **) ckalloc((unsigned) allocatedSize);
672         (VOID *) memset(newCache, (int) 0, (size_t) allocatedSize);
673 
674   if (environCache) {
675       memcpy((VOID *) newCache, (VOID *) environCache,
676         (size_t) (cacheSize * sizeof(char*)));
677       ckfree((char *) environCache);
678   }
679   environCache = newCache;
680   environCache[cacheSize] = newStr;
681   environCache[cacheSize+1] = NULL;
682   cacheSize += 5;
683     }
684 }
TCL_DECLARE_MUTEX (envMutex)

Definition at line 21 of file tclEnv.c.50                                                          :
51  */
52 
53 static char *   EnvTraceProc _ANSI_ARGS_((ClientData clientData,
54           Tcl_Interp *interp, CONST char *name1, 
55           CONST char *name2, int flags));
56 static void   ReplaceString _ANSI_ARGS_((CONST char *oldStr,
57           char *newStr));
58 void      TclSetEnv _ANSI_ARGS_((CONST char *name,
59           CONST char *value));
60 void      TclUnsetEnv _ANSI_ARGS_((CONST char *name));
61 
62 #if defined (__CYGWIN__) && defined(__WIN32__)
63 static void   TclCygwinPutenv _ANSI_ARGS_((CONST char *string));
64 #endif
65 
66 /*
67  *----------------------------------------------------------------------
68  *
69  * TclSetupEnv --
70  *
71  *  This procedure is invoked for an interpreter to make environment
72  *  variables accessible from that interpreter via the "env"
73  *  associative array.
74  *
75  * Results:
76  *  None.
77  *
78  * Side effects:
79  *  The interpreter is added to a list of interpreters managed
80  *  by us, so that its view of envariables can be kept consistent
81  *  with the view in other interpreters.  If this is the first
82  *  call to TclSetupEnv, then additional initialization happens,
83  *  such as copying the environment to dynamically-allocated space
84  *  for ease of management.
85  *
86  *----------------------------------------------------------------------
87  */
88 
89 void
90 TclSetupEnv(interp)
91     Tcl_Interp *interp;   /* Interpreter whose "env" array is to be
92          * managed. */
93 {
94     Tcl_DString envString;
95     char *p1, *p2;
96     int i;
97 
98     /*
99      * For MacOS X
100      */
101 #if defined(__APPLE__) && defined(__DYNAMIC__)
102     environ = *_NSGetEnviron();
103 #endif
104 
105     /*
106      * Synchronize the values in the environ array with the contents
107      * of the Tcl "env" variable.  To do this:
108      *    1) Remove the trace that fires when the "env" var is unset.
109      *    2) Unset the "env" variable.
110      *    3) If there are no environ variables, create an empty "env"
111      *       array.  Otherwise populate the array with current values.
112      *    4) Add a trace that synchronizes the "env" array.
113      */
114     
115     Tcl_UntraceVar2(interp, "env", (char *) NULL,
116       TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
117       TCL_TRACE_READS | TCL_TRACE_ARRAY,  EnvTraceProc,
118       (ClientData) NULL);
119     
120     Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY); 
121     
122     if (environ[0] == NULL) {
123   Tcl_Obj *varNamePtr;
124   
125   varNamePtr = Tcl_NewStringObj("env", -1);
126   Tcl_IncrRefCount(varNamePtr);
127   TclArraySet(interp, varNamePtr, NULL);  
128   Tcl_DecrRefCount(varNamePtr);
129     } else {
130   Tcl_MutexLock(&envMutex);
131   for (i = 0; environ[i] != NULL; i++) {
132       p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
133       p2 = strchr(p1, '=');
134       if (p2 == NULL) {
135     /*
136      * This condition seem to happen occasionally under some
137      * versions of Solaris; ignore the entry.
138      */
139     
140     continue;
141       }
142       p2++;
143       p2[-1] = '\0';
144       Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);  
145       Tcl_DStringFree(&envString);
146   }
147   Tcl_MutexUnlock(&envMutex);
148     }
149 
150     Tcl_TraceVar2(interp, "env", (char *) NULL,
151       TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
152       TCL_TRACE_READS | TCL_TRACE_ARRAY,  EnvTraceProc,
153       (ClientData) NULL);
154 }

int Tcl_PutEnv (CONST char * string)

Definition at line 333 of file tclEnv.c.
References CONST, Tcl_DStringFree(), Tcl_ExternalToUtfDString(), and TclSetEnv().336 {
337     Tcl_DString nameString;   
338     CONST char *name;
339     char *value;
340 
341     if (string == NULL) {
342   return 0;
343     }
344 
345     /*
346      * First convert the native string to UTF.  Then separate the
347      * string into name and value parts, and call TclSetEnv to do
348      * all of the real work.
349      */
350 
351     name = Tcl_ExternalToUtfDString(NULL, string, -1, &nameString);
352     value = strchr(name, '=');
353 
354     if ((value != NULL) && (value != name)) {
355   value[0] = '\0';
356   TclSetEnv(name, value+1);
357     }
358 
359     Tcl_DStringFree(&nameString);
360     return 0;
361 }
void TclFinalizeEnvironment ()

Definition at line 705 of file tclEnv.c.
References ckfree.
Referenced by Tcl_Finalize().706 {
707     /*
708      * For now we just deallocate the cache array and none of the environment
709      * strings.  This may leak more memory that strictly necessary, since some
710      * of the strings may no longer be in the environment.  However,
711      * determining which ones are ok to delete is n-squared, and is pretty
712      * unlikely, so we don't bother.
713      */
714 
715     if (environCache) {
716   ckfree((char *) environCache);
717   environCache = NULL;
718   cacheSize    = 0;
719 #ifndef USE_PUTENV
720   environSize  = 0;
721 #endif
722     }
723 }
CONST char* TclGetEnv (CONST char * name, Tcl_DString * valuePtr)

Definition at line 491 of file tclEnv.c.
References CONST, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, Tcl_ExternalToUtfDString(), Tcl_MutexLock, Tcl_MutexUnlock, and TclpFindVariable().
Referenced by DoTildeSubst(), EnvTraceProc(), SetFsPathFromAny(), TclpInitLibraryPath(), and TclpSetVariables().497 {
498     int length, index;
499     CONST char *result;
500 
501     Tcl_MutexLock(&envMutex);
502     index = TclpFindVariable(name, &length);
503     result = NULL;
504     if (index != -1) {
505   Tcl_DString envStr;
506   
507   result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr);
508   result += length;
509   if (*result == '=') {
510       result++;
511       Tcl_DStringInit(valuePtr);
512       Tcl_DStringAppend(valuePtr, result, -1);
513       result = Tcl_DStringValue(valuePtr);
514   } else {
515       result = NULL;
516   }
517   Tcl_DStringFree(&envStr);
518     }
519     Tcl_MutexUnlock(&envMutex);
520     return result;
521 }
void TclSetEnv (CONST char * name, CONST char * value)

Definition at line 178 of file tclEnv.c.
References ckalloc, ckfree, ckrealloc, CONST, putenv, ReplaceString(), Tcl_DStringFree(), Tcl_ExternalToUtfDString(), Tcl_FSMountsChanged(), Tcl_MutexLock, Tcl_MutexUnlock, Tcl_UtfToExternalDString(), TclpFindVariable(), and VOID.
Referenced by EnvTraceProc(), and Tcl_PutEnv().182 {
183     Tcl_DString envString;
184     int index, length, nameLength;
185     char *p, *oldValue;
186     CONST char *p2;
187 
188     /*
189      * Figure out where the entry is going to go.  If the name doesn't
190      * already exist, enlarge the array if necessary to make room.  If the
191      * name exists, free its old entry.
192      */
193 
194     Tcl_MutexLock(&envMutex);
195     index = TclpFindVariable(name, &length);
196 
197     if (index == -1) {
198 #ifndef USE_PUTENV
199   /*
200    * We need to handle the case where the environment may be changed
201    * outside our control.  environSize is only valid if the current
202    * environment is the one we allocated. [Bug 979640]
203    */
204   if ((ourEnviron != environ) || ((length + 2) > environSize)) {
205       char **newEnviron;
206 
207       newEnviron = (char **) ckalloc((unsigned)
208         ((length + 5) * sizeof(char *)));
209       memcpy((VOID *) newEnviron, (VOID *) environ,
210         length*sizeof(char *));
211       if ((environSize != 0) && (ourEnviron != NULL)) {
212     ckfree((char *) ourEnviron);
213       }
214       environ = ourEnviron = newEnviron;
215       environSize = length + 5;
216 #if defined(__APPLE__) && defined(__DYNAMIC__)
217       {
218       char ***e = _NSGetEnviron();
219       *e = environ;
220       }
221 #endif
222   }
223   index = length;
224   environ[index + 1] = NULL;
225 #endif
226   oldValue = NULL;
227   nameLength = strlen(name);
228     } else {
229   CONST char *env;
230 
231   /*
232    * Compare the new value to the existing value.  If they're
233    * the same then quit immediately (e.g. don't rewrite the
234    * value or propagate it to other interpreters).  Otherwise,
235    * when there are N interpreters there will be N! propagations
236    * of the same value among the interpreters.
237    */
238 
239   env = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envString);
240   if (strcmp(value, (env + length + 1)) == 0) {
241       Tcl_DStringFree(&envString);
242       Tcl_MutexUnlock(&envMutex);
243       return;
244   }
245   Tcl_DStringFree(&envString);
246 
247   oldValue = environ[index];
248   nameLength = length;
249     }
250 
251     /*
252      * Create a new entry.  Build a complete UTF string that contains
253      * a "name=value" pattern.  Then convert the string to the native
254      * encoding, and set the environ array value.
255      */
256 
257     p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2));
258     strcpy(p, name);
259     p[nameLength] = '=';
260     strcpy(p+nameLength+1, value);
261     p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);
262 
263     /*
264      * Copy the native string to heap memory.
265      */
266     
267     p = (char *) ckrealloc(p, (unsigned) (strlen(p2) + 1));
268     strcpy(p, p2);
269     Tcl_DStringFree(&envString);
270 
271 #ifdef USE_PUTENV
272     /*
273      * Update the system environment.
274      */
275 
276     putenv(p);
277     index = TclpFindVariable(name, &length);
278 #else
279     environ[index] = p;
280 #endif
281 
282     /*
283      * Watch out for versions of putenv that copy the string (e.g. VC++).
284      * In this case we need to free the string immediately.  Otherwise
285      * update the string in the cache.
286      */
287 
288     if ((index != -1) && (environ[index] == p)) {
289   ReplaceString(oldValue, p);
290 #ifdef HAVE_PUTENV_THAT_COPIES
291     } else {
292   /* This putenv() copies instead of taking ownership */
293   ckfree(p);
294 #endif
295     }
296 
297     Tcl_MutexUnlock(&envMutex);
298     
299     if (!strcmp(name, "HOME")) {
300   /* 
301    * If the user's home directory has changed, we must invalidate
302    * the filesystem cache, because '~' expansions will now be
303    * incorrect.
304    */
305         Tcl_FSMountsChanged(NULL);
306     }
307 }
void TclUnsetEnv (CONST char * name)

Definition at line 384 of file tclEnv.c.
References ckalloc, ckfree, ckrealloc, putenv, ReplaceString(), size_t(), Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_UtfToExternalDString(), TclpFindVariable(), and VOID.
Referenced by EnvTraceProc().386 {
387     char *oldValue;
388     int length;
389     int index;
390 #ifdef USE_PUTENV_FOR_UNSET
391     Tcl_DString envString;
392     char *string;
393 #else
394     char **envPtr;
395 #endif
396 
397     Tcl_MutexLock(&envMutex);
398     index = TclpFindVariable(name, &length);
399 
400     /*
401      * First make sure that the environment variable exists to avoid
402      * doing needless work and to avoid recursion on the unset.
403      */
404 
405     if (index == -1) {
406   Tcl_MutexUnlock(&envMutex);
407   return;
408     }
409     /*
410      * Remember the old value so we can free it if Tcl created the string.
411      */
412 
413     oldValue = environ[index];
414 
415     /*
416      * Update the system environment.  This must be done before we 
417      * update the interpreters or we will recurse.
418      */
419 
420 #ifdef USE_PUTENV_FOR_UNSET
421     /*
422      * For those platforms that support putenv to unset, Linux indicates
423      * that no = should be included, and Windows requires it.
424      */
425 #ifdef WIN32
426     string = ckalloc((unsigned int) length+2);
427     memcpy((VOID *) string, (VOID *) name, (size_t) length);
428     string[length] = '=';
429     string[length+1] = '\0';
430 #else
431     string = ckalloc((unsigned int) length+1);
432     memcpy((VOID *) string, (VOID *) name, (size_t) length);
433     string[length] = '\0';
434 #endif
435 
436     Tcl_UtfToExternalDString(NULL, string, -1, &envString);
437     string = ckrealloc(string, (unsigned) (Tcl_DStringLength(&envString)+1));
438     strcpy(string, Tcl_DStringValue(&envString));
439     Tcl_DStringFree(&envString);
440 
441     putenv(string);
442 
443     /*
444      * Watch out for versions of putenv that copy the string (e.g. VC++).
445      * In this case we need to free the string immediately.  Otherwise
446      * update the string in the cache.
447      */
448 
449     if (environ[index] == string) {
450   ReplaceString(oldValue, string);
451 #ifdef HAVE_PUTENV_THAT_COPIES
452     } else {
453   /* This putenv() copies instead of taking ownership */
454   ckfree(string);
455 #endif
456     }
457 #else
458     for (envPtr = environ+index+1; ; envPtr++) {
459   envPtr[-1] = *envPtr;
460   if (*envPtr == NULL) {
461       break;
462   }
463     }
464     ReplaceString(oldValue, NULL);
465 #endif
466 
467     Tcl_MutexUnlock(&envMutex);
468 }

generic/tclEvent.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Classes
struct BgError
struct ErrAssocData
struct ExitHandler
Functions
TCL_DECLARE_MUTEX (exitMutex)
static void BgErrorDeleteProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp))
static void HandleBgErrors _ANSI_ARGS_ ((ClientData clientData))
static char *VwaitVarProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags))
void Tcl_BackgroundError (Tcl_Interp *interp)
static void HandleBgErrors (ClientData clientData)
static void BgErrorDeleteProc (ClientData clientData, Tcl_Interp *interp)
void Tcl_CreateExitHandler (Tcl_ExitProc *proc, ClientData clientData)
void Tcl_DeleteExitHandler (Tcl_ExitProc *proc, ClientData clientData)
void Tcl_CreateThreadExitHandler (Tcl_ExitProc *proc, ClientData clientData)
void Tcl_DeleteThreadExitHandler (Tcl_ExitProc *proc, ClientData clientData)
void Tcl_Exit (int status)
void TclSetLibraryPath (Tcl_Obj *pathPtr)
Tcl_Obj * TclGetLibraryPath ()
void TclInitSubsystems (CONST char *argv0)
void Tcl_Finalize ()
void Tcl_FinalizeThread ()
int TclInExit ()
int TclInThreadExit ()
int Tcl_VwaitObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static char * VwaitVarProc (ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags)
int Tcl_UpdateObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
int Tcl_CreateThread (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags)
Variables
static ExitHandler * firstExitPtr = NULL
ThreadSpecificData
static Tcl_ThreadDataKey dataKey
static char * tclLibraryPathStr = NULL

Function Documentation
static char* VwaitVarProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags)) [static]
static void HandleBgErrors _ANSI_ARGS_ ((ClientData clientData)) [static]
static void BgErrorDeleteProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp)) [static]
static void BgErrorDeleteProc (ClientData clientData, Tcl_Interp * interp) [static]

Definition at line 382 of file tclEvent.c.
References ckfree, BgError::errorCode, BgError::errorInfo, BgError::errorMsg, ErrAssocData::firstBgPtr, HandleBgErrors(), BgError::nextPtr, NULL, Tcl_CancelIdleCall(), TCL_DYNAMIC, and Tcl_EventuallyFree().
Referenced by Tcl_BackgroundError().385 {
386     ErrAssocData *assocPtr = (ErrAssocData *) clientData;
387     BgError *errPtr;
388 
389     while (assocPtr->firstBgPtr != NULL) {
390   errPtr = assocPtr->firstBgPtr;
391   assocPtr->firstBgPtr = errPtr->nextPtr;
392   ckfree(errPtr->errorMsg);
393   ckfree(errPtr->errorInfo);
394   ckfree(errPtr->errorCode);
395   ckfree((char *) errPtr);
396     }
397     Tcl_CancelIdleCall(HandleBgErrors, (ClientData) assocPtr);
398     Tcl_EventuallyFree((ClientData) assocPtr, TCL_DYNAMIC);
399 }
static void HandleBgErrors (ClientData clientData) [static]

Definition at line 233 of file tclEvent.c.
References ckfree, CONST, BgError::interp, BgError::nextPtr, NULL, Tcl_AllowExceptions(), TCL_BREAK, TCL_ERROR, Tcl_FindCommand(), Tcl_Flush(), Tcl_GetObjResult(), Tcl_GetStdChannel(), Tcl_GetStringFromObj(), TCL_GLOBAL_ONLY, TCL_INVOKE_HIDDEN, Tcl_IsSafe(), Tcl_Preserve(), Tcl_Release(), Tcl_RestoreResult(), Tcl_SaveResult(), Tcl_SetVar(), TCL_STDERR, Tcl_WriteChars(), and TclGlobalInvoke().
Referenced by BgErrorDeleteProc(), and Tcl_BackgroundError().235 {
236     Tcl_Interp *interp;
237     CONST char *argv[2];
238     int code;
239     BgError *errPtr;
240     ErrAssocData *assocPtr = (ErrAssocData *) clientData;
241     Tcl_Channel errChannel;
242 
243     Tcl_Preserve((ClientData) assocPtr);
244     
245     while (assocPtr->firstBgPtr != NULL) {
246   interp = assocPtr->firstBgPtr->interp;
247   if (interp == NULL) {
248       goto doneWithInterp;
249   }
250 
251   /*
252    * Restore important state variables to what they were at
253    * the time the error occurred.
254    */
255 
256   Tcl_SetVar(interp, "errorInfo", assocPtr->firstBgPtr->errorInfo,
257     TCL_GLOBAL_ONLY);
258   Tcl_SetVar(interp, "errorCode", assocPtr->firstBgPtr->errorCode,
259     TCL_GLOBAL_ONLY);
260 
261   /*
262    * Create and invoke the bgerror command.
263    */
264 
265   argv[0] = "bgerror";
266   argv[1] = assocPtr->firstBgPtr->errorMsg;
267   
268   Tcl_AllowExceptions(interp);
269         Tcl_Preserve((ClientData) interp);
270   code = TclGlobalInvoke(interp, 2, argv, 0);
271   if (code == TCL_ERROR) {
272 
273             /*
274              * If the interpreter is safe, we look for a hidden command
275              * named "bgerror" and call that with the error information.
276              * Otherwise, simply ignore the error. The rationale is that
277              * this could be an error caused by a malicious applet trying
278              * to cause an infinite barrage of error messages. The hidden
279              * "bgerror" command can be used by a security policy to
280              * interpose on such attacks and e.g. kill the applet after a
281              * few attempts.
282              */
283 
284             if (Tcl_IsSafe(interp)) {
285     Tcl_SavedResult save;
286     
287     Tcl_SaveResult(interp, &save);
288                 TclGlobalInvoke(interp, 2, argv, TCL_INVOKE_HIDDEN);
289     Tcl_RestoreResult(interp, &save);
290 
291                 goto doneWithInterp;
292             } 
293 
294             /*
295              * We have to get the error output channel at the latest possible
296              * time, because the eval (above) might have changed the channel.
297              */
298             
299             errChannel = Tcl_GetStdChannel(TCL_STDERR);
300             if (errChannel != (Tcl_Channel) NULL) {
301     char *string;
302     int len;
303 
304     string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len);
305     if (Tcl_FindCommand(interp, "bgerror", NULL, TCL_GLOBAL_ONLY) == NULL) {
306                     Tcl_WriteChars(errChannel, assocPtr->firstBgPtr->errorInfo, -1);
307                     Tcl_WriteChars(errChannel, "\n", -1);
308                 } else {
309                     Tcl_WriteChars(errChannel,
310                             "bgerror failed to handle background error.\n",
311                             -1);
312                     Tcl_WriteChars(errChannel, "    Original error: ", -1);
313                     Tcl_WriteChars(errChannel, assocPtr->firstBgPtr->errorMsg,
314                             -1);
315                     Tcl_WriteChars(errChannel, "\n", -1);
316                     Tcl_WriteChars(errChannel, "    Error in bgerror: ", -1);
317                     Tcl_WriteChars(errChannel, string, len);
318                     Tcl_WriteChars(errChannel, "\n", -1);
319                 }
320                 Tcl_Flush(errChannel);
321             }
322   } else if (code == TCL_BREAK) {
323 
324       /*
325        * Break means cancel any remaining error reports for this
326        * interpreter.
327        */
328 
329       for (errPtr = assocPtr->firstBgPtr; errPtr != NULL;
330         errPtr = errPtr->nextPtr) {
331     if (errPtr->interp == interp) {
332         errPtr->interp = NULL;
333     }
334       }
335   }
336 
337   /*
338    * Discard the command and the information about the error report.
339    */
340 
341 doneWithInterp:
342 
343   if (assocPtr->firstBgPtr) {
344       ckfree(assocPtr->firstBgPtr->errorMsg);
345       ckfree(assocPtr->firstBgPtr->errorInfo);
346       ckfree(assocPtr->firstBgPtr->errorCode);
347       errPtr = assocPtr->firstBgPtr->nextPtr;
348       ckfree((char *) assocPtr->firstBgPtr);
349       assocPtr->firstBgPtr = errPtr;
350   }
351         
352         if (interp != NULL) {
353             Tcl_Release((ClientData) interp);
354         }
355     }
356     assocPtr->lastBgPtr = NULL;
357 
358     Tcl_Release((ClientData) assocPtr);
359 }
void Tcl_BackgroundError (Tcl_Interp * interp)

Definition at line 150 of file tclEvent.c.
References BgErrorDeleteProc(), ckalloc, CONST, BgError::errorCode, BgError::errorInfo, BgError::errorMsg, ErrAssocData::firstBgPtr, HandleBgErrors(), BgError::interp, ErrAssocData::lastBgPtr, BgError::nextPtr, NULL, size_t(), Tcl_AddErrorInfo(), Tcl_DoWhenIdle(), Tcl_GetAssocData(), Tcl_GetObjResult(), Tcl_GetStringFromObj(), Tcl_GetVar(), TCL_GLOBAL_ONLY, Tcl_ResetResult(), and Tcl_SetAssocData().
Referenced by AcceptCallbackProc(), AfterProc(), CopyData(), TclChannelEventScriptInvoker(), and TesteventProc().153 {
154     BgError *errPtr;
155     CONST char *errResult, *varValue;
156     ErrAssocData *assocPtr;
157     int length;
158 
159     /*
160      * The Tcl_AddErrorInfo call below (with an empty string) ensures that
161      * errorInfo gets properly set.  It's needed in cases where the error
162      * came from a utility procedure like Tcl_GetVar instead of Tcl_Eval;
163      * in these cases errorInfo still won't have been set when this
164      * procedure is called.
165      */
166 
167     Tcl_AddErrorInfo(interp, "");
168 
169     errResult = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
170   
171     errPtr = (BgError *) ckalloc(sizeof(BgError));
172     errPtr->interp = interp;
173     errPtr->errorMsg = (char *) ckalloc((unsigned) (length + 1));
174     memcpy(errPtr->errorMsg, errResult, (size_t) (length + 1));
175     varValue = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
176     if (varValue == NULL) {
177   varValue = errPtr->errorMsg;
178     }
179     errPtr->errorInfo = (char *) ckalloc((unsigned) (strlen(varValue) + 1));
180     strcpy(errPtr->errorInfo, varValue);
181     varValue = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
182     if (varValue == NULL) {
183   varValue = "";
184     }
185     errPtr->errorCode = (char *) ckalloc((unsigned) (strlen(varValue) + 1));
186     strcpy(errPtr->errorCode, varValue);
187     errPtr->nextPtr = NULL;
188 
189     assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp, "tclBgError",
190       (Tcl_InterpDeleteProc **) NULL);
191     if (assocPtr == NULL) {
192 
193   /*
194    * This is the first time a background error has occurred in
195    * this interpreter.  Create associated data to keep track of
196    * pending error reports.
197    */
198 
199   assocPtr = (ErrAssocData *) ckalloc(sizeof(ErrAssocData));
200   assocPtr->firstBgPtr = NULL;
201   assocPtr->lastBgPtr = NULL;
202   Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc,
203     (ClientData) assocPtr);
204     }
205     if (assocPtr->firstBgPtr == NULL) {
206   assocPtr->firstBgPtr = errPtr;
207   Tcl_DoWhenIdle(HandleBgErrors, (ClientData) assocPtr);
208     } else {
209   assocPtr->lastBgPtr->nextPtr = errPtr;
210     }
211     assocPtr->lastBgPtr = errPtr;
212     Tcl_ResetResult(interp);
213 }
void Tcl_CreateExitHandler (Tcl_ExitProc * proc, ClientData clientData)

Definition at line 420 of file tclEvent.c.
References ckalloc, ExitHandler::clientData, firstExitPtr, ExitHandler::nextPtr, ExitHandler::proc, Tcl_MutexLock, and Tcl_MutexUnlock.
Referenced by ConsoleInit(), Initialize(), InitNotifier(), InitSockets(), SerialInit(), SetTZIfNecessary(), Tcl_AppInit(), TCL_DECLARE_MUTEX(), Tcl_GetTime(), and TestexithandlerCmd().423 {
424     ExitHandler *exitPtr;
425 
426     exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
427     exitPtr->proc = proc;
428     exitPtr->clientData = clientData;
429     Tcl_MutexLock(&exitMutex);
430     exitPtr->nextPtr = firstExitPtr;
431     firstExitPtr = exitPtr;
432     Tcl_MutexUnlock(&exitMutex);
433 }
int Tcl_CreateThread (Tcl_ThreadId * idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags)

Definition at line 1254 of file tclEvent.c.
References Tcl_Alloc(), TCL_ERROR, and TclpThreadCreate().1261 {
1262 #ifdef TCL_THREADS
1263     ThreadClientData *cdPtr;
1264 
1265     cdPtr = (ThreadClientData*)Tcl_Alloc(sizeof(ThreadClientData));
1266     cdPtr->proc = proc;
1267     cdPtr->clientData = clientData;
1268 
1269     return TclpThreadCreate(idPtr, NewThreadProc, (ClientData)cdPtr,
1270                            stackSize, flags);
1271 #else
1272     return TCL_ERROR;
1273 #endif /* TCL_THREADS */
1274 }
void Tcl_CreateThreadExitHandler (Tcl_ExitProc * proc, ClientData clientData)

Definition at line 498 of file tclEvent.c.
References ckalloc, ExitHandler::clientData, dataKey, ExitHandler::nextPtr, ExitHandler::proc, and TCL_TSD_INIT.
Referenced by CompileRegexp(), ConsoleInit(), FileInit(), FileNameInit(), InitTimer(), SerialInit(), and TclFSCwdPointerEquals().501 {
502     ExitHandler *exitPtr;
503     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
504 
505     exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
506     exitPtr->proc = proc;
507     exitPtr->clientData = clientData;
508     exitPtr->nextPtr = tsdPtr->firstExitPtr;
509     tsdPtr->firstExitPtr = exitPtr;
510 }
TCL_DECLARE_MUTEX (exitMutex)

Definition at line 79 of file tclEvent.c.
References firstExitPtr.91                                   {
92     ExitHandler *firstExitPtr;  /* First in list of all exit handlers for
93          * this thread. */
94     int inExit;     /* True when this thread is exiting. This
95          * is used as a hack to decide to close
96          * the standard channels. */
97     Tcl_Obj *tclLibraryPath;  /* Path(s) to the Tcl library */
98 } ThreadSpecificData;
void Tcl_DeleteExitHandler (Tcl_ExitProc * proc, ClientData clientData)

Definition at line 455 of file tclEvent.c.
References ckfree, firstExitPtr, ExitHandler::nextPtr, NULL, and Tcl_MutexLock.
Referenced by TestexithandlerCmd().458 {
459     ExitHandler *exitPtr, *prevPtr;
460 
461     Tcl_MutexLock(&exitMutex);
462     for (prevPtr = NULL, exitPtr = firstExitPtr; exitPtr != NULL;
463       prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
464   if ((exitPtr->proc == proc)
465     && (exitPtr->clientData == clientData)) {
466       if (prevPtr == NULL) {
467     firstExitPtr = exitPtr->nextPtr;
468       } else {
469     prevPtr->nextPtr = exitPtr->nextPtr;
470       }
471       ckfree((char *) exitPtr);
472       break;
473   }
474     }
475     Tcl_MutexUnlock(&exitMutex);
476     return;
477 }
void Tcl_DeleteThreadExitHandler (Tcl_ExitProc * proc, ClientData clientData)

Definition at line 532 of file tclEvent.c.
References ckfree, ExitHandler::clientData, dataKey, ExitHandler::nextPtr, NULL, ExitHandler::proc, and TCL_TSD_INIT.535 {
536     ExitHandler *exitPtr, *prevPtr;
537     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
538 
539     for (prevPtr = NULL, exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL;
540       prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
541   if ((exitPtr->proc == proc)
542     && (exitPtr->clientData == clientData)) {
543       if (prevPtr == NULL) {
544     tsdPtr->firstExitPtr = exitPtr->nextPtr;
545       } else {
546     prevPtr->nextPtr = exitPtr->nextPtr;
547       }
548       ckfree((char *) exitPtr);
549       return;
550   }
551     }
552 }
void Tcl_Exit (int status)

Definition at line 572 of file tclEvent.c.
References Tcl_Finalize(), and TclpExit.
Referenced by asyncExit(), main(), StdinProc(), Tcl_ExitObjCmd(), and Tcl_Main().575 {
576     Tcl_Finalize();
577     TclpExit(status);
578 }
void Tcl_Finalize ()

Definition at line 783 of file tclEvent.c.
References ckfree, ExitHandler::clientData, dataKey, firstExitPtr, ExitHandler::nextPtr, NULL, ExitHandler::proc, Tcl_FinalizeThread(), Tcl_MutexLock, Tcl_MutexUnlock, Tcl_SetPanicProc(), TCL_TSD_INIT, tclDefaultEncodingDir, tclExecutableName, TclFinalizeCompilation(), TclFinalizeEncodingSubsystem(), TclFinalizeEnvironment(), TclFinalizeExecution(), TclFinalizeFilesystem(), TclFinalizeLoad(), TclFinalizeLock(), TclFinalizeMemorySubsystem(), TclFinalizeObjects(), TclFinalizePreserve(), TclFinalizeSynchronization(), TclFinalizeThreadAlloc(), tclLibraryPathStr, tclNativeExecutableName, TclpInitLock(), TclResetFilesystem(), and void().
Referenced by Tcl_Exit().784 {
785     ExitHandler *exitPtr;
786     
787     /*
788      * Invoke exit handlers first.
789      */
790 
791     Tcl_MutexLock(&exitMutex);
792     inFinalize = 1;
793     for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) {
794   /*
795    * Be careful to remove the handler from the list before
796    * invoking its callback.  This protects us against
797    * double-freeing if the callback should call
798    * Tcl_DeleteExitHandler on itself.
799    */
800 
801   firstExitPtr = exitPtr->nextPtr;
802   Tcl_MutexUnlock(&exitMutex);
803   (*exitPtr->proc)(exitPtr->clientData);
804   ckfree((char *) exitPtr);
805   Tcl_MutexLock(&exitMutex);
806     }    
807     firstExitPtr = NULL;
808     Tcl_MutexUnlock(&exitMutex);
809 
810     TclpInitLock();
811     if (subsystemsInitialized != 0) {
812   subsystemsInitialized = 0;
813 
814   /*
815    * Ensure the thread-specific data is initialised as it is
816    * used in Tcl_FinalizeThread()
817    */
818 
819   (void) TCL_TSD_INIT(&dataKey);
820 
821   /*
822    * Clean up after the current thread now, after exit handlers.
823    * In particular, the testexithandler command sets up something
824    * that writes to standard output, which gets closed.
825    * Note that there is no thread-local storage after this call.
826    */
827 
828   Tcl_FinalizeThread();
829 
830   /*
831    * Now finalize the Tcl execution environment.  Note that this
832    * must be done after the exit handlers, because there are
833    * order dependencies.
834    */
835 
836   TclFinalizeCompilation();
837   TclFinalizeExecution();
838   TclFinalizeEnvironment();
839 
840   /* 
841    * Finalizing the filesystem must come after anything which
842    * might conceivably interact with the 'Tcl_FS' API. 
843    */
844 
845   TclFinalizeFilesystem();
846 
847   /*
848    * Undo all the Tcl_ObjType registrations, and reset the master list
849    * of free Tcl_Obj's.  After this returns, no more Tcl_Obj's should
850    * be allocated or freed.
851    *
852    * Note in particular that TclFinalizeObjects() must follow
853    * TclFinalizeFilesystem() because TclFinalizeFilesystem free's
854    * the Tcl_Obj that holds the path of the current working directory.
855    */
856 
857   TclFinalizeObjects();
858 
859   /* 
860    * We must be sure the encoding finalization doesn't need
861    * to examine the filesystem in any way.  Since it only
862    * needs to clean up internal data structures, this is
863    * fine.
864    */
865   TclFinalizeEncodingSubsystem();
866 
867   if (tclExecutableName != NULL) {
868       ckfree(tclExecutableName);
869       tclExecutableName = NULL;
870   }
871   if (tclNativeExecutableName != NULL) {
872       ckfree(tclNativeExecutableName);
873       tclNativeExecutableName = NULL;
874   }
875   if (tclDefaultEncodingDir != NULL) {
876       ckfree(tclDefaultEncodingDir);
877       tclDefaultEncodingDir = NULL;
878   }
879   if (tclLibraryPathStr != NULL) {
880       ckfree(tclLibraryPathStr);
881       tclLibraryPathStr = NULL;
882   }
883   
884   Tcl_SetPanicProc(NULL);
885 
886   /*
887    * There have been several bugs in the past that cause
888    * exit handlers to be established during Tcl_Finalize
889    * processing.  Such exit handlers leave malloc'ed memory,
890    * and Tcl_FinalizeThreadAlloc or Tcl_FinalizeMemorySubsystem
891    * will result in a corrupted heap.  The result can be a
892    * mysterious crash on process exit.  Check here that
893    * nobody's done this.
894    */
895 
896 #ifdef TCL_MEM_DEBUG
897   if ( firstExitPtr != NULL ) {
898       Tcl_Panic( "exit handlers were created during Tcl_Finalize" );
899   }
900 #endif
901 
902   TclFinalizePreserve();
903 
904   /*
905    * Free synchronization objects.  There really should only be one
906    * thread alive at this moment.
907    */
908 
909   TclFinalizeSynchronization();
910 
911 #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG) && !defined(PURIFY)
912   TclFinalizeThreadAlloc();
913 #endif
914 
915   /*
916    * We defer unloading of packages until very late 
917    * to avoid memory access issues.  Both exit callbacks and
918    * synchronization variables may be stored in packages.
919    * 
920    * Note that TclFinalizeLoad unloads packages in the reverse
921    * of the order they were loaded in (i.e. last to be loaded
922    * is the first to be unloaded).  This can be important for
923    * correct unloading when dependencies exist.
924    * 
925    * Once load has been finalized, we will have deleted any
926    * temporary copies of shared libraries and can therefore
927    * reset the filesystem to its original state.
928    */
929 
930   TclFinalizeLoad();
931   TclResetFilesystem();
932   
933   /*
934    * At this point, there should no longer be any ckalloc'ed memory.
935    */
936 
937   TclFinalizeMemorySubsystem();
938   inFinalize = 0;
939     }
940     TclFinalizeLock();
941 }
void Tcl_FinalizeThread ()

Definition at line 961 of file tclEvent.c.
References ckfree, ExitHandler::clientData, dataKey, ExitHandler::nextPtr, NULL, ExitHandler::proc, Tcl_DecrRefCount, TclFinalizeAsync(), TclFinalizeIOSubsystem(), TclFinalizeNotifier(), TclFinalizeThreadData(), and TclThreadDataKeyGet().
Referenced by Tcl_ExitThread(), and Tcl_Finalize().962 {
963     ExitHandler *exitPtr;
964     ThreadSpecificData *tsdPtr;
965 
966     tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
967     if (tsdPtr != NULL) {
968   tsdPtr->inExit = 1;
969 
970   /*
971    * Clean up the library path now, before we invalidate thread-local
972    * storage or calling thread exit handlers.
973    */
974 
975   if (tsdPtr->tclLibraryPath != NULL) {
976       Tcl_DecrRefCount(tsdPtr->tclLibraryPath);
977       tsdPtr->tclLibraryPath = NULL;
978   }
979 
980   for (exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL;
981     exitPtr = tsdPtr->firstExitPtr) {
982       /*
983        * Be careful to remove the handler from the list before invoking
984        * its callback.  This protects us against double-freeing if the
985        * callback should call Tcl_DeleteThreadExitHandler on itself.
986        */
987 
988       tsdPtr->firstExitPtr = exitPtr->nextPtr;
989       (*exitPtr->proc)(exitPtr->clientData);
990       ckfree((char *) exitPtr);
991   }
992   TclFinalizeIOSubsystem();
993   TclFinalizeNotifier();
994   TclFinalizeAsync();
995     }
996 
997     /*
998      * Blow away all thread local storage blocks.
999      *
1000      * Note that Tcl API allows creation of threads which do not use any
1001      * Tcl interp or other Tcl subsytems. Those threads might, however,
1002      * use thread local storage, so we must unconditionally finalize it.
1003      *
1004      * Fix [Bug #571002]
1005      */
1006 
1007     TclFinalizeThreadData();
1008 }
int Tcl_UpdateObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv)

Definition at line 1155 of file tclEvent.c.
References CONST, NULL, panic, TCL_ALL_EVENTS, TCL_DONT_WAIT, Tcl_DoOneEvent(), TCL_ERROR, Tcl_Free(), Tcl_GetIndexFromObj(), TCL_IDLE_EVENTS, TCL_OK, Tcl_ResetResult(), TCL_THREAD_CREATE_RETURN, Tcl_ThreadCreateType, TCL_WINDOW_EVENTS, and Tcl_WrongNumArgs().1160 {
1161     int optionIndex;
1162     int flags = 0;    /* Initialized to avoid compiler warning. */
1163     static CONST char *updateOptions[] = {"idletasks", (char *) NULL};
1164     enum updateOptions {REGEXP_IDLETASKS};
1165 
1166     if (objc == 1) {
1167   flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
1168     } else if (objc == 2) {
1169   if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions,
1170     "option", 0, &optionIndex) != TCL_OK) {
1171       return TCL_ERROR;
1172   }
1173   switch ((enum updateOptions) optionIndex) {
1174       case REGEXP_IDLETASKS: {
1175     flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
1176     break;
1177       }
1178       default: {
1179     panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions");
1180       }
1181   }
1182     } else {
1183         Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");
1184   return TCL_ERROR;
1185     }
1186     
1187     while (Tcl_DoOneEvent(flags) != 0) {
1188   /* Empty loop body */
1189     }
1190 
1191     /*
1192      * Must clear the interpreter's result because event handlers could
1193      * have executed commands.
1194      */
1195 
1196     Tcl_ResetResult(interp);
1197     return TCL_OK;
1198 }
int Tcl_VwaitObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv)

Definition at line 1079 of file tclEvent.c.
References NULL, TCL_ALL_EVENTS, Tcl_DoOneEvent(), TCL_ERROR, Tcl_GetString(), TCL_GLOBAL_ONLY, TCL_OK, Tcl_ResetResult(), TCL_TRACE_UNSETS, TCL_TRACE_WRITES, Tcl_TraceVar(), Tcl_UntraceVar(), Tcl_WrongNumArgs(), and VwaitVarProc().1084 {
1085     int done, foundEvent;
1086     char *nameString;
1087 
1088     if (objc != 2) {
1089         Tcl_WrongNumArgs(interp, 1, objv, "name");
1090   return TCL_ERROR;
1091     }
1092     nameString = Tcl_GetString(objv[1]);
1093     if (Tcl_TraceVar(interp, nameString,
1094       TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
1095       VwaitVarProc, (ClientData) &done) != TCL_OK) {
1096   return TCL_ERROR;
1097     };
1098     done = 0;
1099     foundEvent = 1;
1100     while (!done && foundEvent) {
1101   foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS);
1102     }
1103     Tcl_UntraceVar(interp, nameString,
1104       TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
1105       VwaitVarProc, (ClientData) &done);
1106 
1107     /*
1108      * Clear out the interpreter's result, since it may have been set
1109      * by event handlers.
1110      */
1111 
1112     Tcl_ResetResult(interp);
1113     if (!foundEvent) {
1114   Tcl_AppendResult(interp, "can't wait for variable \"", nameString,
1115     "\":  would wait forever", (char *) NULL);
1116   return TCL_ERROR;
1117     }
1118     return TCL_OK;
1119 }
Tcl_Obj* TclGetLibraryPath ()

Definition at line 649 of file tclEvent.c.
References dataKey, NULL, Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_TSD_INIT, and tclLibraryPathStr.
Referenced by LoadEncodingFile(), Tcl_GetEncodingNames(), Tcl_Init(), TclFindEncodings(), TclpInitLibraryPath(), TclpSetInitialEncodings(), TclpSetVariables(), and TestencodingObjCmd().650 {
651     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
652 
653     if (tsdPtr->tclLibraryPath == NULL) {
654   /*
655    * Grab the shared string and place it into a new thread specific
656    * Tcl_Obj.
657    */
658   tsdPtr->tclLibraryPath = Tcl_NewStringObj(tclLibraryPathStr, -1);
659 
660   /* take ownership */
661   Tcl_IncrRefCount(tsdPtr->tclLibraryPath);
662     }
663     return tsdPtr->tclLibraryPath;
664 }
int TclInExit ()

Definition at line 1027 of file tclEvent.c.
Referenced by InitNotifier(), PipeClose2Proc(), PipeCloseProc(), and SerialOutputProc().1028 {
1029     return inFinalize;
1030 }
void TclInitSubsystems (CONST char * argv0)

Definition at line 693 of file tclEvent.c.
References dataKey, NULL, panic, TCL_TSD_INIT, tclExecutableName, TclInitEncodingSubsystem(), TclInitIOSubsystem(), TclInitNamespaceSubsystem(), TclInitObjSubsystem(), TclpInitLock(), TclpInitPlatform(), TclpInitUnlock(), TclThreadDataKeyGet(), and void().
Referenced by Tcl_CreateInterp(), Tcl_FindExecutable(), and TclpFindExecutable().696 {
697     ThreadSpecificData *tsdPtr;
698 
699     if (inFinalize != 0) {
700   panic("TclInitSubsystems called while finalizing");
701     }
702 
703     /*
704      * Grab the thread local storage pointer before doing anything because
705      * the initialization routines will be registering exit handlers.
706      * We use this pointer to detect if this is the first time this
707      * thread has created an interpreter.
708      */
709 
710     tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
711 
712     if (subsystemsInitialized == 0) {
713   /* 
714    * Double check inside the mutex.  There are definitly calls
715    * back into this routine from some of the procedures below.
716    */
717 
718   TclpInitLock();
719   if (subsystemsInitialized == 0) {
720       /*
721        * Have to set this bit here to avoid deadlock with the
722        * routines below us that call into TclInitSubsystems.
723        */
724 
725       subsystemsInitialized = 1;
726 
727       tclExecutableName = NULL;
728 
729       /*
730        * Initialize locks used by the memory allocators before anything
731        * interesting happens so we can use the allocators in the
732        * implementation of self-initializing locks.
733        */
734 
735 #if USE_TCLALLOC
736       TclInitAlloc(); /* process wide mutex init */
737 #endif
738 #ifdef TCL_MEM_DEBUG
739       TclInitDbCkalloc(); /* process wide mutex init */
740 #endif
741 
742       TclpInitPlatform(); /* creates signal handler(s) */
743       TclInitObjSubsystem(); /* register obj types, create mutexes */
744       TclInitIOSubsystem(); /* inits a tsd key (noop) */
745       TclInitEncodingSubsystem(); /* process wide encoding init */
746       TclInitNamespaceSubsystem(); /* register ns obj type (mutexed) */
747   }
748   TclpInitUnlock();
749     }
750 
751     if (tsdPtr == NULL) {
752   /*
753    * First time this thread has created an interpreter.
754    * We fetch the key again just in case no exit handlers were
755    * registered by this point.
756    */
757 
758   (void) TCL_TSD_INIT(&dataKey);
759   TclInitNotifier();
760      }
761 }
int TclInThreadExit ()

Definition at line 1049 of file tclEvent.c.
References dataKey, NULL, and TclThreadDataKeyGet().
Referenced by ConsoleCloseProc(), FileCloseProc(), SerialCloseProc(), StdIOClose(), and TclpCloseFile().1050 {
1051     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1052       TclThreadDataKeyGet(&dataKey);
1053     if (tsdPtr == NULL) {
1054   return 0;
1055     } else {
1056   return tsdPtr->inExit;
1057     }
1058 }
void TclSetLibraryPath (Tcl_Obj * pathPtr)

Definition at line 603 of file tclEvent.c.
References ckalloc, ckfree, dataKey, NULL, Tcl_DecrRefCount, Tcl_GetStringFromObj(), Tcl_IncrRefCount, TCL_TSD_INIT, and tclLibraryPathStr.
Referenced by TclFindEncodings(), TclpInitLibraryPath(), and TestencodingObjCmd().606 {
607     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
608     const char *toDupe;
609     int size;
610 
611     if (pathPtr != NULL) {
612   Tcl_IncrRefCount(pathPtr);
613     }
614     if (tsdPtr->tclLibraryPath != NULL) {
615   Tcl_DecrRefCount(tsdPtr->tclLibraryPath);
616     }
617     tsdPtr->tclLibraryPath = pathPtr;
618 
619     /*
620      *  No mutex locking is needed here as up the stack we're within
621      *  TclpInitLock().
622      */
623     if (tclLibraryPathStr != NULL) {
624   ckfree(tclLibraryPathStr);
625     }
626     toDupe = Tcl_GetStringFromObj(pathPtr, &size);
627     tclLibraryPathStr = ckalloc((unsigned)size+1);
628     memcpy(tclLibraryPathStr, toDupe, (unsigned)size+1);
629 }
static char* VwaitVarProc (ClientData clientData, Tcl_Interp * interp, CONST char * name1, CONST char * name2, int flags) [static]

Definition at line 1123 of file tclEvent.c.
References NULL.
Referenced by Tcl_VwaitObjCmd().1129 {
1130     int *donePtr = (int *) clientData;
1131 
1132     *donePtr = 1;
1133     return (char *) NULL;
1134 }

Variable Documentation
Tcl_ThreadDataKey dataKey [static]

Definition at line 99 of file tclEvent.c.ExitHandler* firstExitPtr = NULL [static]

Definition at line 76 of file tclEvent.c.
Referenced by Tcl_CreateExitHandler(), TCL_DECLARE_MUTEX(), Tcl_DeleteExitHandler(), and Tcl_Finalize().char* tclLibraryPathStr = NULL [static]

Definition at line 105 of file tclEvent.c.
Referenced by Tcl_Finalize(), TclGetLibraryPath(), and TclSetLibraryPath().ThreadSpecificData

Definition at line 98 of file tclEvent.c.

generic/tclExecute.c File Reference
#include "tclInt.h"
#include "tclCompile.h"
#include "tclMath.h"
#include "tclPort.h"
Defines
#define DBL_MAX  1.79769313486231570e+308
#define IS_NAN(v)  ((v) != (v))
#define IS_INF(v)  (((v) > DBL_MAX) || ((v) < -DBL_MAX))
#define NEXT_INST_F(pcAdjustment, nCleanup, result)
#define NEXT_INST_V(pcAdjustment, nCleanup, result)
#define CACHE_STACK_INFO()
#define DECACHE_STACK_INFO()  eePtr->stackTop = stackTop
#define PUSH_OBJECT(objPtr)  Tcl_IncrRefCount(stackPtr[++stackTop] = (objPtr))
#define POP_OBJECT()  (stackPtr[stackTop--])
#define TRACE(a)
#define TRACE_APPEND(a)
#define TRACE_WITH_OBJ(a, objPtr)
#define O2S(objPtr)
#define REQUIRE_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar)
#define GET_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar)
#define FORCE_LONG(objPtr, longVar, wideVar)
#define IS_INTEGER_TYPE(typePtr)  ((typePtr) == &tclIntType || (typePtr) == &tclWideIntType)
#define IS_NUMERIC_TYPE(typePtr)  (IS_INTEGER_TYPE(typePtr) || (typePtr) == &tclDoubleType)
#define W0  Tcl_LongAsWide(0)
#define LLD  "%" TCL_LL_MODIFIER "d"
#define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr)
#define TCL_STACK_INITIAL_SIZE  2000
#define STATIC_CATCH_STACK_SIZE  4
#define RAND_IA  16807
#define RAND_IM  2147483647
#define RAND_IQ  127773
#define RAND_IR  2836
#define RAND_MASK  123459876
Functions
TCL_DECLARE_MUTEX (execMutex)
static int TclExecuteByteCode _ANSI_ARGS_ ((Tcl_Interp *interp, ByteCode *codePtr))
static int ExprAbsFunc _ANSI_ARGS_ ((Tcl_Interp *interp, ExecEnv *eePtr, ClientData clientData))
static int ExprCallMathFunc _ANSI_ARGS_ ((Tcl_Interp *interp, ExecEnv *eePtr, int objc, Tcl_Obj **objv))
static ExceptionRange *GetExceptRangeForPc _ANSI_ARGS_ ((unsigned char *pc, int catchOnly, ByteCode *codePtr))
static char *GetSrcInfoForPc _ANSI_ARGS_ ((unsigned char *pc, ByteCode *codePtr, int *lengthPtr))
static void GrowEvaluationStack _ANSI_ARGS_ ((ExecEnv *eePtr))
static void IllegalExprOperandType _ANSI_ARGS_ ((Tcl_Interp *interp, unsigned char *pc, Tcl_Obj *opndPtr))
static void InitByteCodeExecution _ANSI_ARGS_ ((Tcl_Interp *interp))
static int VerifyExprObjType _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
static void InitByteCodeExecution (Tcl_Interp *interp)
ExecEnv * TclCreateExecEnv (Tcl_Interp *interp)
void TclDeleteExecEnv (ExecEnv *eePtr)
void TclFinalizeExecution ()
static void GrowEvaluationStack (ExecEnv *eePtr)
int Tcl_ExprObj (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr)
int TclCompEvalObj (Tcl_Interp *interp, Tcl_Obj *objPtr)
static int TclExecuteByteCode (Tcl_Interp *interp, ByteCode *codePtr)
static void IllegalExprOperandType (Tcl_Interp *interp, unsigned char *pc, Tcl_Obj *opndPtr)
static char * GetSrcInfoForPc (unsigned char *pc, ByteCode *codePtr, int *lengthPtr)
static ExceptionRange * GetExceptRangeForPc (unsigned char *pc, int catchOnly, ByteCode *codePtr)
static int VerifyExprObjType (Tcl_Interp *interp, Tcl_Obj *objPtr)
static int ExprUnaryFunc (Tcl_Interp *interp, ExecEnv *eePtr, ClientData clientData)
static int ExprBinaryFunc (Tcl_Interp *interp, ExecEnv *eePtr, ClientData clientData)
static int ExprAbsFunc (Tcl_Interp *interp, ExecEnv *eePtr, ClientData clientData)
static int ExprDoubleFunc (Tcl_Interp *interp, ExecEnv *eePtr, ClientData clientData)
static int ExprIntFunc (Tcl_Interp *interp, ExecEnv *eePtr, ClientData clientData)
static int ExprWideFunc (Tcl_Interp *interp, ExecEnv *eePtr, ClientData clientData)
static int ExprRandFunc (Tcl_Interp *interp, ExecEnv *eePtr, ClientData clientData)
static int ExprRoundFunc (Tcl_Interp *interp, ExecEnv *eePtr, ClientData clientData)
static int ExprSrandFunc (Tcl_Interp *interp, ExecEnv *eePtr, ClientData clientData)
static int ExprCallMathFunc (Tcl_Interp *interp, ExecEnv *eePtr, int objc, Tcl_Obj **objv)
void TclExprFloatError (Tcl_Interp *interp, double value)
Variables
static int execInitialized = 0
BuiltinFunc tclBuiltinFuncTable []

Define Documentation
#define CACHE_STACK_INFO()
Value:stackPtr = eePtr->stackPtr; \
    stackTop = eePtr->stackTop
Definition at line 196 of file tclExecute.c.
Referenced by ExprAbsFunc(), ExprBinaryFunc(), ExprCallMathFunc(), ExprDoubleFunc(), ExprIntFunc(), ExprRandFunc(), ExprRoundFunc(), ExprSrandFunc(), ExprUnaryFunc(), ExprWideFunc(), and TclExecuteByteCode().#define DBL_MAX  1.79769313486231570e+308

Definition at line 60 of file tclExecute.c.#define DECACHE_STACK_INFO()  eePtr->stackTop = stackTop

Definition at line 200 of file tclExecute.c.
Referenced by ExprAbsFunc(), ExprBinaryFunc(), ExprDoubleFunc(), ExprIntFunc(), ExprRandFunc(), ExprRoundFunc(), ExprSrandFunc(), ExprUnaryFunc(), ExprWideFunc(), and TclExecuteByteCode().#define FORCE_LONG(objPtr, longVar, wideVar)
Value:if ((objPtr)->typePtr == &tclWideIntType) {       \
  (longVar) = Tcl_WideAsLong(wideVar);        \
    }
Definition at line 292 of file tclExecute.c.
Referenced by TclExecuteByteCode().#define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr)
Value:if ((typePtr) == &tclIntType) {         \
  (doubleVar) = (double) (objPtr)->internalRep.longValue;   \
    } else if ((typePtr) == &tclWideIntType) {        \
  (doubleVar) = Tcl_WideAsDouble((objPtr)->internalRep.wideValue);\
    } else {                \
  (doubleVar) = (objPtr)->internalRep.doubleValue;    \
    }
Definition at line 311 of file tclExecute.c.
Referenced by ExprBinaryFunc(), ExprDoubleFunc(), ExprUnaryFunc(), and TclExecuteByteCode().#define GET_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar)
Value:(resultVar) = Tcl_GetWideIntFromObj((Tcl_Interp *) NULL, (objPtr),  \
      &(wideVar));            \
    if ((resultVar) == TCL_OK && (wideVar) >= Tcl_LongAsWide(LONG_MIN)  \
      && (wideVar) <= Tcl_LongAsWide(LONG_MAX)) {     \
  (objPtr)->typePtr = &tclIntType;        \
  (objPtr)->internalRep.longValue = (longVar)     \
    = Tcl_WideAsLong(wideVar);        \
    }
Definition at line 279 of file tclExecute.c.
Referenced by TclExecuteByteCode(), and VerifyExprObjType().#define IS_INF(v)  (((v) > DBL_MAX) || ((v) < -DBL_MAX))

Definition at line 128 of file tclExecute.c.
Referenced by ExprAbsFunc(), ExprBinaryFunc(), ExprIntFunc(), ExprUnaryFunc(), ExprWideFunc(), TclExecuteByteCode(), and TclExprFloatError().#define IS_INTEGER_TYPE(typePtr)  ((typePtr) == &tclIntType || (typePtr) == &tclWideIntType)

Definition at line 296 of file tclExecute.c.
Referenced by TclExecuteByteCode().#define IS_NAN(v)  ((v) != (v))

Definition at line 127 of file tclExecute.c.
Referenced by ExprAbsFunc(), ExprBinaryFunc(), ExprIntFunc(), ExprUnaryFunc(), ExprWideFunc(), TclExecuteByteCode(), and TclExprFloatError().#define IS_NUMERIC_TYPE(typePtr)  (IS_INTEGER_TYPE(typePtr) || (typePtr) == &tclDoubleType)

Definition at line 298 of file tclExecute.c.
Referenced by TclExecuteByteCode(), and VerifyExprObjType().#define LLD  "%" TCL_LL_MODIFIER "d"

Definition at line 305 of file tclExecute.c.
Referenced by TclExecuteByteCode().#define NEXT_INST_F(pcAdjustment, nCleanup, result)
Value:if (nCleanup == 0) {\
   if (result != 0) {\
       if ((result) > 0) {\
     PUSH_OBJECT(objResultPtr);\
       } else {\
     stackPtr[++stackTop] = objResultPtr;\
       }\
   } \
   pc += (pcAdjustment);\
   goto cleanup0;\
     } else if (result != 0) {\
   if ((result) > 0) {\
       Tcl_IncrRefCount(objResultPtr);\
   }\
   pc += (pcAdjustment);\
   switch (nCleanup) {\
       case 1: goto cleanup1_pushObjResultPtr;\
       case 2: goto cleanup2_pushObjResultPtr;\
       default: panic("ERROR: bad usage of macro NEXT_INST_F");\
   }\
     } else {\
   pc += (pcAdjustment);\
   switch (nCleanup) {\
       case 1: goto cleanup1;\
       case 2: goto cleanup2;\
       default: panic("ERROR: bad usage of macro NEXT_INST_F");\
   }\
     }
Definition at line 145 of file tclExecute.c.
Referenced by TclExecuteByteCode().#define NEXT_INST_V(pcAdjustment, nCleanup, result)
Value:pc += (pcAdjustment);\
    cleanup = (nCleanup);\
    if (result) {\
  if ((result) > 0) {\
      Tcl_IncrRefCount(objResultPtr);\
  }\
  goto cleanupV_pushObjResultPtr;\
    } else {\
  goto cleanupV;\
    }
Definition at line 175 of file tclExecute.c.
Referenced by TclExecuteByteCode().#define O2S(objPtr)

Definition at line 258 of file tclExecute.c.
Referenced by TclExecuteByteCode().#define POP_OBJECT()  (stackPtr[stackTop--])

Definition at line 222 of file tclExecute.c.
Referenced by ExprAbsFunc(), ExprBinaryFunc(), ExprDoubleFunc(), ExprIntFunc(), ExprRoundFunc(), ExprSrandFunc(), ExprUnaryFunc(), ExprWideFunc(), and TclExecuteByteCode().#define PUSH_OBJECT(objPtr)  Tcl_IncrRefCount(stackPtr[++stackTop] = (objPtr))

Definition at line 219 of file tclExecute.c.
Referenced by ExprAbsFunc(), ExprBinaryFunc(), ExprDoubleFunc(), ExprIntFunc(), ExprRandFunc(), ExprRoundFunc(), ExprUnaryFunc(), and ExprWideFunc().#define RAND_IA  16807

Referenced by ExprRandFunc().#define RAND_IM  2147483647

Referenced by ExprRandFunc().#define RAND_IQ  127773

Referenced by ExprRandFunc().#define RAND_IR  2836

Referenced by ExprRandFunc().#define RAND_MASK  123459876
#define REQUIRE_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar)
Value:(resultVar) = Tcl_GetWideIntFromObj(interp, (objPtr), &(wideVar));  \
    if ((resultVar) == TCL_OK && (wideVar) >= Tcl_LongAsWide(LONG_MIN)  \
      && (wideVar) <= Tcl_LongAsWide(LONG_MAX)) {     \
  (objPtr)->typePtr = &tclIntType;        \
  (objPtr)->internalRep.longValue = (longVar)     \
    = Tcl_WideAsLong(wideVar);        \
    }
Definition at line 271 of file tclExecute.c.
Referenced by TclExecuteByteCode().#define STATIC_CATCH_STACK_SIZE  4

Referenced by TclExecuteByteCode().#define TCL_STACK_INITIAL_SIZE  2000

Definition at line 481 of file tclExecute.c.
Referenced by TclCreateExecEnv().#define TRACE(a)

Definition at line 255 of file tclExecute.c.#define TRACE_APPEND(a)

Definition at line 256 of file tclExecute.c.
Referenced by TclExecuteByteCode().#define TRACE_WITH_OBJ(a, objPtr)

Definition at line 257 of file tclExecute.c.
Referenced by TclExecuteByteCode().#define W0  Tcl_LongAsWide(0)

Definition at line 301 of file tclExecute.c.
Referenced by ExprAbsFunc(), and TclExecuteByteCode().
Function Documentation
static int VerifyExprObjType _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr)) [static]
static void InitByteCodeExecution _ANSI_ARGS_ ((Tcl_Interp *interp)) [static]
static void IllegalExprOperandType _ANSI_ARGS_ ((Tcl_Interp *interp, unsigned char *pc, Tcl_Obj *opndPtr)) [static]
static void GrowEvaluationStack _ANSI_ARGS_ ((ExecEnv *eePtr)) [static]
static char* GetSrcInfoForPc _ANSI_ARGS_ ((unsigned char *pc, ByteCode *codePtr, int *lengthPtr)) [static]
static ExceptionRange* GetExceptRangeForPc _ANSI_ARGS_ ((unsigned char *pc, int catchOnly, ByteCode *codePtr)) [static]
static int ExprCallMathFunc _ANSI_ARGS_ ((Tcl_Interp *interp, ExecEnv *eePtr, int objc, Tcl_Obj **objv)) [static]
static int ExprAbsFunc _ANSI_ARGS_ ((Tcl_Interp *interp, ExecEnv *eePtr, ClientData clientData)) [static]
static int TclExecuteByteCode _ANSI_ARGS_ ((Tcl_Interp *interp, ByteCode *codePtr)) [static]
static int ExprAbsFunc (Tcl_Interp * interp, ExecEnv * eePtr, ClientData clientData) [static]

Definition at line 5039 of file tclExecute.c.
References CACHE_STACK_INFO, DECACHE_STACK_INFO, Tcl_Obj::doubleValue, Tcl_Obj::internalRep, IS_INF, IS_NAN, LONG_MIN, Tcl_Obj::longValue, NULL, POP_OBJECT, PUSH_OBJECT, Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), Tcl_NewDoubleObj(), Tcl_NewLongObj(), Tcl_NewStringObj(), Tcl_NewWideIntObj(), TCL_OK, Tcl_ResetResult(), Tcl_SetObjResult(), TclDecrRefCount, TclExprFloatError(), TclGetWide, tclIntType, tclWideIntType, Tcl_Obj::typePtr, VerifyExprObjType(), and W0.5045 {
5046     Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
5047     register int stackTop;  /* Cached top index of evaluation stack. */
5048     register Tcl_Obj *valuePtr;
5049     long i, iResult;
5050     double d, dResult;
5051     int result;
5052 
5053     /*
5054      * Set stackPtr and stackTop from eePtr.
5055      */
5056 
5057     result = TCL_OK;
5058     CACHE_STACK_INFO();
5059 
5060     /*
5061      * Pop the argument from the evaluation stack.
5062      */
5063 
5064     valuePtr = POP_OBJECT();
5065 
5066     if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
5067   result = TCL_ERROR;
5068   goto done;
5069     }
5070 
5071     /*
5072      * Push a Tcl object with the result.
5073      */
5074     if (valuePtr->typePtr == &tclIntType) {
5075   i = valuePtr->internalRep.longValue;
5076   if (i < 0) {
5077       if (i == LONG_MIN) {
5078 #ifdef TCL_WIDE_INT_IS_LONG
5079     Tcl_SetObjResult(interp, Tcl_NewStringObj(
5080       "integer value too large to represent", -1));
5081     Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
5082       "integer value too large to represent", (char *) NULL);
5083     result = TCL_ERROR;
5084     goto done;
5085 #else 
5086     /*
5087      * Special case: abs(MIN_INT) must promote to wide.
5088      */
5089 
5090     PUSH_OBJECT( Tcl_NewWideIntObj(-(Tcl_WideInt) i) );
5091     result = TCL_OK;
5092     goto done;
5093 #endif
5094 
5095       }
5096       iResult = -i;
5097   } else {
5098       iResult = i;
5099   }     
5100   PUSH_OBJECT(Tcl_NewLongObj(iResult));
5101     } else if (valuePtr->typePtr == &tclWideIntType) {
5102   Tcl_WideInt wResult, w;
5103   TclGetWide(w,valuePtr);
5104   if (w < W0) {
5105       wResult = -w;
5106       if (wResult < 0) {
5107     Tcl_ResetResult(interp);
5108     Tcl_AppendToObj(Tcl_GetObjResult(interp),
5109             "integer value too large to represent", -1);
5110     Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
5111       "integer value too large to represent", (char *) NULL);
5112     result = TCL_ERROR;
5113     goto done;
5114       }
5115   } else {
5116       wResult = w;
5117   }     
5118   PUSH_OBJECT(Tcl_NewWideIntObj(wResult));
5119     } else {
5120   d = valuePtr->internalRep.doubleValue;
5121   if (d < 0.0) {
5122       dResult = -d;
5123   } else {
5124       dResult = d;
5125   }
5126   if (IS_NAN(dResult) || IS_INF(dResult)) {
5127       TclExprFloatError(interp, dResult);
5128       result = TCL_ERROR;
5129       goto done;
5130   }
5131   PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
5132     }
5133 
5134     /*
5135      * Reflect the change to stackTop back in eePtr.
5136      */
5137 
5138     done:
5139     TclDecrRefCount(valuePtr);
5140     DECACHE_STACK_INFO();
5141     return result;
5142 }
static int ExprBinaryFunc (Tcl_Interp * interp, ExecEnv * eePtr, ClientData clientData) [static]

Definition at line 4971 of file tclExecute.c.
References _ANSI_ARGS_, CACHE_STACK_INFO, DECACHE_STACK_INFO, errno, GET_DOUBLE_VALUE, IS_INF, IS_NAN, POP_OBJECT, PUSH_OBJECT, TCL_ERROR, Tcl_NewDoubleObj(), TCL_OK, TclDecrRefCount, TclExprFloatError(), Tcl_Obj::typePtr, and VerifyExprObjType().4979 {
4980     Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
4981     register int stackTop;  /* Cached top index of evaluation stack. */
4982     register Tcl_Obj *valuePtr, *value2Ptr;
4983     double d1, d2, dResult;
4984     int result;
4985     
4986     double (*func) _ANSI_ARGS_((double, double))
4987   = (double (*)_ANSI_ARGS_((double, double))) clientData;
4988 
4989     /*
4990      * Set stackPtr and stackTop from eePtr.
4991      */
4992 
4993     result = TCL_OK;
4994     CACHE_STACK_INFO();
4995 
4996     /*
4997      * Pop the function's two arguments from the evaluation stack. Convert
4998      * them to doubles if necessary.
4999      */
5000 
5001     value2Ptr = POP_OBJECT();
5002     valuePtr  = POP_OBJECT();
5003 
5004     if ((VerifyExprObjType(interp, valuePtr) != TCL_OK) ||
5005       (VerifyExprObjType(interp, value2Ptr) != TCL_OK)) {
5006   result = TCL_ERROR;
5007   goto done;
5008     }
5009 
5010     GET_DOUBLE_VALUE(d1, valuePtr, valuePtr->typePtr);
5011     GET_DOUBLE_VALUE(d2, value2Ptr, value2Ptr->typePtr);
5012 
5013     errno = 0;
5014     dResult = (*func)(d1, d2);
5015     if ((errno != 0) || IS_NAN(dResult) || IS_INF(dResult)) {
5016   TclExprFloatError(interp, dResult);
5017   result = TCL_ERROR;
5018   goto done;
5019     }
5020 
5021     /*
5022      * Push a Tcl object holding the result.
5023      */
5024 
5025     PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
5026     
5027     /*
5028      * Reflect the change to stackTop back in eePtr.
5029      */
5030 
5031     done:
5032     TclDecrRefCount(valuePtr);
5033     TclDecrRefCount(value2Ptr);
5034     DECACHE_STACK_INFO();
5035     return result;
5036 }
static int ExprCallMathFunc (Tcl_Interp * interp, ExecEnv * eePtr, int objc, Tcl_Obj ** objv) [static]

Definition at line 5641 of file tclExecute.c.
References MathFunc::argTypes, CACHE_STACK_INFO, Tcl_Obj::internalRep, Tcl_Obj::longValue, Interp::mathFuncTable, MAX_MATH_ARGS, NULL, MathFunc::numArgs, panic, TCL_ERROR, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_GetObjResult(), Tcl_LongAsWide, TCL_OK, Tcl_ResetResult(), TCL_WIDE_INT, TclGetString, tclIntType, Tcl_Obj::typePtr, and VerifyExprObjType().
Referenced by TclExecuteByteCode().5650 {
5651     Interp *iPtr = (Interp *) interp;
5652     Tcl_Obj **stackPtr;   /* Cached evaluation stack base pointer. */
5653     register int stackTop;  /* Cached top index of evaluation stack. */
5654     char *funcName;
5655     Tcl_HashEntry *hPtr;
5656     MathFunc *mathFuncPtr;  /* Information about math function. */
5657     Tcl_Value args[MAX_MATH_ARGS]; /* Arguments for function call. */
5658     Tcl_Value funcResult; /* Result of function call as Tcl_Value. */
5659     register Tcl_Obj *valuePtr;
5660     long i;
5661     double d;
5662     int j, k, result;
5663 
5664     Tcl_ResetResult(interp);
5665 
5666     /*
5667      * Set stackPtr and stackTop from eePtr.
5668      */
5669     
5670     CACHE_STACK_INFO();
5671 
5672     /*
5673      * Look up the MathFunc record for the function.
5674      */
5675 
5676     funcName = TclGetString(objv[0]);
5677     hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
5678     if (hPtr == NULL) {
5679   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
5680     "unknown math function \"", funcName, "\"", (char *) NULL);
5681   result = TCL_ERROR;
5682   goto done;
5683     }
5684     mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
5685     if (mathFuncPtr->numArgs != (objc-1)) {
5686   panic("ExprCallMathFunc: expected number of args %d != actual number %d",
5687           mathFuncPtr->numArgs, objc);
5688   result = TCL_ERROR;
5689   goto done;
5690     }
5691 
5692     /*
5693      * Collect the arguments for the function, if there are any, into the
5694      * array "args". Note that args[0] will have the Tcl_Value that
5695      * corresponds to objv[1].
5696      */
5697 
5698     for (j = 1, k = 0;  j < objc;  j++, k++) {
5699   valuePtr = objv[j];
5700 
5701   if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
5702       result = TCL_ERROR;
5703       goto done;
5704   }
5705 
5706   /*
5707    * Copy the object's numeric value to the argument record,
5708    * converting it if necessary. 
5709    */
5710 
5711   if (valuePtr->typePtr == &tclIntType) {
5712       i = valuePtr->internalRep.longValue;
5713       if (mathFuncPtr->argTypes[k] == TCL_DOUBLE) {
5714     args[k].type = TCL_DOUBLE;
5715     args[k].doubleValue = i;
5716       } else if (mathFuncPtr->argTypes[k] == TCL_WIDE_INT) {
5717     args[k].type = TCL_WIDE_INT;
5718     args[k].wideValue = Tcl_LongAsWide(i);
5719       } else {
5720     args[k].type = TCL_INT;
5721     args[k].intValue = i;
5722       }
5723   } else if (valuePtr->typePtr == &tclWideIntType) {
5724       Tcl_WideInt w;
5725       TclGetWide(w,valuePtr);
5726       if (mathFuncPtr->argTypes[k] == TCL_DOUBLE) {
5727     args[k].type = TCL_DOUBLE;
5728     args[k].doubleValue = Tcl_WideAsDouble(w);
5729       } else if (mathFuncPtr->argTypes[k] == TCL_INT) {
5730     args[k].type = TCL_INT;
5731     args[k].intValue = Tcl_WideAsLong(w);
5732       } else {
5733     args[k].type = TCL_WIDE_INT;
5734     args[k].wideValue = w;
5735       }
5736   } else {
5737       d = valuePtr->internalRep.doubleValue;
5738       if (mathFuncPtr->argTypes[k] == TCL_INT) {
5739     args[k].type = TCL_INT;
5740     args[k].intValue = (long) d;
5741       } else if (mathFuncPtr->argTypes[k] == TCL_WIDE_INT) {
5742     args[k].type = TCL_WIDE_INT;
5743     args[k].wideValue = Tcl_DoubleAsWide(d);
5744       } else {
5745     args[k].type = TCL_DOUBLE;
5746     args[k].doubleValue = d;
5747       }
5748   }
5749     }
5750 
5751     /*
5752      * Invoke the function and copy its result back into valuePtr.
5753      */
5754 
5755     result = (*mathFuncPtr->proc)(mathFuncPtr->clientData, interp, args,
5756       &funcResult);
5757     if (result != TCL_OK) {
5758   goto done;
5759     }
5760 
5761     /*
5762      * Pop the objc top stack elements and decrement their ref counts.
5763      */
5764 
5765     k = (stackTop - (objc-1));
5766     while (stackTop >= k) {
5767   valuePtr = POP_OBJECT();
5768   TclDecrRefCount(valuePtr);
5769     }
5770     
5771     /*
5772      * Push the call's object result.
5773      */
5774     
5775     if (funcResult.type == TCL_INT) {
5776   PUSH_OBJECT(Tcl_NewLongObj(funcResult.intValue));
5777     } else if (funcResult.type == TCL_WIDE_INT) {
5778   PUSH_OBJECT(Tcl_NewWideIntObj(funcResult.wideValue));
5779     } else {
5780   d = funcResult.doubleValue;
5781   if (IS_NAN(d) || IS_INF(d)) {
5782       TclExprFloatError(interp, d);
5783       result = TCL_ERROR;
5784       goto done;
5785   }
5786   PUSH_OBJECT(Tcl_NewDoubleObj(d));
5787     }
5788 
5789     /*
5790      * Reflect the change to stackTop back in eePtr.
5791      */
5792 
5793     done:
5794     DECACHE_STACK_INFO();
5795     return result;
5796 }
static int ExprDoubleFunc (Tcl_Interp * interp, ExecEnv * eePtr, ClientData clientData) [static]

Definition at line 5145 of file tclExecute.c.
References CACHE_STACK_INFO, DECACHE_STACK_INFO, GET_DOUBLE_VALUE, POP_OBJECT, PUSH_OBJECT, TCL_ERROR, Tcl_NewDoubleObj(), TCL_OK, TclDecrRefCount, Tcl_Obj::typePtr, and VerifyExprObjType().5151 {
5152     Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
5153     register int stackTop;  /* Cached top index of evaluation stack. */
5154     register Tcl_Obj *valuePtr;
5155     double dResult;
5156     int result;
5157 
5158     /*
5159      * Set stackPtr and stackTop from eePtr.
5160      */
5161 
5162     result = TCL_OK;
5163     CACHE_STACK_INFO();
5164 
5165     /*
5166      * Pop the argument from the evaluation stack.
5167      */
5168 
5169     valuePtr = POP_OBJECT();
5170 
5171     if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
5172   result = TCL_ERROR;
5173   goto done;
5174     }
5175 
5176     GET_DOUBLE_VALUE(dResult, valuePtr, valuePtr->typePtr);
5177 
5178     /*
5179      * Push a Tcl object with the result.
5180      */
5181 
5182     PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
5183 
5184     /*
5185      * Reflect the change to stackTop back in eePtr.
5186      */
5187 
5188     done:
5189     TclDecrRefCount(valuePtr);
5190     DECACHE_STACK_INFO();
5191     return result;
5192 }
static int ExprIntFunc (Tcl_Interp * interp, ExecEnv * eePtr, ClientData clientData) [static]

Definition at line 5195 of file tclExecute.c.
References CACHE_STACK_INFO, DECACHE_STACK_INFO, Tcl_Obj::doubleValue, Tcl_Obj::internalRep, IS_INF, IS_NAN, LONG_MAX, LONG_MIN, Tcl_Obj::longValue, NULL, POP_OBJECT, PUSH_OBJECT, Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), Tcl_NewLongObj(), TCL_OK, Tcl_ResetResult(), TclDecrRefCount, TclExprFloatError(), TclGetLongFromWide, tclIntType, tclWideIntType, Tcl_Obj::typePtr, and VerifyExprObjType().5201 {
5202     Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
5203     register int stackTop;  /* Cached top index of evaluation stack. */
5204     register Tcl_Obj *valuePtr;
5205     long iResult;
5206     double d;
5207     int result;
5208 
5209     /*
5210      * Set stackPtr and stackTop from eePtr.
5211      */
5212 
5213     result = TCL_OK;
5214     CACHE_STACK_INFO();
5215 
5216     /*
5217      * Pop the argument from the evaluation stack.
5218      */
5219 
5220     valuePtr = POP_OBJECT();
5221     
5222     if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
5223   result = TCL_ERROR;
5224   goto done;
5225     }
5226     
5227     if (valuePtr->typePtr == &tclIntType) {
5228   iResult = valuePtr->internalRep.longValue;
5229     } else if (valuePtr->typePtr == &tclWideIntType) {
5230   TclGetLongFromWide(iResult,valuePtr);
5231     } else {
5232   d = valuePtr->internalRep.doubleValue;
5233   if (d < 0.0) {
5234       if (d < (double) (long) LONG_MIN) {
5235     tooLarge:
5236     Tcl_ResetResult(interp);
5237     Tcl_AppendToObj(Tcl_GetObjResult(interp),
5238             "integer value too large to represent", -1);
5239     Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
5240       "integer value too large to represent", (char *) NULL);
5241     result = TCL_ERROR;
5242     goto done;
5243       }
5244   } else {
5245       if (d > (double) LONG_MAX) {
5246     goto tooLarge;
5247       }
5248   }
5249   if (IS_NAN(d) || IS_INF(d)) {
5250       TclExprFloatError(interp, d);
5251       result = TCL_ERROR;
5252       goto done;
5253   }
5254   iResult = (long) d;
5255     }
5256 
5257     /*
5258      * Push a Tcl object with the result.
5259      */
5260     
5261     PUSH_OBJECT(Tcl_NewLongObj(iResult));
5262 
5263     /*
5264      * Reflect the change to stackTop back in eePtr.
5265      */
5266 
5267     done:
5268     TclDecrRefCount(valuePtr);
5269     DECACHE_STACK_INFO();
5270     return result;
5271 }
static int ExprRandFunc (Tcl_Interp * interp, ExecEnv * eePtr, ClientData clientData) [static]

Definition at line 5353 of file tclExecute.c.
References CACHE_STACK_INFO, DECACHE_STACK_INFO, Interp::flags, PUSH_OBJECT, RAND_IA, RAND_IM, RAND_IQ, RAND_IR, RAND_SEED_INITIALIZED, Interp::randSeed, Tcl_GetCurrentThread(), Tcl_NewDoubleObj(), TCL_OK, and TclpGetClicks().
Referenced by ExprSrandFunc().5359 {
5360     Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
5361     register int stackTop;  /* Cached top index of evaluation stack. */
5362     Interp *iPtr = (Interp *) interp;
5363     double dResult;
5364     long tmp;     /* Algorithm assumes at least 32 bits.
5365          * Only long guarantees that.  See below. */
5366 
5367     if (!(iPtr->flags & RAND_SEED_INITIALIZED)) {
5368   iPtr->flags |= RAND_SEED_INITIALIZED;
5369         
5370         /* 
5371    * Take into consideration the thread this interp is running in order
5372    * to insure different seeds in different threads (bug #416643)
5373    */
5374 
5375   iPtr->randSeed = TclpGetClicks() + ((long)Tcl_GetCurrentThread()<<12);
5376 
5377   /*
5378    * Make sure 1 <= randSeed <= (2^31) - 2.  See below.
5379    */
5380 
5381         iPtr->randSeed &= (unsigned long) 0x7fffffff;
5382   if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
5383       iPtr->randSeed ^= 123459876;
5384   }
5385     }
5386     
5387     /*
5388      * Set stackPtr and stackTop from eePtr.
5389      */
5390     
5391     CACHE_STACK_INFO();
5392 
5393     /*
5394      * Generate the random number using the linear congruential
5395      * generator defined by the following recurrence:
5396      *    seed = ( IA * seed ) mod IM
5397      * where IA is 16807 and IM is (2^31) - 1.  The recurrence maps
5398      * a seed in the range [1, IM - 1] to a new seed in that same range.
5399      * The recurrence maps IM to 0, and maps 0 back to 0, so those two
5400      * values must not be allowed as initial values of seed.
5401      *
5402      * In order to avoid potential problems with integer overflow, the
5403      * recurrence is implemented in terms of additional constants
5404      * IQ and IR such that
5405      *    IM = IA*IQ + IR
5406      * None of the operations in the implementation overflows a 32-bit
5407      * signed integer, and the C type long is guaranteed to be at least
5408      * 32 bits wide.
5409      *
5410      * For more details on how this algorithm works, refer to the following
5411      * papers: 
5412      *
5413      *  S.K. Park & K.W. Miller, "Random number generators: good ones
5414      *  are hard to find," Comm ACM 31(10):1192-1201, Oct 1988
5415      *
5416      *  W.H. Press & S.A. Teukolsky, "Portable random number
5417      *  generators," Computers in Physics 6(5):522-524, Sep/Oct 1992.
5418      */
5419 
5420 #define RAND_IA   16807
5421 #define RAND_IM   2147483647
5422 #define RAND_IQ   127773
5423 #define RAND_IR   2836
5424 #define RAND_MASK 123459876
5425 
5426     tmp = iPtr->randSeed/RAND_IQ;
5427     iPtr->randSeed = RAND_IA*(iPtr->randSeed - tmp*RAND_IQ) - RAND_IR*tmp;
5428     if (iPtr->randSeed < 0) {
5429   iPtr->randSeed += RAND_IM;
5430     }
5431 
5432     /*
5433      * Since the recurrence keeps seed values in the range [1, RAND_IM - 1],
5434      * dividing by RAND_IM yields a double in the range (0, 1).
5435      */
5436 
5437     dResult = iPtr->randSeed * (1.0/RAND_IM);
5438 
5439     /*
5440      * Push a Tcl object with the result.
5441      */
5442 
5443     PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
5444     
5445     /*
5446      * Reflect the change to stackTop back in eePtr.
5447      */
5448 
5449     DECACHE_STACK_INFO();
5450     return TCL_OK;
5451 }
static int ExprRoundFunc (Tcl_Interp * interp, ExecEnv * eePtr, ClientData clientData) [static]

Definition at line 5454 of file tclExecute.c.
References CACHE_STACK_INFO, DECACHE_STACK_INFO, Tcl_Obj::doubleValue, Tcl_Obj::internalRep, LLONG_MAX, LLONG_MIN, LONG_MAX, LONG_MIN, NULL, POP_OBJECT, PUSH_OBJECT, Tcl_AppendToObj(), Tcl_DoubleAsWide, TCL_ERROR, Tcl_GetObjResult(), Tcl_NewLongObj(), Tcl_NewWideIntObj(), TCL_OK, Tcl_ResetResult(), Tcl_WideAsDouble, TclDecrRefCount, tclIntType, tclWideIntType, Tcl_Obj::typePtr, and VerifyExprObjType().5460 {
5461     Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
5462     register int stackTop;  /* Cached top index of evaluation stack. */
5463     Tcl_Obj *valuePtr, *resPtr;
5464     double d, f, i;
5465     int result;
5466 
5467     /*
5468      * Set stackPtr and stackTop from eePtr.
5469      */
5470 
5471     result = TCL_OK;
5472     CACHE_STACK_INFO();
5473 
5474     /*
5475      * Pop the argument from the evaluation stack.
5476      */
5477 
5478     valuePtr = POP_OBJECT();
5479 
5480     if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
5481   result = TCL_ERROR;
5482   goto done;
5483     }
5484 
5485     if ((valuePtr->typePtr == &tclIntType) ||
5486       (valuePtr->typePtr == &tclWideIntType)) {
5487   result = TCL_OK;
5488   resPtr = valuePtr;
5489     } else {
5490 
5491   /* 
5492    * Round the number to the nearest integer.  I'd like to use round(),
5493    * but it's C99 (or BSD), and not yet universal.
5494    */
5495   
5496   d = valuePtr->internalRep.doubleValue;
5497   f = modf(d, &i);
5498   if (d < 0.0) {
5499       if (f <= -0.5) {
5500     i += -1.0;
5501       }
5502       if (i <= Tcl_WideAsDouble(LLONG_MIN)) {
5503     goto tooLarge;
5504       } else if (i <= (double) LONG_MIN) {
5505     resPtr = Tcl_NewWideIntObj(Tcl_DoubleAsWide(i));
5506       } else {
5507     resPtr = Tcl_NewLongObj((long) i);
5508       }         
5509   } else {
5510       if (f >= 0.5) {
5511     i += 1.0;
5512       }
5513       if (i >= Tcl_WideAsDouble(LLONG_MAX)) {
5514     goto tooLarge;
5515       } else if (i >= (double) LONG_MAX) {
5516     resPtr = Tcl_NewWideIntObj(Tcl_DoubleAsWide(i));
5517       } else {
5518     resPtr = Tcl_NewLongObj((long) i);
5519       }
5520   }
5521     }
5522 
5523     /*
5524      * Push the result object and free the argument Tcl_Obj.
5525      */
5526 
5527     PUSH_OBJECT(resPtr);
5528     
5529     done:
5530     TclDecrRefCount(valuePtr);
5531     DECACHE_STACK_INFO();
5532     return result;
5533 
5534     /*
5535      * Error return: result cannot be represented as an integer.
5536      */
5537     
5538     tooLarge:
5539     Tcl_ResetResult(interp);
5540     Tcl_AppendToObj(Tcl_GetObjResult(interp),
5541       "integer value too large to represent", -1);
5542     Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
5543       "integer value too large to represent",
5544       (char *) NULL);
5545     result = TCL_ERROR;
5546     goto done;
5547 }
static int ExprSrandFunc (Tcl_Interp * interp, ExecEnv * eePtr, ClientData clientData) [static]

Definition at line 5550 of file tclExecute.c.
References CACHE_STACK_INFO, DECACHE_STACK_INFO, ExprRandFunc(), Interp::flags, NULL, POP_OBJECT, RAND_SEED_INITIALIZED, Interp::randSeed, Tcl_AddErrorInfo(), TCL_ERROR, Tcl_GetLongFromObj(), Tcl_GetWideIntFromObj(), TCL_OK, Tcl_WideAsLong, TclDecrRefCount, and VerifyExprObjType().5556 {
5557     Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
5558     register int stackTop;  /* Cached top index of evaluation stack. */
5559     Interp *iPtr = (Interp *) interp;
5560     Tcl_Obj *valuePtr;
5561     long i = 0;     /* Initialized to avoid compiler warning. */
5562 
5563     /*
5564      * Set stackPtr and stackTop from eePtr.
5565      */
5566     
5567     CACHE_STACK_INFO();
5568 
5569     /*
5570      * Pop the argument from the evaluation stack.  Use the value
5571      * to reset the random number seed.
5572      */
5573 
5574     valuePtr = POP_OBJECT();
5575 
5576     if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
5577   goto badValue;
5578     }
5579 
5580     if (Tcl_GetLongFromObj(NULL, valuePtr, &i) != TCL_OK) {
5581   Tcl_WideInt w;
5582 
5583   if (Tcl_GetWideIntFromObj(interp, valuePtr, &w) != TCL_OK) {
5584   badValue:
5585       Tcl_AddErrorInfo(interp, "\n    (argument to \"srand()\")");
5586       TclDecrRefCount(valuePtr);
5587       DECACHE_STACK_INFO();
5588       return TCL_ERROR;
5589   }
5590 
5591   i = Tcl_WideAsLong(w);
5592     }
5593     
5594     /*
5595      * Reset the seed.  Make sure 1 <= randSeed <= 2^31 - 2.
5596      * See comments in ExprRandFunc() for more details.
5597      */
5598 
5599     iPtr->flags |= RAND_SEED_INITIALIZED;
5600     iPtr->randSeed = i;
5601     iPtr->randSeed &= (unsigned long) 0x7fffffff;
5602     if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
5603   iPtr->randSeed ^= 123459876;
5604     }
5605 
5606     /*
5607      * To avoid duplicating the random number generation code we simply
5608      * clean up our state and call the real random number function. That
5609      * function will always succeed.
5610      */
5611     
5612     TclDecrRefCount(valuePtr);
5613     DECACHE_STACK_INFO();
5614 
5615     ExprRandFunc(interp, eePtr, clientData);
5616     return TCL_OK;
5617 }
static int ExprUnaryFunc (Tcl_Interp * interp, ExecEnv * eePtr, ClientData clientData) [static]

Definition at line 4907 of file tclExecute.c.
References _ANSI_ARGS_, CACHE_STACK_INFO, DECACHE_STACK_INFO, errno, GET_DOUBLE_VALUE, IS_INF, IS_NAN, POP_OBJECT, PUSH_OBJECT, TCL_ERROR, Tcl_NewDoubleObj(), TCL_OK, TclDecrRefCount, TclExprFloatError(), Tcl_Obj::typePtr, and VerifyExprObjType().4915 {
4916     Tcl_Obj **stackPtr;   /* Cached evaluation stack base pointer. */
4917     register int stackTop;  /* Cached top index of evaluation stack. */
4918     register Tcl_Obj *valuePtr;
4919     double d, dResult;
4920     int result;
4921     
4922     double (*func) _ANSI_ARGS_((double)) =
4923   (double (*)_ANSI_ARGS_((double))) clientData;
4924 
4925     /*
4926      * Set stackPtr and stackTop from eePtr.
4927      */
4928 
4929     result = TCL_OK;
4930     CACHE_STACK_INFO();
4931 
4932     /*
4933      * Pop the function's argument from the evaluation stack. Convert it
4934      * to a double if necessary.
4935      */
4936 
4937     valuePtr = POP_OBJECT();
4938 
4939     if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
4940   result = TCL_ERROR;
4941   goto done;
4942     }
4943 
4944     GET_DOUBLE_VALUE(d, valuePtr, valuePtr->typePtr);
4945 
4946     errno = 0;
4947     dResult = (*func)(d);
4948     if ((errno != 0) || IS_NAN(dResult) || IS_INF(dResult)) {
4949   TclExprFloatError(interp, dResult);
4950   result = TCL_ERROR;
4951   goto done;
4952     }
4953     
4954     /*
4955      * Push a Tcl object holding the result.
4956      */
4957 
4958     PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
4959     
4960     /*
4961      * Reflect the change to stackTop back in eePtr.
4962      */
4963 
4964     done:
4965     TclDecrRefCount(valuePtr);
4966     DECACHE_STACK_INFO();
4967     return result;
4968 }
static int ExprWideFunc (Tcl_Interp * interp, ExecEnv * eePtr, ClientData clientData) [static]

Definition at line 5274 of file tclExecute.c.
References CACHE_STACK_INFO, DECACHE_STACK_INFO, Tcl_Obj::doubleValue, Tcl_Obj::internalRep, IS_INF, IS_NAN, LLONG_MAX, LLONG_MIN, Tcl_Obj::longValue, NULL, POP_OBJECT, PUSH_OBJECT, Tcl_AppendToObj(), Tcl_DoubleAsWide, TCL_ERROR, Tcl_GetObjResult(), Tcl_LongAsWide, Tcl_NewWideIntObj(), TCL_OK, Tcl_ResetResult(), Tcl_WideAsDouble, TclDecrRefCount, TclExprFloatError(), TclGetWide, tclIntType, tclWideIntType, Tcl_Obj::typePtr, and VerifyExprObjType().5280 {
5281     Tcl_Obj **stackPtr;        /* Cached evaluation stack base pointer. */
5282     register int stackTop;  /* Cached top index of evaluation stack. */
5283     register Tcl_Obj *valuePtr;
5284     Tcl_WideInt wResult;
5285     double d;
5286     int result;
5287 
5288     /*
5289      * Set stackPtr and stackTop from eePtr.
5290      */
5291 
5292     result = TCL_OK;
5293     CACHE_STACK_INFO();
5294 
5295     /*
5296      * Pop the argument from the evaluation stack.
5297      */
5298 
5299     valuePtr = POP_OBJECT();
5300     
5301     if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
5302   result = TCL_ERROR;
5303   goto done;
5304     }
5305     
5306     if (valuePtr->typePtr == &tclWideIntType) {
5307   TclGetWide(wResult,valuePtr);
5308     } else if (valuePtr->typePtr == &tclIntType) {
5309   wResult = Tcl_LongAsWide(valuePtr->internalRep.longValue);
5310     } else {
5311   d = valuePtr->internalRep.doubleValue;
5312   if (d < 0.0) {
5313       if (d < Tcl_WideAsDouble(LLONG_MIN)) {
5314     tooLarge:
5315     Tcl_ResetResult(interp);
5316     Tcl_AppendToObj(Tcl_GetObjResult(interp),
5317             "integer value too large to represent", -1);
5318     Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
5319       "integer value too large to represent", (char *) NULL);
5320     result = TCL_ERROR;
5321     goto done;
5322       }
5323   } else {
5324       if (d > Tcl_WideAsDouble(LLONG_MAX)) {
5325     goto tooLarge;
5326       }
5327   }
5328   if (IS_NAN(d) || IS_INF(d)) {
5329       TclExprFloatError(interp, d);
5330       result = TCL_ERROR;
5331       goto done;
5332   }
5333   wResult = Tcl_DoubleAsWide(d);
5334     }
5335 
5336     /*
5337      * Push a Tcl object with the result.
5338      */
5339     
5340     PUSH_OBJECT(Tcl_NewWideIntObj(wResult));
5341 
5342     /*
5343      * Reflect the change to stackTop back in eePtr.
5344      */
5345 
5346     done:
5347     TclDecrRefCount(valuePtr);
5348     DECACHE_STACK_INFO();
5349     return result;
5350 }
static ExceptionRange* GetExceptRangeForPc (unsigned char * pc, int catchOnly, ByteCode* codePtr) [static]

Definition at line 4757 of file tclExecute.c.
References CATCH_EXCEPTION_RANGE, ExceptionRange::codeOffset, ByteCode::codeStart, ByteCode::exceptArrayPtr, NULL, ExceptionRange::numCodeBytes, ByteCode::numExceptRanges, and ExceptionRange::type.
Referenced by TclExecuteByteCode().4768 {
4769     ExceptionRange *rangeArrayPtr;
4770     int numRanges = codePtr->numExceptRanges;
4771     register ExceptionRange *rangePtr;
4772     int pcOffset = (pc - codePtr->codeStart);
4773     register int start;
4774 
4775     if (numRanges == 0) {
4776   return NULL;
4777     }
4778 
4779     /* 
4780      * This exploits peculiarities of our compiler: nested ranges
4781      * are always *after* their containing ranges, so that by scanning
4782      * backwards we are sure that the first matching range is indeed
4783      * the deepest.
4784      */
4785 
4786     rangeArrayPtr = codePtr->exceptArrayPtr;
4787     rangePtr = rangeArrayPtr + numRanges;
4788     while (--rangePtr >= rangeArrayPtr) {
4789   start = rangePtr->codeOffset;
4790   if ((start <= pcOffset) &&
4791           (pcOffset < (start + rangePtr->numCodeBytes))) {
4792       if ((!catchOnly)
4793         || (rangePtr->type == CATCH_EXCEPTION_RANGE)) {
4794     return rangePtr;
4795       }
4796   }
4797     }
4798     return NULL;
4799 }
static char* GetSrcInfoForPc (unsigned char * pc, ByteCode * codePtr, int * lengthPtr) [static]

Definition at line 4634 of file tclExecute.c.
References ByteCode::codeDeltaStart, ByteCode::codeLengthStart, ByteCode::codeStart, INT_MAX, NULL, ByteCode::numCodeBytes, ByteCode::numCommands, ByteCode::source, ByteCode::srcDeltaStart, ByteCode::srcLengthStart, TclGetInt1AtPtr, and TclGetInt4AtPtr.
Referenced by TclExecuteByteCode().4644 {
4645     register int pcOffset = (pc - codePtr->codeStart);
4646     int numCmds = codePtr->numCommands;
4647     unsigned char *codeDeltaNext, *codeLengthNext;
4648     unsigned char *srcDeltaNext, *srcLengthNext;
4649     int codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
4650     int bestDist = INT_MAX; /* Distance of pc to best cmd's start pc. */
4651     int bestSrcOffset = -1; /* Initialized to avoid compiler warning. */
4652     int bestSrcLength = -1; /* Initialized to avoid compiler warning. */
4653 
4654     if ((pcOffset < 0) || (pcOffset >= codePtr->numCodeBytes)) {
4655   return NULL;
4656     }
4657 
4658     /*
4659      * Decode the code and source offset and length for each command. The
4660      * closest enclosing command is the last one whose code started before
4661      * pcOffset.
4662      */
4663 
4664     codeDeltaNext = codePtr->codeDeltaStart;
4665     codeLengthNext = codePtr->codeLengthStart;
4666     srcDeltaNext  = codePtr->srcDeltaStart;
4667     srcLengthNext = codePtr->srcLengthStart;
4668     codeOffset = srcOffset = 0;
4669     for (i = 0;  i < numCmds;  i++) {
4670   if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
4671       codeDeltaNext++;
4672       delta = TclGetInt4AtPtr(codeDeltaNext);
4673       codeDeltaNext += 4;
4674   } else {
4675       delta = TclGetInt1AtPtr(codeDeltaNext);
4676       codeDeltaNext++;
4677   }
4678   codeOffset += delta;
4679 
4680   if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
4681       codeLengthNext++;
4682       codeLen = TclGetInt4AtPtr(codeLengthNext);
4683       codeLengthNext += 4;
4684   } else {
4685       codeLen = TclGetInt1AtPtr(codeLengthNext);
4686       codeLengthNext++;
4687   }
4688   codeEnd = (codeOffset + codeLen - 1);
4689 
4690   if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
4691       srcDeltaNext++;
4692       delta = TclGetInt4AtPtr(srcDeltaNext);
4693       srcDeltaNext += 4;
4694   } else {
4695       delta = TclGetInt1AtPtr(srcDeltaNext);
4696       srcDeltaNext++;
4697   }
4698   srcOffset += delta;
4699 
4700   if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
4701       srcLengthNext++;
4702       srcLen = TclGetInt4AtPtr(srcLengthNext);
4703       srcLengthNext += 4;
4704   } else {
4705       srcLen = TclGetInt1AtPtr(srcLengthNext);
4706       srcLengthNext++;
4707   }
4708   
4709   if (codeOffset > pcOffset) {      /* best cmd already found */
4710       break;
4711   } else if (pcOffset <= codeEnd) { /* this cmd's code encloses pc */
4712       int dist = (pcOffset - codeOffset);
4713       if (dist <= bestDist) {
4714     bestDist = dist;
4715     bestSrcOffset = srcOffset;
4716     bestSrcLength = srcLen;
4717       }
4718   }
4719     }
4720 
4721     if (bestDist == INT_MAX) {
4722   return NULL;
4723     }
4724     
4725     if (lengthPtr != NULL) {
4726   *lengthPtr = bestSrcLength;
4727     }
4728     return (codePtr->source + bestSrcOffset);
4729 }
static void GrowEvaluationStack (ExecEnv * eePtr) [static]

Definition at line 599 of file tclExecute.c.
References ckalloc, ckfree, size_t(), and VOID.
Referenced by TclExecuteByteCode().602 {
603     /*
604      * The current Tcl stack elements are stored from eePtr->stackPtr[0]
605      * to eePtr->stackPtr[eePtr->stackEnd] (inclusive).
606      */
607 
608     int currElems = (eePtr->stackEnd + 1);
609     int newElems  = 2*currElems;
610     int currBytes = currElems * sizeof(Tcl_Obj *);
611     int newBytes  = 2*currBytes;
612     Tcl_Obj **newStackPtr = (Tcl_Obj **) ckalloc((unsigned) newBytes);
613     Tcl_Obj **oldStackPtr = eePtr->stackPtr;
614 
615     /*
616      * We keep the stack reference count as a (char *), as that
617      * works nicely as a portable pointer-sized counter.
618      */
619 
620     char *refCount = (char *) oldStackPtr[-1];
621 
622     /*
623      * Copy the existing stack items to the new stack space, free the old
624      * storage if appropriate, and record the refCount of the new stack
625      * held by the environment.
626      */
627  
628     newStackPtr++;
629     memcpy((VOID *) newStackPtr, (VOID *) oldStackPtr,
630      (size_t) currBytes);
631 
632     if (refCount == (char *) 1) {
633   ckfree((VOID *) (oldStackPtr-1));
634     } else {
635   /*
636    * Remove the reference corresponding to the
637    * environment pointer.
638    */
639   
640   oldStackPtr[-1] = (Tcl_Obj *) (refCount-1);
641     }
642 
643     eePtr->stackPtr = newStackPtr;
644     eePtr->stackEnd = (newElems - 2); /* index of last usable item */
645     newStackPtr[-1] = (Tcl_Obj *) ((char *) 1); 
646 }
static void IllegalExprOperandType (Tcl_Interp * interp, unsigned char * pc, Tcl_Obj * opndPtr) [static]

Definition at line 4491 of file tclExecute.c.
References Tcl_Obj::bytes, INST_LOR, Tcl_Obj::length, NULL, Tcl_GetDouble(), Tcl_GetObjResult(), Tcl_GetStringFromObj(), TCL_OK, Tcl_ResetResult(), TclCheckBadOctal(), and UCHAR.
Referenced by TclExecuteByteCode().4498 {
4499     unsigned char opCode = *pc;
4500     
4501     Tcl_ResetResult(interp);
4502     if ((opndPtr->bytes == NULL) || (opndPtr->length == 0)) {
4503   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
4504     "can't use empty string as operand of \"",
4505     operatorStrings[opCode - INST_LOR], "\"", (char *) NULL);
4506     } else {
4507   char *msg = "non-numeric string";
4508   char *s, *p;
4509   int length;
4510   int looksLikeInt = 0;
4511 
4512   s = Tcl_GetStringFromObj(opndPtr, &length);
4513   p = s;
4514   /*
4515    * strtod() isn't at all consistent about detecting Inf and
4516    * NaN between platforms.
4517    */
4518   if (length == 3) {
4519       if ((s[0]=='n' || s[0]=='N') && (s[1]=='a' || s[1]=='A') &&
4520         (s[2]=='n' || s[2]=='N')) {
4521     msg = "non-numeric floating-point value";
4522     goto makeErrorMessage;
4523       }
4524       if ((s[0]=='i' || s[0]=='I') && (s[1]=='n' || s[1]=='N') &&
4525         (s[2]=='f' || s[2]=='F')) {
4526     msg = "infinite floating-point value";
4527     goto makeErrorMessage;
4528       }
4529   }
4530 
4531   /*
4532    * We cannot use TclLooksLikeInt here because it passes strings
4533    * like "10;" [Bug 587140]. We'll accept as "looking like ints"
4534    * for the present purposes any string that looks formally like
4535    * a (decimal|octal|hex) integer.
4536    */
4537 
4538   while (length && isspace(UCHAR(*p))) {
4539       length--;
4540       p++;
4541   }
4542   if (length && ((*p == '+') || (*p == '-'))) {
4543       length--;
4544       p++;
4545   }
4546   if (length) {
4547       if ((*p == '0') && ((*(p+1) == 'x') || (*(p+1) == 'X'))) {
4548     p += 2;
4549     length -= 2;
4550     looksLikeInt = ((length > 0) && isxdigit(UCHAR(*p)));
4551     if (looksLikeInt) {
4552         length--;
4553         p++;
4554         while (length && isxdigit(UCHAR(*p))) {
4555       length--;
4556       p++;
4557         }
4558     }
4559       } else {
4560     looksLikeInt = (length && isdigit(UCHAR(*p)));
4561     if (looksLikeInt) {
4562         length--;
4563         p++;
4564         while (length && isdigit(UCHAR(*p))) {
4565       length--;
4566       p++;
4567         }
4568     }
4569       }
4570       while (length && isspace(UCHAR(*p))) {
4571     length--;
4572     p++;
4573       }
4574       looksLikeInt = !length;
4575   }
4576   if (looksLikeInt) {
4577       /*
4578        * If something that looks like an integer could not be
4579        * converted, then it *must* be a bad octal or too large
4580        * to represent [Bug 542588].
4581        */
4582 
4583       if (TclCheckBadOctal(NULL, s)) {
4584     msg = "invalid octal number";
4585       } else {
4586     msg = "integer value too large to represent";
4587     Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
4588         "integer value too large to represent", (char *) NULL);
4589       }
4590   } else {
4591       /*
4592        * See if the operand can be interpreted as a double in
4593        * order to improve the error message.
4594        */
4595 
4596       double d;
4597 
4598       if (Tcl_GetDouble((Tcl_Interp *) NULL, s, &d) == TCL_OK) {
4599     msg = "floating-point value";
4600       }
4601   }
4602       makeErrorMessage:
4603   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ",
4604     msg, " as operand of \"", operatorStrings[opCode - INST_LOR],
4605     "\"", (char *) NULL);
4606     }
4607 }
static void InitByteCodeExecution (Tcl_Interp * interp) [static]

Definition at line 442 of file tclExecute.c.
References NULL, panic, Tcl_CreateObjCommand(), TCL_LINK_INT, Tcl_LinkVar(), and TCL_OK.
Referenced by TclCreateExecEnv().446 {
447 #ifdef TCL_COMPILE_DEBUG
448     if (Tcl_LinkVar(interp, "tcl_traceExec", (char *) &tclTraceExec,
449         TCL_LINK_INT) != TCL_OK) {
450   panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
451     }
452 #endif
453 #ifdef TCL_COMPILE_STATS    
454     Tcl_CreateObjCommand(interp, "evalstats", EvalStatsCmd,
455       (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
456 #endif /* TCL_COMPILE_STATS */
457 }
TCL_DECLARE_MUTEX (execMutex)

Definition at line 70 of file tclExecute.c.75                                    :
76  *    0: no execution tracing
77  *    1: trace invocations of Tcl procs only
78  *    2: trace invocations of all (not compiled away) commands
79  *    3: display each instruction executed
80  * This variable is linked to the Tcl variable "tcl_traceExec".
81  */
82 
83 int tclTraceExec = 0;
84 #endif
85 
86 /*
87  * Mapping from expression instruction opcodes to strings; used for error
88  * messages. Note that these entries must match the order and number of the
89  * expression opcodes (e.g., INST_LOR) in tclCompile.h.
90  */
91 
92 static char *operatorStrings[] = {
93     "||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
94     "+", "-", "*", "/", "%", "+", "-", "~", "!",
95     "BUILTIN FUNCTION", "FUNCTION",
96     "", "", "", "", "", "", "", "", "eq", "ne",
97 };

int Tcl_ExprObj (Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_Obj ** resultPtrPtr)

Definition at line 673 of file tclExecute.c.
References LiteralTable::buckets, ckfree, AuxData::clientData, CompileEnv::codeNext, CompileEnv::codeStart, Interp::compileEpoch, ByteCode::compileEpoch, ByteCode::flags, Tcl_ObjType::freeIntRepProc, AuxDataType::freeProc, INST_DONE, ByteCode::interpHandle, CompileEnv::localLitTable, NULL, CompileEnv::numSrcBytes, LiteralEntry::objPtr, panic, LiteralTable::staticBuckets, TCL_BYTECODE_PRECOMPILED, Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_NewLongObj(), TCL_OK, tclByteCodeType, TclCompileExpr(), TclEmitOpcode, TclEmitPush, TclFreeCompileEnv(), TclInitByteCodeObj(), TclInitCompileEnv(), TclRegisterLiteral(), TclReleaseLiteral(), Interp::termOffset, and AuxData::type.
Referenced by Tcl_ExprBoolean(), Tcl_ExprBooleanObj(), Tcl_ExprDouble(), Tcl_ExprDoubleObj(), Tcl_ExprLong(), Tcl_ExprLongObj(), Tcl_ExprObjCmd(), Tcl_ExprString(), and TclExecuteByteCode().680 {
681     Interp *iPtr = (Interp *) interp;
682     CompileEnv compEnv;   /* Compilation environment structure
683          * allocated in frame. */
684     LiteralTable *localTablePtr = &(compEnv.localLitTable);
685     register ByteCode *codePtr = NULL;
686             /* Tcl Internal type of bytecode.
687          * Initialized to avoid compiler warning. */
688     AuxData *auxDataPtr;
689     LiteralEntry *entryPtr;
690     Tcl_Obj *saveObjPtr;
691     char *string;
692     int length, i, result;
693 
694     /*
695      * First handle some common expressions specially.
696      */
697 
698     string = Tcl_GetStringFromObj(objPtr, &length);
699     if (length == 1) {
700   if (*string == '0') {
701       *resultPtrPtr = Tcl_NewLongObj(0);
702       Tcl_IncrRefCount(*resultPtrPtr);
703       return TCL_OK;
704   } else if (*string == '1') {
705       *resultPtrPtr = Tcl_NewLongObj(1);
706       Tcl_IncrRefCount(*resultPtrPtr);
707       return TCL_OK;
708   }
709     } else if ((length == 2) && (*string == '!')) {
710   if (*(string+1) == '0') {
711       *resultPtrPtr = Tcl_NewLongObj(1);
712       Tcl_IncrRefCount(*resultPtrPtr);
713       return TCL_OK;
714   } else if (*(string+1) == '1') {
715       *resultPtrPtr = Tcl_NewLongObj(0);
716       Tcl_IncrRefCount(*resultPtrPtr);
717       return TCL_OK;
718   }
719     }
720 
721     /*
722      * Get the ByteCode from the object. If it exists, make sure it hasn't
723      * been invalidated by, e.g., someone redefining a command with a
724      * compile procedure (this might make the compiled code wrong). If
725      * necessary, convert the object to be a ByteCode object and compile it.
726      * Also, if the code was compiled in/for a different interpreter, we
727      * recompile it.
728      *
729      * Precompiled expressions, however, are immutable and therefore
730      * they are not recompiled, even if the epoch has changed.
731      *
732      */
733 
734     if (objPtr->typePtr == &tclByteCodeType) {
735   codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
736   if (((Interp *) *codePtr->interpHandle != iPtr)
737           || (codePtr->compileEpoch != iPtr->compileEpoch)) {
738             if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
739                 if ((Interp *) *codePtr->interpHandle != iPtr) {
740                     panic("Tcl_ExprObj: compiled expression jumped interps");
741                 }
742           codePtr->compileEpoch = iPtr->compileEpoch;
743             } else {
744                 (*tclByteCodeType.freeIntRepProc)(objPtr);
745                 objPtr->typePtr = (Tcl_ObjType *) NULL;
746             }
747   }
748     }
749     if (objPtr->typePtr != &tclByteCodeType) {
750   TclInitCompileEnv(interp, &compEnv, string, length);
751   result = TclCompileExpr(interp, string, length, &compEnv);
752 
753   /*
754    * Free the compilation environment's literal table bucket array if
755    * it was dynamically allocated. 
756    */
757 
758   if (localTablePtr->buckets != localTablePtr->staticBuckets) {
759       ckfree((char *) localTablePtr->buckets);
760   }
761     
762   if (result != TCL_OK) {
763       /*
764        * Compilation errors. Free storage allocated for compilation.
765        */
766 
767 #ifdef TCL_COMPILE_DEBUG
768       TclVerifyLocalLiteralTable(&compEnv);
769 #endif /*TCL_COMPILE_DEBUG*/
770       entryPtr = compEnv.literalArrayPtr;
771       for (i = 0;  i < compEnv.literalArrayNext;  i++) {
772     TclReleaseLiteral(interp, entryPtr->objPtr);
773     entryPtr++;
774       }
775 #ifdef TCL_COMPILE_DEBUG
776       TclVerifyGlobalLiteralTable(iPtr);
777 #endif /*TCL_COMPILE_DEBUG*/
778     
779       auxDataPtr = compEnv.auxDataArrayPtr;
780       for (i = 0;  i < compEnv.auxDataArrayNext;  i++) {
781     if (auxDataPtr->type->freeProc != NULL) {
782         auxDataPtr->type->freeProc(auxDataPtr->clientData);
783     }
784     auxDataPtr++;
785       }
786       TclFreeCompileEnv(&compEnv);
787       return result;
788   }
789 
790   /*
791    * Successful compilation. If the expression yielded no
792    * instructions, push an zero object as the expression's result.
793    */
794       
795   if (compEnv.codeNext == compEnv.codeStart) {
796       TclEmitPush(TclRegisterLiteral(&compEnv, "0", 1, /*onHeap*/ 0),
797               &compEnv);
798   }
799       
800   /*
801    * Add a "done" instruction as the last instruction and change the
802    * object into a ByteCode object. Ownership of the literal objects
803    * and aux data items is given to the ByteCode object.
804    */
805 
806   compEnv.numSrcBytes = iPtr->termOffset;
807   TclEmitOpcode(INST_DONE, &compEnv);
808   TclInitByteCodeObj(objPtr, &compEnv);
809   TclFreeCompileEnv(&compEnv);
810   codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
811 #ifdef TCL_COMPILE_DEBUG
812   if (tclTraceCompile == 2) {
813       TclPrintByteCodeObj(interp, objPtr);
814   }
815 #endif /* TCL_COMPILE_DEBUG */
816     }
817 
818     /*
819      * Execute the expression after first saving the interpreter's result.
820      */
821     
822     saveObjPtr = Tcl_GetObjResult(interp);
823     Tcl_IncrRefCount(saveObjPtr);
824     Tcl_ResetResult(interp);
825 
826     /*
827      * Increment the code's ref count while it is being executed. If
828      * afterwards no references to it remain, free the code.
829      */
830     
831     codePtr->refCount++;
832     result = TclExecuteByteCode(interp, codePtr);
833     codePtr->refCount--;
834     if (codePtr->refCount <= 0) {
835   TclCleanupByteCode(codePtr);
836   objPtr->typePtr = NULL;
837   objPtr->internalRep.otherValuePtr = NULL;
838     }
839     
840     /*
841      * If the expression evaluated successfully, store a pointer to its
842      * value object in resultPtrPtr then restore the old interpreter result.
843      * We increment the object's ref count to reflect the reference that we
844      * are returning to the caller. We also decrement the ref count of the
845      * interpreter's result object after calling Tcl_SetResult since we
846      * next store into that field directly.
847      */
848     
849     if (result == TCL_OK) {
850   *resultPtrPtr = iPtr->objResultPtr;
851   Tcl_IncrRefCount(iPtr->objResultPtr);
852   
853   Tcl_SetObjResult(interp, saveObjPtr);
854     }
855     TclDecrRefCount(saveObjPtr);
856     return result;
857 }
int TclCompEvalObj (Tcl_Interp * interp, Tcl_Obj * objPtr)

Definition at line 880 of file tclExecute.c.
References Interp::cmdCount, Interp::compileEpoch, ByteCode::compileEpoch, ERR_ALREADY_LOGGED, Interp::errorLine, Interp::flags, ByteCode::flags, Tcl_ObjType::freeIntRepProc, Interp::globalNsPtr, Tcl_Obj::internalRep, ByteCode::interpHandle, ByteCode::nsEpoch, ByteCode::nsPtr, CallFrame::nsPtr, NULL, Interp::numLevels, ByteCode::numSrcBytes, Tcl_Obj::otherValuePtr, panic, CallFrame::procPtr, ByteCode::procPtr, ByteCode::refCount, Namespace::resolverEpoch, Tcl_ObjType::setFromAnyProc, Tcl_AsyncInvoke(), Tcl_AsyncReady(), TCL_BYTECODE_PRECOMPILED, TCL_ERROR, Tcl_GetStringFromObj(), Tcl_LogCommandInfo(), TCL_OK, tclByteCodeType, TclCleanupByteCode(), TclExecuteByteCode(), TclInterpReady(), Interp::termOffset, Tcl_Obj::typePtr, and Interp::varFramePtr.
Referenced by Tcl_EvalObjEx(), and TclExecuteByteCode().883 {
884     register Interp *iPtr = (Interp *) interp;
885     register ByteCode* codePtr;   /* Tcl Internal type of bytecode. */
886     int oldCount = iPtr->cmdCount;  /* Used to tell whether any commands
887            * at all were executed. */
888     char *script;
889     int numSrcBytes;
890     int result;
891     Namespace *namespacePtr;
892 
893 
894     /*
895      * Check that the interpreter is ready to execute scripts
896      */
897 
898     iPtr->numLevels++;
899     if (TclInterpReady(interp) == TCL_ERROR) {
900   iPtr->numLevels--;
901   return TCL_ERROR;
902     }
903 
904     if (iPtr->varFramePtr != NULL) {
905         namespacePtr = iPtr->varFramePtr->nsPtr;
906     } else {
907         namespacePtr = iPtr->globalNsPtr;
908     }
909 
910     /* 
911      * If the object is not already of tclByteCodeType, compile it (and
912      * reset the compilation flags in the interpreter; this should be 
913      * done after any compilation).
914      * Otherwise, check that it is "fresh" enough.
915      */
916 
917     if (objPtr->typePtr != &tclByteCodeType) {
918         recompileObj:
919   iPtr->errorLine = 1; 
920   result = tclByteCodeType.setFromAnyProc(interp, objPtr);
921   if (result != TCL_OK) {
922       iPtr->numLevels--;
923       return result;
924   }
925   codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
926     } else {
927   /*
928    * Make sure the Bytecode hasn't been invalidated by, e.g., someone 
929    * redefining a command with a compile procedure (this might make the 
930    * compiled code wrong). 
931    * The object needs to be recompiled if it was compiled in/for a 
932    * different interpreter, or for a different namespace, or for the 
933    * same namespace but with different name resolution rules. 
934    * Precompiled objects, however, are immutable and therefore
935    * they are not recompiled, even if the epoch has changed.
936    *
937    * To be pedantically correct, we should also check that the
938    * originating procPtr is the same as the current context procPtr
939    * (assuming one exists at all - none for global level).  This
940    * code is #def'ed out because [info body] was changed to never
941    * return a bytecode type object, which should obviate us from
942    * the extra checks here.
943    */
944   codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
945   if (((Interp *) *codePtr->interpHandle != iPtr)
946           || (codePtr->compileEpoch != iPtr->compileEpoch)
947 #ifdef CHECK_PROC_ORIGINATION /* [Bug: 3412 Pedantic] */
948     || (codePtr->procPtr != NULL && !(iPtr->varFramePtr &&
949       iPtr->varFramePtr->procPtr == codePtr->procPtr))
950 #endif
951           || (codePtr->nsPtr != namespacePtr)
952           || (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
953             if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
954                 if ((Interp *) *codePtr->interpHandle != iPtr) {
955                     panic("Tcl_EvalObj: compiled script jumped interps");
956                 }
957           codePtr->compileEpoch = iPtr->compileEpoch;
958             } else {
959     /*
960      * This byteCode is invalid: free it and recompile
961      */
962                 tclByteCodeType.freeIntRepProc(objPtr);
963     goto recompileObj;
964       }
965   }
966     }
967 
968     /*
969      * Execute the commands. If the code was compiled from an empty string,
970      * don't bother executing the code.
971      */
972 
973     numSrcBytes = codePtr->numSrcBytes;
974     if ((numSrcBytes > 0) || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
975   /*
976    * Increment the code's ref count while it is being executed. If
977    * afterwards no references to it remain, free the code.
978    */
979   
980   codePtr->refCount++;
981   result = TclExecuteByteCode(interp, codePtr);
982   codePtr->refCount--;
983   if (codePtr->refCount <= 0) {
984       TclCleanupByteCode(codePtr);
985   }
986     } else {
987   result = TCL_OK;
988     }
989     iPtr->numLevels--;
990 
991 
992     /*
993      * If no commands at all were executed, check for asynchronous
994      * handlers so that they at least get one change to execute.
995      * This is needed to handle event loops written in Tcl with
996      * empty bodies.
997      */
998 
999     if ((oldCount == iPtr->cmdCount) && Tcl_AsyncReady()) {
1000   result = Tcl_AsyncInvoke(interp, result);
1001     
1002 
1003   /*
1004    * If an error occurred, record information about what was being
1005    * executed when the error occurred.
1006    */
1007   
1008   if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
1009       script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
1010       Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
1011   }
1012     }
1013 
1014     /*
1015      * Set the interpreter's termOffset member to the offset of the
1016      * character just after the last one executed. We approximate the offset
1017      * of the last character executed by using the number of characters
1018      * compiled. 
1019      */
1020 
1021     iPtr->termOffset = numSrcBytes;
1022     iPtr->flags &= ~ERR_ALREADY_LOGGED;
1023 
1024     return result;
1025 }
ExecEnv* TclCreateExecEnv (Tcl_Interp * interp)

Definition at line 484 of file tclExecute.c.
References ckalloc, ExecEnv::errorCode, ExecEnv::errorInfo, execInitialized, InitByteCodeExecution(), size_t(), ExecEnv::stackEnd, ExecEnv::stackPtr, ExecEnv::stackTop, Tcl_IncrRefCount, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_NewStringObj(), TCL_STACK_INITIAL_SIZE, and TclInitAuxDataTypeTable().
Referenced by Tcl_CreateInterp().487 {
488     ExecEnv *eePtr = (ExecEnv *) ckalloc(sizeof(ExecEnv));
489     Tcl_Obj **stackPtr;
490 
491     stackPtr = (Tcl_Obj **)
492   ckalloc((size_t) (TCL_STACK_INITIAL_SIZE * sizeof(Tcl_Obj *)));
493 
494     /*
495      * Use the bottom pointer to keep a reference count; the 
496      * execution environment holds a reference.
497      */
498 
499     stackPtr++;
500     eePtr->stackPtr = stackPtr;
501     stackPtr[-1] = (Tcl_Obj *) ((char *) 1);
502 
503     eePtr->stackTop = -1;
504     eePtr->stackEnd = (TCL_STACK_INITIAL_SIZE - 2);
505 
506     eePtr->errorInfo = Tcl_NewStringObj("::errorInfo", -1);
507     Tcl_IncrRefCount(eePtr->errorInfo);
508 
509     eePtr->errorCode = Tcl_NewStringObj("::errorCode", -1);
510     Tcl_IncrRefCount(eePtr->errorCode);
511 
512     Tcl_MutexLock(&execMutex);
513     if (!execInitialized) {
514   TclInitAuxDataTypeTable();
515   InitByteCodeExecution(interp);
516   execInitialized = 1;
517     }
518     Tcl_MutexUnlock(&execMutex);
519 
520     return eePtr;
521 }
void TclDeleteExecEnv (ExecEnv * eePtr)

Definition at line 542 of file tclExecute.c.
References ckfree, panic, and TclDecrRefCount.
Referenced by DeleteInterpProc().544 {
545     if (eePtr->stackPtr[-1] == (Tcl_Obj *) ((char *) 1)) {
546   ckfree((char *) (eePtr->stackPtr-1));
547     } else {
548   panic("ERROR: freeing an execEnv whose stack is still in use.\n");
549     }
550     TclDecrRefCount(eePtr->errorInfo);
551     TclDecrRefCount(eePtr->errorCode);
552     ckfree((char *) eePtr);
553 }
static int TclExecuteByteCode (Tcl_Interp * interp, ByteCode * codePtr) [static]

Definition at line 1048 of file tclExecute.c.
References ByteCode::auxDataArrayPtr, ExceptionRange::breakOffset, Tcl_Obj::bytes, CACHE_STACK_INFO, CATCH_EXCEPTION_RANGE, ExceptionRange::catchOffset, ckalloc, ckfree, cleanup(), AuxData::clientData, BuiltinFunc::clientData, CMD_HAS_EXEC_TRACES, ExceptionRange::codeOffset, ByteCode::codeStart, CallFrame::compiledLocals, CONST, ExceptionRange::continueOffset, DECACHE_STACK_INFO, Tcl_Obj::doubleValue, ERR_ALREADY_LOGGED, Interp::execEnvPtr, ExprCallMathFunc(), ForeachInfo::firstValueTemp, Interp::flags, Command::flags, FORCE_LONG, GET_DOUBLE_VALUE, GET_WIDE_OR_INT, GetExceptRangeForPc(), GetSrcInfoForPc(), GrowEvaluationStack(), IllegalExprOperandType(), INST_ADD, INST_APPEND_ARRAY1, INST_APPEND_ARRAY4, INST_APPEND_ARRAY_STK, INST_APPEND_SCALAR1, INST_APPEND_SCALAR4, INST_APPEND_STK, INST_BEGIN_CATCH4, INST_BITAND, INST_BITNOT, INST_BITOR, INST_BITXOR, INST_BREAK, INST_CALL_BUILTIN_FUNC1, INST_CALL_FUNC1, INST_CONCAT1, INST_CONTINUE, INST_DIV, INST_DONE, INST_DUP, INST_END_CATCH, INST_EQ, INST_EVAL_STK, INST_EXPR_STK, INST_FOREACH_START4, INST_FOREACH_STEP4, INST_GE, INST_GT, INST_INCR_ARRAY1, INST_INCR_ARRAY1_IMM, INST_INCR_ARRAY_STK, INST_INCR_ARRAY_STK_IMM, INST_INCR_SCALAR1, INST_INCR_SCALAR1_IMM, INST_INCR_SCALAR_STK, INST_INCR_SCALAR_STK_IMM, INST_INCR_STK, INST_INCR_STK_IMM, INST_INVOKE_STK1, INST_INVOKE_STK4, INST_JUMP1, INST_JUMP4, INST_JUMP_FALSE1, INST_JUMP_FALSE4, INST_JUMP_TRUE1, INST_JUMP_TRUE4, INST_LAND, INST_LAPPEND_ARRAY1, INST_LAPPEND_ARRAY4, INST_LAPPEND_ARRAY_STK, INST_LAPPEND_SCALAR1, INST_LAPPEND_SCALAR4, INST_LAPPEND_STK, INST_LE, INST_LIST, INST_LIST_INDEX, INST_LIST_INDEX_MULTI, INST_LIST_LENGTH, INST_LNOT, INST_LOAD_ARRAY1, INST_LOAD_ARRAY4, INST_LOAD_ARRAY_STK, INST_LOAD_SCALAR1, INST_LOAD_SCALAR4, INST_LOAD_SCALAR_STK, INST_LOAD_STK, INST_LOR, INST_LSET_FLAT, INST_LSET_LIST, INST_LSHIFT, INST_LT, INST_MOD, INST_MULT, INST_NEQ, INST_OVER, INST_POP, INST_PUSH1, INST_PUSH4, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, INST_RSHIFT, INST_STORE_ARRAY1, INST_STORE_ARRAY4, INST_STORE_ARRAY_STK, INST_STORE_SCALAR1, INST_STORE_SCALAR4, INST_STORE_SCALAR_STK, INST_STORE_STK, INST_STR_CMP, INST_STR_EQ, INST_STR_INDEX, INST_STR_LEN, INST_STR_MATCH, INST_STR_NEQ, INST_SUB, INST_TRY_CVT_TO_NUMERIC, INST_UMINUS, INST_UPLUS, Tcl_Obj::internalRep, IS_INF, IS_INTEGER_TYPE, IS_NAN, IS_NUMERIC_TYPE, LAST_BUILTIN_FUNC, Tcl_Obj::length, Trace::level, Var::linkPtr, LLD, Tcl_Obj::longValue, ForeachInfo::loopCtTemp, ByteCode::maxExceptDepth, ByteCode::maxStackDepth, memcmp(), Tcl_ObjType::name, Var::name, NEXT_INST_F, NEXT_INST_V, Trace::nextPtr, NULL, Interp::numLevels, ForeachInfo::numLists, ForeachVarList::numVars, O2S, ByteCode::objArrayPtr, Var::objPtr, Interp::objResultPtr, panic, POP_OBJECT, BuiltinFunc::proc, REQUIRE_WIDE_OR_INT, size_t(), ByteCode::source, ExecEnv::stackEnd, ExecEnv::stackPtr, ExecEnv::stackTop, STATIC_CATCH_STACK_SIZE, Tcl_AddErrorInfo(), Tcl_AddObjErrorInfo(), TCL_APPEND_VALUE, Tcl_AppendToObj(), TCL_BREAK, TCL_CONTINUE, TCL_ERROR, Tcl_ExprObj(), Tcl_GetBooleanFromObj(), Tcl_GetByteArrayFromObj(), Tcl_GetCharLength(), Tcl_GetCommandFromObj(), Tcl_GetDoubleFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_GetUniChar(), Tcl_GetUnicode(), Tcl_GetUnicodeFromObj(), Tcl_IncrRefCount, Tcl_InvalidateStringRep(), Tcl_IsShared, TCL_LEAVE_ERR_MSG, TCL_LIST_ELEMENT, Tcl_ListObjLength(), Tcl_LogCommandInfo(), Tcl_LongAsWide, Tcl_NewByteArrayObj(), Tcl_NewDoubleObj(), Tcl_NewIntObj(), Tcl_NewListObj(), Tcl_NewLongObj(), Tcl_NewStringObj(), Tcl_NewWideIntObj(), TCL_OK, Tcl_ResetResult(), TCL_RETURN, Tcl_SetDoubleObj(), Tcl_SetIntObj(), Tcl_SetLongObj(), Tcl_SetObjResult(), Tcl_SetWideIntObj(), Tcl_StringCaseMatch(), TCL_TRACE_READS, Tcl_UniCharToUtf(), TCL_UTF_MAX, Tcl_WideAsDouble, tclBooleanType, tclBuiltinFuncTable, tclByteArrayType, TclClearVarUndefined, TclCompEvalObj(), TclDecrRefCount, tclDoubleType, TclEvalObjvInternal(), TclExprFloatError(), TclGetInt1AtPtr, TclGetInt4AtPtr, TclGetIntForIndex(), TclGetLongFromWide, TclGetString, TclGetUInt1AtPtr, TclGetUInt4AtPtr, TclGetWide, tclIntType, TclIsVarLink, TclIsVarScalar, TclIsVarUndefined, TclLindexFlat(), TclLindexList(), tclListType, TclLooksLikeInt(), TclLookupArrayElement(), TclLsetFlat(), TclLsetList(), TclNewObj, TclObjLookupVar(), TclPrintInstruction(), TclPrintObject(), TclPtrGetVar(), TclPtrIncrVar(), TclPtrSetVar(), TclpUtfNcmp2(), TclSetVarScalar, tclStringType, TclUniCharMatch(), TclUniCharNcmp, tclWideIntType, TRACE, TRACE_APPEND, TRACE_WITH_OBJ, Var::tracePtr, Interp::tracePtr, ExceptionRange::type, Tcl_Obj::typePtr, Var::value, VAR_IN_HASHTABLE, Interp::varFramePtr, ForeachInfo::varLists, varPtr, void(), VOID, and W0.
Referenced by TclCompEvalObj().1051 {
1052     Interp *iPtr = (Interp *) interp;
1053     ExecEnv *eePtr = iPtr->execEnvPtr;
1054             /* Points to the execution environment. */
1055     register Tcl_Obj **stackPtr = eePtr->stackPtr;
1056             /* Cached evaluation stack base pointer. */
1057     register int stackTop = eePtr->stackTop;
1058             /* Cached top index of evaluation stack. */
1059     register unsigned char *pc = codePtr->codeStart;
1060         /* The current program counter. */
1061     int opnd;     /* Current instruction's operand byte(s). */
1062     int pcAdjustment;   /* Hold pc adjustment after instruction. */
1063     int initStackTop = stackTop;/* Stack top at start of execution. */
1064     ExceptionRange *rangePtr; /* Points to closest loop or catch exception
1065          * range enclosing the pc. Used by various
1066          * instructions and processCatch to
1067          * process break, continue, and errors. */
1068     int result = TCL_OK;  /* Return code returned after execution. */
1069     int storeFlags;
1070     Tcl_Obj *valuePtr, *value2Ptr, *objPtr;
1071     char *bytes;
1072     int length;
1073     long i = 0;     /* Init. avoids compiler warning. */
1074     Tcl_WideInt w;
1075     register int cleanup;
1076     Tcl_Obj *objResultPtr;
1077     char *part1, *part2;
1078     Var *varPtr, *arrayPtr;
1079     CallFrame *varFramePtr = iPtr->varFramePtr;
1080 #ifdef TCL_COMPILE_DEBUG
1081     int traceInstructions = (tclTraceExec == 3);
1082     char cmdNameBuf[21];
1083 #endif
1084 
1085     /*
1086      * This procedure uses a stack to hold information about catch commands.
1087      * This information is the current operand stack top when starting to
1088      * execute the code for each catch command. It starts out with stack-
1089      * allocated space but uses dynamically-allocated storage if needed.
1090      */
1091 
1092 #define STATIC_CATCH_STACK_SIZE 4
1093     int (catchStackStorage[STATIC_CATCH_STACK_SIZE]);
1094     int *catchStackPtr = catchStackStorage;
1095     int catchTop = -1;
1096 
1097 #ifdef TCL_COMPILE_DEBUG
1098     if (tclTraceExec >= 2) {
1099   PrintByteCodeInfo(codePtr);
1100   fprintf(stdout, "  Starting stack top=%d\n", eePtr->stackTop);
1101   fflush(stdout);
1102     }
1103     opnd = 0;     /* Init. avoids compiler warning. */       
1104 #endif
1105     
1106 #ifdef TCL_COMPILE_STATS
1107     iPtr->stats.numExecutions++;
1108 #endif
1109 
1110     /*
1111      * Make sure the catch stack is large enough to hold the maximum number
1112      * of catch commands that could ever be executing at the same time. This
1113      * will be no more than the exception range array's depth.
1114      */
1115 
1116     if (codePtr->maxExceptDepth > STATIC_CATCH_STACK_SIZE) {
1117   catchStackPtr = (int *)
1118           ckalloc(codePtr->maxExceptDepth * sizeof(int));
1119     }
1120 
1121     /*
1122      * Make sure the stack has enough room to execute this ByteCode.
1123      */
1124 
1125     while ((stackTop + codePtr->maxStackDepth) > eePtr->stackEnd) {
1126         GrowEvaluationStack(eePtr); 
1127         stackPtr = eePtr->stackPtr;
1128     }
1129 
1130     /*
1131      * Loop executing instructions until a "done" instruction, a 
1132      * TCL_RETURN, or some error.
1133      */
1134 
1135     goto cleanup0;
1136 
1137     
1138     /*
1139      * Targets for standard instruction endings; unrolled
1140      * for speed in the most frequent cases (instructions that 
1141      * consume up to two stack elements).
1142      *
1143      * This used to be a "for(;;)" loop, with each instruction doing
1144      * its own cleanup.
1145      */
1146     
1147     cleanupV_pushObjResultPtr:
1148     switch (cleanup) {
1149         case 0:
1150       stackPtr[++stackTop] = (objResultPtr);
1151       goto cleanup0;
1152         default:
1153       cleanup -= 2;
1154       while (cleanup--) {
1155     valuePtr = POP_OBJECT();
1156     TclDecrRefCount(valuePtr);
1157       }
1158         case 2: 
1159         cleanup2_pushObjResultPtr:
1160       valuePtr = POP_OBJECT();
1161       TclDecrRefCount(valuePtr);
1162         case 1: 
1163         cleanup1_pushObjResultPtr:
1164       valuePtr = stackPtr[stackTop];
1165       TclDecrRefCount(valuePtr);
1166     }
1167     stackPtr[stackTop] = objResultPtr;
1168     goto cleanup0;
1169     
1170     cleanupV:
1171     switch (cleanup) {
1172         default:
1173       cleanup -= 2;
1174       while (cleanup--) {
1175     valuePtr = POP_OBJECT();
1176     TclDecrRefCount(valuePtr);
1177       }
1178         case 2: 
1179         cleanup2:
1180       valuePtr = POP_OBJECT();
1181       TclDecrRefCount(valuePtr);
1182         case 1: 
1183         cleanup1:
1184       valuePtr = POP_OBJECT();
1185       TclDecrRefCount(valuePtr);
1186         case 0:
1187       /*
1188        * We really want to do nothing now, but this is needed
1189        * for some compilers (SunPro CC)
1190        */
1191       break;
1192     }
1193 
1194     cleanup0:
1195     
1196 #ifdef TCL_COMPILE_DEBUG
1197     ValidatePcAndStackTop(codePtr, pc, stackTop, initStackTop);
1198     if (traceInstructions) {
1199   fprintf(stdout, "%2d: %2d ", iPtr->numLevels, stackTop);
1200   TclPrintInstruction(codePtr, pc);
1201   fflush(stdout);
1202     }
1203 #endif /* TCL_COMPILE_DEBUG */
1204     
1205 #ifdef TCL_COMPILE_STATS    
1206     iPtr->stats.instructionCount[*pc]++;
1207 #endif
1208     switch (*pc) {
1209     case INST_DONE:
1210   if (stackTop <= initStackTop) {
1211       stackTop--;
1212       goto abnormalReturn;
1213   }
1214   
1215   /*
1216    * Set the interpreter's object result to point to the 
1217    * topmost object from the stack, and check for a possible
1218    * [catch]. The stackTop's level and refCount will be handled 
1219    * by "processCatch" or "abnormalReturn".
1220    */
1221 
1222   valuePtr = stackPtr[stackTop];
1223   Tcl_SetObjResult(interp, valuePtr);
1224 #ifdef TCL_COMPILE_DEBUG      
1225   TRACE_WITH_OBJ(("=> return code=%d, result=", result),
1226           iPtr->objResultPtr);
1227   if (traceInstructions) {
1228       fprintf(stdout, "\n");
1229   }
1230 #endif
1231   goto checkForCatch;
1232   
1233     case INST_PUSH1:
1234   objResultPtr = codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)];
1235   TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), objResultPtr);
1236   NEXT_INST_F(2, 0, 1);
1237 
1238     case INST_PUSH4:
1239   objResultPtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)];
1240   TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr);
1241   NEXT_INST_F(5, 0, 1);
1242 
1243     case INST_POP:
1244   TRACE_WITH_OBJ(("=> discarding "), stackPtr[stackTop]);
1245   valuePtr = POP_OBJECT();
1246   TclDecrRefCount(valuePtr);
1247   NEXT_INST_F(1, 0, 0);
1248   
1249     case INST_DUP:
1250   objResultPtr = stackPtr[stackTop];
1251   TRACE_WITH_OBJ(("=> "), objResultPtr);
1252   NEXT_INST_F(1, 0, 1);
1253 
1254     case INST_OVER:
1255   opnd = TclGetUInt4AtPtr( pc+1 );
1256   objResultPtr = stackPtr[ stackTop - opnd ];
1257   TRACE_WITH_OBJ(("=> "), objResultPtr);
1258   NEXT_INST_F(5, 0, 1);
1259 
1260     case INST_CONCAT1:
1261   opnd = TclGetUInt1AtPtr(pc+1);
1262   {
1263       int totalLen = 0;
1264       
1265       /*
1266        * Peephole optimisation for appending an empty string.
1267        * This enables replacing 'K $x [set x{}]' by '$x[set x{}]'
1268        * for fastest execution. Avoid doing the optimisation for wide
1269        * ints - a case where equal strings may refer to different values
1270        * (see [Bug 1251791]).
1271        */
1272 
1273       if ((opnd == 2) && (stackPtr[stackTop-1]->typePtr != &tclWideIntType)) {
1274     Tcl_GetStringFromObj(stackPtr[stackTop], &length);
1275     if (length == 0) {
1276         /* Just drop the top item from the stack */
1277         NEXT_INST_F(2, 1, 0);
1278     }
1279       }
1280 
1281       /*
1282        * Concatenate strings (with no separators) from the top
1283        * opnd items on the stack starting with the deepest item.
1284        * First, determine how many characters are needed.
1285        */
1286 
1287       for (i = (stackTop - (opnd-1));  i <= stackTop;  i++) {
1288     bytes = Tcl_GetStringFromObj(stackPtr[i], &length);
1289     if (bytes != NULL) {
1290         totalLen += length;
1291     }
1292       }
1293 
1294       /*
1295        * Initialize the new append string object by appending the
1296        * strings of the opnd stack objects. Also pop the objects. 
1297        */
1298 
1299       TclNewObj(objResultPtr);
1300       if (totalLen > 0) {
1301     char *p = (char *) ckalloc((unsigned) (totalLen + 1));
1302     objResultPtr->bytes = p;
1303     objResultPtr->length = totalLen;
1304     for (i = (stackTop - (opnd-1));  i <= stackTop;  i++) {
1305         valuePtr = stackPtr[i];
1306         bytes = Tcl_GetStringFromObj(valuePtr, &length);
1307         if (bytes != NULL) {
1308       memcpy((VOID *) p, (VOID *) bytes,
1309              (size_t) length);
1310       p += length;
1311         }
1312     }
1313     *p = '\0';
1314       }
1315     
1316       TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
1317       NEXT_INST_V(2, opnd, 1);
1318   }
1319       
1320     case INST_INVOKE_STK4:
1321   opnd = TclGetUInt4AtPtr(pc+1);
1322   pcAdjustment = 5;
1323   goto doInvocation;
1324 
1325     case INST_INVOKE_STK1:
1326   opnd = TclGetUInt1AtPtr(pc+1);
1327   pcAdjustment = 2;
1328       
1329     doInvocation:
1330   {
1331       int objc = opnd; /* The number of arguments. */
1332       Tcl_Obj **objv;  /* The array of argument objects. */
1333 
1334       /*
1335        * We keep the stack reference count as a (char *), as that
1336        * works nicely as a portable pointer-sized counter.
1337        */
1338 
1339       char **preservedStackRefCountPtr;
1340       
1341       /* 
1342        * Reference to memory block containing
1343        * objv array (must be kept live throughout
1344        * trace and command invokations.) 
1345        */
1346 
1347       objv = &(stackPtr[stackTop - (objc-1)]);
1348 
1349 #ifdef TCL_COMPILE_DEBUG
1350       if (tclTraceExec >= 2) {
1351     if (traceInstructions) {
1352         strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
1353         TRACE(("%u => call ", objc));
1354     } else {
1355         fprintf(stdout, "%d: (%u) invoking ",
1356           iPtr->numLevels,
1357           (unsigned int)(pc - codePtr->codeStart));
1358     }
1359     for (i = 0;  i < objc;  i++) {
1360         TclPrintObject(stdout, objv[i], 15);
1361         fprintf(stdout, " ");
1362     }
1363     fprintf(stdout, "\n");
1364     fflush(stdout);
1365       }
1366 #endif /*TCL_COMPILE_DEBUG*/
1367 
1368       /* 
1369        * If trace procedures will be called, we need a
1370        * command string to pass to TclEvalObjvInternal; note 
1371        * that a copy of the string will be made there to 
1372        * include the ending \0.
1373        */
1374 
1375       bytes = NULL;
1376       length = 0;
1377       if (iPtr->tracePtr != NULL) {
1378     Trace *tracePtr, *nextTracePtr;
1379         
1380     for (tracePtr = iPtr->tracePtr;  tracePtr != NULL;
1381          tracePtr = nextTracePtr) {
1382         nextTracePtr = tracePtr->nextPtr;
1383         if (tracePtr->level == 0 ||
1384       iPtr->numLevels <= tracePtr->level) {
1385       /*
1386        * Traces will be called: get command string
1387        */
1388 
1389       bytes = GetSrcInfoForPc(pc, codePtr, &length);
1390       break;
1391         }
1392     }
1393       } else {    
1394     Command *cmdPtr;
1395     cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
1396     if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
1397         bytes = GetSrcInfoForPc(pc, codePtr, &length);
1398     }
1399       }   
1400 
1401       /*
1402        * A reference to part of the stack vector itself
1403        * escapes our control: increase its refCount
1404        * to stop it from being deallocated by a recursive
1405        * call to ourselves.  The extra variable is needed
1406        * because all others are liable to change due to the
1407        * trace procedures.
1408        */
1409 
1410       preservedStackRefCountPtr = (char **) (stackPtr-1);
1411       ++*preservedStackRefCountPtr;
1412 
1413       /*
1414        * Finally, let TclEvalObjvInternal handle the command. 
1415        */
1416 
1417       DECACHE_STACK_INFO();
1418       Tcl_ResetResult(interp);
1419       result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0);
1420       CACHE_STACK_INFO();
1421 
1422       /*
1423        * If the old stack is going to be released, it is
1424        * safe to do so now, since no references to objv are
1425        * going to be used from now on.
1426        */
1427 
1428       --*preservedStackRefCountPtr;
1429       if (*preservedStackRefCountPtr == (char *) 0) {
1430     ckfree((VOID *) preservedStackRefCountPtr);
1431       }     
1432 
1433       if (result == TCL_OK) {
1434     /*
1435      * Push the call's object result and continue execution
1436      * with the next instruction.
1437      */
1438 
1439     TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
1440             objc, cmdNameBuf), Tcl_GetObjResult(interp));
1441 
1442     objResultPtr = Tcl_GetObjResult(interp);
1443 
1444     /*
1445      * Reset the interp's result to avoid possible duplications
1446      * of large objects [Bug 781585]. We do not call
1447      * Tcl_ResetResult() to avoid any side effects caused by
1448      * the resetting of errorInfo and errorCode [Bug 804681], 
1449      * which are not needed here. We chose instead to manipulate
1450      * the interp's object result directly.
1451      *
1452      * Note that the result object is now in objResultPtr, it
1453      * keeps the refCount it had in its role of iPtr->objResultPtr.
1454      */
1455     {
1456         Tcl_Obj *newObjResultPtr;
1457         TclNewObj(newObjResultPtr);
1458         Tcl_IncrRefCount(newObjResultPtr);
1459         iPtr->objResultPtr = newObjResultPtr;
1460     }
1461 
1462     NEXT_INST_V(pcAdjustment, opnd, -1);
1463       } else {
1464     cleanup = opnd;
1465     goto processExceptionReturn;
1466       }
1467   }
1468 
1469     case INST_EVAL_STK:
1470   /*
1471    * Note to maintainers: it is important that INST_EVAL_STK
1472    * pop its argument from the stack before jumping to
1473    * checkForCatch! DO NOT OPTIMISE!
1474    */
1475 
1476   objPtr = stackPtr[stackTop];
1477   DECACHE_STACK_INFO();
1478   result = TclCompEvalObj(interp, objPtr);
1479   CACHE_STACK_INFO();
1480   if (result == TCL_OK) {
1481       /*
1482        * Normal return; push the eval's object result.
1483        */
1484 
1485       objResultPtr = Tcl_GetObjResult(interp);
1486       TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)),
1487          Tcl_GetObjResult(interp));
1488 
1489       /*
1490        * Reset the interp's result to avoid possible duplications
1491        * of large objects [Bug 781585]. We do not call
1492        * Tcl_ResetResult() to avoid any side effects caused by
1493        * the resetting of errorInfo and errorCode [Bug 804681], 
1494        * which are not needed here. We chose instead to manipulate
1495        * the interp's object result directly.
1496        *
1497        * Note that the result object is now in objResultPtr, it
1498        * keeps the refCount it had in its role of iPtr->objResultPtr.
1499        */
1500       {
1501           Tcl_Obj *newObjResultPtr;
1502     TclNewObj(newObjResultPtr);
1503     Tcl_IncrRefCount(newObjResultPtr);
1504     iPtr->objResultPtr = newObjResultPtr;
1505       }
1506 
1507       NEXT_INST_F(1, 1, -1);
1508   } else {
1509       cleanup = 1;
1510       goto processExceptionReturn;
1511   }
1512 
1513     case INST_EXPR_STK:
1514   objPtr = stackPtr[stackTop];
1515   DECACHE_STACK_INFO();
1516   Tcl_ResetResult(interp);
1517   result = Tcl_ExprObj(interp, objPtr, &valuePtr);
1518   CACHE_STACK_INFO();
1519   if (result != TCL_OK) {
1520       TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", 
1521           O2S(objPtr)), Tcl_GetObjResult(interp));
1522       goto checkForCatch;
1523   }
1524   objResultPtr = valuePtr;
1525   TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
1526   NEXT_INST_F(1, 1, -1); /* already has right refct */
1527 
1528     /*
1529      * ---------------------------------------------------------
1530      *     Start of INST_LOAD instructions.
1531      *
1532      * WARNING: more 'goto' here than your doctor recommended!
1533      * The different instructions set the value of some variables
1534      * and then jump to somme common execution code.
1535      */
1536 
1537     case INST_LOAD_SCALAR1:
1538   opnd = TclGetUInt1AtPtr(pc+1);
1539   varPtr = &(varFramePtr->compiledLocals[opnd]);
1540   part1 = varPtr->name;
1541   while (TclIsVarLink(varPtr)) {
1542       varPtr = varPtr->value.linkPtr;
1543   }
1544   TRACE(("%u => ", opnd));
1545   if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr) 
1546           && (varPtr->tracePtr == NULL)) {
1547       /*
1548        * No errors, no traces: just get the value.
1549        */
1550       objResultPtr = varPtr->value.objPtr;
1551       TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
1552       NEXT_INST_F(2, 0, 1);
1553   }
1554   pcAdjustment = 2;
1555   cleanup = 0;
1556   arrayPtr = NULL;
1557   part2 = NULL;
1558   goto doCallPtrGetVar;
1559 
1560     case INST_LOAD_SCALAR4:
1561   opnd = TclGetUInt4AtPtr(pc+1);
1562   varPtr = &(varFramePtr->compiledLocals[opnd]);
1563   part1 = varPtr->name;
1564   while (TclIsVarLink(varPtr)) {
1565       varPtr = varPtr->value.linkPtr;
1566   }
1567   TRACE(("%u => ", opnd));
1568   if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr) 
1569           && (varPtr->tracePtr == NULL)) {
1570       /*
1571        * No errors, no traces: just get the value.
1572        */
1573       objResultPtr = varPtr->value.objPtr;
1574       TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
1575       NEXT_INST_F(5, 0, 1);
1576   }
1577   pcAdjustment = 5;
1578   cleanup = 0;
1579   arrayPtr = NULL;
1580   part2 = NULL;
1581   goto doCallPtrGetVar;
1582 
1583     case INST_LOAD_ARRAY_STK:
1584   cleanup = 2;
1585   part2 = Tcl_GetString(stackPtr[stackTop]);  /* element name */
1586   objPtr = stackPtr[stackTop-1]; /* array name */
1587   TRACE(("\"%.30s(%.30s)\" => ", O2S(objPtr), part2));
1588   goto doLoadStk;
1589 
1590     case INST_LOAD_STK:
1591     case INST_LOAD_SCALAR_STK:
1592   cleanup = 1;
1593   part2 = NULL;
1594   objPtr = stackPtr[stackTop]; /* variable name */
1595   TRACE(("\"%.30s\" => ", O2S(objPtr)));
1596 
1597     doLoadStk:
1598   part1 = TclGetString(objPtr);
1599   varPtr = TclObjLookupVar(interp, objPtr, part2, 
1600            TCL_LEAVE_ERR_MSG, "read",
1601                  /*createPart1*/ 0,
1602            /*createPart2*/ 1, &arrayPtr);
1603   if (varPtr == NULL) {
1604       TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
1605       result = TCL_ERROR;
1606       goto checkForCatch;
1607   }
1608   if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr) 
1609           && (varPtr->tracePtr == NULL)
1610           && ((arrayPtr == NULL) 
1611             || (arrayPtr->tracePtr == NULL))) {
1612       /*
1613        * No errors, no traces: just get the value.
1614        */
1615       objResultPtr = varPtr->value.objPtr;
1616       TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
1617       NEXT_INST_V(1, cleanup, 1);
1618   }
1619   pcAdjustment = 1;
1620   goto doCallPtrGetVar;
1621 
1622     case INST_LOAD_ARRAY4:
1623   opnd = TclGetUInt4AtPtr(pc+1);
1624   pcAdjustment = 5;
1625   goto doLoadArray;
1626 
1627     case INST_LOAD_ARRAY1:
1628   opnd = TclGetUInt1AtPtr(pc+1);
1629   pcAdjustment = 2;
1630     
1631     doLoadArray:
1632   part2 = TclGetString(stackPtr[stackTop]);
1633   arrayPtr = &(varFramePtr->compiledLocals[opnd]);
1634   part1 = arrayPtr->name;
1635   while (TclIsVarLink(arrayPtr)) {
1636       arrayPtr = arrayPtr->value.linkPtr;
1637   }
1638   TRACE(("%u \"%.30s\" => ", opnd, part2));
1639   varPtr = TclLookupArrayElement(interp, part1, part2, 
1640           TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr);
1641   if (varPtr == NULL) {
1642       TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
1643       result = TCL_ERROR;
1644       goto checkForCatch;
1645   }
1646   if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr) 
1647           && (varPtr->tracePtr == NULL)
1648           && ((arrayPtr == NULL) 
1649             || (arrayPtr->tracePtr == NULL))) {
1650       /*
1651        * No errors, no traces: just get the value.
1652        */
1653       objResultPtr = varPtr->value.objPtr;
1654       TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
1655       NEXT_INST_F(pcAdjustment, 1, 1);
1656   }
1657   cleanup = 1;
1658   goto doCallPtrGetVar;
1659 
1660     doCallPtrGetVar:
1661   /*
1662    * There are either errors or the variable is traced:
1663    * call TclPtrGetVar to process fully.
1664    */
1665 
1666   DECACHE_STACK_INFO();
1667   objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, 
1668           part2, TCL_LEAVE_ERR_MSG);
1669   CACHE_STACK_INFO();
1670   if (objResultPtr == NULL) {
1671       TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
1672       result = TCL_ERROR;
1673       goto checkForCatch;
1674   }
1675   TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
1676   NEXT_INST_V(pcAdjustment, cleanup, 1);
1677 
1678     /*
1679      *     End of INST_LOAD instructions.
1680      * ---------------------------------------------------------
1681      */
1682 
1683     /*
1684      * ---------------------------------------------------------
1685      *     Start of INST_STORE and related instructions.
1686      *
1687      * WARNING: more 'goto' here than your doctor recommended!
1688      * The different instructions set the value of some variables
1689      * and then jump to somme common execution code.
1690      */
1691 
1692     case INST_LAPPEND_STK:
1693   valuePtr = stackPtr[stackTop]; /* value to append */
1694   part2 = NULL;
1695   storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
1696           | TCL_LIST_ELEMENT | TCL_TRACE_READS);
1697   goto doStoreStk;
1698 
1699     case INST_LAPPEND_ARRAY_STK:
1700   valuePtr = stackPtr[stackTop]; /* value to append */
1701   part2 = TclGetString(stackPtr[stackTop - 1]);
1702   storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
1703           | TCL_LIST_ELEMENT | TCL_TRACE_READS);
1704   goto doStoreStk;
1705 
1706     case INST_APPEND_STK:
1707   valuePtr = stackPtr[stackTop]; /* value to append */
1708   part2 = NULL;
1709   storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
1710   goto doStoreStk;
1711 
1712     case INST_APPEND_ARRAY_STK:
1713   valuePtr = stackPtr[stackTop]; /* value to append */
1714   part2 = TclGetString(stackPtr[stackTop - 1]);
1715   storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
1716   goto doStoreStk;
1717 
1718     case INST_STORE_ARRAY_STK:
1719   valuePtr = stackPtr[stackTop];
1720   part2 = TclGetString(stackPtr[stackTop - 1]);
1721   storeFlags = TCL_LEAVE_ERR_MSG;
1722   goto doStoreStk;
1723 
1724     case INST_STORE_STK:
1725     case INST_STORE_SCALAR_STK:
1726   valuePtr = stackPtr[stackTop];
1727   part2 = NULL;
1728   storeFlags = TCL_LEAVE_ERR_MSG;
1729 
1730     doStoreStk:
1731   objPtr = stackPtr[stackTop - 1 - (part2 != NULL)]; /* variable name */
1732   part1 = TclGetString(objPtr);
1733 #ifdef TCL_COMPILE_DEBUG
1734   if (part2 == NULL) {
1735       TRACE(("\"%.30s\" <- \"%.30s\" =>", 
1736               part1, O2S(valuePtr)));
1737   } else {
1738       TRACE(("\"%.30s(%.30s)\" <- \"%.30s\" => ",
1739         part1, part2, O2S(valuePtr)));
1740   }
1741 #endif
1742   varPtr = TclObjLookupVar(interp, objPtr, part2, 
1743            TCL_LEAVE_ERR_MSG, "set",
1744                  /*createPart1*/ 1,
1745            /*createPart2*/ 1, &arrayPtr);
1746   if (varPtr == NULL) {
1747       TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
1748       result = TCL_ERROR;
1749       goto checkForCatch;
1750   }
1751   cleanup = ((part2 == NULL)? 2 : 3);
1752   pcAdjustment = 1;
1753   goto doCallPtrSetVar;
1754 
1755     case INST_LAPPEND_ARRAY4:
1756   opnd = TclGetUInt4AtPtr(pc+1);
1757   pcAdjustment = 5;
1758   storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
1759           | TCL_LIST_ELEMENT | TCL_TRACE_READS);
1760   goto doStoreArray;
1761 
1762     case INST_LAPPEND_ARRAY1:
1763   opnd = TclGetUInt1AtPtr(pc+1);
1764   pcAdjustment = 2;
1765   storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
1766           | TCL_LIST_ELEMENT | TCL_TRACE_READS);
1767   goto doStoreArray;
1768 
1769     case INST_APPEND_ARRAY4:
1770   opnd = TclGetUInt4AtPtr(pc+1);
1771   pcAdjustment = 5;
1772   storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
1773   goto doStoreArray;
1774 
1775     case INST_APPEND_ARRAY1:
1776   opnd = TclGetUInt1AtPtr(pc+1);
1777   pcAdjustment = 2;
1778   storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
1779   goto doStoreArray;
1780 
1781     case INST_STORE_ARRAY4:
1782   opnd = TclGetUInt4AtPtr(pc+1);
1783   pcAdjustment = 5;
1784   storeFlags = TCL_LEAVE_ERR_MSG;
1785   goto doStoreArray;
1786 
1787     case INST_STORE_ARRAY1:
1788   opnd = TclGetUInt1AtPtr(pc+1);
1789   pcAdjustment = 2;
1790   storeFlags = TCL_LEAVE_ERR_MSG;
1791       
1792     doStoreArray:
1793   valuePtr = stackPtr[stackTop];
1794   part2 = TclGetString(stackPtr[stackTop - 1]);
1795   arrayPtr = &(varFramePtr->compiledLocals[opnd]);
1796   part1 = arrayPtr->name;
1797   TRACE(("%u \"%.30s\" <- \"%.30s\" => ",
1798         opnd, part2, O2S(valuePtr)));
1799   while (TclIsVarLink(arrayPtr)) {
1800       arrayPtr = arrayPtr->value.linkPtr;
1801   }
1802   varPtr = TclLookupArrayElement(interp, part1, part2, 
1803           TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr);
1804   if (varPtr == NULL) {
1805       TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
1806       result = TCL_ERROR;
1807       goto checkForCatch;
1808   }
1809   cleanup = 2;
1810   goto doCallPtrSetVar;
1811 
1812     case INST_LAPPEND_SCALAR4:
1813   opnd = TclGetUInt4AtPtr(pc+1);
1814   pcAdjustment = 5;
1815   storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
1816           | TCL_LIST_ELEMENT | TCL_TRACE_READS);
1817   goto doStoreScalar;
1818 
1819     case INST_LAPPEND_SCALAR1:
1820   opnd = TclGetUInt1AtPtr(pc+1);
1821   pcAdjustment = 2;     
1822   storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
1823           | TCL_LIST_ELEMENT | TCL_TRACE_READS);
1824   goto doStoreScalar;
1825 
1826     case INST_APPEND_SCALAR4:
1827   opnd = TclGetUInt4AtPtr(pc+1);
1828   pcAdjustment = 5;
1829   storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
1830   goto doStoreScalar;
1831 
1832     case INST_APPEND_SCALAR1:
1833   opnd = TclGetUInt1AtPtr(pc+1);
1834   pcAdjustment = 2;     
1835   storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
1836   goto doStoreScalar;
1837 
1838     case INST_STORE_SCALAR4:
1839   opnd = TclGetUInt4AtPtr(pc+1);
1840   pcAdjustment = 5;
1841   storeFlags = TCL_LEAVE_ERR_MSG;
1842   goto doStoreScalar;
1843 
1844     case INST_STORE_SCALAR1:
1845   opnd = TclGetUInt1AtPtr(pc+1);
1846   pcAdjustment = 2;
1847   storeFlags = TCL_LEAVE_ERR_MSG;
1848 
1849     doStoreScalar:
1850   valuePtr = stackPtr[stackTop];
1851   varPtr = &(varFramePtr->compiledLocals[opnd]);
1852   part1 = varPtr->name;
1853   TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
1854   while (TclIsVarLink(varPtr)) {
1855       varPtr = varPtr->value.linkPtr;
1856   }
1857   cleanup = 1;
1858   arrayPtr = NULL;
1859   part2 = NULL;
1860 
1861     doCallPtrSetVar:
1862   if ((storeFlags == TCL_LEAVE_ERR_MSG)
1863           && !((varPtr->flags & VAR_IN_HASHTABLE) 
1864             && (varPtr->hPtr == NULL))
1865           && (varPtr->tracePtr == NULL)
1866           && (TclIsVarScalar(varPtr) 
1867             || TclIsVarUndefined(varPtr))
1868           && ((arrayPtr == NULL) 
1869             || (arrayPtr->tracePtr == NULL))) {
1870       /*
1871        * No traces, no errors, plain 'set': we can safely inline.
1872        * The value *will* be set to what's requested, so that 
1873        * the stack top remains pointing to the same Tcl_Obj.
1874        */
1875       valuePtr = varPtr->value.objPtr;
1876       objResultPtr = stackPtr[stackTop];
1877       if (valuePtr != objResultPtr) {
1878     if (valuePtr != NULL) {
1879         TclDecrRefCount(valuePtr);
1880     } else {
1881         TclSetVarScalar(varPtr);
1882         TclClearVarUndefined(varPtr);
1883     }
1884     varPtr->value.objPtr = objResultPtr;
1885     Tcl_IncrRefCount(objResultPtr);
1886       }
1887 #ifndef TCL_COMPILE_DEBUG
1888       if (*(pc+pcAdjustment) == INST_POP) {
1889     NEXT_INST_V((pcAdjustment+1), cleanup, 0);
1890       }
1891 #else
1892   TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
1893 #endif
1894       NEXT_INST_V(pcAdjustment, cleanup, 1);
1895   } else {
1896       DECACHE_STACK_INFO();
1897       objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr, 
1898               part1, part2, valuePtr, storeFlags);
1899       CACHE_STACK_INFO();
1900       if (objResultPtr == NULL) {
1901     TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
1902     result = TCL_ERROR;
1903     goto checkForCatch;
1904       }
1905   }
1906 #ifndef TCL_COMPILE_DEBUG
1907   if (*(pc+pcAdjustment) == INST_POP) {
1908       NEXT_INST_V((pcAdjustment+1), cleanup, 0);
1909   }
1910 #endif
1911   TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
1912   NEXT_INST_V(pcAdjustment, cleanup, 1);
1913 
1914 
1915     /*
1916      *     End of INST_STORE and related instructions.
1917      * ---------------------------------------------------------
1918      */
1919 
1920     /*
1921      * ---------------------------------------------------------
1922      *     Start of INST_INCR instructions.
1923      *
1924      * WARNING: more 'goto' here than your doctor recommended!
1925      * The different instructions set the value of some variables
1926      * and then jump to somme common execution code.
1927      */
1928 
1929     case INST_INCR_SCALAR1:
1930     case INST_INCR_ARRAY1:
1931     case INST_INCR_ARRAY_STK:
1932     case INST_INCR_SCALAR_STK:
1933     case INST_INCR_STK:
1934   opnd = TclGetUInt1AtPtr(pc+1);
1935   valuePtr = stackPtr[stackTop];
1936   if (valuePtr->typePtr == &tclIntType) {
1937       i = valuePtr->internalRep.longValue;
1938   } else if (valuePtr->typePtr == &tclWideIntType) {
1939       TclGetLongFromWide(i,valuePtr);
1940   } else {
1941       REQUIRE_WIDE_OR_INT(result, valuePtr, i, w);
1942       if (result != TCL_OK) {
1943     TRACE_WITH_OBJ(("%u (by %s) => ERROR converting increment amount to int: ",
1944             opnd, O2S(valuePtr)), Tcl_GetObjResult(interp));
1945     DECACHE_STACK_INFO();
1946     Tcl_AddErrorInfo(interp, "\n    (reading increment)");
1947     CACHE_STACK_INFO();
1948     goto checkForCatch;
1949       }
1950       FORCE_LONG(valuePtr, i, w);
1951   }
1952   stackTop--;
1953   TclDecrRefCount(valuePtr);
1954   switch (*pc) {
1955       case INST_INCR_SCALAR1:
1956     pcAdjustment = 2;
1957     goto doIncrScalar;
1958       case INST_INCR_ARRAY1:
1959     pcAdjustment = 2;
1960     goto doIncrArray;
1961       default:
1962     pcAdjustment = 1;
1963     goto doIncrStk;
1964   }
1965 
1966     case INST_INCR_ARRAY_STK_IMM:
1967     case INST_INCR_SCALAR_STK_IMM:
1968     case INST_INCR_STK_IMM:
1969   i = TclGetInt1AtPtr(pc+1);
1970   pcAdjustment = 2;
1971       
1972     doIncrStk:
1973   if ((*pc == INST_INCR_ARRAY_STK_IMM) 
1974           || (*pc == INST_INCR_ARRAY_STK)) {
1975       part2 = TclGetString(stackPtr[stackTop]);
1976       objPtr = stackPtr[stackTop - 1];
1977       TRACE(("\"%.30s(%.30s)\" (by %ld) => ",
1978         O2S(objPtr), part2, i));
1979   } else {
1980       part2 = NULL;
1981       objPtr = stackPtr[stackTop];
1982       TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), i));
1983   }
1984   part1 = TclGetString(objPtr);
1985 
1986   varPtr = TclObjLookupVar(interp, objPtr, part2, 
1987           TCL_LEAVE_ERR_MSG, "read", 0, 1, &arrayPtr);
1988   if (varPtr == NULL) {
1989       DECACHE_STACK_INFO();
1990       Tcl_AddObjErrorInfo(interp,
1991               "\n    (reading value of variable to increment)", -1);
1992       CACHE_STACK_INFO();
1993       TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
1994       result = TCL_ERROR;
1995       goto checkForCatch;
1996   }
1997   cleanup = ((part2 == NULL)? 1 : 2);
1998   goto doIncrVar;
1999 
2000     case INST_INCR_ARRAY1_IMM:
2001   opnd = TclGetUInt1AtPtr(pc+1);
2002   i = TclGetInt1AtPtr(pc+2);
2003   pcAdjustment = 3;
2004 
2005     doIncrArray:
2006   part2 = TclGetString(stackPtr[stackTop]);
2007   arrayPtr = &(varFramePtr->compiledLocals[opnd]);
2008   part1 = arrayPtr->name;
2009   while (TclIsVarLink(arrayPtr)) {
2010       arrayPtr = arrayPtr->value.linkPtr;
2011   }
2012   TRACE(("%u \"%.30s\" (by %ld) => ",
2013         opnd, part2, i));
2014   varPtr = TclLookupArrayElement(interp, part1, part2, 
2015           TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr);
2016   if (varPtr == NULL) {
2017       TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
2018       result = TCL_ERROR;
2019       goto checkForCatch;
2020   }
2021   cleanup = 1;
2022   goto doIncrVar;
2023 
2024     case INST_INCR_SCALAR1_IMM:
2025   opnd = TclGetUInt1AtPtr(pc+1);
2026   i = TclGetInt1AtPtr(pc+2);
2027   pcAdjustment = 3;
2028 
2029     doIncrScalar:
2030   varPtr = &(varFramePtr->compiledLocals[opnd]);
2031   part1 = varPtr->name;
2032   while (TclIsVarLink(varPtr)) {
2033       varPtr = varPtr->value.linkPtr;
2034   }
2035   arrayPtr = NULL;
2036   part2 = NULL;
2037   cleanup = 0;
2038   TRACE(("%u %ld => ", opnd, i));
2039 
2040 
2041     doIncrVar:
2042   objPtr = varPtr->value.objPtr;
2043   if (TclIsVarScalar(varPtr)
2044           && !TclIsVarUndefined(varPtr) 
2045           && (varPtr->tracePtr == NULL)
2046           && ((arrayPtr == NULL) 
2047             || (arrayPtr->tracePtr == NULL))
2048           && (objPtr->typePtr == &tclIntType)) {
2049       /*
2050        * No errors, no traces, the variable already has an
2051        * integer value: inline processing.
2052        */
2053 
2054       i += objPtr->internalRep.longValue;
2055       if (Tcl_IsShared(objPtr)) {
2056     objResultPtr = Tcl_NewLongObj(i);
2057     TclDecrRefCount(objPtr);
2058     Tcl_IncrRefCount(objResultPtr);
2059     varPtr->value.objPtr = objResultPtr;
2060       } else {
2061     Tcl_SetLongObj(objPtr, i);
2062     objResultPtr = objPtr;
2063       }
2064       TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
2065   } else {
2066       DECACHE_STACK_INFO();
2067       objResultPtr = TclPtrIncrVar(interp, varPtr, arrayPtr, part1, 
2068                     part2, i, TCL_LEAVE_ERR_MSG);
2069       CACHE_STACK_INFO();
2070       if (objResultPtr == NULL) {
2071     TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
2072     result = TCL_ERROR;
2073     goto checkForCatch;
2074       }
2075   }
2076   TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
2077 #ifndef TCL_COMPILE_DEBUG
2078   if (*(pc+pcAdjustment) == INST_POP) {
2079       NEXT_INST_V((pcAdjustment+1), cleanup, 0);
2080   }
2081 #endif
2082   NEXT_INST_V(pcAdjustment, cleanup, 1);
2083             
2084     /*
2085      *     End of INST_INCR instructions.
2086      * ---------------------------------------------------------
2087      */
2088 
2089 
2090     case INST_JUMP1:
2091   opnd = TclGetInt1AtPtr(pc+1);
2092   TRACE(("%d => new pc %u\n", opnd,
2093           (unsigned int)(pc + opnd - codePtr->codeStart)));
2094   NEXT_INST_F(opnd, 0, 0);
2095 
2096     case INST_JUMP4:
2097   opnd = TclGetInt4AtPtr(pc+1);
2098   TRACE(("%d => new pc %u\n", opnd,
2099           (unsigned int)(pc + opnd - codePtr->codeStart)));
2100   NEXT_INST_F(opnd, 0, 0);
2101 
2102     case INST_JUMP_FALSE4:
2103   opnd = 5;                             /* TRUE */
2104   pcAdjustment = TclGetInt4AtPtr(pc+1); /* FALSE */
2105   goto doJumpTrue;
2106 
2107     case INST_JUMP_TRUE4:
2108   opnd = TclGetInt4AtPtr(pc+1);         /* TRUE */
2109   pcAdjustment = 5;                     /* FALSE */
2110   goto doJumpTrue;
2111 
2112     case INST_JUMP_FALSE1:
2113   opnd = 2;                             /* TRUE */
2114   pcAdjustment = TclGetInt1AtPtr(pc+1); /* FALSE */
2115   goto doJumpTrue;
2116 
2117     case INST_JUMP_TRUE1:
2118   opnd = TclGetInt1AtPtr(pc+1);          /* TRUE */
2119   pcAdjustment = 2;                      /* FALSE */
2120       
2121     doJumpTrue:
2122   {
2123       int b;
2124     
2125       valuePtr = stackPtr[stackTop];
2126       if (valuePtr->typePtr == &tclIntType) {
2127     b = (valuePtr->internalRep.longValue != 0);
2128       } else if (valuePtr->typePtr == &tclDoubleType) {
2129     b = (valuePtr->internalRep.doubleValue != 0.0);
2130       } else if (valuePtr->typePtr == &tclWideIntType) {
2131     TclGetWide(w,valuePtr);
2132     b = (w != W0);
2133       } else {
2134     result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
2135     if (result != TCL_OK) {
2136         TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
2137         goto checkForCatch;
2138     }
2139       }
2140 #ifndef TCL_COMPILE_DEBUG
2141       NEXT_INST_F((b? opnd : pcAdjustment), 1, 0);
2142 #else
2143       if (b) {
2144     if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE1)) {
2145         TRACE(("%d => %.20s true, new pc %u\n", opnd, O2S(valuePtr),
2146                 (unsigned int)(pc+opnd - codePtr->codeStart)));
2147     } else {
2148         TRACE(("%d => %.20s true\n", pcAdjustment, O2S(valuePtr)));
2149     }
2150     NEXT_INST_F(opnd, 1, 0);
2151       } else {
2152     if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE1)) {
2153         TRACE(("%d => %.20s false\n", opnd, O2S(valuePtr)));
2154     } else {
2155         opnd = pcAdjustment;
2156         TRACE(("%d => %.20s false, new pc %u\n", opnd, O2S(valuePtr),
2157                 (unsigned int)(pc + opnd - codePtr->codeStart)));
2158     }
2159     NEXT_INST_F(pcAdjustment, 1, 0);
2160       }
2161 #endif
2162   }
2163             
2164     case INST_LOR:
2165     case INST_LAND:
2166     {
2167   /*
2168    * Operands must be boolean or numeric. No int->double
2169    * conversions are performed.
2170    */
2171     
2172   int i1, i2;
2173   int iResult;
2174   char *s;
2175   Tcl_ObjType *t1Ptr, *t2Ptr;
2176 
2177   value2Ptr = stackPtr[stackTop];
2178   valuePtr  = stackPtr[stackTop - 1];;
2179   t1Ptr = valuePtr->typePtr;
2180   t2Ptr = value2Ptr->typePtr;
2181 
2182   if ((t1Ptr == &tclIntType) || (t1Ptr == &tclBooleanType)) {
2183       i1 = (valuePtr->internalRep.longValue != 0);
2184   } else if (t1Ptr == &tclWideIntType) {
2185       TclGetWide(w,valuePtr);
2186       i1 = (w != W0);
2187   } else if (t1Ptr == &tclDoubleType) {
2188       i1 = (valuePtr->internalRep.doubleValue != 0.0);
2189   } else {
2190       s = Tcl_GetStringFromObj(valuePtr, &length);
2191       if (TclLooksLikeInt(s, length)) {
2192     GET_WIDE_OR_INT(result, valuePtr, i, w);
2193     if (valuePtr->typePtr == &tclIntType) {
2194         i1 = (i != 0);
2195     } else {
2196         i1 = (w != W0);
2197     }
2198       } else {
2199     result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
2200                  valuePtr, &i1);
2201     i1 = (i1 != 0);
2202       }
2203       if (result != TCL_OK) {
2204     TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
2205             (t1Ptr? t1Ptr->name : "null")));
2206     DECACHE_STACK_INFO();
2207     IllegalExprOperandType(interp, pc, valuePtr);
2208     CACHE_STACK_INFO();
2209     goto checkForCatch;
2210       }
2211   }
2212     
2213   if ((t2Ptr == &tclIntType) || (t2Ptr == &tclBooleanType)) {
2214       i2 = (value2Ptr->internalRep.longValue != 0);
2215   } else if (t2Ptr == &tclWideIntType) {
2216       TclGetWide(w,value2Ptr);
2217       i2 = (w != W0);
2218   } else if (t2Ptr == &tclDoubleType) {
2219       i2 = (value2Ptr->internalRep.doubleValue != 0.0);
2220   } else {
2221       s = Tcl_GetStringFromObj(value2Ptr, &length);
2222       if (TclLooksLikeInt(s, length)) {
2223     GET_WIDE_OR_INT(result, value2Ptr, i, w);
2224     if (value2Ptr->typePtr == &tclIntType) {
2225         i2 = (i != 0);
2226     } else {
2227         i2 = (w != W0);
2228     }
2229       } else {
2230     result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL, value2Ptr, &i2);
2231       }
2232       if (result != TCL_OK) {
2233     TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
2234             (t2Ptr? t2Ptr->name : "null")));
2235     DECACHE_STACK_INFO();
2236     IllegalExprOperandType(interp, pc, value2Ptr);
2237     CACHE_STACK_INFO();
2238     goto checkForCatch;
2239       }
2240   }
2241 
2242   /*
2243    * Reuse the valuePtr object already on stack if possible.
2244    */
2245   
2246   if (*pc == INST_LOR) {
2247       iResult = (i1 || i2);
2248   } else {
2249       iResult = (i1 && i2);
2250   }
2251   if (Tcl_IsShared(valuePtr)) {
2252       objResultPtr = Tcl_NewLongObj(iResult);
2253       TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
2254       NEXT_INST_F(1, 2, 1);
2255   } else {  /* reuse the valuePtr object */
2256       TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
2257       Tcl_SetLongObj(valuePtr, iResult);
2258       NEXT_INST_F(1, 1, 0);
2259   }
2260     }
2261 
2262     /*
2263      * ---------------------------------------------------------
2264      *     Start of INST_LIST and related instructions.
2265      */
2266 
2267     case INST_LIST:
2268   /*
2269    * Pop the opnd (objc) top stack elements into a new list obj
2270    * and then decrement their ref counts. 
2271    */
2272 
2273   opnd = TclGetUInt4AtPtr(pc+1);
2274   objResultPtr = Tcl_NewListObj(opnd, &(stackPtr[stackTop - (opnd-1)]));
2275   TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
2276   NEXT_INST_V(5, opnd, 1);
2277 
2278     case INST_LIST_LENGTH:
2279   valuePtr = stackPtr[stackTop];
2280 
2281   result = Tcl_ListObjLength(interp, valuePtr, &length);
2282   if (result != TCL_OK) {
2283       TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
2284               Tcl_GetObjResult(interp));
2285       goto checkForCatch;
2286   }
2287   objResultPtr = Tcl_NewIntObj(length);
2288   TRACE(("%.20s => %d\n", O2S(valuePtr), length));
2289   NEXT_INST_F(1, 1, 1);
2290       
2291     case INST_LIST_INDEX:
2292   /*** lindex with objc == 3 ***/
2293     
2294   /*
2295    * Pop the two operands
2296    */
2297   value2Ptr = stackPtr[stackTop];
2298   valuePtr  = stackPtr[stackTop- 1];
2299 
2300   /*
2301    * Extract the desired list element
2302    */
2303   objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
2304   if (objResultPtr == NULL) {
2305       TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", O2S(valuePtr), O2S(value2Ptr)),
2306               Tcl_GetObjResult(interp));
2307       result = TCL_ERROR;
2308       goto checkForCatch;
2309   }
2310 
2311   /*
2312    * Stash the list element on the stack
2313    */
2314   TRACE(("%.20s %.20s => %s\n",
2315           O2S(valuePtr), O2S(value2Ptr), O2S(objResultPtr)));
2316   NEXT_INST_F(1, 2, -1); /* already has the correct refCount */
2317 
2318     case INST_LIST_INDEX_MULTI:
2319     {
2320   /*
2321    * 'lindex' with multiple index args:
2322    *
2323    * Determine the count of index args.
2324    */
2325 
2326   int numIdx;
2327 
2328   opnd = TclGetUInt4AtPtr(pc+1);
2329   numIdx = opnd-1;
2330 
2331   /*
2332    * Do the 'lindex' operation.
2333    */
2334   objResultPtr = TclLindexFlat(interp, stackPtr[stackTop - numIdx],
2335           numIdx, stackPtr + stackTop - numIdx + 1);
2336 
2337   /*
2338    * Check for errors
2339    */
2340   if (objResultPtr == NULL) {
2341       TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
2342       result = TCL_ERROR;
2343       goto checkForCatch;
2344   }
2345 
2346   /*
2347    * Set result
2348    */
2349   TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
2350   NEXT_INST_V(5, opnd, -1);
2351     }
2352 
2353     case INST_LSET_FLAT:
2354     {
2355   /*
2356    * Lset with 3, 5, or more args.  Get the number
2357    * of index args.
2358    */
2359   int numIdx;
2360 
2361   opnd = TclGetUInt4AtPtr( pc + 1 );
2362   numIdx = opnd - 2;
2363 
2364   /*
2365    * Get the old value of variable, and remove the stack ref.
2366    * This is safe because the variable still references the
2367    * object; the ref count will never go zero here.
2368    */
2369   value2Ptr = POP_OBJECT();
2370   TclDecrRefCount(value2Ptr); /* This one should be done here */
2371 
2372   /*
2373    * Get the new element value.
2374    */
2375   valuePtr = stackPtr[stackTop];
2376 
2377   /*
2378    * Compute the new variable value
2379    */
2380   objResultPtr = TclLsetFlat(interp, value2Ptr, numIdx,
2381           stackPtr + stackTop - numIdx, valuePtr);
2382 
2383 
2384   /*
2385    * Check for errors
2386    */
2387   if (objResultPtr == NULL) {
2388       TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
2389       result = TCL_ERROR;
2390       goto checkForCatch;
2391   }
2392 
2393   /*
2394    * Set result
2395    */
2396   TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
2397   NEXT_INST_V(5, (numIdx+1), -1);
2398     }
2399 
2400     case INST_LSET_LIST:
2401   /*
2402    * 'lset' with 4 args.
2403    *
2404    * Get the old value of variable, and remove the stack ref.
2405    * This is safe because the variable still references the
2406    * object; the ref count will never go zero here.
2407    */
2408   objPtr = POP_OBJECT(); 
2409   TclDecrRefCount(objPtr); /* This one should be done here */
2410   
2411   /*
2412    * Get the new element value, and the index list
2413    */
2414   valuePtr = stackPtr[stackTop];
2415   value2Ptr = stackPtr[stackTop - 1];
2416   
2417   /*
2418    * Compute the new variable value
2419    */
2420   objResultPtr = TclLsetList(interp, objPtr, value2Ptr, valuePtr);
2421 
2422   /*
2423    * Check for errors
2424    */
2425   if (objResultPtr == NULL) {
2426       TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(value2Ptr)),
2427               Tcl_GetObjResult(interp));
2428       result = TCL_ERROR;
2429       goto checkForCatch;
2430   }
2431 
2432   /*
2433    * Set result
2434    */
2435   TRACE(("=> %s\n", O2S(objResultPtr)));
2436   NEXT_INST_F(1, 2, -1);
2437 
2438     /*
2439      *     End of INST_LIST and related instructions.
2440      * ---------------------------------------------------------
2441      */
2442 
2443     case INST_STR_EQ:
2444     case INST_STR_NEQ:
2445     {
2446   /*
2447    * String (in)equality check
2448    */
2449   int iResult;
2450 
2451   value2Ptr = stackPtr[stackTop];
2452   valuePtr = stackPtr[stackTop - 1];
2453 
2454   if (valuePtr == value2Ptr) {
2455       /*
2456        * On the off-chance that the objects are the same,
2457        * we don't really have to think hard about equality.
2458        */
2459       iResult = (*pc == INST_STR_EQ);
2460   } else {
2461       char *s1, *s2;
2462       int s1len, s2len;
2463 
2464       s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
2465       s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
2466       if (s1len == s2len) {
2467     /*
2468      * We only need to check (in)equality when
2469      * we have equal length strings.
2470      */
2471     if (*pc == INST_STR_NEQ) {
2472         iResult = (strcmp(s1, s2) != 0);
2473     } else {
2474         /* INST_STR_EQ */
2475         iResult = (strcmp(s1, s2) == 0);
2476     }
2477       } else {
2478     iResult = (*pc == INST_STR_NEQ);
2479       }
2480   }
2481 
2482   TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
2483 
2484   /*
2485    * Peep-hole optimisation: if you're about to jump, do jump
2486    * from here.
2487    */
2488 
2489   pc++;
2490 #ifndef TCL_COMPILE_DEBUG
2491   switch (*pc) {
2492       case INST_JUMP_FALSE1:
2493     NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
2494       case INST_JUMP_TRUE1:
2495     NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
2496       case INST_JUMP_FALSE4:
2497     NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
2498       case INST_JUMP_TRUE4:
2499     NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
2500   }
2501 #endif
2502   objResultPtr = Tcl_NewIntObj(iResult);
2503   NEXT_INST_F(0, 2, 1);
2504     }
2505 
2506     case INST_STR_CMP:
2507     {
2508   /*
2509    * String compare
2510    */
2511   CONST char *s1, *s2;
2512   int s1len, s2len, iResult;
2513 
2514   value2Ptr = stackPtr[stackTop];
2515   valuePtr = stackPtr[stackTop - 1];
2516 
2517   /*
2518    * The comparison function should compare up to the
2519    * minimum byte length only.
2520    */
2521   if (valuePtr == value2Ptr) {
2522       /*
2523        * In the pure equality case, set lengths too for
2524        * the checks below (or we could goto beyond it).
2525        */
2526       iResult = s1len = s2len = 0;
2527   } else if ((valuePtr->typePtr == &tclByteArrayType)
2528           && (value2Ptr->typePtr == &tclByteArrayType)) {
2529       s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
2530       s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
2531       iResult = memcmp(s1, s2, 
2532               (size_t) ((s1len < s2len) ? s1len : s2len));
2533   } else if (((valuePtr->typePtr == &tclStringType)
2534           && (value2Ptr->typePtr == &tclStringType))) {
2535       /*
2536        * Do a unicode-specific comparison if both of the args are of
2537        * String type.  If the char length == byte length, we can do a
2538        * memcmp.  In benchmark testing this proved the most efficient
2539        * check between the unicode and string comparison operations.
2540        */
2541 
2542       s1len = Tcl_GetCharLength(valuePtr);
2543       s2len = Tcl_GetCharLength(value2Ptr);
2544       if ((s1len == valuePtr->length) && (s2len == value2Ptr->length)) {
2545     iResult = memcmp(valuePtr->bytes, value2Ptr->bytes,
2546       (unsigned) ((s1len < s2len) ? s1len : s2len));
2547       } else {
2548     iResult = TclUniCharNcmp(Tcl_GetUnicode(valuePtr),
2549       Tcl_GetUnicode(value2Ptr),
2550       (unsigned) ((s1len < s2len) ? s1len : s2len));
2551       }
2552   } else {
2553       /*
2554        * We can't do a simple memcmp in order to handle the
2555        * special Tcl \xC0\x80 null encoding for utf-8.
2556        */
2557       s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
2558       s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
2559       iResult = TclpUtfNcmp2(s1, s2,
2560               (size_t) ((s1len < s2len) ? s1len : s2len));
2561   }
2562 
2563   /*
2564    * Make sure only -1,0,1 is returned
2565    */
2566   if (iResult == 0) {
2567       iResult = s1len - s2len;
2568   }
2569   if (iResult < 0) {
2570       iResult = -1;
2571   } else if (iResult > 0) {
2572       iResult = 1;
2573   }
2574 
2575   objResultPtr = Tcl_NewIntObj(iResult);
2576   TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
2577   NEXT_INST_F(1, 2, 1);
2578     }
2579 
2580     case INST_STR_LEN:
2581     {
2582   int length1;
2583      
2584   valuePtr = stackPtr[stackTop];
2585 
2586   if (valuePtr->typePtr == &tclByteArrayType) {
2587       (void) Tcl_GetByteArrayFromObj(valuePtr, &length1);
2588   } else {
2589       length1 = Tcl_GetCharLength(valuePtr);
2590   }
2591   objResultPtr = Tcl_NewIntObj(length1);
2592   TRACE(("%.20s => %d\n", O2S(valuePtr), length1));
2593   NEXT_INST_F(1, 1, 1);
2594     }
2595       
2596     case INST_STR_INDEX:
2597     {
2598   /*
2599    * String compare
2600    */
2601   int index;
2602   bytes = NULL; /* lint */
2603 
2604   value2Ptr = stackPtr[stackTop];
2605   valuePtr = stackPtr[stackTop - 1];
2606 
2607   /*
2608    * If we have a ByteArray object, avoid indexing in the
2609    * Utf string since the byte array contains one byte per
2610    * character.  Otherwise, use the Unicode string rep to
2611    * get the index'th char.
2612    */
2613 
2614   if (valuePtr->typePtr == &tclByteArrayType) {
2615       bytes = (char *)Tcl_GetByteArrayFromObj(valuePtr, &length);
2616   } else {
2617       /*
2618        * Get Unicode char length to calulate what 'end' means.
2619        */
2620       length = Tcl_GetCharLength(valuePtr);
2621   }
2622 
2623   result = TclGetIntForIndex(interp, value2Ptr, length - 1, &index);
2624   if (result != TCL_OK) {
2625       goto checkForCatch;
2626   }
2627 
2628   if ((index >= 0) && (index < length)) {
2629       if (valuePtr->typePtr == &tclByteArrayType) {
2630     objResultPtr = Tcl_NewByteArrayObj((unsigned char *)
2631             (&bytes[index]), 1);
2632       } else if (valuePtr->bytes && length == valuePtr->length) {
2633     objResultPtr = Tcl_NewStringObj((CONST char *)
2634             (&valuePtr->bytes[index]), 1);
2635       } else {
2636     char buf[TCL_UTF_MAX];
2637     Tcl_UniChar ch;
2638 
2639     ch = Tcl_GetUniChar(valuePtr, index);
2640     /*
2641      * This could be:
2642      * Tcl_NewUnicodeObj((CONST Tcl_UniChar *)&ch, 1)
2643      * but creating the object as a string seems to be
2644      * faster in practical use.
2645      */
2646     length = Tcl_UniCharToUtf(ch, buf);
2647     objResultPtr = Tcl_NewStringObj(buf, length);
2648       }
2649   } else {
2650       TclNewObj(objResultPtr);
2651   }
2652 
2653   TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr), 
2654           O2S(objResultPtr)));
2655   NEXT_INST_F(1, 2, 1);
2656     }
2657 
2658     case INST_STR_MATCH:
2659     {
2660   int nocase, match;
2661 
2662   nocase    = TclGetInt1AtPtr(pc+1);
2663   valuePtr  = stackPtr[stackTop];         /* String */
2664   value2Ptr = stackPtr[stackTop - 1]; /* Pattern */
2665 
2666   /*
2667    * Check that at least one of the objects is Unicode before
2668    * promoting both.
2669    */
2670 
2671   if ((valuePtr->typePtr == &tclStringType)
2672           || (value2Ptr->typePtr == &tclStringType)) {
2673       Tcl_UniChar *ustring1, *ustring2;
2674       int length1, length2;
2675 
2676       ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length1);
2677       ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
2678       match = TclUniCharMatch(ustring1, length1, ustring2, length2,
2679         nocase);
2680   } else {
2681       match = Tcl_StringCaseMatch(TclGetString(valuePtr),
2682         TclGetString(value2Ptr), nocase);
2683   }
2684 
2685   /*
2686    * Reuse value2Ptr object already on stack if possible.
2687    * Adjustment is 2 due to the nocase byte
2688    */
2689 
2690   TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
2691   if (Tcl_IsShared(value2Ptr)) {
2692       objResultPtr = Tcl_NewIntObj(match);
2693       NEXT_INST_F(2, 2, 1);
2694   } else {  /* reuse the valuePtr object */
2695       Tcl_SetIntObj(value2Ptr, match);
2696       NEXT_INST_F(2, 1, 0);
2697   }
2698     }
2699 
2700     case INST_EQ:
2701     case INST_NEQ:
2702     case INST_LT:
2703     case INST_GT:
2704     case INST_LE:
2705     case INST_GE:
2706     {
2707   /*
2708    * Any type is allowed but the two operands must have the
2709    * same type. We will compute value op value2.
2710    */
2711 
2712   Tcl_ObjType *t1Ptr, *t2Ptr;
2713   char *s1 = NULL;  /* Init. avoids compiler warning. */
2714   char *s2 = NULL;  /* Init. avoids compiler warning. */
2715   long i2 = 0;    /* Init. avoids compiler warning. */
2716   double d1 = 0.0;  /* Init. avoids compiler warning. */
2717   double d2 = 0.0;  /* Init. avoids compiler warning. */
2718   long iResult = 0; /* Init. avoids compiler warning. */
2719 
2720   value2Ptr = stackPtr[stackTop];
2721   valuePtr  = stackPtr[stackTop - 1];
2722 
2723   /*
2724    * Be careful in the equal-object case; 'NaN' isn't supposed
2725    * to be equal to even itself. [Bug 761471]
2726    */
2727 
2728   t1Ptr = valuePtr->typePtr;
2729   if (valuePtr == value2Ptr) {
2730       /*
2731        * If we are numeric already, we can proceed to the main
2732        * equality check right now.  Otherwise, we need to try to
2733        * coerce to a numeric type so we can see if we've got a
2734        * NaN but haven't parsed it as numeric.
2735        */
2736       if (!IS_NUMERIC_TYPE(t1Ptr)) {
2737     if (t1Ptr == &tclListType) {
2738         int length;
2739         /*
2740          * Only a list of length 1 can be NaN or such
2741          * things.
2742          */
2743         (void) Tcl_ListObjLength(NULL, valuePtr, &length);
2744         if (length == 1) {
2745       goto mustConvertForNaNCheck;
2746         }
2747     } else {
2748         /*
2749          * Too bad, we'll have to compute the string and
2750          * try the conversion
2751          */
2752 
2753       mustConvertForNaNCheck:
2754         s1 = Tcl_GetStringFromObj(valuePtr, &length);
2755         if (TclLooksLikeInt(s1, length)) {
2756       GET_WIDE_OR_INT(iResult, valuePtr, i, w);
2757         } else {
2758       (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
2759         valuePtr, &d1);
2760         }
2761         t1Ptr = valuePtr->typePtr;
2762     }
2763       }
2764 
2765       switch (*pc) {
2766       case INST_EQ:
2767       case INST_LE:
2768       case INST_GE:
2769     iResult = !((t1Ptr == &tclDoubleType)
2770       && IS_NAN(valuePtr->internalRep.doubleValue));
2771     break;
2772       case INST_LT:
2773       case INST_GT:
2774     iResult = 0;
2775     break;
2776       case INST_NEQ:
2777     iResult = ((t1Ptr == &tclDoubleType)
2778       && IS_NAN(valuePtr->internalRep.doubleValue));
2779     break;
2780       }
2781       goto foundResult;
2782   }
2783 
2784   t2Ptr = value2Ptr->typePtr;
2785 
2786   /*
2787    * We only want to coerce numeric validation if neither type
2788    * is NULL.  A NULL type means the arg is essentially an empty
2789    * object ("", {} or [list]).
2790    */
2791   if (!(     (!t1Ptr && !valuePtr->bytes)
2792           || (valuePtr->bytes && !valuePtr->length)
2793        || (!t2Ptr && !value2Ptr->bytes)
2794        || (value2Ptr->bytes && !value2Ptr->length))) {
2795       if (!IS_NUMERIC_TYPE(t1Ptr)) {
2796     s1 = Tcl_GetStringFromObj(valuePtr, &length);
2797     if (TclLooksLikeInt(s1, length)) {
2798         GET_WIDE_OR_INT(iResult, valuePtr, i, w);
2799     } else {
2800         (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, 
2801                 valuePtr, &d1);
2802     }
2803     t1Ptr = valuePtr->typePtr;
2804       }
2805       if (!IS_NUMERIC_TYPE(t2Ptr)) {
2806     s2 = Tcl_GetStringFromObj(value2Ptr, &length);
2807     if (TclLooksLikeInt(s2, length)) {
2808         GET_WIDE_OR_INT(iResult, value2Ptr, i2, w);
2809     } else {
2810         (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
2811                 value2Ptr, &d2);
2812     }
2813     t2Ptr = value2Ptr->typePtr;
2814       }
2815   }
2816   if (!IS_NUMERIC_TYPE(t1Ptr) || !IS_NUMERIC_TYPE(t2Ptr)) {
2817       /*
2818        * One operand is not numeric. Compare as strings.  NOTE:
2819        * strcmp is not correct for \x00 < \x01, but that is
2820        * unlikely to occur here.  We could use the TclUtfNCmp2
2821        * to handle this.
2822        */
2823       int s1len, s2len;
2824       s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
2825       s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
2826       switch (*pc) {
2827           case INST_EQ:
2828         if (s1len == s2len) {
2829       iResult = (strcmp(s1, s2) == 0);
2830         } else {
2831       iResult = 0;
2832         }
2833         break;
2834           case INST_NEQ:
2835         if (s1len == s2len) {
2836       iResult = (strcmp(s1, s2) != 0);
2837         } else {
2838       iResult = 1;
2839         }
2840         break;
2841           case INST_LT:
2842         iResult = (strcmp(s1, s2) < 0);
2843         break;
2844           case INST_GT:
2845         iResult = (strcmp(s1, s2) > 0);
2846         break;
2847           case INST_LE:
2848         iResult = (strcmp(s1, s2) <= 0);
2849         break;
2850           case INST_GE:
2851         iResult = (strcmp(s1, s2) >= 0);
2852         break;
2853       }
2854   } else if ((t1Ptr == &tclDoubleType)
2855        || (t2Ptr == &tclDoubleType)) {
2856       /*
2857        * Compare as doubles.
2858        */
2859       if (t1Ptr == &tclDoubleType) {
2860     d1 = valuePtr->internalRep.doubleValue;
2861     GET_DOUBLE_VALUE(d2, value2Ptr, t2Ptr);
2862       } else {  /* t1Ptr is integer, t2Ptr is double */
2863     GET_DOUBLE_VALUE(d1, valuePtr, t1Ptr);
2864     d2 = value2Ptr->internalRep.doubleValue;
2865       }
2866       switch (*pc) {
2867           case INST_EQ:
2868         iResult = d1 == d2;
2869         break;
2870           case INST_NEQ:
2871         iResult = d1 != d2;
2872         break;
2873           case INST_LT:
2874         iResult = d1 < d2;
2875         break;
2876           case INST_GT:
2877         iResult = d1 > d2;
2878         break;
2879           case INST_LE:
2880         iResult = d1 <= d2;
2881         break;
2882           case INST_GE:
2883         iResult = d1 >= d2;
2884         break;
2885       }
2886   } else if ((t1Ptr == &tclWideIntType)
2887           || (t2Ptr == &tclWideIntType)) {
2888       Tcl_WideInt w2;
2889       /*
2890        * Compare as wide ints (neither are doubles)
2891        */
2892       if (t1Ptr == &tclIntType) {
2893     w  = Tcl_LongAsWide(valuePtr->internalRep.longValue);
2894     TclGetWide(w2,value2Ptr);
2895       } else if (t2Ptr == &tclIntType) {
2896     TclGetWide(w,valuePtr);
2897     w2 = Tcl_LongAsWide(value2Ptr->internalRep.longValue);
2898       } else {
2899     TclGetWide(w,valuePtr);
2900     TclGetWide(w2,value2Ptr);
2901       }
2902       switch (*pc) {
2903           case INST_EQ:
2904         iResult = w == w2;
2905         break;
2906           case INST_NEQ:
2907         iResult = w != w2;
2908         break;
2909           case INST_LT:
2910         iResult = w < w2;
2911         break;
2912           case INST_GT:
2913         iResult = w > w2;
2914         break;
2915           case INST_LE:
2916         iResult = w <= w2;
2917         break;
2918           case INST_GE:
2919         iResult = w >= w2;
2920         break;
2921       }
2922   } else {
2923       /*
2924        * Compare as ints.
2925        */
2926       i  = valuePtr->internalRep.longValue;
2927       i2 = value2Ptr->internalRep.longValue;
2928       switch (*pc) {
2929           case INST_EQ:
2930         iResult = i == i2;
2931         break;
2932           case INST_NEQ:
2933         iResult = i != i2;
2934         break;
2935           case INST_LT:
2936         iResult = i < i2;
2937         break;
2938           case INST_GT:
2939         iResult = i > i2;
2940         break;
2941           case INST_LE:
2942         iResult = i <= i2;
2943         break;
2944           case INST_GE:
2945         iResult = i >= i2;
2946         break;
2947       }
2948   }
2949 
2950     foundResult:
2951   TRACE(("%.20s %.20s => %ld\n", O2S(valuePtr), O2S(value2Ptr), iResult));
2952 
2953   /*
2954    * Peep-hole optimisation: if you're about to jump, do jump
2955    * from here.
2956    */
2957 
2958   pc++;
2959 #ifndef TCL_COMPILE_DEBUG
2960   switch (*pc) {
2961       case INST_JUMP_FALSE1:
2962     NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
2963       case INST_JUMP_TRUE1:
2964     NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
2965       case INST_JUMP_FALSE4:
2966     NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
2967       case INST_JUMP_TRUE4:
2968     NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
2969   }
2970 #endif
2971   objResultPtr = Tcl_NewIntObj(iResult);
2972   NEXT_INST_F(0, 2, 1);
2973     }
2974 
2975     case INST_MOD:
2976     case INST_LSHIFT:
2977     case INST_RSHIFT:
2978     case INST_BITOR:
2979     case INST_BITXOR:
2980     case INST_BITAND:
2981     {
2982   /*
2983    * Only integers are allowed. We compute value op value2.
2984    */
2985 
2986   long i2 = 0, rem, negative;
2987   long iResult = 0; /* Init. avoids compiler warning. */
2988   Tcl_WideInt w2, wResult = W0;
2989   int doWide = 0;
2990 
2991   value2Ptr = stackPtr[stackTop];
2992   valuePtr  = stackPtr[stackTop - 1]; 
2993   if (valuePtr->typePtr == &tclIntType) {
2994       i = valuePtr->internalRep.longValue;
2995   } else if (valuePtr->typePtr == &tclWideIntType) {
2996       TclGetWide(w,valuePtr);
2997   } else {  /* try to convert to int */
2998       REQUIRE_WIDE_OR_INT(result, valuePtr, i, w);
2999       if (result != TCL_OK) {
3000     TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
3001             O2S(valuePtr), O2S(value2Ptr), 
3002             (valuePtr->typePtr? 
3003            valuePtr->typePtr->name : "null")));
3004     DECACHE_STACK_INFO();
3005     IllegalExprOperandType(interp, pc, valuePtr);
3006     CACHE_STACK_INFO();
3007     goto checkForCatch;
3008       }
3009   }
3010   if (value2Ptr->typePtr == &tclIntType) {
3011       i2 = value2Ptr->internalRep.longValue;
3012   } else if (value2Ptr->typePtr == &tclWideIntType) {
3013       TclGetWide(w2,value2Ptr);
3014   } else {
3015       REQUIRE_WIDE_OR_INT(result, value2Ptr, i2, w2);
3016       if (result != TCL_OK) {
3017     TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
3018             O2S(valuePtr), O2S(value2Ptr),
3019             (value2Ptr->typePtr?
3020           value2Ptr->typePtr->name : "null")));
3021     DECACHE_STACK_INFO();
3022     IllegalExprOperandType(interp, pc, value2Ptr);
3023     CACHE_STACK_INFO();
3024     goto checkForCatch;
3025       }
3026   }
3027 
3028   switch (*pc) {
3029   case INST_MOD:
3030       /*
3031        * This code is tricky: C doesn't guarantee much about
3032        * the quotient or remainder, but Tcl does. The
3033        * remainder always has the same sign as the divisor and
3034        * a smaller absolute value.
3035        */
3036       if (value2Ptr->typePtr == &tclWideIntType && w2 == W0) {
3037     if (valuePtr->typePtr == &tclIntType) {
3038         TRACE(("%ld "LLD" => DIVIDE BY ZERO\n", i, w2));
3039     } else {
3040         TRACE((LLD" "LLD" => DIVIDE BY ZERO\n", w, w2));
3041     }
3042     goto divideByZero;
3043       }
3044       if (value2Ptr->typePtr == &tclIntType && i2 == 0) {
3045     if (valuePtr->typePtr == &tclIntType) {
3046         TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2));
3047     } else {
3048         TRACE((LLD" %ld => DIVIDE BY ZERO\n", w, i2));
3049     }
3050     goto divideByZero;
3051       }
3052       negative = 0;
3053       if (valuePtr->typePtr == &tclWideIntType
3054     || value2Ptr->typePtr == &tclWideIntType) {
3055     Tcl_WideInt wRemainder;
3056     /*
3057      * Promote to wide
3058      */
3059     if (valuePtr->typePtr == &tclIntType) {
3060         w = Tcl_LongAsWide(i);
3061     } else if (value2Ptr->typePtr == &tclIntType) {
3062         w2 = Tcl_LongAsWide(i2);
3063     }
3064     if (w2 < 0) {
3065         w2 = -w2;
3066         w = -w;
3067         negative = 1;
3068     }
3069     wRemainder  = w % w2;
3070     if (wRemainder < 0) {
3071         wRemainder += w2;
3072     }
3073     if (negative) {
3074         wRemainder = -wRemainder;
3075     }
3076     wResult = wRemainder;
3077     doWide = 1;
3078     break;
3079       }
3080       if (i2 < 0) {
3081     i2 = -i2;
3082     i = -i;
3083     negative = 1;
3084       }
3085       rem  = i % i2;
3086       if (rem < 0) {
3087     rem += i2;
3088       }
3089       if (negative) {
3090     rem = -rem;
3091       }
3092       iResult = rem;
3093       break;
3094   case INST_LSHIFT:
3095       /*
3096        * Shifts are never usefully 64-bits wide!
3097        */
3098       FORCE_LONG(value2Ptr, i2, w2);
3099       if (valuePtr->typePtr == &tclWideIntType) {
3100 #ifdef TCL_COMPILE_DEBUG
3101     w2 = Tcl_LongAsWide(i2);
3102 #endif /* TCL_COMPILE_DEBUG */
3103     wResult = w;
3104     /*
3105      * Shift in steps when the shift gets large to prevent
3106      * annoying compiler/processor bugs. [Bug 868467]
3107      */
3108     if (i2 >= 64) {
3109         wResult = Tcl_LongAsWide(0);
3110     } else if (i2 > 60) {
3111         wResult = w << 30;
3112         wResult <<= 30;
3113         wResult <<= i2-60;
3114     } else if (i2 > 30) {
3115         wResult = w << 30;
3116         wResult <<= i2-30;
3117     } else {
3118         wResult = w << i2;
3119     }
3120     doWide = 1;
3121     break;
3122       }
3123       /*
3124        * Shift in steps when the shift gets large to prevent
3125        * annoying compiler/processor bugs. [Bug 868467]
3126        */
3127       if (i2 >= 64) {
3128     iResult = 0;
3129       } else if (i2 > 60) {
3130     iResult = i << 30;
3131     iResult <<= 30;
3132     iResult <<= i2-60;
3133       } else if (i2 > 30) {
3134     iResult = i << 30;
3135     iResult <<= i2-30;
3136       } else {
3137     iResult = i << i2;
3138       }
3139       break;
3140   case INST_RSHIFT:
3141       /*
3142        * The following code is a bit tricky: it ensures that
3143        * right shifts propagate the sign bit even on machines
3144        * where ">>" won't do it by default.
3145        */
3146       /*
3147        * Shifts are never usefully 64-bits wide!
3148        */
3149       FORCE_LONG(value2Ptr, i2, w2);
3150       if (valuePtr->typePtr == &tclWideIntType) {
3151 #ifdef TCL_COMPILE_DEBUG
3152     w2 = Tcl_LongAsWide(i2);
3153 #endif /* TCL_COMPILE_DEBUG */
3154     if (w < 0) {
3155         wResult = ~w;
3156     } else {
3157         wResult = w;
3158     }
3159     /*
3160      * Shift in steps when the shift gets large to prevent
3161      * annoying compiler/processor bugs. [Bug 868467]
3162      */
3163     if (i2 >= 64) {
3164         wResult = Tcl_LongAsWide(0);
3165     } else if (i2 > 60) {
3166         wResult >>= 30;
3167         wResult >>= 30;
3168         wResult >>= i2-60;
3169     } else if (i2 > 30) {
3170         wResult >>= 30;
3171         wResult >>= i2-30;
3172     } else {
3173         wResult >>= i2;
3174     }
3175     if (w < 0) {
3176         wResult = ~wResult;
3177     }
3178     doWide = 1;
3179     break;
3180       }
3181       if (i < 0) {
3182     iResult = ~i;
3183       } else {
3184     iResult = i;
3185       }
3186       /*
3187        * Shift in steps when the shift gets large to prevent
3188        * annoying compiler/processor bugs. [Bug 868467]
3189        */
3190       if (i2 >= 64) {
3191     iResult = 0;
3192       } else if (i2 > 60) {
3193     iResult >>= 30;
3194     iResult >>= 30;
3195     iResult >>= i2-60;
3196       } else if (i2 > 30) {
3197     iResult >>= 30;
3198     iResult >>= i2-30;
3199       } else {
3200     iResult >>= i2;
3201       }
3202       if (i < 0) {
3203     iResult = ~iResult;
3204       }
3205       break;
3206   case INST_BITOR:
3207       if (valuePtr->typePtr == &tclWideIntType
3208     || value2Ptr->typePtr == &tclWideIntType) {
3209     /*
3210      * Promote to wide
3211      */
3212     if (valuePtr->typePtr == &tclIntType) {
3213         w = Tcl_LongAsWide(i);
3214     } else if (value2Ptr->typePtr == &tclIntType) {
3215         w2 = Tcl_LongAsWide(i2);
3216     }
3217     wResult = w | w2;
3218     doWide = 1;
3219     break;
3220       }
3221       iResult = i | i2;
3222       break;
3223   case INST_BITXOR:
3224       if (valuePtr->typePtr == &tclWideIntType
3225     || value2Ptr->typePtr == &tclWideIntType) {
3226     /*
3227      * Promote to wide
3228      */
3229     if (valuePtr->typePtr == &tclIntType) {
3230         w = Tcl_LongAsWide(i);
3231     } else if (value2Ptr->typePtr == &tclIntType) {
3232         w2 = Tcl_LongAsWide(i2);
3233     }
3234     wResult = w ^ w2;
3235     doWide = 1;
3236     break;
3237       }
3238       iResult = i ^ i2;
3239       break;
3240   case INST_BITAND:
3241       if (valuePtr->typePtr == &tclWideIntType
3242     || value2Ptr->typePtr == &tclWideIntType) {
3243     /*
3244      * Promote to wide
3245      */
3246     if (valuePtr->typePtr == &tclIntType) {
3247         w = Tcl_LongAsWide(i);
3248     } else if (value2Ptr->typePtr == &tclIntType) {
3249         w2 = Tcl_LongAsWide(i2);
3250     }
3251     wResult = w & w2;
3252     doWide = 1;
3253     break;
3254       }
3255       iResult = i & i2;
3256       break;
3257   }
3258 
3259   /*
3260    * Reuse the valuePtr object already on stack if possible.
3261    */
3262     
3263   if (Tcl_IsShared(valuePtr)) {
3264       if (doWide) {
3265     objResultPtr = Tcl_NewWideIntObj(wResult);
3266     TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult));
3267       } else {
3268     objResultPtr = Tcl_NewLongObj(iResult);
3269     TRACE(("%ld %ld => %ld\n", i, i2, iResult));
3270       }
3271       NEXT_INST_F(1, 2, 1);
3272   } else {  /* reuse the valuePtr object */
3273       if (doWide) {
3274     TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult));
3275     Tcl_SetWideIntObj(valuePtr, wResult);
3276       } else {
3277     TRACE(("%ld %ld => %ld\n", i, i2, iResult));
3278     Tcl_SetLongObj(valuePtr, iResult);
3279       }
3280       NEXT_INST_F(1, 1, 0);
3281   }
3282     }
3283 
3284     case INST_ADD:
3285     case INST_SUB:
3286     case INST_MULT:
3287     case INST_DIV:
3288     {
3289   /*
3290    * Operands must be numeric and ints get converted to floats
3291    * if necessary. We compute value op value2.
3292    */
3293 
3294   Tcl_ObjType *t1Ptr, *t2Ptr;
3295   long i2 = 0, quot, rem; /* Init. avoids compiler warning. */
3296   double d1, d2;
3297   long iResult = 0; /* Init. avoids compiler warning. */
3298   double dResult = 0.0; /* Init. avoids compiler warning. */
3299   int doDouble = 0; /* 1 if doing floating arithmetic */
3300   Tcl_WideInt w2, wquot, wrem;
3301   Tcl_WideInt wResult = W0; /* Init. avoids compiler warning. */
3302   int doWide = 0;   /* 1 if doing wide arithmetic. */
3303 
3304   value2Ptr = stackPtr[stackTop];
3305   valuePtr  = stackPtr[stackTop - 1];
3306   t1Ptr = valuePtr->typePtr;
3307   t2Ptr = value2Ptr->typePtr;
3308     
3309   if (t1Ptr == &tclIntType) {
3310       i = valuePtr->internalRep.longValue;
3311   } else if (t1Ptr == &tclWideIntType) {
3312       TclGetWide(w,valuePtr);
3313   } else if ((t1Ptr == &tclDoubleType)
3314        && (valuePtr->bytes == NULL)) {
3315       /*
3316        * We can only use the internal rep directly if there is
3317        * no string rep.  Otherwise the string rep might actually
3318        * look like an integer, which is preferred.
3319        */
3320 
3321       d1 = valuePtr->internalRep.doubleValue;
3322   } else {
3323       char *s = Tcl_GetStringFromObj(valuePtr, &length);
3324       if (TclLooksLikeInt(s, length)) {
3325     GET_WIDE_OR_INT(result, valuePtr, i, w);
3326       } else {
3327     result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
3328                 valuePtr, &d1);
3329       }
3330       if (result != TCL_OK) {
3331     TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
3332             s, O2S(valuePtr),
3333             (valuePtr->typePtr?
3334           valuePtr->typePtr->name : "null")));
3335     DECACHE_STACK_INFO();
3336     IllegalExprOperandType(interp, pc, valuePtr);
3337     CACHE_STACK_INFO();
3338     goto checkForCatch;
3339       }
3340       t1Ptr = valuePtr->typePtr;
3341   }
3342 
3343   if (t2Ptr == &tclIntType) {
3344       i2 = value2Ptr->internalRep.longValue;
3345   } else if (t2Ptr == &tclWideIntType) {
3346       TclGetWide(w2,value2Ptr);
3347   } else if ((t2Ptr == &tclDoubleType)
3348        && (value2Ptr->bytes == NULL)) {
3349       /*
3350        * We can only use the internal rep directly if there is
3351        * no string rep.  Otherwise the string rep might actually
3352        * look like an integer, which is preferred.
3353        */
3354 
3355       d2 = value2Ptr->internalRep.doubleValue;
3356   } else {
3357       char *s = Tcl_GetStringFromObj(value2Ptr, &length);
3358       if (TclLooksLikeInt(s, length)) {
3359     GET_WIDE_OR_INT(result, value2Ptr, i2, w2);
3360       } else {
3361     result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
3362             value2Ptr, &d2);
3363       }
3364       if (result != TCL_OK) {
3365     TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
3366             O2S(value2Ptr), s,
3367             (value2Ptr->typePtr?
3368           value2Ptr->typePtr->name : "null")));
3369     DECACHE_STACK_INFO();
3370     IllegalExprOperandType(interp, pc, value2Ptr);
3371     CACHE_STACK_INFO();
3372     goto checkForCatch;
3373       }
3374       t2Ptr = value2Ptr->typePtr;
3375   }
3376 
3377   if ((t1Ptr == &tclDoubleType) || (t2Ptr == &tclDoubleType)) {
3378       /*
3379        * Do double arithmetic.
3380        */
3381       doDouble = 1;
3382       if (t1Ptr == &tclIntType) {
3383     d1 = i;       /* promote value 1 to double */
3384       } else if (t2Ptr == &tclIntType) {
3385     d2 = i2;      /* promote value 2 to double */
3386       } else if (t1Ptr == &tclWideIntType) {
3387     d1 = Tcl_WideAsDouble(w);
3388       } else if (t2Ptr == &tclWideIntType) {
3389     d2 = Tcl_WideAsDouble(w2);
3390       }
3391       switch (*pc) {
3392           case INST_ADD:
3393         dResult = d1 + d2;
3394         break;
3395           case INST_SUB:
3396         dResult = d1 - d2;
3397         break;
3398           case INST_MULT:
3399         dResult = d1 * d2;
3400         break;
3401           case INST_DIV:
3402         if (d2 == 0.0) {
3403       TRACE(("%.6g %.6g => DIVIDE BY ZERO\n", d1, d2));
3404       goto divideByZero;
3405         }
3406         dResult = d1 / d2;
3407         break;
3408       }
3409         
3410       /*
3411        * Check now for IEEE floating-point error.
3412        */
3413         
3414       if (IS_NAN(dResult) || IS_INF(dResult)) {
3415     TRACE(("%.20s %.20s => IEEE FLOATING PT ERROR\n",
3416             O2S(valuePtr), O2S(value2Ptr)));
3417     DECACHE_STACK_INFO();
3418     TclExprFloatError(interp, dResult);
3419     CACHE_STACK_INFO();
3420     result = TCL_ERROR;
3421     goto checkForCatch;
3422       }
3423   } else if ((t1Ptr == &tclWideIntType) 
3424        || (t2Ptr == &tclWideIntType)) {
3425       /*
3426        * Do wide integer arithmetic.
3427        */
3428       doWide = 1;
3429       if (t1Ptr == &tclIntType) {
3430     w = Tcl_LongAsWide(i);
3431       } else if (t2Ptr == &tclIntType) {
3432     w2 = Tcl_LongAsWide(i2);
3433       }
3434       switch (*pc) {
3435           case INST_ADD:
3436         wResult = w + w2;
3437         break;
3438           case INST_SUB:
3439         wResult = w - w2;
3440         break;
3441           case INST_MULT:
3442         wResult = w * w2;
3443         break;
3444           case INST_DIV:
3445         /*
3446          * This code is tricky: C doesn't guarantee much
3447          * about the quotient or remainder, but Tcl does.
3448          * The remainder always has the same sign as the
3449          * divisor and a smaller absolute value.
3450          */
3451         if (w2 == W0) {
3452       TRACE((LLD" "LLD" => DIVIDE BY ZERO\n", w, w2));
3453       goto divideByZero;
3454         }
3455         if (w2 < 0) {
3456       w2 = -w2;
3457       w = -w;
3458         }
3459         wquot = w / w2;
3460         wrem  = w % w2;
3461         if (wrem < W0) {
3462       wquot -= 1;
3463         }
3464         wResult = wquot;
3465         break;
3466       }
3467   } else {
3468       /*
3469          * Do integer arithmetic.
3470          */
3471       switch (*pc) {
3472           case INST_ADD:
3473         iResult = i + i2;
3474         break;
3475           case INST_SUB:
3476         iResult = i - i2;
3477         break;
3478           case INST_MULT:
3479         iResult = i * i2;
3480         break;
3481           case INST_DIV:
3482         /*
3483          * This code is tricky: C doesn't guarantee much
3484          * about the quotient or remainder, but Tcl does.
3485          * The remainder always has the same sign as the
3486          * divisor and a smaller absolute value.
3487          */
3488         if (i2 == 0) {
3489       TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2));
3490       goto divideByZero;
3491         }
3492         if (i2 < 0) {
3493       i2 = -i2;
3494       i = -i;
3495         }
3496         quot = i / i2;
3497         rem  = i % i2;
3498         if (rem < 0) {
3499       quot -= 1;
3500         }
3501         iResult = quot;
3502         break;
3503       }
3504   }
3505 
3506   /*
3507    * Reuse the valuePtr object already on stack if possible.
3508    */
3509     
3510   if (Tcl_IsShared(valuePtr)) {
3511       if (doDouble) {
3512     objResultPtr = Tcl_NewDoubleObj(dResult);
3513     TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult));
3514       } else if (doWide) {
3515     objResultPtr = Tcl_NewWideIntObj(wResult);
3516     TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult));
3517       } else {
3518     objResultPtr = Tcl_NewLongObj(iResult);
3519     TRACE(("%ld %ld => %ld\n", i, i2, iResult));
3520       } 
3521       NEXT_INST_F(1, 2, 1);
3522   } else {      /* reuse the valuePtr object */
3523       if (doDouble) { /* NB: stack top is off by 1 */
3524     TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult));
3525     Tcl_SetDoubleObj(valuePtr, dResult);
3526       } else if (doWide) {
3527     TRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult));
3528     Tcl_SetWideIntObj(valuePtr, wResult);
3529       } else {
3530     TRACE(("%ld %ld => %ld\n", i, i2, iResult));
3531     Tcl_SetLongObj(valuePtr, iResult);
3532       }
3533       NEXT_INST_F(1, 1, 0);
3534   }
3535     }
3536 
3537     case INST_UPLUS:
3538     {
3539   /*
3540    * Operand must be numeric.
3541    */
3542 
3543   double d;
3544   Tcl_ObjType *tPtr;
3545     
3546   valuePtr = stackPtr[stackTop];
3547   tPtr = valuePtr->typePtr;
3548   if (!IS_INTEGER_TYPE(tPtr) && ((tPtr != &tclDoubleType) 
3549                 || (valuePtr->bytes != NULL))) {
3550       char *s = Tcl_GetStringFromObj(valuePtr, &length);
3551       if (TclLooksLikeInt(s, length)) {
3552     GET_WIDE_OR_INT(result, valuePtr, i, w);
3553       } else {
3554     result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
3555       }
3556       if (result != TCL_OK) { 
3557     TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n",
3558             s, (tPtr? tPtr->name : "null")));
3559     DECACHE_STACK_INFO();
3560     IllegalExprOperandType(interp, pc, valuePtr);
3561     CACHE_STACK_INFO();
3562     goto checkForCatch;
3563       }
3564       tPtr = valuePtr->typePtr;
3565   }
3566 
3567   /*
3568    * Ensure that the operand's string rep is the same as the
3569    * formatted version of its internal rep. This makes sure
3570    * that "expr +000123" yields "83", not "000123". We
3571    * implement this by _discarding_ the string rep since we
3572    * know it will be regenerated, if needed later, by
3573    * formatting the internal rep's value.
3574    */
3575 
3576   if (Tcl_IsShared(valuePtr)) {
3577       if (tPtr == &tclIntType) {
3578     i = valuePtr->internalRep.longValue;
3579     objResultPtr = Tcl_NewLongObj(i);
3580       } else if (tPtr == &tclWideIntType) {
3581     TclGetWide(w,valuePtr);
3582     objResultPtr = Tcl_NewWideIntObj(w);
3583       } else {
3584     d = valuePtr->internalRep.doubleValue;
3585     objResultPtr = Tcl_NewDoubleObj(d);
3586       }
3587       TRACE_WITH_OBJ(("%s => ", O2S(objResultPtr)), objResultPtr);
3588       NEXT_INST_F(1, 1, 1);
3589   } else {
3590       Tcl_InvalidateStringRep(valuePtr);
3591       TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), valuePtr);
3592       NEXT_INST_F(1, 0, 0);
3593   }
3594     }
3595       
3596     case INST_UMINUS:
3597     case INST_LNOT:
3598     {
3599   /*
3600    * The operand must be numeric or a boolean string as
3601    * accepted by Tcl_GetBooleanFromObj(). If the operand
3602    * object is unshared modify it directly, otherwise
3603    * create a copy to modify: this is "copy on write".
3604    * Free any old string representation since it is now
3605    * invalid.
3606    */
3607 
3608   double d;
3609   int boolvar;
3610   Tcl_ObjType *tPtr;
3611 
3612   valuePtr = stackPtr[stackTop];
3613   tPtr = valuePtr->typePtr;
3614   if (!IS_INTEGER_TYPE(tPtr) && ((tPtr != &tclDoubleType)
3615           || (valuePtr->bytes != NULL))) {
3616       if ((tPtr == &tclBooleanType) && (valuePtr->bytes == NULL)) {
3617     valuePtr->typePtr = &tclIntType;
3618       } else {
3619     char *s = Tcl_GetStringFromObj(valuePtr, &length);
3620     if (TclLooksLikeInt(s, length)) {
3621         GET_WIDE_OR_INT(result, valuePtr, i, w);
3622     } else {
3623         result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
3624                 valuePtr, &d);
3625     }
3626     if (result == TCL_ERROR && *pc == INST_LNOT) {
3627         result = Tcl_GetBooleanFromObj((Tcl_Interp *)NULL,
3628                 valuePtr, &boolvar);
3629         i = (long)boolvar; /* i is long, not int! */
3630     }
3631     if (result != TCL_OK) {
3632         TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n",
3633                 s, (tPtr? tPtr->name : "null")));
3634         DECACHE_STACK_INFO();
3635         IllegalExprOperandType(interp, pc, valuePtr);
3636         CACHE_STACK_INFO();
3637         goto checkForCatch;
3638     }
3639       }
3640       tPtr = valuePtr->typePtr;
3641   }
3642 
3643   if (Tcl_IsShared(valuePtr)) {
3644       /*
3645        * Create a new object.
3646        */
3647       if ((tPtr == &tclIntType) || (tPtr == &tclBooleanType)) {
3648     i = valuePtr->internalRep.longValue;
3649     objResultPtr = Tcl_NewLongObj(
3650         (*pc == INST_UMINUS)? -i : !i);
3651     TRACE_WITH_OBJ(("%ld => ", i), objResultPtr);
3652       } else if (tPtr == &tclWideIntType) {
3653     TclGetWide(w,valuePtr);
3654     if (*pc == INST_UMINUS) {
3655         objResultPtr = Tcl_NewWideIntObj(-w);
3656     } else {
3657         objResultPtr = Tcl_NewLongObj(w == W0);
3658     }
3659     TRACE_WITH_OBJ((LLD" => ", w), objResultPtr);
3660       } else {
3661     d = valuePtr->internalRep.doubleValue;
3662     if (*pc == INST_UMINUS) {
3663         objResultPtr = Tcl_NewDoubleObj(-d);
3664     } else {
3665         /*
3666          * Should be able to use "!d", but apparently
3667          * some compilers can't handle it.
3668          */
3669         objResultPtr = Tcl_NewLongObj((d==0.0)? 1 : 0);
3670     }
3671     TRACE_WITH_OBJ(("%.6g => ", d), objResultPtr);
3672       }
3673       NEXT_INST_F(1, 1, 1);
3674   } else {
3675       /*
3676        * valuePtr is unshared. Modify it directly.
3677        */
3678       if ((tPtr == &tclIntType) || (tPtr == &tclBooleanType)) {
3679     i = valuePtr->internalRep.longValue;
3680     Tcl_SetLongObj(valuePtr,
3681                   (*pc == INST_UMINUS)? -i : !i);
3682     TRACE_WITH_OBJ(("%ld => ", i), valuePtr);
3683       } else if (tPtr == &tclWideIntType) {
3684     TclGetWide(w,valuePtr);
3685     if (*pc == INST_UMINUS) {
3686         Tcl_SetWideIntObj(valuePtr, -w);
3687     } else {
3688         Tcl_SetLongObj(valuePtr, w == W0);
3689     }
3690     TRACE_WITH_OBJ((LLD" => ", w), valuePtr);
3691       } else {
3692     d = valuePtr->internalRep.doubleValue;
3693     if (*pc == INST_UMINUS) {
3694         Tcl_SetDoubleObj(valuePtr, -d);
3695     } else {
3696         /*
3697          * Should be able to use "!d", but apparently
3698          * some compilers can't handle it.
3699          */
3700         Tcl_SetLongObj(valuePtr, (d==0.0)? 1 : 0);
3701     }
3702     TRACE_WITH_OBJ(("%.6g => ", d), valuePtr);
3703       }
3704       NEXT_INST_F(1, 0, 0);
3705   }
3706     }
3707 
3708     case INST_BITNOT:
3709     {
3710   /*
3711    * The operand must be an integer. If the operand object is
3712    * unshared modify it directly, otherwise modify a copy. 
3713    * Free any old string representation since it is now
3714    * invalid.
3715    */
3716     
3717   Tcl_ObjType *tPtr;
3718     
3719   valuePtr = stackPtr[stackTop];
3720   tPtr = valuePtr->typePtr;
3721   if (!IS_INTEGER_TYPE(tPtr)) {
3722       REQUIRE_WIDE_OR_INT(result, valuePtr, i, w);
3723       if (result != TCL_OK) {   /* try to convert to double */
3724     TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n",
3725             O2S(valuePtr), (tPtr? tPtr->name : "null")));
3726     DECACHE_STACK_INFO();
3727     IllegalExprOperandType(interp, pc, valuePtr);
3728     CACHE_STACK_INFO();
3729     goto checkForCatch;
3730       }
3731   }
3732     
3733   if (valuePtr->typePtr == &tclWideIntType) {
3734       TclGetWide(w,valuePtr);
3735       if (Tcl_IsShared(valuePtr)) {
3736     objResultPtr = Tcl_NewWideIntObj(~w);
3737     TRACE(("0x%llx => (%llu)\n", w, ~w));
3738     NEXT_INST_F(1, 1, 1);
3739       } else {
3740     /*
3741      * valuePtr is unshared. Modify it directly.
3742      */
3743     Tcl_SetWideIntObj(valuePtr, ~w);
3744     TRACE(("0x%llx => (%llu)\n", w, ~w));
3745     NEXT_INST_F(1, 0, 0);
3746       }
3747   } else {
3748       i = valuePtr->internalRep.longValue;
3749       if (Tcl_IsShared(valuePtr)) {
3750     objResultPtr = Tcl_NewLongObj(~i);
3751     TRACE(("0x%lx => (%lu)\n", i, ~i));
3752     NEXT_INST_F(1, 1, 1);
3753       } else {
3754     /*
3755      * valuePtr is unshared. Modify it directly.
3756      */
3757     Tcl_SetLongObj(valuePtr, ~i);
3758     TRACE(("0x%lx => (%lu)\n", i, ~i));
3759     NEXT_INST_F(1, 0, 0);
3760       }
3761   }
3762     }
3763 
3764     case INST_CALL_BUILTIN_FUNC1:
3765   opnd = TclGetUInt1AtPtr(pc+1);
3766   {
3767       /*
3768        * Call one of the built-in Tcl math functions.
3769        */
3770 
3771       BuiltinFunc *mathFuncPtr;
3772 
3773       if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
3774     TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
3775     panic("TclExecuteByteCode: unrecognized builtin function code %d", opnd);
3776       }
3777       mathFuncPtr = &(tclBuiltinFuncTable[opnd]);
3778       DECACHE_STACK_INFO();
3779       result = (*mathFuncPtr->proc)(interp, eePtr,
3780               mathFuncPtr->clientData);
3781       CACHE_STACK_INFO();
3782       if (result != TCL_OK) {
3783     goto checkForCatch;
3784       }
3785       TRACE_WITH_OBJ(("%d => ", opnd), stackPtr[stackTop]);
3786   }
3787   NEXT_INST_F(2, 0, 0);
3788         
3789     case INST_CALL_FUNC1:
3790   opnd = TclGetUInt1AtPtr(pc+1);
3791   {
3792       /*
3793        * Call a non-builtin Tcl math function previously
3794        * registered by a call to Tcl_CreateMathFunc.
3795        */
3796     
3797       int objc = opnd;   /* Number of arguments. The function name
3798         * is the 0-th argument. */
3799       Tcl_Obj **objv;    /* The array of arguments. The function
3800         * name is objv[0]. */
3801 
3802       objv = &(stackPtr[stackTop - (objc-1)]); /* "objv[0]" */
3803       DECACHE_STACK_INFO();
3804       result = ExprCallMathFunc(interp, eePtr, objc, objv);
3805       CACHE_STACK_INFO();
3806       if (result != TCL_OK) {
3807     goto checkForCatch;
3808       }
3809       TRACE_WITH_OBJ(("%d => ", objc), stackPtr[stackTop]);
3810   }
3811   NEXT_INST_F(2, 0, 0);
3812 
3813     case INST_TRY_CVT_TO_NUMERIC:
3814     {
3815   /*
3816    * Try to convert the topmost stack object to an int or
3817    * double object. This is done in order to support Tcl's
3818    * policy of interpreting operands if at all possible as
3819    * first integers, else floating-point numbers.
3820    */
3821     
3822   double d;
3823   char *s;
3824   Tcl_ObjType *tPtr;
3825   int converted, needNew;
3826 
3827   valuePtr = stackPtr[stackTop];
3828   tPtr = valuePtr->typePtr;
3829   converted = 0;
3830   if (!IS_INTEGER_TYPE(tPtr) && ((tPtr != &tclDoubleType)
3831           || (valuePtr->bytes != NULL))) {
3832       if ((tPtr == &tclBooleanType) && (valuePtr->bytes == NULL)) {
3833     valuePtr->typePtr = &tclIntType;
3834     converted = 1;
3835       } else {
3836     s = Tcl_GetStringFromObj(valuePtr, &length);
3837     if (TclLooksLikeInt(s, length)) {
3838         GET_WIDE_OR_INT(result, valuePtr, i, w);
3839     } else {
3840         result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
3841                 valuePtr, &d);
3842     }
3843     if (result == TCL_OK) {
3844         converted = 1;
3845     }
3846     result = TCL_OK; /* reset the result variable */
3847       }
3848       tPtr = valuePtr->typePtr;
3849   }
3850 
3851   /*
3852    * Ensure that the topmost stack object, if numeric, has a
3853    * string rep the same as the formatted version of its
3854    * internal rep. This is used, e.g., to make sure that "expr
3855    * {0001}" yields "1", not "0001". We implement this by
3856    * _discarding_ the string rep since we know it will be
3857    * regenerated, if needed later, by formatting the internal
3858    * rep's value. Also check if there has been an IEEE
3859    * floating point error.
3860    */
3861   
3862   objResultPtr = valuePtr;
3863   needNew = 0;
3864   if (IS_NUMERIC_TYPE(tPtr)) {
3865       if (Tcl_IsShared(valuePtr)) {
3866     if (valuePtr->bytes != NULL) {
3867         /*
3868          * We only need to make a copy of the object
3869          * when it already had a string rep
3870          */
3871         needNew = 1;
3872         if (tPtr == &tclIntType) {
3873       i = valuePtr->internalRep.longValue;
3874       objResultPtr = Tcl_NewLongObj(i);
3875         } else if (tPtr == &tclWideIntType) {
3876       TclGetWide(w,valuePtr);
3877       objResultPtr = Tcl_NewWideIntObj(w);
3878         } else {
3879       d = valuePtr->internalRep.doubleValue;
3880       objResultPtr = Tcl_NewDoubleObj(d);
3881         }
3882         tPtr = objResultPtr->typePtr;
3883     }
3884       } else {
3885     Tcl_InvalidateStringRep(valuePtr);
3886       }
3887     
3888       if (tPtr == &tclDoubleType) {
3889     d = objResultPtr->internalRep.doubleValue;
3890     if (IS_NAN(d) || IS_INF(d)) {
3891         TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
3892                 O2S(objResultPtr)));
3893         DECACHE_STACK_INFO();
3894         TclExprFloatError(interp, d);
3895         CACHE_STACK_INFO();
3896         result = TCL_ERROR;
3897         goto checkForCatch;
3898     }
3899       }
3900       converted = converted;  /* lint, converted not used. */
3901       TRACE(("\"%.20s\" => numeric, %s, %s\n", O2S(valuePtr),
3902               (converted? "converted" : "not converted"),
3903         (needNew? "new Tcl_Obj" : "same Tcl_Obj")));
3904   } else {
3905       TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
3906   }
3907   if (needNew) {
3908       NEXT_INST_F(1, 1, 1);
3909   } else {
3910       NEXT_INST_F(1, 0, 0);
3911   }
3912     }
3913   
3914     case INST_BREAK:
3915   DECACHE_STACK_INFO();
3916   Tcl_ResetResult(interp);
3917   CACHE_STACK_INFO();
3918   result = TCL_BREAK;
3919   cleanup = 0;
3920   goto processExceptionReturn;
3921 
3922     case INST_CONTINUE:
3923   DECACHE_STACK_INFO();
3924   Tcl_ResetResult(interp);
3925   CACHE_STACK_INFO();
3926   result = TCL_CONTINUE;
3927   cleanup = 0;
3928   goto processExceptionReturn;
3929 
3930     case INST_FOREACH_START4:
3931   opnd = TclGetUInt4AtPtr(pc+1);
3932   {
3933       /*
3934        * Initialize the temporary local var that holds the count
3935        * of the number of iterations of the loop body to -1.
3936        */
3937 
3938       ForeachInfo *infoPtr = (ForeachInfo *)
3939               codePtr->auxDataArrayPtr[opnd].clientData;
3940       int iterTmpIndex = infoPtr->loopCtTemp;
3941       Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
3942       Var *iterVarPtr = &(compiledLocals[iterTmpIndex]);
3943       Tcl_Obj *oldValuePtr = iterVarPtr->value.objPtr;
3944 
3945       if (oldValuePtr == NULL) {
3946     iterVarPtr->value.objPtr = Tcl_NewLongObj(-1);
3947     Tcl_IncrRefCount(iterVarPtr->value.objPtr);
3948       } else {
3949     Tcl_SetLongObj(oldValuePtr, -1);
3950       }
3951       TclSetVarScalar(iterVarPtr);
3952       TclClearVarUndefined(iterVarPtr);
3953       TRACE(("%u => loop iter count temp %d\n", 
3954        opnd, iterTmpIndex));
3955   }
3956       
3957 #ifndef TCL_COMPILE_DEBUG
3958   /* 
3959    * Remark that the compiler ALWAYS sets INST_FOREACH_STEP4
3960    * immediately after INST_FOREACH_START4 - let us just fall
3961    * through instead of jumping back to the top.
3962    */
3963 
3964   pc += 5;
3965 #else
3966   NEXT_INST_F(5, 0, 0);
3967 #endif  
3968     case INST_FOREACH_STEP4:
3969   opnd = TclGetUInt4AtPtr(pc+1);
3970   {
3971       /*
3972        * "Step" a foreach loop (i.e., begin its next iteration) by
3973        * assigning the next value list element to each loop var.
3974        */
3975 
3976       ForeachInfo *infoPtr = (ForeachInfo *)
3977               codePtr->auxDataArrayPtr[opnd].clientData;
3978       ForeachVarList *varListPtr;
3979       int numLists = infoPtr->numLists;
3980       Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
3981       Tcl_Obj *listPtr;
3982       List *listRepPtr;
3983       Var *iterVarPtr, *listVarPtr;
3984       int iterNum, listTmpIndex, listLen, numVars;
3985       int varIndex, valIndex, continueLoop, j;
3986 
3987       /*
3988        * Increment the temp holding the loop iteration number.
3989        */
3990 
3991       iterVarPtr = &(compiledLocals[infoPtr->loopCtTemp]);
3992       valuePtr = iterVarPtr->value.objPtr;
3993       iterNum = (valuePtr->internalRep.longValue + 1);
3994       Tcl_SetLongObj(valuePtr, iterNum);
3995     
3996       /*
3997        * Check whether all value lists are exhausted and we should
3998        * stop the loop.
3999        */
4000 
4001       continueLoop = 0;
4002       listTmpIndex = infoPtr->firstValueTemp;
4003       for (i = 0;  i < numLists;  i++) {
4004     varListPtr = infoPtr->varLists[i];
4005     numVars = varListPtr->numVars;
4006         
4007     listVarPtr = &(compiledLocals[listTmpIndex]);
4008     listPtr = listVarPtr->value.objPtr;
4009     result = Tcl_ListObjLength(interp, listPtr, &listLen);
4010     if (result != TCL_OK) {
4011         TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
4012                 opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
4013         goto checkForCatch;
4014     }
4015     if (listLen > (iterNum * numVars)) {
4016         continueLoop = 1;
4017     }
4018     listTmpIndex++;
4019       }
4020 
4021       /*
4022        * If some var in some var list still has a remaining list
4023        * element iterate one more time. Assign to var the next
4024        * element from its value list. We already checked above
4025        * that each list temp holds a valid list object.
4026        */
4027     
4028       if (continueLoop) {
4029     listTmpIndex = infoPtr->firstValueTemp;
4030     for (i = 0;  i < numLists;  i++) {
4031         varListPtr = infoPtr->varLists[i];
4032         numVars = varListPtr->numVars;
4033 
4034         listVarPtr = &(compiledLocals[listTmpIndex]);
4035         listPtr = listVarPtr->value.objPtr;
4036         listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
4037         listLen = listRepPtr->elemCount;
4038       
4039         valIndex = (iterNum * numVars);
4040         for (j = 0;  j < numVars;  j++) {
4041       if (valIndex >= listLen) {
4042           TclNewObj(valuePtr);
4043       } else {
4044           valuePtr = listRepPtr->elements[valIndex];
4045       }
4046           
4047       varIndex = varListPtr->varIndexes[j];
4048       varPtr = &(varFramePtr->compiledLocals[varIndex]);
4049       part1 = varPtr->name;
4050       while (TclIsVarLink(varPtr)) {
4051           varPtr = varPtr->value.linkPtr;
4052       }
4053       if (!((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL))
4054               && (varPtr->tracePtr == NULL)
4055               && (TclIsVarScalar(varPtr) || TclIsVarUndefined(varPtr))) {
4056           value2Ptr = varPtr->value.objPtr;
4057           if (valuePtr != value2Ptr) {
4058         if (value2Ptr != NULL) {
4059             TclDecrRefCount(value2Ptr);
4060         } else {
4061             TclSetVarScalar(varPtr);
4062             TclClearVarUndefined(varPtr);
4063         }
4064         varPtr->value.objPtr = valuePtr;
4065         Tcl_IncrRefCount(valuePtr);
4066           }
4067       } else {
4068           DECACHE_STACK_INFO();
4069           Tcl_IncrRefCount(valuePtr);
4070           value2Ptr = TclPtrSetVar(interp, varPtr, NULL, part1, 
4071                  NULL, valuePtr, TCL_LEAVE_ERR_MSG);
4072           TclDecrRefCount(valuePtr);
4073           CACHE_STACK_INFO();
4074           if (value2Ptr == NULL) {
4075         TRACE_WITH_OBJ(("%u => ERROR init. index temp %d: ",
4076             opnd, varIndex),
4077                  Tcl_GetObjResult(interp));
4078         result = TCL_ERROR;
4079         goto checkForCatch;
4080           }
4081       }
4082       valIndex++;
4083         }
4084         listTmpIndex++;
4085     }
4086       }
4087       TRACE(("%u => %d lists, iter %d, %s loop\n", opnd, numLists, 
4088               iterNum, (continueLoop? "continue" : "exit")));
4089 
4090       /* 
4091        * Run-time peep-hole optimisation: the compiler ALWAYS follows
4092        * INST_FOREACH_STEP4 with an INST_JUMP_FALSE. We just skip that
4093        * instruction and jump direct from here.
4094        */
4095 
4096       pc += 5;
4097       if (*pc == INST_JUMP_FALSE1) {
4098     NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
4099       } else {
4100     NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
4101       }
4102   }
4103 
4104     case INST_BEGIN_CATCH4:
4105   /*
4106    * Record start of the catch command with exception range index
4107    * equal to the operand. Push the current stack depth onto the
4108    * special catch stack.
4109    */
4110   catchStackPtr[++catchTop] = stackTop;
4111   TRACE(("%u => catchTop=%d, stackTop=%d\n",
4112          TclGetUInt4AtPtr(pc+1), catchTop, stackTop));
4113   NEXT_INST_F(5, 0, 0);
4114 
4115     case INST_END_CATCH:
4116   catchTop--;
4117   result = TCL_OK;
4118   TRACE(("=> catchTop=%d\n", catchTop));
4119   NEXT_INST_F(1, 0, 0);
4120       
4121     case INST_PUSH_RESULT:
4122   objResultPtr = Tcl_GetObjResult(interp);
4123   TRACE_WITH_OBJ(("=> "), Tcl_GetObjResult(interp));
4124 
4125   /*
4126    * See the comments at INST_INVOKE_STK
4127    */
4128   {
4129       Tcl_Obj *newObjResultPtr;
4130       TclNewObj(newObjResultPtr);
4131       Tcl_IncrRefCount(newObjResultPtr);
4132       iPtr->objResultPtr = newObjResultPtr;
4133   }
4134 
4135   NEXT_INST_F(1, 0, -1);
4136 
4137     case INST_PUSH_RETURN_CODE:
4138   objResultPtr = Tcl_NewLongObj(result);
4139   TRACE(("=> %u\n", result));
4140   NEXT_INST_F(1, 0, 1);
4141 
4142     default:
4143   panic("TclExecuteByteCode: unrecognized opCode %u", *pc);
4144     } /* end of switch on opCode */
4145 
4146     /*
4147      * Division by zero in an expression. Control only reaches this
4148      * point by "goto divideByZero".
4149      */
4150   
4151  divideByZero:
4152     DECACHE_STACK_INFO();
4153     Tcl_ResetResult(interp);
4154     Tcl_AppendToObj(Tcl_GetObjResult(interp), "divide by zero", -1);
4155     Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero",
4156             (char *) NULL);
4157     CACHE_STACK_INFO();
4158 
4159     result = TCL_ERROR;
4160     goto checkForCatch;
4161   
4162     /*
4163      * An external evaluation (INST_INVOKE or INST_EVAL) returned 
4164      * something different from TCL_OK, or else INST_BREAK or 
4165      * INST_CONTINUE were called.
4166      */
4167 
4168  processExceptionReturn:
4169 #if TCL_COMPILE_DEBUG    
4170     switch (*pc) {
4171         case INST_INVOKE_STK1:
4172         case INST_INVOKE_STK4:
4173       TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf));
4174       break;
4175         case INST_EVAL_STK:
4176       /*
4177        * Note that the object at stacktop has to be used
4178        * before doing the cleanup.
4179        */
4180 
4181       TRACE(("\"%.30s\" => ", O2S(stackPtr[stackTop])));
4182       break;
4183         default:
4184       TRACE(("=> "));
4185     }       
4186 #endif     
4187     if ((result == TCL_CONTINUE) || (result == TCL_BREAK)) {
4188   rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
4189   if (rangePtr == NULL) {
4190       TRACE_APPEND(("no encl. loop or catch, returning %s\n",
4191               StringForResultCode(result)));
4192       goto abnormalReturn;
4193   } 
4194   if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
4195       TRACE_APPEND(("%s ...\n", StringForResultCode(result)));
4196       goto processCatch;
4197   }
4198   while (cleanup--) {
4199       valuePtr = POP_OBJECT();
4200       TclDecrRefCount(valuePtr);
4201   }
4202   if (result == TCL_BREAK) {
4203       result = TCL_OK;
4204       pc = (codePtr->codeStart + rangePtr->breakOffset);
4205       TRACE_APPEND(("%s, range at %d, new pc %d\n",
4206        StringForResultCode(result),
4207        rangePtr->codeOffset, rangePtr->breakOffset));
4208       NEXT_INST_F(0, 0, 0);
4209   } else {
4210       if (rangePtr->continueOffset == -1) {
4211     TRACE_APPEND(("%s, loop w/o continue, checking for catch\n",
4212             StringForResultCode(result)));
4213     goto checkForCatch;
4214       } 
4215       result = TCL_OK;
4216       pc = (codePtr->codeStart + rangePtr->continueOffset);
4217       TRACE_APPEND(("%s, range at %d, new pc %d\n",
4218        StringForResultCode(result),
4219        rangePtr->codeOffset, rangePtr->continueOffset));
4220       NEXT_INST_F(0, 0, 0);
4221   }
4222 #if TCL_COMPILE_DEBUG    
4223     } else if (traceInstructions) {
4224   if ((result != TCL_ERROR) && (result != TCL_RETURN))  {
4225       objPtr = Tcl_GetObjResult(interp);
4226       TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ", 
4227         result, O2S(objPtr)));
4228   } else {
4229       objPtr = Tcl_GetObjResult(interp);
4230       TRACE_APPEND(("%s, result= \"%s\"\n", 
4231               StringForResultCode(result), O2S(objPtr)));
4232   }
4233 #endif
4234     }
4235         
4236     /*
4237      * Execution has generated an "exception" such as TCL_ERROR. If the
4238      * exception is an error, record information about what was being
4239      * executed when the error occurred. Find the closest enclosing
4240      * catch range, if any. If no enclosing catch range is found, stop
4241      * execution and return the "exception" code.
4242      */
4243   
4244  checkForCatch:
4245     if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
4246   bytes = GetSrcInfoForPc(pc, codePtr, &length);
4247   if (bytes != NULL) {
4248       DECACHE_STACK_INFO();
4249       Tcl_LogCommandInfo(interp, codePtr->source, bytes, length);
4250             CACHE_STACK_INFO();
4251       iPtr->flags |= ERR_ALREADY_LOGGED;
4252   }
4253     }
4254     if (catchTop == -1) {
4255 #ifdef TCL_COMPILE_DEBUG
4256   if (traceInstructions) {
4257       fprintf(stdout, "   ... no enclosing catch, returning %s\n",
4258               StringForResultCode(result));
4259   }
4260 #endif
4261   goto abnormalReturn;
4262     }
4263     rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 1, codePtr);
4264     if (rangePtr == NULL) {
4265   /*
4266    * This is only possible when compiling a [catch] that sends its
4267    * script to INST_EVAL. Cannot correct the compiler without 
4268    * breakingcompat with previous .tbc compiled scripts.
4269    */
4270 #ifdef TCL_COMPILE_DEBUG
4271   if (traceInstructions) {
4272       fprintf(stdout, "   ... no enclosing catch, returning %s\n",
4273               StringForResultCode(result));
4274   }
4275 #endif
4276   goto abnormalReturn;
4277     }
4278 
4279     /*
4280      * A catch exception range (rangePtr) was found to handle an
4281      * "exception". It was found either by checkForCatch just above or
4282      * by an instruction during break, continue, or error processing.
4283      * Jump to its catchOffset after unwinding the operand stack to
4284      * the depth it had when starting to execute the range's catch
4285      * command.
4286      */
4287 
4288  processCatch:
4289     while (stackTop > catchStackPtr[catchTop]) {
4290   valuePtr = POP_OBJECT();
4291   TclDecrRefCount(valuePtr);
4292     }
4293 #ifdef TCL_COMPILE_DEBUG
4294     if (traceInstructions) {
4295   fprintf(stdout, "  ... found catch at %d, catchTop=%d, unwound to %d, new pc %u\n",
4296           rangePtr->codeOffset, catchTop, catchStackPtr[catchTop],
4297           (unsigned int)(rangePtr->catchOffset));
4298     }
4299 #endif  
4300     pc = (codePtr->codeStart + rangePtr->catchOffset);
4301     NEXT_INST_F(0, 0, 0); /* restart the execution loop at pc */
4302 
4303     /* 
4304      * end of infinite loop dispatching on instructions.
4305      */
4306 
4307     /*
4308      * Abnormal return code. Restore the stack to state it had when starting
4309      * to execute the ByteCode. Panic if the stack is below the initial level.
4310      */
4311 
4312  abnormalReturn:
4313     while (stackTop > initStackTop) {
4314   valuePtr = POP_OBJECT();
4315   TclDecrRefCount(valuePtr);
4316     }
4317     if (stackTop < initStackTop) {
4318   fprintf(stderr, "\nTclExecuteByteCode: abnormal return at pc %u: stack top %d < entry stack top %d\n",
4319           (unsigned int)(pc - codePtr->codeStart),
4320     (unsigned int) stackTop,
4321     (unsigned int) initStackTop);
4322   panic("TclExecuteByteCode execution failure: end stack top < start stack top");
4323     }
4324   
4325     /*
4326      * Free the catch stack array if malloc'ed storage was used.
4327      */
4328 
4329     if (catchStackPtr != catchStackStorage) {
4330   ckfree((char *) catchStackPtr);
4331     }
4332     eePtr->stackTop = initStackTop;
4333     return result;
4334 #undef STATIC_CATCH_STACK_SIZE
4335 }
void TclExprFloatError (Tcl_Interp * interp, double value)

Definition at line 5817 of file tclExecute.c.
References EDOM, ERANGE, errno, IS_INF, IS_NAN, NULL, Tcl_AppendToObj(), Tcl_GetObjResult(), TCL_INTEGER_SPACE, and Tcl_ResetResult().
Referenced by ExprAbsFunc(), ExprBinaryFunc(), ExprIntFunc(), ExprUnaryFunc(), ExprWideFunc(), GetLexeme(), SetDoubleFromAny(), Tcl_GetDouble(), and TclExecuteByteCode().5821 {
5822     char *s;
5823 
5824     Tcl_ResetResult(interp);
5825     if ((errno == EDOM) || IS_NAN(value)) {
5826   s = "domain error: argument not in valid range";
5827   Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
5828   Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, (char *) NULL);
5829     } else if ((errno == ERANGE) || IS_INF(value)) {
5830   if (value == 0.0) {
5831       s = "floating-point value too small to represent";
5832       Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
5833       Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, (char *) NULL);
5834   } else {
5835       s = "floating-point value too large to represent";
5836       Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
5837       Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL);
5838   }
5839     } else {
5840   char msg[64 + TCL_INTEGER_SPACE];
5841   
5842   sprintf(msg, "unknown floating-point error, errno = %d", errno);
5843   Tcl_AppendToObj(Tcl_GetObjResult(interp), msg, -1);
5844   Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", msg, (char *) NULL);
5845     }
5846 }
void TclFinalizeExecution ()

Definition at line 574 of file tclExecute.c.
References execInitialized, Tcl_MutexLock, Tcl_MutexUnlock, and TclFinalizeAuxDataTypeTable().
Referenced by Tcl_Finalize().575 {
576     Tcl_MutexLock(&execMutex);
577     execInitialized = 0;
578     Tcl_MutexUnlock(&execMutex);
579     TclFinalizeAuxDataTypeTable();
580 }
static int VerifyExprObjType (Tcl_Interp * interp, Tcl_Obj * objPtr) [static]

Definition at line 4852 of file tclExecute.c.
References GET_WIDE_OR_INT, IS_NUMERIC_TYPE, NULL, Tcl_AppendToObj(), Tcl_GetDoubleFromObj(), Tcl_GetObjResult(), Tcl_GetStringFromObj(), TCL_OK, Tcl_ResetResult(), TclCheckBadOctal(), TclLooksLikeInt(), and Tcl_Obj::typePtr.
Referenced by ExprAbsFunc(), ExprBinaryFunc(), ExprCallMathFunc(), ExprDoubleFunc(), ExprIntFunc(), ExprRoundFunc(), ExprSrandFunc(), ExprUnaryFunc(), and ExprWideFunc().4856 {
4857     if (IS_NUMERIC_TYPE(objPtr->typePtr)) {
4858   return TCL_OK;
4859     } else {
4860   int length, result = TCL_OK;
4861   char *s = Tcl_GetStringFromObj(objPtr, &length);
4862   
4863   if (TclLooksLikeInt(s, length)) {
4864       long i;
4865       Tcl_WideInt w;
4866       GET_WIDE_OR_INT(result, objPtr, i, w);
4867   } else {
4868       double d;
4869       result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, objPtr, &d);
4870   }
4871   if ((result != TCL_OK) && (interp != NULL)) {
4872       Tcl_ResetResult(interp);
4873       if (TclCheckBadOctal((Tcl_Interp *) NULL, s)) {
4874     Tcl_AppendToObj(Tcl_GetObjResult(interp),
4875       "argument to math function was an invalid octal number",
4876       -1);
4877       } else {
4878     Tcl_AppendToObj(Tcl_GetObjResult(interp),
4879       "argument to math function didn't have numeric value",
4880       -1);
4881       }
4882   }
4883   return result;
4884     }
4885 }

Variable Documentation
int execInitialized = 0 [static]

Definition at line 69 of file tclExecute.c.
Referenced by TclCreateExecEnv(), and TclFinalizeExecution().BuiltinFunc tclBuiltinFuncTable[]

Definition at line 388 of file tclExecute.c.
Referenced by TclExecuteByteCode().

generic/tclFCmd.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Functions
static int CopyRenameOneFile _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, int copyFlag, int force))
static Tcl_Obj *FileBasename _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr))
static int FileCopyRename _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int copyFlag))
static int FileForceOption _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int *forcePtr))
int TclFileRenameCmd (Tcl_Interp *interp, int objc, objv)
int TclFileCopyCmd (Tcl_Interp *interp, int objc, objv)
static int FileCopyRename (Tcl_Interp *interp, int objc, objv, int copyFlag)
int TclFileMakeDirsCmd (Tcl_Interp *interp, int objc, objv)
int TclFileDeleteCmd (Tcl_Interp *interp, int objc, objv)
static int CopyRenameOneFile (Tcl_Interp *interp, Tcl_Obj *source, Tcl_Obj *target, int copyFlag, int force)
static int FileForceOption (Tcl_Interp *interp, int objc, objv, int *forcePtr)
static Tcl_Obj * FileBasename (Tcl_Interp *interp, Tcl_Obj *pathPtr)
int TclFileAttrsCmd (Tcl_Interp *interp, int objc, objv)

Function Documentation
static int FileForceOption _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int *forcePtr)) [static]
static int FileCopyRename _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int copyFlag)) [static]
static Tcl_Obj* FileBasename _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr)) [static]
static int CopyRenameOneFile _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, int copyFlag, int force)) [static]
static int CopyRenameOneFile (Tcl_Interp * interp, Tcl_Obj * source, Tcl_Obj * target, int copyFlag, int force) [static]

Definition at line 463 of file tclFCmd.c.
References EEXIST, EINVAL, EISDIR, EMLINK, ENOENT, errno, EXDEV, NULL, S_ISDIR, S_ISLNK, Tcl_DecrRefCount, Tcl_DiscardResult(), TCL_ERROR, TCL_EVAL_DIRECT, TCL_EVAL_GLOBAL, Tcl_EvalObjEx(), Tcl_FSConvertToPathType(), Tcl_FSCopyDirectory(), Tcl_FSCopyFile(), Tcl_FSDeleteFile(), Tcl_FSEqualPaths(), Tcl_FSLink(), Tcl_FSLstat(), Tcl_FSRemoveDirectory(), Tcl_FSRenameFile(), Tcl_FSStat(), Tcl_GetString(), Tcl_IncrRefCount, Tcl_ListObjAppendElement(), Tcl_NewListObj(), Tcl_NewStringObj(), TCL_OK, Tcl_PosixError(), Tcl_ResetResult(), Tcl_RestoreResult(), Tcl_SaveResult(), Tcl_SetErrno(), and TclCrossFilesystemCopy().
Referenced by FileCopyRename().474 {
475     int result;
476     Tcl_Obj *errfile, *errorBuffer;
477     /* If source is a link, then this is the real file/directory */
478     Tcl_Obj *actualSource = NULL;
479     Tcl_StatBuf sourceStatBuf, targetStatBuf;
480 
481     if (Tcl_FSConvertToPathType(interp, source) != TCL_OK) {
482   return TCL_ERROR;
483     }
484     if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) {
485   return TCL_ERROR;
486     }
487     
488     errfile = NULL;
489     errorBuffer = NULL;
490     result = TCL_ERROR;
491     
492     /*
493      * We want to copy/rename links and not the files they point to, so we
494      * use lstat(). If target is a link, we also want to replace the 
495      * link and not the file it points to, so we also use lstat() on the
496      * target.
497      */
498 
499     if (Tcl_FSLstat(source, &sourceStatBuf) != 0) {
500   errfile = source;
501   goto done;
502     }
503     if (Tcl_FSLstat(target, &targetStatBuf) != 0) {
504   if (errno != ENOENT) {
505       errfile = target;
506       goto done;
507   }
508     } else {
509   if (force == 0) {
510       errno = EEXIST;
511       errfile = target;
512       goto done;
513   }
514 
515         /* 
516          * Prevent copying or renaming a file onto itself.  Under Windows, 
517          * stat always returns 0 for st_ino.  However, the Windows-specific 
518          * code knows how to deal with copying or renaming a file on top of
519          * itself.  It might be a good idea to write a stat that worked.
520          */
521      
522         if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) {
523             if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) &&
524                   (sourceStatBuf.st_dev == targetStatBuf.st_dev)) {
525               result = TCL_OK;
526               goto done;
527             }
528         }
529 
530   /*
531    * Prevent copying/renaming a file onto a directory and
532    * vice-versa.  This is a policy decision based on the fact that
533    * existing implementations of copy and rename on all platforms
534    * also prevent this.
535    */
536 
537   if (S_ISDIR(sourceStatBuf.st_mode)
538                 && !S_ISDIR(targetStatBuf.st_mode)) {
539       errno = EISDIR;
540       Tcl_AppendResult(interp, "can't overwrite file \"", 
541         Tcl_GetString(target), "\" with directory \"", 
542         Tcl_GetString(source), "\"", (char *) NULL);
543       goto done;
544   }
545   if (!S_ISDIR(sourceStatBuf.st_mode)
546           && S_ISDIR(targetStatBuf.st_mode)) {
547       errno = EISDIR;
548       Tcl_AppendResult(interp, "can't overwrite directory \"", 
549         Tcl_GetString(target), "\" with file \"", 
550         Tcl_GetString(source), "\"", (char *) NULL);
551       goto done;
552   }
553     }
554 
555     if (copyFlag == 0) {
556   result = Tcl_FSRenameFile(source, target);
557   if (result == TCL_OK) {
558       goto done;
559   }
560       
561   if (errno == EINVAL) {
562       Tcl_AppendResult(interp, "error renaming \"", 
563         Tcl_GetString(source), "\" to \"",
564         Tcl_GetString(target), "\": trying to rename a volume or ",
565         "move a directory into itself", (char *) NULL);
566       goto done;
567   } else if (errno != EXDEV) {
568       errfile = target;
569       goto done;
570   }
571   
572   /*
573    * The rename failed because the move was across file systems.
574    * Fall through to copy file and then remove original.  Note that
575    * the low-level Tcl_FSRenameFileProc in the filesystem is allowed 
576    * to implement cross-filesystem moves itself, if it desires.
577    */
578     }
579 
580     actualSource = source;
581     Tcl_IncrRefCount(actualSource);
582 #if 0
583 #ifdef S_ISLNK
584     /* 
585      * To add a flag to make 'copy' copy links instead of files, we could
586      * add a condition to ignore this 'if' here.
587      */
588     if (copyFlag && S_ISLNK(sourceStatBuf.st_mode)) {
589   /* 
590    * We want to copy files not links.  Therefore we must follow the
591    * link.  There are two purposes to this 'stat' call here.  First
592    * we want to know if the linked-file/dir actually exists, and
593    * second, in the block of code which follows, some 20 lines
594    * down, we want to check if the thing is a file or directory.
595    */
596   if (Tcl_FSStat(source, &sourceStatBuf) != 0) {
597       /* Actual file doesn't exist */
598       Tcl_AppendResult(interp, 
599         "error copying \"", Tcl_GetString(source), 
600         "\": the target of this link doesn't exist",
601         (char *) NULL);
602       goto done;
603   } else {
604       int counter = 0;
605       while (1) {
606     Tcl_Obj *path = Tcl_FSLink(actualSource, NULL, 0);
607     if (path == NULL) {
608         break;
609     }
610     Tcl_DecrRefCount(actualSource);
611     actualSource = path;
612     counter++;
613     /* Arbitrary limit of 20 links to follow */
614     if (counter > 20) {
615         /* Too many links */
616         Tcl_SetErrno(EMLINK);
617         errfile = source;
618         goto done;
619     }
620       }
621       /* Now 'actualSource' is the correct file */
622   }
623     }
624 #endif
625 #endif
626 
627     if (S_ISDIR(sourceStatBuf.st_mode)) {
628   result = Tcl_FSCopyDirectory(actualSource, target, &errorBuffer);
629   if (result != TCL_OK) {
630       if (errno == EXDEV) {
631     /* 
632      * The copy failed because we're trying to do a
633      * cross-filesystem copy.  We do this through our Tcl
634      * library.
635      */
636     Tcl_SavedResult savedResult;
637     Tcl_Obj *copyCommand = Tcl_NewListObj(0,NULL);
638     Tcl_IncrRefCount(copyCommand);
639     Tcl_ListObjAppendElement(interp, copyCommand, 
640       Tcl_NewStringObj("::tcl::CopyDirectory",-1));
641     if (copyFlag) {
642         Tcl_ListObjAppendElement(interp, copyCommand, 
643                Tcl_NewStringObj("copying",-1));
644     } else {
645         Tcl_ListObjAppendElement(interp, copyCommand, 
646                Tcl_NewStringObj("renaming",-1));
647     }
648     Tcl_ListObjAppendElement(interp, copyCommand, source);
649     Tcl_ListObjAppendElement(interp, copyCommand, target);
650     Tcl_SaveResult(interp, &savedResult);
651     result = Tcl_EvalObjEx(interp, copyCommand, 
652                TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
653     Tcl_DecrRefCount(copyCommand);
654     if (result != TCL_OK) {
655         /* 
656          * There was an error in the Tcl-level copy.
657          * We will pass on the Tcl error message and
658          * can ensure this by setting errfile to NULL
659          */
660         Tcl_DiscardResult(&savedResult);
661         errfile = NULL;
662     } else {
663         /* The copy was successful */
664         Tcl_RestoreResult(interp, &savedResult);
665     }
666       } else {
667     errfile = errorBuffer;
668     if (Tcl_FSEqualPaths(errfile, source)) {
669         errfile = source;
670     } else if (Tcl_FSEqualPaths(errfile, target)) {
671         errfile = target;
672     }
673       }
674   }
675     } else {
676   result = Tcl_FSCopyFile(actualSource, target);
677   if ((result != TCL_OK) && (errno == EXDEV)) {
678       result = TclCrossFilesystemCopy(interp, source, target);
679   }
680   if (result != TCL_OK) {
681       /* 
682        * We could examine 'errno' to double-check if the problem
683        * was with the target, but we checked the source above,
684        * so it should be quite clear 
685        */
686       errfile = target;
687       /* 
688        * We now need to reset the result, because the above call,
689        * if it failed, may have put an error message in place.
690        * (Ideally we would prefer not to pass an interpreter in
691        * above, but the channel IO code used by
692        * TclCrossFilesystemCopy currently requires one)
693        */
694       Tcl_ResetResult(interp);
695   }
696     }
697     if ((copyFlag == 0) && (result == TCL_OK)) {
698   if (S_ISDIR(sourceStatBuf.st_mode)) {
699       result = Tcl_FSRemoveDirectory(source, 1, &errorBuffer);
700       if (result != TCL_OK) {
701     if (Tcl_FSEqualPaths(errfile, source) == 0) {
702         errfile = source;
703     }
704       }
705   } else {
706       result = Tcl_FSDeleteFile(source);
707       if (result != TCL_OK) {
708     errfile = source;
709       }
710   }
711   if (result != TCL_OK) {
712       Tcl_AppendResult(interp, "can't unlink \"", 
713     Tcl_GetString(errfile), "\": ",
714     Tcl_PosixError(interp), (char *) NULL);
715       errfile = NULL;
716   }
717     }
718     
719     done:
720     if (errfile != NULL) {
721   Tcl_AppendResult(interp, 
722     ((copyFlag) ? "error copying \"" : "error renaming \""),
723      Tcl_GetString(source), (char *) NULL);
724   if (errfile != source) {
725       Tcl_AppendResult(interp, "\" to \"", Tcl_GetString(target), 
726            (char *) NULL);
727       if (errfile != target) {
728     Tcl_AppendResult(interp, "\": \"", Tcl_GetString(errfile), 
729          (char *) NULL);
730       }
731   }
732   Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp),
733     (char *) NULL);
734     }
735     if (errorBuffer != NULL) {
736         Tcl_DecrRefCount(errorBuffer);
737     }
738     if (actualSource != NULL) {
739   Tcl_DecrRefCount(actualSource);
740     }
741     return result;
742 }
static Tcl_Obj* FileBasename (Tcl_Interp * interp, Tcl_Obj * pathPtr) [static]

Definition at line 816 of file tclFCmd.c.
References NULL, Tcl_DecrRefCount, Tcl_FSConvertToPathType(), Tcl_FSGetPathType(), Tcl_FSSplitPath(), Tcl_GetString(), Tcl_IncrRefCount, Tcl_ListObjIndex(), Tcl_NewObj(), TCL_OK, and TCL_PATH_RELATIVE.
Referenced by FileCopyRename().819 {
820     int objc;
821     Tcl_Obj *splitPtr;
822     Tcl_Obj *resultPtr = NULL;
823     
824     splitPtr = Tcl_FSSplitPath(pathPtr, &objc);
825 
826     if (objc != 0) {
827   if ((objc == 1) && (*Tcl_GetString(pathPtr) == '~')) {
828       Tcl_DecrRefCount(splitPtr);
829       if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
830     return NULL;
831       }
832       splitPtr = Tcl_FSSplitPath(pathPtr, &objc);
833   }
834 
835   /*
836    * Return the last component, unless it is the only component, and it
837    * is the root of an absolute path.
838    */
839 
840   if (objc > 0) {
841       Tcl_ListObjIndex(NULL, splitPtr, objc-1, &resultPtr);
842       if ((objc == 1) &&
843         (Tcl_FSGetPathType(resultPtr) != TCL_PATH_RELATIVE)) {
844     resultPtr = NULL;
845       }
846   }
847     }
848     if (resultPtr == NULL) {
849   resultPtr = Tcl_NewObj();
850     }
851     Tcl_IncrRefCount(resultPtr);
852     Tcl_DecrRefCount(splitPtr);
853     return resultPtr;
854 }
static int FileCopyRename (Tcl_Interp * interp, int objc, objv, int copyFlag) [static]

Definition at line 106 of file tclFCmd.c.
References CopyRenameOneFile(), ENOTDIR, errno, FileBasename(), FileForceOption(), NULL, S_ISDIR, Tcl_DecrRefCount, TCL_ERROR, Tcl_FSConvertToPathType(), Tcl_FSJoinPath(), Tcl_FSStat(), Tcl_GetString(), Tcl_IncrRefCount, Tcl_NewListObj(), TCL_OK, and Tcl_PosixError().
Referenced by TclFileCopyCmd(), and TclFileRenameCmd().112 {
113     int i, result, force;
114     Tcl_StatBuf statBuf; 
115     Tcl_Obj *target;
116 
117     i = FileForceOption(interp, objc - 2, objv + 2, &force);
118     if (i < 0) {
119   return TCL_ERROR;
120     }
121     i += 2;
122     if ((objc - i) < 2) {
123   Tcl_AppendResult(interp, "wrong # args: should be \"", 
124     Tcl_GetString(objv[0]), " ", Tcl_GetString(objv[1]), 
125     " ?options? source ?source ...? target\"", 
126     (char *) NULL);
127   return TCL_ERROR;
128     }
129 
130     /*
131      * If target doesn't exist or isn't a directory, try the copy/rename.
132      * More than 2 arguments is only valid if the target is an existing
133      * directory.
134      */
135 
136     target = objv[objc - 1];
137     if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) {
138   return TCL_ERROR;
139     }
140 
141     result = TCL_OK;
142 
143     /*
144      * Call Tcl_FSStat() so that if target is a symlink that points to a
145      * directory we will put the sources in that directory instead of
146      * overwriting the symlink.
147      */
148 
149     if ((Tcl_FSStat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
150   if ((objc - i) > 2) {
151       errno = ENOTDIR;
152       Tcl_PosixError(interp);
153       Tcl_AppendResult(interp, "error ",
154         ((copyFlag) ? "copying" : "renaming"), ": target \"",
155         Tcl_GetString(target), "\" is not a directory", 
156         (char *) NULL);
157       result = TCL_ERROR;
158   } else {
159       /*
160        * Even though already have target == translated(objv[i+1]),
161        * pass the original argument down, so if there's an error, the
162        * error message will reflect the original arguments.
163        */
164 
165       result = CopyRenameOneFile(interp, objv[i], objv[i + 1], copyFlag,
166         force);
167   }
168   return result;
169     }
170     
171     /*
172      * Move each source file into target directory.  Extract the basename
173      * from each source, and append it to the end of the target path.
174      */
175 
176     for ( ; i < objc - 1; i++) {
177   Tcl_Obj *jargv[2];
178   Tcl_Obj *source, *newFileName;
179   Tcl_Obj *temp;
180   
181   source = FileBasename(interp, objv[i]);
182   if (source == NULL) {
183       result = TCL_ERROR;
184       break;
185   }
186   jargv[0] = objv[objc - 1];
187   jargv[1] = source;
188   temp = Tcl_NewListObj(2, jargv);
189   newFileName = Tcl_FSJoinPath(temp, -1);
190   Tcl_IncrRefCount(newFileName);
191   result = CopyRenameOneFile(interp, objv[i], newFileName, copyFlag,
192     force);
193   Tcl_DecrRefCount(newFileName);
194   Tcl_DecrRefCount(temp);
195   Tcl_DecrRefCount(source);
196 
197   if (result == TCL_ERROR) {
198       break;
199   }
200     }
201     return result;
202 }
static int FileForceOption (Tcl_Interp * interp, int objc, objv, int * forcePtr) [static]

Definition at line 765 of file tclFCmd.c.
References NULL, and Tcl_GetString().
Referenced by FileCopyRename(), and TclFileDeleteCmd().772 {
773     int force, i;
774     
775     force = 0;
776     for (i = 0; i < objc; i++) {
777   if (Tcl_GetString(objv[i])[0] != '-') {
778       break;
779   }
780   if (strcmp(Tcl_GetString(objv[i]), "-force") == 0) {
781       force = 1;
782   } else if (strcmp(Tcl_GetString(objv[i]), "--") == 0) {
783       i++;
784       break;
785   } else {
786       Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[i]), 
787         "\": should be -force or --", (char *)NULL);
788       return -1;
789   }
790     }
791     *forcePtr = force;
792     return i;
793 }
int TclFileAttrsCmd (Tcl_Interp * interp, int objc, objv)

Definition at line 892 of file tclFCmd.c.
References ckalloc, ckfree, CONST, NULL, Tcl_DecrRefCount, TCL_ERROR, Tcl_FSConvertToPathType(), Tcl_FSFileAttrsGet(), Tcl_FSFileAttrsSet(), Tcl_FSFileAttrStrings(), Tcl_GetErrno(), Tcl_GetIndexFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_IncrRefCount, Tcl_ListObjAppendElement(), Tcl_ListObjIndex(), Tcl_ListObjLength(), Tcl_NewListObj(), Tcl_NewStringObj(), TCL_OK, Tcl_PosixError(), Tcl_SetErrno(), Tcl_SetObjResult(), and Tcl_WrongNumArgs().
Referenced by Tcl_FileObjCmd().896 {
897     int result;
898     CONST char ** attributeStrings;
899     Tcl_Obj* objStrings = NULL;
900     int numObjStrings = -1;
901     Tcl_Obj *filePtr;
902     
903     if (objc < 3) {
904   Tcl_WrongNumArgs(interp, 2, objv,
905     "name ?option? ?value? ?option value ...?");
906   return TCL_ERROR;
907     }
908 
909     filePtr = objv[2];
910     if (Tcl_FSConvertToPathType(interp, filePtr) != TCL_OK) {
911       return TCL_ERROR;
912     }
913     
914     objc -= 3;
915     objv += 3;
916     result = TCL_ERROR;
917     Tcl_SetErrno(0);
918     attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings);
919     if (attributeStrings == NULL) {
920   int index;
921   Tcl_Obj *objPtr;
922   if (objStrings == NULL) {
923       if (Tcl_GetErrno() != 0) {
924     /* 
925      * There was an error, probably that the filePtr is
926      * not accepted by any filesystem
927      */
928     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
929       "could not read \"", Tcl_GetString(filePtr), 
930       "\": ", Tcl_PosixError(interp), 
931       (char *) NULL);
932     return TCL_ERROR;
933       }
934       goto end;
935   }
936   /* We own the object now */
937   Tcl_IncrRefCount(objStrings);
938         /* Use objStrings as a list object */
939   if (Tcl_ListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) {
940       goto end;
941   }
942   attributeStrings = (CONST char **)
943     ckalloc ((1+numObjStrings) * sizeof(char*));
944   for (index = 0; index < numObjStrings; index++) {
945       Tcl_ListObjIndex(interp, objStrings, index, &objPtr);
946       attributeStrings[index] = Tcl_GetString(objPtr);
947   }
948   attributeStrings[index] = NULL;
949     }
950     if (objc == 0) {
951   /*
952    * Get all attributes.
953    */
954 
955   int index;
956   Tcl_Obj *listPtr;
957    
958   listPtr = Tcl_NewListObj(0, NULL);
959   for (index = 0; attributeStrings[index] != NULL; index++) {
960       Tcl_Obj *objPtr = Tcl_NewStringObj(attributeStrings[index], -1);
961       Tcl_ListObjAppendElement(interp, listPtr, objPtr);
962       /* We now forget about objPtr, it is in the list */
963       objPtr = NULL;
964       if (Tcl_FSFileAttrsGet(interp, index, filePtr,
965         &objPtr) != TCL_OK) {
966     Tcl_DecrRefCount(listPtr);
967     goto end;
968       }
969       Tcl_ListObjAppendElement(interp, listPtr, objPtr);
970   }
971       Tcl_SetObjResult(interp, listPtr);
972     } else if (objc == 1) {
973   /*
974    * Get one attribute.
975    */
976 
977   int index;
978   Tcl_Obj *objPtr = NULL;
979 
980   if (numObjStrings == 0) {
981       Tcl_AppendResult(interp, "bad option \"",
982         Tcl_GetString(objv[0]), "\", there are no file attributes"
983            " in this filesystem.", (char *) NULL);
984       goto end;
985   }
986 
987   if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings,
988     "option", 0, &index) != TCL_OK) {
989       goto end;
990   }
991   if (Tcl_FSFileAttrsGet(interp, index, filePtr,
992     &objPtr) != TCL_OK) {
993       goto end;
994   }
995   Tcl_SetObjResult(interp, objPtr);
996     } else {
997   /*
998    * Set option/value pairs.
999    */
1000 
1001   int i, index;
1002         
1003   if (numObjStrings == 0) {
1004       Tcl_AppendResult(interp, "bad option \"",
1005         Tcl_GetString(objv[0]), "\", there are no file attributes"
1006            " in this filesystem.", (char *) NULL);
1007       goto end;
1008   }
1009 
1010       for (i = 0; i < objc ; i += 2) {
1011           if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
1012         "option", 0, &index) != TCL_OK) {
1013     goto end;
1014           }
1015       if (i + 1 == objc) {
1016     Tcl_AppendResult(interp, "value for \"",
1017       Tcl_GetString(objv[i]), "\" missing",
1018       (char *) NULL);
1019     goto end;
1020       }
1021           if (Tcl_FSFileAttrsSet(interp, index, filePtr,
1022                 objv[i + 1]) != TCL_OK) {
1023     goto end;
1024           }
1025       }
1026     }
1027     result = TCL_OK;
1028 
1029     end:
1030     if (numObjStrings != -1) {
1031   /* Free up the array we allocated */
1032   ckfree((char*)attributeStrings);
1033   /* 
1034    * We don't need this object that was passed to us
1035    * any more.
1036    */
1037   if (objStrings != NULL) {
1038       Tcl_DecrRefCount(objStrings);
1039   }
1040     }
1041     return result;
1042 }
int TclFileCopyCmd (Tcl_Interp * interp, int objc, objv)

Definition at line 80 of file tclFCmd.c.
References FileCopyRename().
Referenced by Tcl_FileObjCmd().84 {
85     return FileCopyRename(interp, objc, objv, 1);
86 }
int TclFileDeleteCmd (Tcl_Interp * interp, int objc, objv)

Definition at line 337 of file tclFCmd.c.
References EEXIST, ENOENT, errno, FileForceOption(), NULL, S_ISDIR, TCL_ERROR, Tcl_FSConvertToPathType(), Tcl_FSDeleteFile(), Tcl_FSEqualPaths(), Tcl_FSLstat(), Tcl_FSRemoveDirectory(), Tcl_GetString(), TCL_OK, and Tcl_PosixError().
Referenced by Tcl_FileObjCmd().341 {
342     int i, force, result;
343     Tcl_Obj *errfile;
344     Tcl_Obj *errorBuffer = NULL;
345     
346     i = FileForceOption(interp, objc - 2, objv + 2, &force);
347     if (i < 0) {
348   return TCL_ERROR;
349     }
350     i += 2;
351     if ((objc - i) < 1) {
352   Tcl_AppendResult(interp, "wrong # args: should be \"", 
353     Tcl_GetString(objv[0]), " ", Tcl_GetString(objv[1]), 
354     " ?options? file ?file ...?\"", (char *) NULL);
355   return TCL_ERROR;
356     }
357 
358     errfile = NULL;
359     result = TCL_OK;
360 
361     for ( ; i < objc; i++) {
362   Tcl_StatBuf statBuf;
363 
364   errfile = objv[i];
365   if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
366       result = TCL_ERROR;
367       goto done;
368   }
369 
370   /*
371    * Call lstat() to get info so can delete symbolic link itself.
372    */
373 
374   if (Tcl_FSLstat(objv[i], &statBuf) != 0) {
375       /*
376        * Trying to delete a file that does not exist is not
377        * considered an error, just a no-op
378        */
379 
380       if (errno != ENOENT) {
381     result = TCL_ERROR;
382       }
383   } else if (S_ISDIR(statBuf.st_mode)) {
384       /* 
385        * We own a reference count on errorBuffer, if it was set
386        * as a result of this call. 
387        */
388       result = Tcl_FSRemoveDirectory(objv[i], force, &errorBuffer);
389       if (result != TCL_OK) {
390     if ((force == 0) && (errno == EEXIST)) {
391         Tcl_AppendResult(interp, "error deleting \"", 
392           Tcl_GetString(objv[i]),
393           "\": directory not empty", (char *) NULL);
394         Tcl_PosixError(interp);
395         goto done;
396     }
397 
398     /* 
399      * If possible, use the untranslated name for the file.
400      */
401      
402     errfile = errorBuffer;
403     /* FS supposed to check between translated objv and errfile */
404     if (Tcl_FSEqualPaths(objv[i], errfile)) {
405         errfile = objv[i];
406     }
407       }
408   } else {
409       result = Tcl_FSDeleteFile(objv[i]);
410   }
411   
412   if (result != TCL_OK) {
413       result = TCL_ERROR;
414       /* 
415        * It is important that we break on error, otherwise we
416        * might end up owning reference counts on numerous
417        * errorBuffers.
418        */
419       break;
420   }
421     }
422     if (result != TCL_OK) {
423   if (errfile == NULL) {
424       /* 
425        * We try to accomodate poor error results from our 
426        * Tcl_FS calls 
427        */
428       Tcl_AppendResult(interp, "error deleting unknown file: ", 
429         Tcl_PosixError(interp), (char *) NULL);
430   } else {
431       Tcl_AppendResult(interp, "error deleting \"", 
432         Tcl_GetString(errfile), "\": ", 
433         Tcl_PosixError(interp), (char *) NULL);
434   }
435     } 
436     done:
437     if (errorBuffer != NULL) {
438   Tcl_DecrRefCount(errorBuffer);
439     }
440     return result;
441 }
int TclFileMakeDirsCmd (Tcl_Interp * interp, int objc, objv)

Definition at line 223 of file tclFCmd.c.
References EEXIST, ENOENT, errno, NULL, S_ISDIR, Tcl_DecrRefCount, TCL_ERROR, Tcl_FSConvertToPathType(), Tcl_FSCreateDirectory(), Tcl_FSJoinPath(), Tcl_FSSplitPath(), Tcl_FSStat(), Tcl_GetString(), Tcl_IncrRefCount, TCL_OK, Tcl_PosixError(), and Tcl_ResetResult().
Referenced by Tcl_FileObjCmd().227 {
228     Tcl_Obj *errfile;
229     int result, i, j, pobjc;
230     Tcl_Obj *split = NULL;
231     Tcl_Obj *target = NULL;
232     Tcl_StatBuf statBuf;
233 
234     errfile = NULL;
235 
236     result = TCL_OK;
237     for (i = 2; i < objc; i++) {
238   if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
239       result = TCL_ERROR;
240       break;
241   }
242 
243   split = Tcl_FSSplitPath(objv[i],&pobjc);
244   if (pobjc == 0) {
245       errno = ENOENT;
246       errfile = objv[i];
247       break;
248   }
249   for (j = 0; j < pobjc; j++) {
250       target = Tcl_FSJoinPath(split, j + 1);
251       Tcl_IncrRefCount(target);
252       /*
253        * Call Tcl_FSStat() so that if target is a symlink that
254        * points to a directory we will create subdirectories in
255        * that directory.
256        */
257 
258       if (Tcl_FSStat(target, &statBuf) == 0) {
259     if (!S_ISDIR(statBuf.st_mode)) {
260         errno = EEXIST;
261         errfile = target;
262         goto done;
263     }
264       } else if (errno != ENOENT) {
265     /*
266      * If Tcl_FSStat() failed and the error is anything
267      * other than non-existence of the target, throw the
268      * error.
269      */
270     errfile = target;
271     goto done;
272       } else if (Tcl_FSCreateDirectory(target) != TCL_OK) {
273     /*
274      * Create might have failed because of being in a race
275      * condition with another process trying to create the
276      * same subdirectory.
277      */
278     if (errno == EEXIST) {
279         if ((Tcl_FSStat(target, &statBuf) == 0)
280           && S_ISDIR(statBuf.st_mode)) {
281       /*
282        * It is a directory that wasn't there before,
283        * so keep going without error.
284        */
285       Tcl_ResetResult(interp);
286         } else {
287       errfile = target;
288       goto done;
289         }
290     } else {
291         errfile = target;
292         goto done;
293     }
294       }
295       /* Forget about this sub-path */
296       Tcl_DecrRefCount(target);
297       target = NULL;
298   }
299   Tcl_DecrRefCount(split);
300   split = NULL;
301     }
302 
303     done:
304     if (errfile != NULL) {
305   Tcl_AppendResult(interp, "can't create directory \"",
306     Tcl_GetString(errfile), "\": ", Tcl_PosixError(interp), 
307     (char *) NULL);
308   result = TCL_ERROR;
309     }
310     if (split != NULL) {
311   Tcl_DecrRefCount(split);
312     }
313     if (target != NULL) {
314   Tcl_DecrRefCount(target);
315     }
316     return result;
317 }
int TclFileRenameCmd (Tcl_Interp * interp, int objc, objv)

Definition at line 52 of file tclFCmd.c.
References FileCopyRename().
Referenced by Tcl_FileObjCmd().56 {
57     return FileCopyRename(interp, objc, objv, 0);
58 }

generic/tclFileName.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"
Classes
struct ThreadSpecificData
Defines
#define MAC_UNDERSTANDS_UNIX_PATHS
#define MAC_ROOT_PATTERN  "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$"
Functions
static void FileNameCleanup _ANSI_ARGS_ ((ClientData clientData))
static void FileNameInit _ANSI_ARGS_ ((void))
static CONST char *DoTildeSubst _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *user, Tcl_DString *resultPtr))
static CONST char *ExtractWinRoot _ANSI_ARGS_ ((CONST char *path, Tcl_DString *resultPtr, int offset, Tcl_PathType *typePtr))
static int SkipToChar _ANSI_ARGS_ ((char **stringPtr, char *match))
static Tcl_Obj *SplitMacPath _ANSI_ARGS_ ((CONST char *path))
static void FileNameInit ()
static void FileNameCleanup (ClientData clientData)
static CONST char * ExtractWinRoot (CONST char *path, Tcl_DString *resultPtr, int offset, Tcl_PathType *typePtr)
Tcl_PathType Tcl_GetPathType (CONST char *path)
Tcl_PathType TclpGetNativePathType (Tcl_Obj *pathObjPtr, int *driveNameLengthPtr, Tcl_Obj **driveNameRef)
Tcl_Obj * TclpNativeSplitPath (Tcl_Obj *pathPtr, int *lenPtr)
void Tcl_SplitPath (CONST char *path, int *argcPtr, CONST char ***argvPtr)
static Tcl_Obj * SplitUnixPath (CONST char *path)
static Tcl_Obj * SplitWinPath (CONST char *path)
static Tcl_Obj * SplitMacPath (CONST char *path)
Tcl_Obj * Tcl_FSJoinToPath (Tcl_Obj *basePtr, int objc, objv)
void TclpNativeJoinPath (Tcl_Obj *prefix, char *joining)
char * Tcl_JoinPath (int argc, CONST char *CONST *argv, Tcl_DString *resultPtr)
char * Tcl_TranslateFileName (Tcl_Interp *interp, CONST char *name, Tcl_DString *bufferPtr)
char * TclGetExtension (char *name)
static CONST char * DoTildeSubst (Tcl_Interp *interp, CONST char *user, Tcl_DString *resultPtr)
int Tcl_GlobObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int TclGlob (Tcl_Interp *interp, char *pattern, Tcl_Obj *unquotedPrefix, int globFlags, Tcl_GlobTypeData *types)
static int SkipToChar (char **stringPtr, char *match)
int TclDoGlob (Tcl_Interp *interp, char *separators, Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)
Tcl_Obj * TclFileDirname (Tcl_Interp *interp, Tcl_Obj *pathPtr)
Tcl_StatBuf * Tcl_AllocStatBuf ()
Variables
static Tcl_ThreadDataKey dataKey
TclPlatformType tclPlatform = TCL_PLATFORM_UNIX

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

Definition at line 43 of file tclFileName.c.
Referenced by FileNameInit().#define MAC_UNDERSTANDS_UNIX_PATHS

Definition at line 25 of file tclFileName.c.
Function Documentation
static Tcl_Obj* SplitMacPath _ANSI_ARGS_ ((CONST char *path)) [static]
static int SkipToChar _ANSI_ARGS_ ((char **stringPtr, char *match)) [static]
static CONST char* ExtractWinRoot _ANSI_ARGS_ ((CONST char *path, Tcl_DString *resultPtr, int offset, Tcl_PathType *typePtr)) [static]
static CONST char* DoTildeSubst _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *user, Tcl_DString *resultPtr)) [static]
static void FileNameInit _ANSI_ARGS_ ((void)) [static]
static void FileNameCleanup _ANSI_ARGS_ ((ClientData clientData)) [static]
static CONST char* DoTildeSubst (Tcl_Interp * interp, CONST char * user, Tcl_DString * resultPtr) [static]

Definition at line 1522 of file tclFileName.c.
References CONST, NULL, Tcl_DStringFree(), Tcl_DStringValue, Tcl_JoinPath(), Tcl_ResetResult(), TclGetEnv(), and TclpGetUserHome().
Referenced by TclGlob().1529 {
1530     CONST char *dir;
1531 
1532     if (*user == '\0') {
1533   Tcl_DString dirString;
1534   
1535   dir = TclGetEnv("HOME", &dirString);
1536   if (dir == NULL) {
1537       if (interp) {
1538     Tcl_ResetResult(interp);
1539     Tcl_AppendResult(interp, "couldn't find HOME environment ",
1540       "variable to expand path", (char *) NULL);
1541       }
1542       return NULL;
1543   }
1544   Tcl_JoinPath(1, &dir, resultPtr);
1545   Tcl_DStringFree(&dirString);
1546     } else {
1547   if (TclpGetUserHome(user, resultPtr) == NULL) { 
1548       if (interp) {
1549     Tcl_ResetResult(interp);
1550     Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
1551       (char *) NULL);
1552       }
1553       return NULL;
1554   }
1555     }
1556     return Tcl_DStringValue(resultPtr);
1557 }
static CONST char* ExtractWinRoot (CONST char * path, Tcl_DString * resultPtr, int offset, Tcl_PathType * typePtr) [static]

Definition at line 160 of file tclFileName.c.
References CONST, Tcl_DStringAppend(), Tcl_DStringSetLength(), TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, and TCL_PATH_VOLUME_RELATIVE.
Referenced by SplitWinPath(), and TclpGetNativePathType().166 {
167     if (path[0] == '/' || path[0] == '\\') {
168   /* Might be a UNC or Vol-Relative path */
169   CONST char *host, *share, *tail;
170   int hlen, slen;
171   if (path[1] != '/' && path[1] != '\\') {
172       Tcl_DStringSetLength(resultPtr, offset);
173       *typePtr = TCL_PATH_VOLUME_RELATIVE;
174       Tcl_DStringAppend(resultPtr, "/", 1);
175       return &path[1];
176   }
177   host = &path[2];
178 
179   /* Skip separators */
180   while (host[0] == '/' || host[0] == '\\') host++;
181 
182   for (hlen = 0; host[hlen];hlen++) {
183       if (host[hlen] == '/' || host[hlen] == '\\')
184     break;
185   }
186   if (host[hlen] == 0 || host[hlen+1] == 0) {
187       /* 
188        * The path given is simply of the form 
189        * '/foo', '//foo', '/////foo' or the same
190        * with backslashes.  If there is exactly
191        * one leading '/' the path is volume relative
192        * (see filename man page).  If there are more
193        * than one, we are simply assuming they
194        * are superfluous and we trim them away.
195        * (An alternative interpretation would
196        * be that it is a host name, but we have
197        * been documented that that is not the case).
198        */
199       *typePtr = TCL_PATH_VOLUME_RELATIVE;
200       Tcl_DStringAppend(resultPtr, "/", 1);
201       return &path[2];
202   }
203   Tcl_DStringSetLength(resultPtr, offset);
204   share = &host[hlen];
205 
206   /* Skip separators */
207   while (share[0] == '/' || share[0] == '\\') share++;
208 
209   for (slen = 0; share[slen];slen++) {
210       if (share[slen] == '/' || share[slen] == '\\')
211     break;
212   }
213   Tcl_DStringAppend(resultPtr, "//", 2);
214   Tcl_DStringAppend(resultPtr, host, hlen);
215   Tcl_DStringAppend(resultPtr, "/", 1);
216   Tcl_DStringAppend(resultPtr, share, slen);
217 
218   tail = &share[slen];
219 
220   /* Skip separators */
221   while (tail[0] == '/' || tail[0] == '\\') tail++;
222 
223   *typePtr = TCL_PATH_ABSOLUTE;
224   return tail;
225     } else if (*path && path[1] == ':') {
226   /* Might be a drive sep */
227   Tcl_DStringSetLength(resultPtr, offset);
228 
229   if (path[2] != '/' && path[2] != '\\') {
230       *typePtr = TCL_PATH_VOLUME_RELATIVE;
231       Tcl_DStringAppend(resultPtr, path, 2);
232       return &path[2];
233   } else {
234       char *tail = (char*)&path[3];
235 
236       /* Skip separators */
237       while (*tail && (tail[0] == '/' || tail[0] == '\\')) tail++;
238 
239       *typePtr = TCL_PATH_ABSOLUTE;
240       Tcl_DStringAppend(resultPtr, path, 2);
241       Tcl_DStringAppend(resultPtr, "/", 1);
242 
243       return tail;
244   }
245     } else {
246   int abs = 0;
247   if ((path[0] == 'c' || path[0] == 'C') 
248       && (path[1] == 'o' || path[1] == 'O')) {
249       if ((path[2] == 'm' || path[2] == 'M')
250     && path[3] >= '1' && path[3] <= '4') {
251     /* May have match for 'com[1-4]:?', which is a serial port */
252     if (path[4] == '\0') {
253         abs = 4;
254     } else if (path [4] == ':' && path[5] == '\0') {
255         abs = 5;
256     }
257       } else if ((path[2] == 'n' || path[2] == 'N') && path[3] == '\0') {
258     /* Have match for 'con' */
259     abs = 3;
260       }
261   } else if ((path[0] == 'l' || path[0] == 'L')
262        && (path[1] == 'p' || path[1] == 'P')
263        && (path[2] == 't' || path[2] == 'T')) {
264       if (path[3] >= '1' && path[3] <= '3') {
265     /* May have match for 'lpt[1-3]:?' */
266     if (path[4] == '\0') {
267         abs = 4;
268     } else if (path [4] == ':' && path[5] == '\0') {
269         abs = 5;
270     }
271       }
272   } else if ((path[0] == 'p' || path[0] == 'P')
273        && (path[1] == 'r' || path[1] == 'R')
274        && (path[2] == 'n' || path[2] == 'N')
275        && path[3] == '\0') {
276       /* Have match for 'prn' */
277       abs = 3;
278   } else if ((path[0] == 'n' || path[0] == 'N')
279        && (path[1] == 'u' || path[1] == 'U')
280        && (path[2] == 'l' || path[2] == 'L')
281        && path[3] == '\0') {
282       /* Have match for 'nul' */
283       abs = 3;
284   } else if ((path[0] == 'a' || path[0] == 'A')
285        && (path[1] == 'u' || path[1] == 'U')
286        && (path[2] == 'x' || path[2] == 'X')
287        && path[3] == '\0') {
288       /* Have match for 'aux' */
289       abs = 3;
290   }
291   if (abs != 0) {
292       *typePtr = TCL_PATH_ABSOLUTE;
293       Tcl_DStringSetLength(resultPtr, offset);
294       Tcl_DStringAppend(resultPtr, path, abs);
295       return path + abs;
296   }
297     }
298     /* Anything else is treated as relative */
299     *typePtr = TCL_PATH_RELATIVE;
300     return path;
301 }
static void FileNameCleanup (ClientData clientData) [static]

Definition at line 130 of file tclFileName.c.
References dataKey, ThreadSpecificData::initialized, ThreadSpecificData::macRootPatternPtr, Tcl_DecrRefCount, and TCL_TSD_INIT.
Referenced by FileNameInit().132 {
133     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
134     Tcl_DecrRefCount(tsdPtr->macRootPatternPtr);
135     tsdPtr->initialized = 0;
136 }
static void FileNameInit () [static]

Definition at line 102 of file tclFileName.c.
References dataKey, FileNameCleanup(), ThreadSpecificData::initialized, MAC_ROOT_PATTERN, ThreadSpecificData::macRootPatternPtr, NULL, Tcl_CreateThreadExitHandler(), Tcl_NewStringObj(), and TCL_TSD_INIT.
Referenced by SplitMacPath(), and TclpGetNativePathType().103 {
104     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
105     if (!tsdPtr->initialized) {
106   tsdPtr->initialized = 1;
107   tsdPtr->macRootPatternPtr = Tcl_NewStringObj(MAC_ROOT_PATTERN, -1);
108   Tcl_CreateThreadExitHandler(FileNameCleanup, NULL);
109     }
110 }
static int SkipToChar (char ** stringPtr, char * match) [static]

Definition at line 2247 of file tclFileName.c.
Referenced by TclDoGlob().2250 {
2251     int quoted, level;
2252     register char *p;
2253 
2254     quoted = 0;
2255     level = 0;
2256 
2257     for (p = *stringPtr; *p != '\0'; p++) {
2258   if (quoted) {
2259       quoted = 0;
2260       continue;
2261   }
2262   if ((level == 0) && (*p == *match)) {
2263       *stringPtr = p;
2264       return 1;
2265   }
2266   if (*p == '{') {
2267       level++;
2268   } else if (*p == '}') {
2269       level--;
2270   } else if (*p == '\\') {
2271       quoted = 1;
2272   }
2273     }
2274     *stringPtr = p;
2275     return 0;
2276 }
static Tcl_Obj* SplitMacPath (CONST char * path) [static]

Definition at line 842 of file tclFileName.c.
References CONST, dataKey, FileNameInit(), ThreadSpecificData::macRootPatternPtr, NULL, REG_ADVANCED, Tcl_AppendToObj(), Tcl_GetRegExpFromObj(), Tcl_ListObjAppendElement(), Tcl_NewObj(), Tcl_NewStringObj(), Tcl_RegExpExec(), Tcl_RegExpRange(), and TCL_TSD_INIT.
Referenced by TclpNativeSplitPath().844 {
845     int isMac = 0;    /* 1 if is Mac-style, 0 if Unix-style path. */
846     int length;
847     CONST char *p, *elementStart;
848     Tcl_Obj *result;
849 #ifdef MAC_UNDERSTANDS_UNIX_PATHS
850     Tcl_RegExp re;
851     int i;
852     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
853 #endif
854     
855     result = Tcl_NewObj();
856     
857 #ifdef MAC_UNDERSTANDS_UNIX_PATHS
858     /*
859      * Initialize the path name parser for Macintosh path names.
860      */
861 
862     FileNameInit();
863 
864     /*
865      * Match the root portion of a Mac path name.
866      */
867 
868     i = 0;      /* Needed only to prevent gcc warnings. */
869 
870     re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr, REG_ADVANCED);
871 
872     if (Tcl_RegExpExec(NULL, re, path, path) == 1) {
873   CONST char *start, *end;
874   Tcl_Obj *nextElt;
875 
876   /*
877    * Treat degenerate absolute paths like / and /../.. as
878    * Mac relative file names for lack of anything else to do.
879    */
880 
881   Tcl_RegExpRange(re, 2, &start, &end);
882   if (start) {
883       Tcl_Obj *elt = Tcl_NewStringObj(":", 1);
884       Tcl_RegExpRange(re, 0, &start, &end);
885       Tcl_AppendToObj(elt, path, end - start);
886       Tcl_ListObjAppendElement(NULL, result, elt);
887       return result;
888   }
889 
890   Tcl_RegExpRange(re, 5, &start, &end);
891   if (start) {
892       /*
893        * Unix-style tilde prefixed paths.
894        */
895 
896       isMac = 0;
897       i = 5;
898   } else {
899       Tcl_RegExpRange(re, 7, &start, &end);
900       if (start) {
901     /*
902      * Mac-style tilde prefixed paths.
903      */
904 
905     isMac = 1;
906     i = 7;
907       } else {
908     Tcl_RegExpRange(re, 10, &start, &end);
909     if (start) {
910         /*
911          * Normal Unix style paths.
912          */
913 
914         isMac = 0;
915         i = 10;
916     } else {
917         Tcl_RegExpRange(re, 12, &start, &end);
918         if (start) {
919       /*
920        * Normal Mac style paths.
921        */
922 
923       isMac = 1;
924       i = 12;
925         }
926     }
927       }
928   }
929   Tcl_RegExpRange(re, i, &start, &end);
930   length = end - start;
931 
932   /*
933    * Append the element and terminate it with a : 
934    */
935 
936   nextElt = Tcl_NewStringObj(start, length);
937   Tcl_AppendToObj(nextElt, ":", 1);
938   Tcl_ListObjAppendElement(NULL, result, nextElt);
939   p = end;
940     } else {
941   isMac = (strchr(path, ':') != NULL);
942   p = path;
943     }
944 #else
945     if ((path[0] != ':') && (path[0] == '~' || (strchr(path,':') != NULL))) {
946   CONST char *end;
947   Tcl_Obj *nextElt;
948 
949   isMac = 1;
950   
951   end = strchr(path,':');
952   if (end == NULL) {
953       length = strlen(path);
954   } else {
955       length = end - path;
956   }
957 
958   /*
959    * Append the element and terminate it with a :
960    */
961 
962   nextElt = Tcl_NewStringObj(path, length);
963   Tcl_AppendToObj(nextElt, ":", 1);
964   Tcl_ListObjAppendElement(NULL, result, nextElt);
965   p = path + length;
966     } else {
967   isMac = (strchr(path, ':') != NULL);
968   isMac = 1;
969   p = path;
970     }
971 #endif
972     
973     if (isMac) {
974 
975   /*
976    * p is pointing at the first colon in the path.  There
977    * will always be one, since this is a Mac-style path.
978    * (This is no longer true if MAC_UNDERSTANDS_UNIX_PATHS 
979    * is false, so we must check whether 'p' points to the
980    * end of the string.)
981    */
982   elementStart = p;
983   if (*p == ':') {
984       p++;
985   }
986   
987   while ((p = strchr(p, ':')) != NULL) {
988       length = p - elementStart;
989       if (length == 1) {
990     while (*p == ':') {
991         Tcl_ListObjAppendElement(NULL, result,
992           Tcl_NewStringObj("::", 2));
993         elementStart = p++;
994     }
995       } else {
996     /*
997      * If this is a simple component, drop the leading colon.
998      */
999 
1000     if ((elementStart[1] != '~')
1001       && (strchr(elementStart+1, '/') == NULL)) {
1002         elementStart++;
1003         length--;
1004     }
1005     Tcl_ListObjAppendElement(NULL, result, 
1006       Tcl_NewStringObj(elementStart, length));
1007     elementStart = p++;
1008       }
1009   }
1010   if (elementStart[0] != ':') {
1011       if (elementStart[0] != '\0') {
1012     Tcl_ListObjAppendElement(NULL, result, 
1013       Tcl_NewStringObj(elementStart, -1));
1014       }
1015   } else {
1016       if (elementStart[1] != '\0' || elementStart == path) {
1017     if ((elementStart[1] != '~') && (elementStart[1] != '\0')
1018       && (strchr(elementStart+1, '/') == NULL)) {
1019         elementStart++;
1020     }
1021     Tcl_ListObjAppendElement(NULL, result, 
1022       Tcl_NewStringObj(elementStart, -1));
1023       }
1024   }
1025     } else {
1026 
1027   /*
1028    * Split on slashes, suppress extra /'s, and convert .. to ::. 
1029    */
1030 
1031   for (;;) {
1032       elementStart = p;
1033       while ((*p != '\0') && (*p != '/')) {
1034     p++;
1035       }
1036       length = p - elementStart;
1037       if (length > 0) {
1038     if ((length == 1) && (elementStart[0] == '.')) {
1039         Tcl_ListObjAppendElement(NULL, result, 
1040                Tcl_NewStringObj(":", 1));
1041     } else if ((length == 2) && (elementStart[0] == '.')
1042       && (elementStart[1] == '.')) {
1043         Tcl_ListObjAppendElement(NULL, result, 
1044                Tcl_NewStringObj("::", 2));
1045     } else {
1046         Tcl_Obj *nextElt;
1047         if (*elementStart == '~') {
1048       nextElt = Tcl_NewStringObj(":",1);
1049       Tcl_AppendToObj(nextElt, elementStart, length);
1050         } else {
1051       nextElt = Tcl_NewStringObj(elementStart, length);
1052         }
1053         Tcl_ListObjAppendElement(NULL, result, nextElt);
1054     }
1055       }
1056       if (*p++ == '\0') {
1057     break;
1058       }
1059   }
1060     }
1061     return result;
1062 }
static Tcl_Obj* SplitUnixPath (CONST char * path) [static]

Definition at line 693 of file tclFileName.c.
References CONST, NULL, Tcl_AppendToObj(), Tcl_ListObjAppendElement(), Tcl_NewObj(), Tcl_NewStringObj(), and UCHAR.
Referenced by TclpNativeSplitPath().695 {
696     int length;
697     CONST char *p, *elementStart;
698     Tcl_Obj *result = Tcl_NewObj();
699 
700     /*
701      * Deal with the root directory as a special case.
702      */
703 
704 #ifdef __QNX__
705     /*
706      * Check for QNX //<node id> prefix
707      */
708     if ((path[0] == '/') && (path[1] == '/')
709       && isdigit(UCHAR(path[2]))) { /* INTL: digit */
710   path += 3;
711   while (isdigit(UCHAR(*path))) { /* INTL: digit */
712       ++path;
713   }
714     }
715 #endif
716 
717     if (path[0] == '/') {
718   Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj("/",1));
719   p = path+1;
720     } else {
721   p = path;
722     }
723 
724     /*
725      * Split on slashes.  Embedded elements that start with tilde will be
726      * prefixed with "./" so they are not affected by tilde substitution.
727      */
728 
729     for (;;) {
730   elementStart = p;
731   while ((*p != '\0') && (*p != '/')) {
732       p++;
733   }
734   length = p - elementStart;
735   if (length > 0) {
736       Tcl_Obj *nextElt;
737       if ((elementStart[0] == '~') && (elementStart != path)) {
738     nextElt = Tcl_NewStringObj("./",2);
739     Tcl_AppendToObj(nextElt, elementStart, length);
740       } else {
741     nextElt = Tcl_NewStringObj(elementStart, length);
742       }
743       Tcl_ListObjAppendElement(NULL, result, nextElt);
744   }
745   if (*p++ == '\0') {
746       break;
747   }
748     }
749     return result;
750 }
static Tcl_Obj* SplitWinPath (CONST char * path) [static]

Definition at line 771 of file tclFileName.c.
References CONST, ExtractWinRoot(), NULL, Tcl_AppendToObj(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringValue, Tcl_ListObjAppendElement(), Tcl_NewObj(), Tcl_NewStringObj(), TCL_PATH_ABSOLUTE, and UCHAR.
Referenced by TclpNativeSplitPath().773 {
774     int length;
775     CONST char *p, *elementStart;
776     Tcl_PathType type = TCL_PATH_ABSOLUTE;
777     Tcl_DString buf;
778     Tcl_Obj *result = Tcl_NewObj();
779     Tcl_DStringInit(&buf);
780     
781     p = ExtractWinRoot(path, &buf, 0, &type);
782 
783     /*
784      * Terminate the root portion, if we matched something.
785      */
786 
787     if (p != path) {
788   Tcl_ListObjAppendElement(NULL, result, 
789          Tcl_NewStringObj(Tcl_DStringValue(&buf), 
790               Tcl_DStringLength(&buf)));
791     }
792     Tcl_DStringFree(&buf);
793     
794     /*
795      * Split on slashes.  Embedded elements that start with tilde 
796      * or a drive letter will be prefixed with "./" so they are not 
797      * affected by tilde substitution.
798      */
799 
800     do {
801   elementStart = p;
802   while ((*p != '\0') && (*p != '/') && (*p != '\\')) {
803       p++;
804   }
805   length = p - elementStart;
806   if (length > 0) {
807       Tcl_Obj *nextElt;
808       if ((elementStart != path)
809     && ((elementStart[0] == '~')
810         || (isalpha(UCHAR(elementStart[0]))
811       && elementStart[1] == ':'))) {
812     nextElt = Tcl_NewStringObj("./",2);
813     Tcl_AppendToObj(nextElt, elementStart, length);
814       } else {
815     nextElt = Tcl_NewStringObj(elementStart, length);
816       }
817       Tcl_ListObjAppendElement(NULL, result, nextElt);
818   }
819     } while (*p++ != '\0');
820 
821     return result;
822 }
Tcl_StatBuf* Tcl_AllocStatBuf ()

Definition at line 2754 of file tclFileName.c.
References ckalloc.2754                    {
2755     return (Tcl_StatBuf *) ckalloc(sizeof(Tcl_StatBuf));
2756 }
Tcl_Obj* Tcl_FSJoinToPath (Tcl_Obj * basePtr, int objc, objv)

Definition at line 1083 of file tclFileName.c.
References NULL, Tcl_DecrRefCount, Tcl_FSJoinPath(), Tcl_ListObjAppendElement(), and Tcl_NewListObj().
Referenced by SetFsPathFromAny(), Tcl_FileObjCmd(), Tcl_FSGetNormalizedPath(), and Tcl_GetEncodingNames().1087 {
1088     int i;
1089     Tcl_Obj *lobj, *ret;
1090 
1091     if (basePtr == NULL) {
1092   lobj = Tcl_NewListObj(0, NULL);
1093     } else {
1094   lobj = Tcl_NewListObj(1, &basePtr);
1095     }
1096     
1097     for (i = 0; i<objc;i++) {
1098   Tcl_ListObjAppendElement(NULL, lobj, objv[i]);
1099     }
1100     ret = Tcl_FSJoinPath(lobj, -1);
1101     Tcl_DecrRefCount(lobj);
1102     return ret;
1103 }
Tcl_PathType Tcl_GetPathType (CONST char * path)

Definition at line 326 of file tclFileName.c.
References Tcl_DecrRefCount, Tcl_FSGetPathType(), Tcl_IncrRefCount, and Tcl_NewStringObj().328 {
329     Tcl_PathType type;
330     Tcl_Obj *tempObj = Tcl_NewStringObj(path,-1);
331     Tcl_IncrRefCount(tempObj);
332     type = Tcl_FSGetPathType(tempObj);
333     Tcl_DecrRefCount(tempObj);
334     return type;
335 }
int Tcl_GlobObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 1578 of file tclFileName.c.
References ckalloc, ckfree, CONST, find(), Tcl_GlobTypeData::macCreator, Tcl_GlobTypeData::macType, NULL, Tcl_GlobTypeData::perm, Tcl_AppendObjToObj(), Tcl_AppendToObj(), Tcl_DecrRefCount, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringValue, TCL_ERROR, Tcl_GetIndexFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), TCL_GLOB_PERM_HIDDEN, TCL_GLOB_PERM_R, TCL_GLOB_PERM_RONLY, TCL_GLOB_PERM_W, TCL_GLOB_PERM_X, TCL_GLOB_TYPE_BLOCK, TCL_GLOB_TYPE_CHAR, TCL_GLOB_TYPE_DIR, TCL_GLOB_TYPE_FILE, TCL_GLOB_TYPE_LINK, TCL_GLOB_TYPE_PIPE, TCL_GLOB_TYPE_SOCK, TCL_GLOBMODE_DIR, TCL_GLOBMODE_NO_COMPLAIN, TCL_GLOBMODE_TAILS, Tcl_IncrRefCount, Tcl_ListObjIndex(), Tcl_ListObjLength(), Tcl_NewStringObj(), TCL_OK, TCL_PLATFORM_MAC, TCL_PLATFORM_UNIX, TCL_PLATFORM_WINDOWS, Tcl_ResetResult(), Tcl_SetObjResult(), Tcl_WrongNumArgs(), TclGlob(), and Tcl_GlobTypeData::type.
Referenced by Tcl_LsObjCmd().1583 {
1584     int index, i, globFlags, length, join, dir, result;
1585     char *string, *separators;
1586     Tcl_Obj *typePtr, *resultPtr, *look;
1587     Tcl_Obj *pathOrDir = NULL;
1588     Tcl_DString prefix;
1589     static CONST char *options[] = {
1590   "-directory", "-join", "-nocomplain", "-path", "-tails", 
1591   "-types", "--", NULL
1592     };
1593     enum options {
1594   GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TAILS, 
1595   GLOB_TYPE, GLOB_LAST
1596     };
1597     enum pathDirOptions {PATH_NONE = -1 , PATH_GENERAL = 0, PATH_DIR = 1};
1598     Tcl_GlobTypeData *globTypes = NULL;
1599 
1600     globFlags = 0;
1601     join = 0;
1602     dir = PATH_NONE;
1603     typePtr = NULL;
1604     for (i = 1; i < objc; i++) {
1605   if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
1606     != TCL_OK) {
1607       string = Tcl_GetStringFromObj(objv[i], &length);
1608       if (string[0] == '-') {
1609     /*
1610      * It looks like the command contains an option so signal
1611      * an error
1612      */
1613     return TCL_ERROR;
1614       } else {
1615     /*
1616      * This clearly isn't an option; assume it's the first
1617      * glob pattern.  We must clear the error
1618      */
1619     Tcl_ResetResult(interp);
1620     break;
1621       }
1622   }
1623   switch (index) {
1624       case GLOB_NOCOMPLAIN:     /* -nocomplain */
1625           globFlags |= TCL_GLOBMODE_NO_COMPLAIN;
1626     break;
1627       case GLOB_DIR:        /* -dir */
1628     if (i == (objc-1)) {
1629         Tcl_SetObjResult(interp, Tcl_NewStringObj(
1630           "missing argument to \"-directory\"", -1));
1631         return TCL_ERROR;
1632     }
1633     if (dir != PATH_NONE) {
1634         Tcl_SetObjResult(interp, Tcl_NewStringObj(
1635           "\"-directory\" cannot be used with \"-path\"",
1636           -1));
1637         return TCL_ERROR;
1638     }
1639     dir = PATH_DIR;
1640     globFlags |= TCL_GLOBMODE_DIR;
1641     pathOrDir = objv[i+1];
1642     i++;
1643     break;
1644       case GLOB_JOIN:       /* -join */
1645     join = 1;
1646     break;
1647       case GLOB_TAILS:        /* -tails */
1648           globFlags |= TCL_GLOBMODE_TAILS;
1649     break;
1650       case GLOB_PATH:       /* -path */
1651           if (i == (objc-1)) {
1652         Tcl_SetObjResult(interp, Tcl_NewStringObj(
1653           "missing argument to \"-path\"", -1));
1654         return TCL_ERROR;
1655     }
1656     if (dir != PATH_NONE) {
1657         Tcl_SetObjResult(interp, Tcl_NewStringObj(
1658           "\"-path\" cannot be used with \"-directory\"",
1659           -1));
1660         return TCL_ERROR;
1661     }
1662     dir = PATH_GENERAL;
1663     pathOrDir = objv[i+1];
1664     i++;
1665     break;
1666       case GLOB_TYPE:       /* -types */
1667           if (i == (objc-1)) {
1668         Tcl_SetObjResult(interp, Tcl_NewStringObj(
1669           "missing argument to \"-types\"", -1));
1670         return TCL_ERROR;
1671     }
1672     typePtr = objv[i+1];
1673     if (Tcl_ListObjLength(interp, typePtr, &length) != TCL_OK) {
1674         return TCL_ERROR;
1675     }
1676     i++;
1677     break;
1678       case GLOB_LAST:       /* -- */
1679           i++;
1680     goto endOfForLoop;
1681   }
1682     }
1683     endOfForLoop:
1684     if (objc - i < 1) {
1685         Tcl_WrongNumArgs(interp, 1, objv, "?switches? name ?name ...?");
1686   return TCL_ERROR;
1687     }
1688     if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) {
1689   Tcl_SetObjResult(interp, Tcl_NewStringObj(
1690     "\"-tails\" must be used with either \"-directory\" or \"-path\"",
1691     -1));
1692   return TCL_ERROR;
1693     }
1694     
1695     separators = NULL;    /* lint. */
1696     switch (tclPlatform) {
1697   case TCL_PLATFORM_UNIX:
1698       separators = "/";
1699       break;
1700   case TCL_PLATFORM_WINDOWS:
1701       separators = "/\\:";
1702       break;
1703   case TCL_PLATFORM_MAC:
1704       separators = ":";
1705       break;
1706     }
1707     if (dir == PATH_GENERAL) {
1708   int pathlength;
1709   char *last;
1710   char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength);
1711 
1712   /*
1713    * Find the last path separator in the path
1714    */
1715   last = first + pathlength;
1716   for (; last != first; last--) {
1717       if (strchr(separators, *(last-1)) != NULL) {
1718     break;
1719       }
1720   }
1721   if (last == first + pathlength) {
1722       /* It's really a directory */
1723       dir = PATH_DIR;
1724   } else {
1725       Tcl_DString pref;
1726       char *search, *find;
1727       Tcl_DStringInit(&pref);
1728       if (last == first) {
1729     /* The whole thing is a prefix */
1730     Tcl_DStringAppend(&pref, first, -1);
1731     pathOrDir = NULL;
1732       } else {
1733     /* Have to split off the end */
1734     Tcl_DStringAppend(&pref, last, first+pathlength-last);
1735     pathOrDir = Tcl_NewStringObj(first, last-first-1);
1736     /* 
1737      * We must ensure that we haven't cut off too much,
1738      * and turned a valid path like '/' or 'C:/' into
1739      * an incorrect path like '' or 'C:'.  The way we
1740      * do this is to add a separator if there are none
1741      * presently in the prefix.
1742      */
1743     if (strpbrk(Tcl_GetString(pathOrDir), "\\/") == NULL) {
1744         Tcl_AppendToObj(pathOrDir, last-1, 1); 
1745     }
1746       }
1747       /* Need to quote 'prefix' */
1748       Tcl_DStringInit(&prefix);
1749       search = Tcl_DStringValue(&pref);
1750       while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) {
1751           Tcl_DStringAppend(&prefix, search, find-search);
1752           Tcl_DStringAppend(&prefix, "\\", 1);
1753           Tcl_DStringAppend(&prefix, find, 1);
1754           search = find+1;
1755           if (*search == '\0') {
1756               break;
1757           }
1758       }
1759       if (*search != '\0') {
1760     Tcl_DStringAppend(&prefix, search, -1);
1761       }
1762       Tcl_DStringFree(&pref);
1763   }
1764     }
1765     
1766     if (pathOrDir != NULL) {
1767   Tcl_IncrRefCount(pathOrDir);
1768     }
1769     
1770     if (typePtr != NULL) {
1771   /* 
1772    * The rest of the possible type arguments (except 'd') are
1773    * platform specific.  We don't complain when they are used
1774    * on an incompatible platform.
1775    */
1776   Tcl_ListObjLength(interp, typePtr, &length);
1777   globTypes = (Tcl_GlobTypeData*) ckalloc(sizeof(Tcl_GlobTypeData));
1778   globTypes->type = 0;
1779   globTypes->perm = 0;
1780   globTypes->macType = NULL;
1781   globTypes->macCreator = NULL;
1782   while(--length >= 0) {
1783       int len;
1784       char *str;
1785       Tcl_ListObjIndex(interp, typePtr, length, &look);
1786       str = Tcl_GetStringFromObj(look, &len);
1787       if (strcmp("readonly", str) == 0) {
1788     globTypes->perm |= TCL_GLOB_PERM_RONLY;
1789       } else if (strcmp("hidden", str) == 0) {
1790     globTypes->perm |= TCL_GLOB_PERM_HIDDEN;
1791       } else if (len == 1) {
1792     switch (str[0]) {
1793       case 'r':
1794         globTypes->perm |= TCL_GLOB_PERM_R;
1795         break;
1796       case 'w':
1797         globTypes->perm |= TCL_GLOB_PERM_W;
1798         break;
1799       case 'x':
1800         globTypes->perm |= TCL_GLOB_PERM_X;
1801         break;
1802       case 'b':
1803         globTypes->type |= TCL_GLOB_TYPE_BLOCK;
1804         break;
1805       case 'c':
1806         globTypes->type |= TCL_GLOB_TYPE_CHAR;
1807         break;
1808       case 'd':
1809         globTypes->type |= TCL_GLOB_TYPE_DIR;
1810         break;
1811       case 'p':
1812         globTypes->type |= TCL_GLOB_TYPE_PIPE;
1813         break;
1814       case 'f':
1815         globTypes->type |= TCL_GLOB_TYPE_FILE;
1816         break;
1817             case 'l':
1818         globTypes->type |= TCL_GLOB_TYPE_LINK;
1819         break;
1820       case 's':
1821         globTypes->type |= TCL_GLOB_TYPE_SOCK;
1822         break;
1823       default:
1824         goto badTypesArg;
1825     }
1826       } else if (len == 4) {
1827     /* This is assumed to be a MacOS file type */
1828     if (globTypes->macType != NULL) {
1829         goto badMacTypesArg;
1830     }
1831     globTypes->macType = look;
1832     Tcl_IncrRefCount(look);
1833       } else {
1834     Tcl_Obj* item;
1835     if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK) &&
1836       (len == 3)) {
1837         Tcl_ListObjIndex(interp, look, 0, &item);
1838         if (!strcmp("macintosh", Tcl_GetString(item))) {
1839       Tcl_ListObjIndex(interp, look, 1, &item);
1840       if (!strcmp("type", Tcl_GetString(item))) {
1841           Tcl_ListObjIndex(interp, look, 2, &item);
1842           if (globTypes->macType != NULL) {
1843         goto badMacTypesArg;
1844           }
1845           globTypes->macType = item;
1846           Tcl_IncrRefCount(item);
1847           continue;
1848       } else if (!strcmp("creator", Tcl_GetString(item))) {
1849           Tcl_ListObjIndex(interp, look, 2, &item);
1850           if (globTypes->macCreator != NULL) {
1851         goto badMacTypesArg;
1852           }
1853           globTypes->macCreator = item;
1854           Tcl_IncrRefCount(item);
1855           continue;
1856       }
1857         }
1858     }
1859     /*
1860      * Error cases.  We reset
1861      * the 'join' flag to zero, since we haven't yet
1862      * made use of it.
1863      */
1864     badTypesArg:
1865     resultPtr = Tcl_GetObjResult(interp);
1866     Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1);
1867     Tcl_AppendObjToObj(resultPtr, look);
1868     result = TCL_ERROR;
1869     join = 0;
1870     goto endOfGlob;
1871     badMacTypesArg:
1872     Tcl_SetObjResult(interp, Tcl_NewStringObj(
1873        "only one MacOS type or creator argument"
1874        " to \"-types\" allowed", -1));
1875     result = TCL_ERROR;
1876     join = 0;
1877     goto endOfGlob;
1878       }
1879   }
1880     }
1881 
1882     /* 
1883      * Now we perform the actual glob below.  This may involve joining
1884      * together the pattern arguments, dealing with particular file types
1885      * etc.  We use a 'goto' to ensure we free any memory allocated along
1886      * the way.
1887      */
1888     objc -= i;
1889     objv += i;
1890     result = TCL_OK;
1891     if (join) {
1892   if (dir != PATH_GENERAL) {
1893       Tcl_DStringInit(&prefix);
1894   }
1895   for (i = 0; i < objc; i++) {
1896       string = Tcl_GetStringFromObj(objv[i], &length);
1897       Tcl_DStringAppend(&prefix, string, length);
1898       if (i != objc -1) {
1899     Tcl_DStringAppend(&prefix, separators, 1);
1900       }
1901   }
1902   if (TclGlob(interp, Tcl_DStringValue(&prefix), pathOrDir,
1903     globFlags, globTypes) != TCL_OK) {
1904       result = TCL_ERROR;
1905       goto endOfGlob;
1906   }
1907     } else {
1908   if (dir == PATH_GENERAL) {
1909       Tcl_DString str;
1910       for (i = 0; i < objc; i++) {
1911     Tcl_DStringInit(&str);
1912     if (dir == PATH_GENERAL) {
1913         Tcl_DStringAppend(&str, Tcl_DStringValue(&prefix),
1914           Tcl_DStringLength(&prefix));
1915     }
1916     string = Tcl_GetStringFromObj(objv[i], &length);
1917     Tcl_DStringAppend(&str, string, length);
1918     if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir,
1919       globFlags, globTypes) != TCL_OK) {
1920         result = TCL_ERROR;
1921         Tcl_DStringFree(&str);
1922         goto endOfGlob;
1923     }
1924       }
1925       Tcl_DStringFree(&str);
1926   } else {
1927       for (i = 0; i < objc; i++) {
1928     string = Tcl_GetString(objv[i]);
1929     if (TclGlob(interp, string, pathOrDir,
1930       globFlags, globTypes) != TCL_OK) {
1931         result = TCL_ERROR;
1932         goto endOfGlob;
1933     }
1934       }
1935   }
1936     }
1937     if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) {
1938   if (Tcl_ListObjLength(interp, Tcl_GetObjResult(interp),
1939     &length) != TCL_OK) {
1940       /* This should never happen.  Maybe we should be more dramatic */
1941       result = TCL_ERROR;
1942       goto endOfGlob;
1943   }
1944   if (length == 0) {
1945       Tcl_AppendResult(interp, "no files matched glob pattern",
1946         (join || (objc == 1)) ? " \"" : "s \"", (char *) NULL);
1947       if (join) {
1948     Tcl_AppendResult(interp, Tcl_DStringValue(&prefix),
1949       (char *) NULL);
1950       } else {
1951     char *sep = "";
1952     for (i = 0; i < objc; i++) {
1953         string = Tcl_GetString(objv[i]);
1954         Tcl_AppendResult(interp, sep, string, (char *) NULL);
1955         sep = " ";
1956     }
1957       }
1958       Tcl_AppendResult(interp, "\"", (char *) NULL);
1959       result = TCL_ERROR;
1960   }
1961     }
1962   endOfGlob:
1963     if (join || (dir == PATH_GENERAL)) {
1964   Tcl_DStringFree(&prefix);
1965     }
1966     if (pathOrDir != NULL) {
1967   Tcl_DecrRefCount(pathOrDir);
1968     }
1969     if (globTypes != NULL) {
1970   if (globTypes->macType != NULL) {
1971       Tcl_DecrRefCount(globTypes->macType);
1972   }
1973   if (globTypes->macCreator != NULL) {
1974       Tcl_DecrRefCount(globTypes->macCreator);
1975   }
1976   ckfree((char *) globTypes);
1977     }
1978     return result;
1979 }
char* Tcl_JoinPath (int argc, CONST char * CONST * argv, Tcl_DString * resultPtr)

Definition at line 1330 of file tclFileName.c.
References NULL, Tcl_DecrRefCount, Tcl_DStringAppend(), Tcl_DStringValue, Tcl_FSJoinPath(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_ListObjAppendElement(), Tcl_NewObj(), and Tcl_NewStringObj().
Referenced by AppendEnvironment(), DoTildeSubst(), GetFileSpecs(), OpenEncodingFile(), SetFsPathFromAny(), TclpInitLibraryPath(), TestOpenFileChannelProc1(), TestOpenFileChannelProc2(), and TestOpenFileChannelProc3().1334 {
1335     int i, len;
1336     Tcl_Obj *listObj = Tcl_NewObj();
1337     Tcl_Obj *resultObj;
1338     char *resultStr;
1339 
1340     /* Build the list of paths */
1341     for (i = 0; i < argc; i++) {
1342         Tcl_ListObjAppendElement(NULL, listObj,
1343     Tcl_NewStringObj(argv[i], -1));
1344     }
1345 
1346     /* Ask the objectified code to join the paths */
1347     Tcl_IncrRefCount(listObj);
1348     resultObj = Tcl_FSJoinPath(listObj, argc);
1349     Tcl_IncrRefCount(resultObj);
1350     Tcl_DecrRefCount(listObj);
1351 
1352     /* Store the result */
1353     resultStr = Tcl_GetStringFromObj(resultObj, &len);
1354     Tcl_DStringAppend(resultPtr, resultStr, len);
1355     Tcl_DecrRefCount(resultObj);
1356 
1357     /* Return a pointer to the result */
1358     return Tcl_DStringValue(resultPtr);
1359 }
void Tcl_SplitPath (CONST char * path, int * argcPtr, CONST char *** argvPtr)

Definition at line 605 of file tclFileName.c.
References ckalloc, CONST, NULL, size_t(), Tcl_DecrRefCount, Tcl_FSSplitPath(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_ListObjIndex(), Tcl_NewStringObj(), and VOID.
Referenced by AppendEnvironment(), DoRenameFile(), GetFileSpecs(), and TclpInitLibraryPath().611 {
612     Tcl_Obj *resultPtr = NULL;  /* Needed only to prevent gcc warnings. */
613     Tcl_Obj *tmpPtr, *eltPtr;
614     int i, size, len;
615     char *p, *str;
616 
617     /*
618      * Perform the splitting, using objectified, vfs-aware code.
619      */
620 
621     tmpPtr = Tcl_NewStringObj(path, -1);
622     Tcl_IncrRefCount(tmpPtr);
623     resultPtr = Tcl_FSSplitPath(tmpPtr, argcPtr);
624     Tcl_DecrRefCount(tmpPtr);
625 
626     /* Calculate space required for the result */
627     
628     size = 1;
629     for (i = 0; i < *argcPtr; i++) {
630   Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
631   Tcl_GetStringFromObj(eltPtr, &len);
632   size += len + 1;
633     }
634     
635     /*
636      * Allocate a buffer large enough to hold the contents of all of
637      * the list plus the argv pointers and the terminating NULL pointer.
638      */
639 
640     *argvPtr = (CONST char **) ckalloc((unsigned)
641       ((((*argcPtr) + 1) * sizeof(char *)) + size));
642 
643     /*
644      * Position p after the last argv pointer and copy the contents of
645      * the list in, piece by piece.
646      */
647 
648     p = (char *) &(*argvPtr)[(*argcPtr) + 1];
649     for (i = 0; i < *argcPtr; i++) {
650   Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
651   str = Tcl_GetStringFromObj(eltPtr, &len);
652   memcpy((VOID *) p, (VOID *) str, (size_t) len+1);
653   p += len+1;
654     }
655     
656     /*
657      * Now set up the argv pointers.
658      */
659 
660     p = (char *) &(*argvPtr)[(*argcPtr) + 1];
661 
662     for (i = 0; i < *argcPtr; i++) {
663   (*argvPtr)[i] = p;
664   while ((*p++) != '\0') {}
665     }
666     (*argvPtr)[i] = NULL;
667 
668     /*
669      * Free the result ptr given to us by Tcl_FSSplitPath
670      */
671 
672     Tcl_DecrRefCount(resultPtr);
673 }
char* Tcl_TranslateFileName (Tcl_Interp * interp, CONST char * name, Tcl_DString * bufferPtr)

Definition at line 1388 of file tclFileName.c.
References NULL, Tcl_DecrRefCount, Tcl_DStringAppend(), Tcl_DStringInit(), Tcl_DStringValue, Tcl_FSGetTranslatedPath(), Tcl_GetString(), Tcl_IncrRefCount, Tcl_NewStringObj(), and TCL_PLATFORM_WINDOWS.
Referenced by TCL_DECLARE_MUTEX(), Tcl_FileObjCmd(), Tcl_MacEvalResource(), Tcl_ResourceObjCmd(), Tcl_SourceRCFile(), TclCreatePipeline(), tclOSALoad(), tclOSAStore(), TestchmodCmd(), and TesttranslatefilenameCmd().1397 {
1398     Tcl_Obj *path = Tcl_NewStringObj(name, -1);
1399     Tcl_Obj *transPtr;
1400 
1401     Tcl_IncrRefCount(path);
1402     transPtr = Tcl_FSGetTranslatedPath(interp, path);
1403     if (transPtr == NULL) {
1404   Tcl_DecrRefCount(path);
1405   return NULL;
1406     }
1407     
1408     Tcl_DStringInit(bufferPtr);
1409     Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1);
1410     Tcl_DecrRefCount(path);
1411     Tcl_DecrRefCount(transPtr);
1412     
1413     /*
1414      * Convert forward slashes to backslashes in Windows paths because
1415      * some system interfaces don't accept forward slashes.
1416      */
1417 
1418     if (tclPlatform == TCL_PLATFORM_WINDOWS) {
1419   register char *p;
1420   for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
1421       if (*p == '/') {
1422     *p = '\\';
1423       }
1424   }
1425     }
1426     return Tcl_DStringValue(bufferPtr);
1427 }
int TclDoGlob (Tcl_Interp * interp, char * separators, Tcl_DString * headPtr, char * tail, Tcl_GlobTypeData * types)

Definition at line 2306 of file tclFileName.c.
References _ANSI_ARGS_, CONST, element(), NULL, SkipToChar(), Tcl_DecrRefCount, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringSetLength(), Tcl_DStringValue, TCL_ERROR, Tcl_FSMatchInDirectory(), Tcl_GetObjResult(), Tcl_GetString(), TCL_GLOB_TYPE_DIR, Tcl_IncrRefCount, Tcl_ListObjIndex(), Tcl_ListObjLength(), Tcl_NewListObj(), Tcl_NewStringObj(), TCL_OK, TCL_PLATFORM_MAC, TCL_PLATFORM_UNIX, TCL_PLATFORM_WINDOWS, Tcl_SetResult(), and TCL_STATIC.
Referenced by TclGlob().2317 {
2318     int baseLength, quoted, count;
2319     int result = TCL_OK;
2320     char *name, *p, *openBrace, *closeBrace, *firstSpecialChar, savedChar;
2321     char lastChar = 0;
2322     
2323     int length = Tcl_DStringLength(headPtr);
2324 
2325     if (length > 0) {
2326   lastChar = Tcl_DStringValue(headPtr)[length-1];
2327     }
2328 
2329     /*
2330      * Consume any leading directory separators, leaving tail pointing
2331      * just past the last initial separator.
2332      */
2333 
2334     count = 0;
2335     name = tail;
2336     for (; *tail != '\0'; tail++) {
2337   if (*tail == '\\') {
2338       /* 
2339        * If the first character is escaped, either we have a directory
2340        * separator, or we have any other character.  In the latter case
2341        * the rest of tail is a pattern, and we must break from the loop.
2342        * This is particularly important on Windows where '\' is both
2343        * the escaping character and a directory separator.
2344        */
2345       if (strchr(separators, tail[1]) != NULL) {
2346     tail++;
2347       } else {
2348     break;
2349       }
2350   } else if (strchr(separators, *tail) == NULL) {
2351       break;
2352   }
2353   if (tclPlatform != TCL_PLATFORM_MAC) {
2354       if (*tail == '\\') {
2355     Tcl_DStringAppend(headPtr, separators, 1);
2356       } else {
2357     Tcl_DStringAppend(headPtr, tail, 1);
2358       }
2359   }
2360   count++;
2361     }
2362 
2363     /*
2364      * Deal with path separators.  On the Mac, we have to watch out
2365      * for multiple separators, since they are special in Mac-style
2366      * paths.
2367      */
2368 
2369     switch (tclPlatform) {
2370   case TCL_PLATFORM_MAC:
2371 #ifdef MAC_UNDERSTANDS_UNIX_PATHS
2372       if (*separators == '/') {
2373     if (((length == 0) && (count == 0))
2374       || ((length > 0) && (lastChar != ':'))) {
2375         Tcl_DStringAppend(headPtr, ":", 1);
2376     }
2377       } else {
2378 #endif
2379     if (count == 0) {
2380         if ((length > 0) && (lastChar != ':')) {
2381       Tcl_DStringAppend(headPtr, ":", 1);
2382         }
2383     } else {
2384         if (lastChar == ':') {
2385       count--;
2386         }
2387         while (count-- > 0) {
2388       Tcl_DStringAppend(headPtr, ":", 1);
2389         }
2390     }
2391 #ifdef MAC_UNDERSTANDS_UNIX_PATHS
2392       }
2393 #endif
2394       break;
2395   case TCL_PLATFORM_WINDOWS:
2396       /*
2397        * If this is a drive relative path, add the colon and the
2398        * trailing slash if needed.  Otherwise add the slash if
2399        * this is the first absolute element, or a later relative
2400        * element.  Add an extra slash if this is a UNC path.
2401 
2402       if (*name == ':') {
2403     Tcl_DStringAppend(headPtr, ":", 1);
2404     if (count > 1) {
2405         Tcl_DStringAppend(headPtr, "/", 1);
2406     }
2407       } else if ((*tail != '\0')
2408         && (((length > 0)
2409           && (strchr(separators, lastChar) == NULL))
2410           || ((length == 0) && (count > 0)))) {
2411     Tcl_DStringAppend(headPtr, "/", 1);
2412     if ((length == 0) && (count > 1)) {
2413         Tcl_DStringAppend(headPtr, "/", 1);
2414     }
2415       }
2416        */
2417       
2418       break;
2419   case TCL_PLATFORM_UNIX: {
2420       /*
2421        * Add a separator if this is the first absolute element, or
2422        * a later relative element.
2423 
2424       if ((*tail != '\0')
2425         && (((length > 0)
2426           && (strchr(separators, lastChar) == NULL))
2427           || ((length == 0) && (count > 0)))) {
2428     Tcl_DStringAppend(headPtr, "/", 1);
2429       }
2430        */
2431       break;
2432   }
2433     }
2434 
2435     /*
2436      * Look for the first matching pair of braces or the first
2437      * directory separator that is not inside a pair of braces.
2438      */
2439 
2440     openBrace = closeBrace = NULL;
2441     quoted = 0;
2442     for (p = tail; *p != '\0'; p++) {
2443   if (quoted) {
2444       quoted = 0;
2445   } else if (*p == '\\') {
2446       quoted = 1;
2447       if (strchr(separators, p[1]) != NULL) {
2448     break;      /* Quoted directory separator. */
2449       }
2450   } else if (strchr(separators, *p) != NULL) {
2451       break;      /* Unquoted directory separator. */
2452   } else if (*p == '{') {
2453       openBrace = p;
2454       p++;
2455       if (SkipToChar(&p, "}")) {
2456     closeBrace = p;   /* Balanced braces. */
2457     break;
2458       }
2459       Tcl_SetResult(interp, "unmatched open-brace in file name",
2460         TCL_STATIC);
2461       return TCL_ERROR;
2462   } else if (*p == '}') {
2463       Tcl_SetResult(interp, "unmatched close-brace in file name",
2464         TCL_STATIC);
2465       return TCL_ERROR;
2466   }
2467     }
2468 
2469     /*
2470      * Substitute the alternate patterns from the braces and recurse.
2471      */
2472 
2473     if (openBrace != NULL) {
2474   char *element;
2475   Tcl_DString newName;
2476   Tcl_DStringInit(&newName);
2477 
2478   /*
2479    * For each element within in the outermost pair of braces,
2480    * append the element and the remainder to the fixed portion
2481    * before the first brace and recursively call TclDoGlob.
2482    */
2483 
2484   Tcl_DStringAppend(&newName, tail, openBrace-tail);
2485   baseLength = Tcl_DStringLength(&newName);
2486   length = Tcl_DStringLength(headPtr);
2487   *closeBrace = '\0';
2488   for (p = openBrace; p != closeBrace; ) {
2489       p++;
2490       element = p;
2491       SkipToChar(&p, ",");
2492       Tcl_DStringSetLength(headPtr, length);
2493       Tcl_DStringSetLength(&newName, baseLength);
2494       Tcl_DStringAppend(&newName, element, p-element);
2495       Tcl_DStringAppend(&newName, closeBrace+1, -1);
2496       result = TclDoGlob(interp, separators, headPtr, 
2497              Tcl_DStringValue(&newName), types);
2498       if (result != TCL_OK) {
2499     break;
2500       }
2501   }
2502   *closeBrace = '}';
2503   Tcl_DStringFree(&newName);
2504   return result;
2505     }
2506 
2507     /*
2508      * At this point, there are no more brace substitutions to perform on
2509      * this path component.  The variable p is pointing at a quoted or
2510      * unquoted directory separator or the end of the string.  So we need
2511      * to check for special globbing characters in the current pattern.
2512      * We avoid modifying tail if p is pointing at the end of the string.
2513      */
2514 
2515     if (*p != '\0') {
2516 
2517   /*
2518    * Note that we are modifying the string in place.  This won't work
2519    * if the string is a static.
2520    */
2521 
2522   savedChar = *p;
2523   *p = '\0';
2524   firstSpecialChar = strpbrk(tail, "*[]?\\");
2525   *p = savedChar;
2526     } else {
2527   firstSpecialChar = strpbrk(tail, "*[]?\\");
2528     }
2529 
2530     if (firstSpecialChar != NULL) {
2531   int ret;
2532   Tcl_Obj *head = Tcl_NewStringObj(Tcl_DStringValue(headPtr),-1);
2533   Tcl_IncrRefCount(head);
2534   /*
2535    * Look for matching files in the given directory.  The
2536    * implementation of this function is platform specific.  For
2537    * each file that matches, it will add the match onto the
2538    * resultPtr given.
2539    */
2540   if (*p == '\0') {
2541       ret = Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp), 
2542            head, tail, types);
2543   } else {
2544       /* 
2545        * We do the recursion ourselves.  This makes implementing
2546        * Tcl_FSMatchInDirectory for each filesystem much easier.
2547        */
2548       Tcl_GlobTypeData dirOnly = { TCL_GLOB_TYPE_DIR, 0, NULL, NULL };
2549       char save = *p;
2550       Tcl_Obj *resultPtr;
2551 
2552       resultPtr = Tcl_NewListObj(0, NULL);
2553       Tcl_IncrRefCount(resultPtr);
2554       *p = '\0';
2555       ret = Tcl_FSMatchInDirectory(interp, resultPtr, 
2556            head, tail, &dirOnly);
2557       *p = save;
2558       if (ret == TCL_OK) {
2559     int resLength;
2560     ret = Tcl_ListObjLength(interp, resultPtr, &resLength);
2561     if (ret == TCL_OK) {
2562         int i;
2563         for (i =0; i< resLength; i++) {
2564       Tcl_Obj *elt;
2565       Tcl_DString ds;
2566       Tcl_ListObjIndex(interp, resultPtr, i, &elt);
2567       Tcl_DStringInit(&ds);
2568       Tcl_DStringAppend(&ds, Tcl_GetString(elt), -1);
2569       if(tclPlatform == TCL_PLATFORM_MAC) {
2570           Tcl_DStringAppend(&ds, ":",1);
2571       } else {
2572           Tcl_DStringAppend(&ds, "/",1);
2573       }
2574       ret = TclDoGlob(interp, separators, &ds, p+1, types);
2575       Tcl_DStringFree(&ds);
2576       if (ret != TCL_OK) {
2577           break;
2578       }
2579         }
2580     }
2581       }
2582       Tcl_DecrRefCount(resultPtr);
2583   }
2584   Tcl_DecrRefCount(head);
2585   return ret;
2586     }
2587     Tcl_DStringAppend(headPtr, tail, p-tail);
2588     if (*p != '\0') {
2589   return TclDoGlob(interp, separators, headPtr, p, types);
2590     } else {
2591   /*
2592    * This is the code path reached by a command like 'glob foo'.
2593    *
2594    * There are no more wildcards in the pattern and no more
2595    * unprocessed characters in the tail, so now we can construct
2596    * the path, and pass it to Tcl_FSMatchInDirectory with an
2597    * empty pattern to verify the existence of the file and check
2598    * it is of the correct type (if a 'types' flag it given -- if
2599    * no such flag was given, we could just use 'Tcl_FSLStat', but
2600    * for simplicity we keep to a common approach).
2601    */
2602 
2603   Tcl_Obj *nameObj;
2604 
2605   switch (tclPlatform) {
2606       case TCL_PLATFORM_MAC: {
2607     if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) {
2608         Tcl_DStringAppend(headPtr, ":", 1);
2609     }
2610     break;
2611       }
2612       case TCL_PLATFORM_WINDOWS: {
2613     if (Tcl_DStringLength(headPtr) == 0) {
2614         if (((*name == '\\') && (name[1] == '/' || name[1] == '\\'))
2615           || (*name == '/')) {
2616       Tcl_DStringAppend(headPtr, "/", 1);
2617         } else {
2618       Tcl_DStringAppend(headPtr, ".", 1);
2619         }
2620     }
2621 #if defined(__CYGWIN__) && defined(__WIN32__)
2622     {
2623     extern int cygwin_conv_to_win32_path 
2624         _ANSI_ARGS_((CONST char *, char *));
2625     char winbuf[MAX_PATH+1];
2626 
2627     cygwin_conv_to_win32_path(Tcl_DStringValue(headPtr), winbuf);
2628     Tcl_DStringFree(headPtr);
2629     Tcl_DStringAppend(headPtr, winbuf, -1);
2630     }
2631 #endif /* __CYGWIN__ && __WIN32__ */
2632     /* 
2633      * Convert to forward slashes.  This is required to pass
2634      * some Tcl tests.  We should probably remove the conversions
2635      * here and in tclWinFile.c, since they aren't needed since
2636      * the dropping of support for Win32s.
2637      */
2638     for (p = Tcl_DStringValue(headPtr); *p != '\0'; p++) {
2639         if (*p == '\\') {
2640       *p = '/';
2641         }
2642     }
2643     break;
2644       }
2645       case TCL_PLATFORM_UNIX: {
2646     if (Tcl_DStringLength(headPtr) == 0) {
2647         if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
2648       Tcl_DStringAppend(headPtr, "/", 1);
2649         } else {
2650       Tcl_DStringAppend(headPtr, ".", 1);
2651         }
2652     }
2653     break;
2654       }
2655   }
2656   /* Common for all platforms */
2657   name = Tcl_DStringValue(headPtr);
2658   nameObj = Tcl_NewStringObj(name, Tcl_DStringLength(headPtr));
2659 
2660   Tcl_IncrRefCount(nameObj);
2661   Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp), nameObj, 
2662              NULL, types);
2663   Tcl_DecrRefCount(nameObj);
2664   return TCL_OK;
2665     }
2666 }
Tcl_Obj* TclFileDirname (Tcl_Interp * interp, Tcl_Obj * pathPtr)

Definition at line 2689 of file tclFileName.c.
References NULL, Tcl_DecrRefCount, Tcl_FSGetNormalizedPath(), Tcl_FSGetPathType(), Tcl_FSJoinPath(), Tcl_FSSplitPath(), Tcl_GetString(), Tcl_IncrRefCount, Tcl_ListObjIndex(), Tcl_NewStringObj(), TCL_PATH_RELATIVE, and TCL_PLATFORM_MAC.
Referenced by Tcl_FileObjCmd(), and Tcl_FSRemoveDirectory().2692 {
2693     int splitElements;
2694     Tcl_Obj *splitPtr;
2695     Tcl_Obj *splitResultPtr = NULL;
2696 
2697     /* 
2698      * The behaviour we want here is slightly different to
2699      * the standard Tcl_FSSplitPath in the handling of home
2700      * directories; Tcl_FSSplitPath preserves the "~" while 
2701      * this code computes the actual full path name, if we
2702      * had just a single component.
2703      */     
2704     splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements);
2705     if ((splitElements == 1) && (Tcl_GetString(pathPtr)[0] == '~')) {
2706   Tcl_DecrRefCount(splitPtr);
2707   splitPtr = Tcl_FSGetNormalizedPath(interp, pathPtr);
2708   if (splitPtr == NULL) {
2709       return NULL;
2710   }
2711   splitPtr = Tcl_FSSplitPath(splitPtr, &splitElements);
2712     }
2713 
2714     /*
2715      * Return all but the last component.  If there is only one
2716      * component, return it if the path was non-relative, otherwise
2717      * return the current directory.
2718      */
2719 
2720     if (splitElements > 1) {
2721   splitResultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1);
2722     } else if (splitElements == 0 || 
2723       (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) {
2724   splitResultPtr = Tcl_NewStringObj(
2725     ((tclPlatform == TCL_PLATFORM_MAC) ? ":" : "."), 1);
2726     } else {
2727   Tcl_ListObjIndex(NULL, splitPtr, 0, &splitResultPtr);
2728     }
2729     Tcl_IncrRefCount(splitResultPtr);
2730     Tcl_DecrRefCount(splitPtr);
2731     return splitResultPtr;
2732 }
char* TclGetExtension (char * name)

Definition at line 1448 of file tclFileName.c.
References NULL, TCL_PLATFORM_MAC, TCL_PLATFORM_UNIX, and TCL_PLATFORM_WINDOWS.
Referenced by Tcl_FileObjCmd().1450 {
1451     char *p, *lastSep;
1452 
1453     /*
1454      * First find the last directory separator.
1455      */
1456 
1457     lastSep = NULL;   /* Needed only to prevent gcc warnings. */
1458     switch (tclPlatform) {
1459   case TCL_PLATFORM_UNIX:
1460       lastSep = strrchr(name, '/');
1461       break;
1462 
1463   case TCL_PLATFORM_MAC:
1464 #ifdef MAC_UNDERSTANDS_UNIX_PATHS
1465       if (strchr(name, ':') == NULL) {
1466     lastSep = strrchr(name, '/');
1467       } else {
1468     lastSep = strrchr(name, ':');
1469       }
1470 #else
1471       lastSep = strrchr(name, ':');
1472 #endif
1473       break;
1474 
1475   case TCL_PLATFORM_WINDOWS:
1476       lastSep = NULL;
1477       for (p = name; *p != '\0'; p++) {
1478     if (strchr("/\\:", *p) != NULL) {
1479         lastSep = p;
1480     }
1481       }
1482       break;
1483     }
1484     p = strrchr(name, '.');
1485     if ((p != NULL) && (lastSep != NULL) && (lastSep > p)) {
1486   p = NULL;
1487     }
1488 
1489     /*
1490      * In earlier versions, we used to back up to the first period in a series
1491      * so that "foo..o" would be split into "foo" and "..o".  This is a
1492      * confusing and usually incorrect behavior, so now we split at the last
1493      * period in the name.
1494      */
1495 
1496     return p;
1497 }
int TclGlob (Tcl_Interp * interp, char * pattern, Tcl_Obj * unquotedPrefix, int globFlags, Tcl_GlobTypeData * types)

Definition at line 2013 of file tclFileName.c.
References CONST, DoTildeSubst(), NULL, Tcl_DecrRefCount, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringValue, Tcl_DuplicateObj(), TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), TCL_GLOBMODE_DIR, TCL_GLOBMODE_NO_COMPLAIN, TCL_GLOBMODE_TAILS, Tcl_IncrRefCount, Tcl_IsShared, Tcl_ListObjAppendElement(), Tcl_ListObjGetElements(), Tcl_NewStringObj(), TCL_OK, TCL_PLATFORM_MAC, TCL_PLATFORM_UNIX, TCL_PLATFORM_WINDOWS, Tcl_ResetResult(), Tcl_SetObjResult(), and TclDoGlob().
Referenced by Tcl_GetEncodingNames(), and Tcl_GlobObjCmd().2023 {
2024     char *separators;
2025     CONST char *head;
2026     char *tail, *start;
2027     char c;
2028     int result, prefixLen;
2029     Tcl_DString buffer;
2030     Tcl_Obj *oldResult;
2031 
2032     separators = NULL;    /* lint. */
2033     switch (tclPlatform) {
2034   case TCL_PLATFORM_UNIX:
2035       separators = "/";
2036       break;
2037   case TCL_PLATFORM_WINDOWS:
2038       separators = "/\\:";
2039       break;
2040   case TCL_PLATFORM_MAC:
2041 #ifdef MAC_UNDERSTANDS_UNIX_PATHS
2042       if (unquotedPrefix == NULL) {
2043     separators = (strchr(pattern, ':') == NULL) ? "/" : ":";
2044       } else {
2045     separators = ":";
2046       }
2047 #else
2048       separators = ":";
2049 #endif
2050       break;
2051     }
2052 
2053     Tcl_DStringInit(&buffer);
2054     if (unquotedPrefix != NULL) {
2055   start = Tcl_GetString(unquotedPrefix);
2056     } else {
2057   start = pattern;
2058     }
2059 
2060     /*
2061      * Perform tilde substitution, if needed.
2062      */
2063 
2064     if (start[0] == '~') {
2065   
2066   /*
2067    * Find the first path separator after the tilde.
2068    */
2069   for (tail = start; *tail != '\0'; tail++) {
2070       if (*tail == '\\') {
2071     if (strchr(separators, tail[1]) != NULL) {
2072         break;
2073     }
2074       } else if (strchr(separators, *tail) != NULL) {
2075     break;
2076       }
2077   }
2078 
2079   /*
2080    * Determine the home directory for the specified user.  
2081    */
2082   
2083   c = *tail;
2084   *tail = '\0';
2085   if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
2086       /* 
2087        * We will ignore any error message here, and we
2088        * don't want to mess up the interpreter's result.
2089        */
2090       head = DoTildeSubst(NULL, start+1, &buffer);
2091   } else {
2092       head = DoTildeSubst(interp, start+1, &buffer);
2093   }
2094   *tail = c;
2095   if (head == NULL) {
2096       if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
2097     return TCL_OK;
2098       } else {
2099     return TCL_ERROR;
2100       }
2101   }
2102   if (head != Tcl_DStringValue(&buffer)) {
2103       Tcl_DStringAppend(&buffer, head, -1);
2104   }
2105   if (unquotedPrefix != NULL) {
2106       Tcl_DStringAppend(&buffer, tail, -1);
2107       tail = pattern;
2108   }
2109     } else {
2110   tail = pattern;
2111   if (unquotedPrefix != NULL) {
2112       Tcl_DStringAppend(&buffer,Tcl_GetString(unquotedPrefix),-1);
2113   }
2114     }
2115     
2116     /* 
2117      * We want to remember the length of the current prefix,
2118      * in case we are using TCL_GLOBMODE_TAILS.  Also if we
2119      * are using TCL_GLOBMODE_DIR, we must make sure the
2120      * prefix ends in a directory separator.
2121      */
2122     prefixLen = Tcl_DStringLength(&buffer);
2123 
2124     if (prefixLen > 0) {
2125   c = Tcl_DStringValue(&buffer)[prefixLen-1];
2126   if (strchr(separators, c) == NULL) {
2127       /* 
2128        * If the prefix is a directory, make sure it ends in a
2129        * directory separator.
2130        */
2131       if (globFlags & TCL_GLOBMODE_DIR) {
2132     Tcl_DStringAppend(&buffer,separators,1);
2133     /* Try to borrow that separator from the tail */
2134     if (*tail == *separators) {
2135         tail++;
2136     }
2137       }
2138       prefixLen++;
2139   }
2140     }
2141 
2142     /* 
2143      * We need to get the old result, in case it is over-written
2144      * below when we still need it.
2145      */
2146     oldResult = Tcl_GetObjResult(interp);
2147     Tcl_IncrRefCount(oldResult);
2148     Tcl_ResetResult(interp);
2149     
2150     result = TclDoGlob(interp, separators, &buffer, tail, types);
2151     
2152     if (result != TCL_OK) {
2153   if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
2154       /* Put back the old result and reset the return code */
2155       Tcl_SetObjResult(interp, oldResult);
2156       result = TCL_OK;
2157   }
2158     } else {
2159   /* 
2160    * Now we must concatenate the 'oldResult' and the current
2161    * result, and then place that into the interpreter.
2162    * 
2163    * If we only want the tails, we must strip off the prefix now.
2164    * It may seem more efficient to pass the tails flag down into
2165    * TclDoGlob, Tcl_FSMatchInDirectory, but those functions are
2166    * continually adjusting the prefix as the various pieces of
2167    * the pattern are assimilated, so that would add a lot of
2168    * complexity to the code.  This way is a little slower (when
2169    * the -tails flag is given), but much simpler to code.
2170    */
2171   int objc, i;
2172   Tcl_Obj **objv;
2173 
2174   /* Ensure sole ownership */
2175   if (Tcl_IsShared(oldResult)) {
2176       Tcl_DecrRefCount(oldResult);
2177       oldResult = Tcl_DuplicateObj(oldResult);
2178       Tcl_IncrRefCount(oldResult);
2179   }
2180 
2181   Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp), 
2182              &objc, &objv);
2183 #ifdef MAC_TCL
2184   /* adjust prefixLen if TclDoGlob prepended a ':' */
2185   if ((prefixLen > 0) && (objc > 0)
2186   && (Tcl_DStringValue(&buffer)[0] != ':')) {
2187       char *str = Tcl_GetStringFromObj(objv[0],NULL);
2188       if (str[0] == ':') {
2189         prefixLen++;
2190       }
2191   }
2192 #endif
2193   for (i = 0; i< objc; i++) {
2194       Tcl_Obj* elt;
2195       if (globFlags & TCL_GLOBMODE_TAILS) {
2196     int len;
2197     char *oldStr = Tcl_GetStringFromObj(objv[i],&len);
2198     if (len == prefixLen) {
2199         if ((pattern[0] == '\0')
2200       || (strchr(separators, pattern[0]) == NULL)) {
2201       elt = Tcl_NewStringObj(".",1);
2202         } else {
2203       elt = Tcl_NewStringObj("/",1);
2204         }
2205     } else {
2206         elt = Tcl_NewStringObj(oldStr + prefixLen, 
2207             len - prefixLen);
2208     }
2209       } else {
2210     elt = objv[i];
2211       }
2212       /* Assumption that 'oldResult' is a valid list */
2213       Tcl_ListObjAppendElement(interp, oldResult, elt);
2214   }
2215   Tcl_SetObjResult(interp, oldResult);
2216     }
2217     /* 
2218      * Release our temporary copy.  All code paths above must
2219      * end here so we free our reference.
2220      */
2221     Tcl_DecrRefCount(oldResult);
2222     Tcl_DStringFree(&buffer);
2223     return result;
2224 }
Tcl_PathType TclpGetNativePathType (Tcl_Obj * pathObjPtr, int * driveNameLengthPtr, Tcl_Obj ** driveNameRef)

Definition at line 360 of file tclFileName.c.
References CONST, dataKey, ExtractWinRoot(), FileNameInit(), ThreadSpecificData::macRootPatternPtr, NULL, REG_ADVANCED, Tcl_AppendToObj(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringValue, Tcl_GetRegExpFromObj(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, TCL_PLATFORM_MAC, TCL_PLATFORM_UNIX, TCL_PLATFORM_WINDOWS, Tcl_RegExpExec(), Tcl_RegExpRange(), Tcl_SetObjLength(), TCL_TSD_INIT, and UCHAR.
Referenced by GetPathType().364 {
365     Tcl_PathType type = TCL_PATH_ABSOLUTE;
366     int pathLen;
367     char *path = Tcl_GetStringFromObj(pathObjPtr, &pathLen);
368     
369     if (path[0] == '~') {
370   /* 
371    * This case is common to all platforms.
372    * Paths that begin with ~ are absolute.
373    */
374   if (driveNameLengthPtr != NULL) {
375       char *end = path + 1;
376       while ((*end != '\0') && (*end != '/')) {
377     end++;
378       }
379       *driveNameLengthPtr = end - path;
380   }
381     } else {
382   switch (tclPlatform) {
383       case TCL_PLATFORM_UNIX: {
384     char *origPath = path;
385           
386     /*
387      * Paths that begin with / are absolute.
388      */
389 
390 #ifdef __QNX__
391     /*
392      * Check for QNX //<node id> prefix
393      */
394     if (*path && (pathLen > 3) && (path[0] == '/') 
395       && (path[1] == '/') && isdigit(UCHAR(path[2]))) {
396         path += 3;
397         while (isdigit(UCHAR(*path))) {
398       ++path;
399         }
400     }
401 #endif
402     if (path[0] == '/') {
403         if (driveNameLengthPtr != NULL) {
404       /* 
405        * We need this addition in case the QNX code 
406        * was used 
407        */
408       *driveNameLengthPtr = (1 + path - origPath);
409         }
410     } else {
411         type = TCL_PATH_RELATIVE;
412     }
413     break;
414       }
415       case TCL_PLATFORM_MAC:
416     if (path[0] == ':') {
417         type = TCL_PATH_RELATIVE;
418     } else {
419 #ifdef MAC_UNDERSTANDS_UNIX_PATHS
420         ThreadSpecificData *tsdPtr;
421         Tcl_RegExp re;
422 
423         tsdPtr = TCL_TSD_INIT(&dataKey);
424 
425         /*
426          * Since we have eliminated the easy cases, use the
427          * root pattern to look for the other types.
428          */
429 
430         FileNameInit();
431         re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr,
432           REG_ADVANCED);
433 
434         if (!Tcl_RegExpExec(NULL, re, path, path)) {
435       type = TCL_PATH_RELATIVE;
436         } else {
437       CONST char *root, *end;
438       Tcl_RegExpRange(re, 2, &root, &end);
439       if (root != NULL) {
440           type = TCL_PATH_RELATIVE;
441       } else {
442           if (driveNameLengthPtr != NULL) {
443         Tcl_RegExpRange(re, 0, &root, &end);
444         *driveNameLengthPtr = end - root;
445           }
446           if (driveNameRef != NULL) {
447         if (*root == '/') {
448             char *c;
449             int gotColon = 0;
450             *driveNameRef = Tcl_NewStringObj(root + 1,
451               end - root -1);
452             c = Tcl_GetString(*driveNameRef);
453             while (*c != '\0') {
454           if (*c == '/') {
455               gotColon++;
456               *c = ':';
457           }
458           c++;
459             }
460             /* 
461              * If there is no colon, we have just a
462              * volume name so we must add a colon so
463              * it is an absolute path.
464              */
465             if (gotColon == 0) {
466                 Tcl_AppendToObj(*driveNameRef, ":", 1);
467             } else if ((gotColon > 1) &&
468               (*(c-1) == ':')) {
469           /* We have an extra colon */
470                 Tcl_SetObjLength(*driveNameRef, 
471             c - Tcl_GetString(*driveNameRef) - 1);
472             }
473         }
474           }
475       }
476         }
477 #else
478         if (path[0] == '~') {
479         } else if (path[0] == ':') {
480       type = TCL_PATH_RELATIVE;
481         } else {
482       char *colonPos = strchr(path,':');
483       if (colonPos == NULL) {
484           type = TCL_PATH_RELATIVE;
485       } else {
486       }
487         }
488         if (type == TCL_PATH_ABSOLUTE) {
489       if (driveNameLengthPtr != NULL) {
490           *driveNameLengthPtr = strlen(path);
491       }
492         }
493 #endif
494     }
495     break;
496       
497       case TCL_PLATFORM_WINDOWS: {
498     Tcl_DString ds;
499     CONST char *rootEnd;
500     
501     Tcl_DStringInit(&ds);
502     rootEnd = ExtractWinRoot(path, &ds, 0, &type);
503     if ((rootEnd != path) && (driveNameLengthPtr != NULL)) {
504         *driveNameLengthPtr = rootEnd - path;
505         if (driveNameRef != NULL) {
506       *driveNameRef = Tcl_NewStringObj(Tcl_DStringValue(&ds),
507         Tcl_DStringLength(&ds));
508       Tcl_IncrRefCount(*driveNameRef);
509         }
510     }
511     Tcl_DStringFree(&ds);
512     break;
513       }
514   }
515     }
516     return type;
517 }
void TclpNativeJoinPath (Tcl_Obj * prefix, char* joining)

Definition at line 1122 of file tclFileName.c.
References NULL, Tcl_AppendToObj(), Tcl_GetString(), Tcl_GetStringFromObj(), TCL_PLATFORM_MAC, TCL_PLATFORM_UNIX, TCL_PLATFORM_WINDOWS, Tcl_SetObjLength(), and UCHAR.
Referenced by SetFsPathFromAny(), and Tcl_FSJoinPath().1125 {
1126     int length, needsSep;
1127     char *dest, *p, *start;
1128     
1129     start = Tcl_GetStringFromObj(prefix, &length);
1130 
1131     /*
1132      * Remove the ./ from tilde prefixed elements, and drive-letter
1133      * prefixed elements on Windows, unless it is the first component.
1134      */
1135     
1136     p = joining;
1137     
1138     if (length != 0) {
1139   if ((p[0] == '.') && (p[1] == '/')
1140       && ((p[2] == '~')
1141     || ((tclPlatform == TCL_PLATFORM_WINDOWS)
1142         && isalpha(UCHAR(p[2]))
1143         && (p[3] == ':')))) {
1144       p += 2;
1145   }
1146     }
1147     if (*p == '\0') {
1148   return;
1149     }
1150 
1151     switch (tclPlatform) {
1152         case TCL_PLATFORM_UNIX:
1153       /*
1154        * Append a separator if needed.
1155        */
1156 
1157       if (length > 0 && (start[length-1] != '/')) {
1158     Tcl_AppendToObj(prefix, "/", 1);
1159     length++;
1160       }
1161       needsSep = 0;
1162       
1163       /*
1164        * Append the element, eliminating duplicate and trailing
1165        * slashes.
1166        */
1167 
1168       Tcl_SetObjLength(prefix, length + (int) strlen(p));
1169       
1170       dest = Tcl_GetString(prefix) + length;
1171       for (; *p != '\0'; p++) {
1172     if (*p == '/') {
1173         while (p[1] == '/') {
1174       p++;
1175         }
1176         if (p[1] != '\0') {
1177       if (needsSep) {
1178           *dest++ = '/';
1179       }
1180         }
1181     } else {
1182         *dest++ = *p;
1183         needsSep = 1;
1184     }
1185       }
1186       length = dest - Tcl_GetString(prefix);
1187       Tcl_SetObjLength(prefix, length);
1188       break;
1189 
1190   case TCL_PLATFORM_WINDOWS:
1191       /*
1192        * Check to see if we need to append a separator.
1193        */
1194 
1195       if ((length > 0) && 
1196     (start[length-1] != '/') && (start[length-1] != ':')) {
1197     Tcl_AppendToObj(prefix, "/", 1);
1198     length++;
1199       }
1200       needsSep = 0;
1201       
1202       /*
1203        * Append the element, eliminating duplicate and
1204        * trailing slashes.
1205        */
1206 
1207       Tcl_SetObjLength(prefix, length + (int) strlen(p));
1208       dest = Tcl_GetString(prefix) + length;
1209       for (; *p != '\0'; p++) {
1210     if ((*p == '/') || (*p == '\\')) {
1211         while ((p[1] == '/') || (p[1] == '\\')) {
1212       p++;
1213         }
1214         if ((p[1] != '\0') && needsSep) {
1215       *dest++ = '/';
1216         }
1217     } else {
1218         *dest++ = *p;
1219         needsSep = 1;
1220     }
1221       }
1222       length = dest - Tcl_GetString(prefix);
1223       Tcl_SetObjLength(prefix, length);
1224       break;
1225 
1226   case TCL_PLATFORM_MAC: {
1227       int newLength;
1228       
1229       /*
1230        * Sort out separators.  We basically add the object we've
1231        * been given, but we have to make sure that there is
1232        * exactly one separator inbetween (unless the object we're
1233        * adding contains multiple contiguous colons, all of which
1234        * we must add).  Also if an object is just ':' we don't
1235        * bother to add it unless it's the very first element.
1236        */
1237 
1238 #ifdef MAC_UNDERSTANDS_UNIX_PATHS
1239       int adjustedPath = 0;
1240       if ((strchr(p, ':') == NULL) && (strchr(p, '/') != NULL)) {
1241     char *start = p;
1242     adjustedPath = 1;
1243     while (*start != '\0') {
1244         if (*start == '/') {
1245             *start = ':';
1246         }
1247         start++;
1248     }
1249       }
1250 #endif
1251       if (length > 0) {
1252     if ((p[0] == ':') && (p[1] == '\0')) {
1253         return;
1254     }
1255     if (start[length-1] != ':') {
1256         if (*p != '\0' && *p != ':') {
1257       Tcl_AppendToObj(prefix, ":", 1);
1258       length++;
1259         }
1260     } else if (*p == ':') {
1261         p++;
1262     }
1263       } else {
1264     if (*p != '\0' && *p != ':') {
1265         Tcl_AppendToObj(prefix, ":", 1);
1266         length++;
1267     }
1268       }
1269       
1270       /*
1271        * Append the element
1272        */
1273 
1274       newLength = strlen(p);
1275       /* 
1276        * It may not be good to just do 'Tcl_AppendToObj(prefix,
1277        * p, newLength)' because the object may contain duplicate
1278        * colons which we want to get rid of.
1279        */
1280       Tcl_AppendToObj(prefix, p, newLength);
1281       
1282       /* Remove spurious trailing single ':' */
1283       dest = Tcl_GetString(prefix) + length + newLength;
1284       if (*(dest-1) == ':') {
1285     if (dest-1 > Tcl_GetString(prefix)) {
1286         if (*(dest-2) != ':') {
1287             Tcl_SetObjLength(prefix, length + newLength -1);
1288         }
1289     }
1290       }
1291 #ifdef MAC_UNDERSTANDS_UNIX_PATHS
1292       /* Revert the path to what it was */
1293       if (adjustedPath) {
1294     char *start = joining;
1295     while (*start != '\0') {
1296         if (*start == ':') {
1297       *start = '/';
1298         }
1299         start++;
1300     }
1301       }
1302 #endif
1303       break;
1304   }
1305     }
1306     return;
1307 }
Tcl_Obj* TclpNativeSplitPath (Tcl_Obj * pathPtr, int * lenPtr)

Definition at line 544 of file tclFileName.c.
References NULL, SplitMacPath(), SplitUnixPath(), SplitWinPath(), Tcl_GetString(), Tcl_ListObjLength(), TCL_PLATFORM_MAC, TCL_PLATFORM_UNIX, and TCL_PLATFORM_WINDOWS.
Referenced by SetFsPathFromAny(), and Tcl_FSSplitPath().547 {
548     Tcl_Obj *resultPtr = NULL;  /* Needed only to prevent gcc warnings. */
549 
550     /*
551      * Perform platform specific splitting. 
552      */
553 
554     switch (tclPlatform) {
555   case TCL_PLATFORM_UNIX:
556       resultPtr = SplitUnixPath(Tcl_GetString(pathPtr));
557       break;
558 
559   case TCL_PLATFORM_WINDOWS:
560       resultPtr = SplitWinPath(Tcl_GetString(pathPtr));
561       break;
562       
563   case TCL_PLATFORM_MAC:
564       resultPtr = SplitMacPath(Tcl_GetString(pathPtr));
565       break;
566     }
567 
568     /*
569      * Compute the number of elements in the result.
570      */
571 
572     if (lenPtr != NULL) {
573   Tcl_ListObjLength(NULL, resultPtr, lenPtr);
574     }
575     return resultPtr;
576 }

Variable Documentation
Tcl_ThreadDataKey dataKey [static]

Definition at line 55 of file tclFileName.c.TclPlatformType tclPlatform = TCL_PLATFORM_UNIX

Definition at line 67 of file tclFileName.c.
Referenced by FindSplitPos(), MakeFolderEnvVar(), NativeFilesystemSeparator(), SetFsPathFromAny(), Tcl_FileObjCmd(), Tcl_FSGetNormalizedPath(), Tcl_FSJoinPath(), TclFSMakePathRelative(), TclNewFSPathObj(), TclpInitPlatform(), TclWinGetPlatform(), TestgetplatformCmd(), TestsetplatformCmd(), and UpdateStringOfFsPath().

generic/tclGet.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include "tclMath.h"
Functions
int Tcl_GetInt (Tcl_Interp *interp, CONST char *string, int *intPtr)
int TclGetLong (Tcl_Interp *interp, CONST char *string, long *longPtr)
int Tcl_GetDouble (Tcl_Interp *interp, CONST char *string, double *doublePtr)
int Tcl_GetBoolean (Tcl_Interp *interp, CONST char *string, int *boolPtr)

Function Documentation
int Tcl_GetBoolean (Tcl_Interp * interp, CONST char * string, int * boolPtr)

Definition at line 279 of file tclGet.c.
References NULL, size_t(), TCL_ERROR, and TCL_OK.
Referenced by SerialSetOptionProc(), Tcl_SetChannelOption(), Tcl_StringObjCmd(), TclOSACompileCmd(), and TestlinkCmd().286 {
287     int i;
288     char lowerCase[10], c;
289     size_t length;
290 
291     /*
292      * Convert the input string to all lower-case. 
293      * INTL: This code will work on UTF strings.
294      */
295 
296     for (i = 0; i < 9; i++) {
297   c = string[i];
298   if (c == 0) {
299       break;
300   }
301   if ((c >= 'A') && (c <= 'Z')) {
302       c += (char) ('a' - 'A');
303   }
304   lowerCase[i] = c;
305     }
306     lowerCase[i] = 0;
307 
308     length = strlen(lowerCase);
309     c = lowerCase[0];
310     if ((c == '0') && (lowerCase[1] == '\0')) {
311   *boolPtr = 0;
312     } else if ((c == '1') && (lowerCase[1] == '\0')) {
313   *boolPtr = 1;
314     } else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {
315   *boolPtr = 1;
316     } else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {
317   *boolPtr = 0;
318     } else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {
319   *boolPtr = 1;
320     } else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {
321   *boolPtr = 0;
322     } else if ((c == 'o') && (length >= 2)) {
323   if (strncmp(lowerCase, "on", length) == 0) {
324       *boolPtr = 1;
325   } else if (strncmp(lowerCase, "off", length) == 0) {
326       *boolPtr = 0;
327   } else {
328       goto badBoolean;
329   }
330     } else {
331   badBoolean:
332         if (interp != (Tcl_Interp *) NULL) {
333             Tcl_AppendResult(interp, "expected boolean value but got \"",
334                     string, "\"", (char *) NULL);
335         }
336   return TCL_ERROR;
337     }
338     return TCL_OK;
339 }
int Tcl_GetDouble (Tcl_Interp * interp, CONST char * string, double * doublePtr)

Definition at line 222 of file tclGet.c.
References errno, NULL, strtod(), TCL_ERROR, TCL_OK, TclExprFloatError(), and UCHAR.
Referenced by IllegalExprOperandType(), TestdoubleobjCmd(), and TestlinkCmd().227 {
228     char *end;
229     double d;
230 
231     errno = 0;
232     d = strtod(string, &end); /* INTL: Tcl source. */
233     if (end == string) {
234   badDouble:
235         if (interp != (Tcl_Interp *) NULL) {
236             Tcl_AppendResult(interp,
237                     "expected floating-point number but got \"",
238                     string, "\"", (char *) NULL);
239         }
240   return TCL_ERROR;
241     }
242     if (errno != 0 && (d == HUGE_VAL || d == -HUGE_VAL || d == 0)) {
243         if (interp != (Tcl_Interp *) NULL) {
244             TclExprFloatError(interp, d); 
245         }
246   return TCL_ERROR;
247     }
248     while ((*end != 0) && isspace(UCHAR(*end))) { /* INTL: ISO space. */
249   end++;
250     }
251     if (*end != 0) {
252   goto badDouble;
253     }
254     *doublePtr = d;
255     return TCL_OK;
256 }
int Tcl_GetInt (Tcl_Interp * interp, CONST char * string, int * intPtr)

Definition at line 42 of file tclGet.c.
References CONST, ERANGE, errno, INT_MAX, LONG_MAX, NULL, strtoul(), TCL_ERROR, Tcl_GetStringResult(), TCL_OK, Tcl_SetResult(), TCL_STATIC, TclCheckBadOctal(), and UCHAR.
Referenced by GetTimesCmd(), GetVariableIndex(), SetEndOffsetFromAny(), Tcl_SetChannelOption(), TclGetFrame(), tclOSALoadCmd(), tclOSAStoreCmd(), TclSockGetPort(), TestalarmCmd(), TestasyncCmd(), TestChannelEventCmd(), TestdcallCmd(), TestdstringCmd(), TestexithandlerCmd(), TestfilehandlerCmd(), TestfilewaitCmd(), TestintobjCmd(), TestlinkCmd(), and TeststaticpkgCmd().47 {
48     char *end;
49     CONST char *p = string;
50     long i;
51 
52     /*
53      * Note: use strtoul instead of strtol for integer conversions
54      * to allow full-size unsigned numbers, but don't depend on strtoul
55      * to handle sign characters;  it won't in some implementations.
56      */
57 
58     errno = 0;
59 #ifdef TCL_STRTOUL_SIGN_CHECK
60     /*
61      * This special sign check actually causes bad numbers to be allowed
62      * when strtoul.  I can't find a strtoul that doesn't validly handle
63      * signed characters, and the C standard implies that this is all
64      * unnecessary. [Bug #634856]
65      */
66     for ( ; isspace(UCHAR(*p)); p++) {  /* INTL: ISO space. */
67   /* Empty loop body. */
68     }
69     if (*p == '-') {
70   p++;
71   i = -((long)strtoul(p, &end, 0)); /* INTL: Tcl source. */
72     } else if (*p == '+') {
73   p++;
74   i = strtoul(p, &end, 0); /* INTL: Tcl source. */
75     } else
76 #else
77   i = strtoul(p, &end, 0); /* INTL: Tcl source. */
78 #endif
79     if (end == p) {
80   badInteger:
81         if (interp != (Tcl_Interp *) NULL) {
82       Tcl_AppendResult(interp, "expected integer but got \"", string,
83         "\"", (char *) NULL);
84       TclCheckBadOctal(interp, string);
85         }
86   return TCL_ERROR;
87     }
88 
89     /*
90      * The second test below is needed on platforms where "long" is
91      * larger than "int" to detect values that fit in a long but not in
92      * an int.
93      */
94 
95     if ((errno == ERANGE) 
96 #if (LONG_MAX > INT_MAX)
97       || (i > UINT_MAX) || (i < -(long)UINT_MAX)
98 #endif
99     ) {
100         if (interp != (Tcl_Interp *) NULL) {
101       Tcl_SetResult(interp, "integer value too large to represent",
102         TCL_STATIC);
103             Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
104         Tcl_GetStringResult(interp), (char *) NULL);
105         }
106   return TCL_ERROR;
107     }
108     while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */
109   end++;
110     }
111     if (*end != 0) {
112   goto badInteger;
113     }
114     *intPtr = (int) i;
115     return TCL_OK;
116 }
int TclGetLong (Tcl_Interp * interp, CONST char * string, long * longPtr)

Definition at line 141 of file tclGet.c.
References CONST, ERANGE, errno, NULL, strtoul(), TCL_ERROR, Tcl_GetStringResult(), TCL_OK, Tcl_SetResult(), TCL_STATIC, TclCheckBadOctal(), and UCHAR.
Referenced by TclRegisterLiteral().148 {
149     char *end;
150     CONST char *p = string;
151     long i;
152 
153     /*
154      * Note: don't depend on strtoul to handle sign characters; it won't
155      * in some implementations.
156      */
157 
158     errno = 0;
159 #ifdef TCL_STRTOUL_SIGN_CHECK
160     for ( ; isspace(UCHAR(*p)); p++) {  /* INTL: ISO space. */
161   /* Empty loop body. */
162     }
163     if (*p == '-') {
164   p++;
165   i = -(int)strtoul(p, &end, 0); /* INTL: Tcl source. */
166     } else if (*p == '+') {
167   p++;
168   i = strtoul(p, &end, 0); /* INTL: Tcl source. */
169     } else
170 #else
171   i = strtoul(p, &end, 0); /* INTL: Tcl source. */
172 #endif
173     if (end == p) {
174   badInteger:
175         if (interp != (Tcl_Interp *) NULL) {
176       Tcl_AppendResult(interp, "expected integer but got \"", string,
177         "\"", (char *) NULL);
178       TclCheckBadOctal(interp, string);
179         }
180   return TCL_ERROR;
181     }
182     if (errno == ERANGE) {
183         if (interp != (Tcl_Interp *) NULL) {
184       Tcl_SetResult(interp, "integer value too large to represent",
185         TCL_STATIC);
186             Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
187                     Tcl_GetStringResult(interp), (char *) NULL);
188         }
189   return TCL_ERROR;
190     }
191     while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */
192   end++;
193     }
194     if (*end != 0) {
195   goto badInteger;
196     }
197     *longPtr = i;
198     return TCL_OK;
199 }

generic/tclHash.c File Reference
#include "tclInt.h"
Defines
#define REBUILD_MULTIPLIER  3
#define RANDOM_INDEX(tablePtr, i)  (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)
#define NUM_COUNTERS  10
Functions
static Tcl_HashEntry *AllocArrayEntry _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, VOID *keyPtr))
static int CompareArrayKeys _ANSI_ARGS_ ((VOID *keyPtr, Tcl_HashEntry *hPtr))
static Tcl_HashEntry *BogusFind _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, CONST char *key))
static Tcl_HashEntry *BogusCreate _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, CONST char *key, int *newPtr))
static void RebuildTable _ANSI_ARGS_ ((Tcl_HashTable *tablePtr))
void Tcl_InitHashTable (Tcl_HashTable *tablePtr, int keyType)
void Tcl_InitCustomHashTable (Tcl_HashTable *tablePtr, int keyType, Tcl_HashKeyType *typePtr)
Tcl_HashEntry * Tcl_FindHashEntry (Tcl_HashTable *tablePtr, CONST char *key)
Tcl_HashEntry * Tcl_CreateHashEntry (Tcl_HashTable *tablePtr, CONST char *key, int *newPtr)
void Tcl_DeleteHashEntry (Tcl_HashEntry *entryPtr)
void Tcl_DeleteHashTable (Tcl_HashTable *tablePtr)
Tcl_HashEntry * Tcl_FirstHashEntry (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr)
Tcl_HashEntry * Tcl_NextHashEntry (Tcl_HashSearch *searchPtr)
CONST char * Tcl_HashStats (Tcl_HashTable *tablePtr)
static Tcl_HashEntry * AllocArrayEntry (Tcl_HashTable *tablePtr, VOID *keyPtr)
static int CompareArrayKeys (VOID *keyPtr, Tcl_HashEntry *hPtr)
static unsigned int HashArrayKey (Tcl_HashTable *tablePtr, VOID *keyPtr)
static Tcl_HashEntry * AllocStringEntry (Tcl_HashTable *tablePtr, VOID *keyPtr)
static int CompareStringKeys (VOID *keyPtr, Tcl_HashEntry *hPtr)
static unsigned int HashStringKey (Tcl_HashTable *tablePtr, VOID *keyPtr)
static Tcl_HashEntry * BogusFind (Tcl_HashTable *tablePtr, CONST char *key)
static Tcl_HashEntry * BogusCreate (Tcl_HashTable *tablePtr, CONST char *key, int *newPtr)
static void RebuildTable (Tcl_HashTable *tablePtr)
Variables
Tcl_HashKeyType tclArrayHashKeyType
Tcl_HashKeyType tclOneWordHashKeyType
Tcl_HashKeyType tclStringHashKeyType

Define Documentation
#define NUM_COUNTERS  10

Referenced by Tcl_HashStats().#define RANDOM_INDEX(tablePtr, i)  (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)

Definition at line 42 of file tclHash.c.
Referenced by RebuildTable(), Tcl_CreateHashEntry(), Tcl_DeleteHashEntry(), and Tcl_FindHashEntry().#define REBUILD_MULTIPLIER  3

Definition at line 32 of file tclHash.c.
Referenced by Tcl_InitCustomHashTable(), and TclInitLiteralTable().
Function Documentation
static void RebuildTable _ANSI_ARGS_ ((Tcl_HashTable *tablePtr)) [static]
static Tcl_HashEntry* BogusCreate _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, CONST char *key, int *newPtr)) [static]
static Tcl_HashEntry* BogusFind _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, CONST char *key)) [static]
static int CompareArrayKeys _ANSI_ARGS_ ((VOID *keyPtr, Tcl_HashEntry *hPtr)) [static]
static Tcl_HashEntry* AllocArrayEntry _ANSI_ARGS_ ((Tcl_HashTable *tablePtr, VOID *keyPtr)) [static]
static Tcl_HashEntry* AllocArrayEntry (Tcl_HashTable * tablePtr, VOID * keyPtr) [static]

Definition at line 812 of file tclHash.c.
References ckalloc, Tcl_HashEntry::key, and Tcl_HashEntry::words.815 {
816     int *array = (int *) keyPtr;
817     register int *iPtr1, *iPtr2;
818     Tcl_HashEntry *hPtr;
819     int count;
820     unsigned int size;
821 
822     count = tablePtr->keyType;
823     
824     size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key);
825     if (size < sizeof(Tcl_HashEntry))
826   size = sizeof(Tcl_HashEntry);
827     hPtr = (Tcl_HashEntry *) ckalloc(size);
828     
829     for (iPtr1 = array, iPtr2 = hPtr->key.words;
830       count > 0; count--, iPtr1++, iPtr2++) {
831   *iPtr2 = *iPtr1;
832     }
833 
834     return hPtr;
835 }
static Tcl_HashEntry* AllocStringEntry (Tcl_HashTable * tablePtr, VOID * keyPtr) [static]

Definition at line 926 of file tclHash.c.
References ckalloc, CONST, Tcl_HashEntry::key, and Tcl_HashEntry::string.929 {
930     CONST char *string = (CONST char *) keyPtr;
931     Tcl_HashEntry *hPtr;
932     unsigned int size;
933 
934     size = sizeof(Tcl_HashEntry) + strlen(string) + 1 - sizeof(hPtr->key);
935     if (size < sizeof(Tcl_HashEntry))
936   size = sizeof(Tcl_HashEntry);
937     hPtr = (Tcl_HashEntry *) ckalloc(size);
938     strcpy(hPtr->key.string, string);
939 
940     return hPtr;
941 }
static Tcl_HashEntry* BogusCreate (Tcl_HashTable * tablePtr, CONST char * key, int * newPtr) [static]

Definition at line 1083 of file tclHash.c.
References panic.1089 {
1090     panic("called Tcl_CreateHashEntry on deleted table");
1091     return NULL;
1092 }
static Tcl_HashEntry* BogusFind (Tcl_HashTable * tablePtr, CONST char * key) [static]

Definition at line 1055 of file tclHash.c.
References panic.1058 {
1059     panic("called Tcl_FindHashEntry on deleted table");
1060     return NULL;
1061 }
static int CompareArrayKeys (VOID * keyPtr, Tcl_HashEntry * hPtr) [static]

Definition at line 855 of file tclHash.c.
References CONST, Tcl_HashEntry::key, Tcl_HashEntry::tablePtr, and Tcl_HashEntry::words.858 {
859     register CONST int *iPtr1 = (CONST int *) keyPtr;
860     register CONST int *iPtr2 = (CONST int *) hPtr->key.words;
861     Tcl_HashTable *tablePtr = hPtr->tablePtr;
862     int count;
863 
864     for (count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
865   if (count == 0) {
866       return 1;
867   }
868   if (*iPtr1 != *iPtr2) {
869       break;
870   }
871     }
872     return 0;
873 }
static int CompareStringKeys (VOID * keyPtr, Tcl_HashEntry * hPtr) [static]

Definition at line 961 of file tclHash.c.
References CONST, Tcl_HashEntry::key, and Tcl_HashEntry::string.964 {
965     register CONST char *p1 = (CONST char *) keyPtr;
966     register CONST char *p2 = (CONST char *) hPtr->key.string;
967 
968     for (;; p1++, p2++) {
969   if (*p1 != *p2) {
970       break;
971   }
972   if (*p1 == '\0') {
973       return 1;
974   }
975     }
976     return 0;
977 }
static unsigned int HashArrayKey (Tcl_HashTable * tablePtr, VOID * keyPtr) [static]

Definition at line 894 of file tclHash.c.
References CONST.897 {
898     register CONST int *array = (CONST int *) keyPtr;
899     register unsigned int result;
900     int count;
901 
902     for (result = 0, count = tablePtr->keyType; count > 0;
903       count--, array++) {
904   result += *array;
905     }
906     return result;
907 }
static unsigned int HashStringKey (Tcl_HashTable * tablePtr, VOID * keyPtr) [static]

Definition at line 998 of file tclHash.c.
References CONST.1001 {
1002     register CONST char *string = (CONST char *) keyPtr;
1003     register unsigned int result;
1004     register int c;
1005 
1006     /*
1007      * I tried a zillion different hash functions and asked many other
1008      * people for advice.  Many people had their own favorite functions,
1009      * all different, but no-one had much idea why they were good ones.
1010      * I chose the one below (multiply by 9 and add new character)
1011      * because of the following reasons:
1012      *
1013      * 1. Multiplying by 10 is perfect for keys that are decimal strings,
1014      *    and multiplying by 9 is just about as good.
1015      * 2. Times-9 is (shift-left-3) plus (old).  This means that each
1016      *    character's bits hang around in the low-order bits of the
1017      *    hash value for ever, plus they spread fairly rapidly up to
1018      *    the high-order bits to fill out the hash value.  This seems
1019      *    works well both for decimal and non-decimal strings.
1020      */
1021 
1022     result = 0;
1023     while (1) {
1024   c = *string;
1025   if (c == 0) {
1026       break;
1027   }
1028   result += (result<<3) + c;
1029   string++;
1030     }
1031     return result;
1032 }
static void RebuildTable (Tcl_HashTable * tablePtr) [static]

Definition at line 1116 of file tclHash.c.
References ckalloc, Tcl_HashKeyType::flags, hash(), Tcl_HashEntry::hash, Tcl_HashKeyType::hashKeyProc, Tcl_HashEntry::nextPtr, RANDOM_INDEX, TCL_CUSTOM_PTR_KEYS, TCL_CUSTOM_TYPE_KEYS, Tcl_GetHashKey, TCL_HASH_KEY_RANDOMIZE_HASH, TCL_ONE_WORD_KEYS, TCL_STRING_KEYS, tclArrayHashKeyType, tclOneWordHashKeyType, tclStringHashKeyType, and VOID.
Referenced by Tcl_CreateHashEntry().1118 {
1119     int oldSize, count, index;
1120     Tcl_HashEntry **oldBuckets;
1121     register Tcl_HashEntry **oldChainPtr, **newChainPtr;
1122     register Tcl_HashEntry *hPtr;
1123     Tcl_HashKeyType *typePtr;
1124     VOID *key;
1125 
1126     oldSize = tablePtr->numBuckets;
1127     oldBuckets = tablePtr->buckets;
1128 
1129     /*
1130      * Allocate and initialize the new bucket array, and set up
1131      * hashing constants for new array size.
1132      */
1133 
1134     tablePtr->numBuckets *= 4;
1135     tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
1136       (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
1137     for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
1138       count > 0; count--, newChainPtr++) {
1139   *newChainPtr = NULL;
1140     }
1141     tablePtr->rebuildSize *= 4;
1142     tablePtr->downShift -= 2;
1143     tablePtr->mask = (tablePtr->mask << 2) + 3;
1144 
1145 #if TCL_PRESERVE_BINARY_COMPATABILITY
1146     if (tablePtr->keyType == TCL_STRING_KEYS) {
1147   typePtr = &tclStringHashKeyType;
1148     } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
1149   typePtr = &tclOneWordHashKeyType;
1150     } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
1151          || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
1152   typePtr = tablePtr->typePtr;
1153     } else {
1154   typePtr = &tclArrayHashKeyType;
1155     }
1156 #else
1157     typePtr = tablePtr->typePtr;
1158 #endif
1159 
1160     /*
1161      * Rehash all of the existing entries into the new bucket array.
1162      */
1163 
1164     for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
1165   for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
1166       *oldChainPtr = hPtr->nextPtr;
1167 
1168       key = (VOID *) Tcl_GetHashKey (tablePtr, hPtr);
1169 
1170 #if TCL_HASH_KEY_STORE_HASH
1171       if (typePtr->hashKeyProc == NULL
1172     || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
1173     index = RANDOM_INDEX (tablePtr, hPtr->hash);
1174       } else {
1175     index = ((unsigned int) hPtr->hash) & tablePtr->mask;
1176       }
1177       hPtr->nextPtr = tablePtr->buckets[index];
1178       tablePtr->buckets[index] = hPtr;
1179 #else
1180       if (typePtr->hashKeyProc) {
1181     unsigned int hash;
1182     hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
1183     if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
1184         index = RANDOM_INDEX (tablePtr, hash);
1185     } else {
1186         index = hash & tablePtr->mask;
1187     }
1188       } else {
1189     index = RANDOM_INDEX (tablePtr, key);
1190       }
1191 
1192       hPtr->bucketPtr = &(tablePtr->buckets[index]);
1193       hPtr->nextPtr = *hPtr->bucketPtr;
1194       *hPtr->bucketPtr = hPtr;
1195 #endif
1196   }
1197     }
1198 
1199     /*
1200      * Free up the old bucket array, if it was dynamically allocated.
1201      */
1202 
1203     if (oldBuckets != tablePtr->staticBuckets) {
1204   ckfree((char *) oldBuckets);
1205     }
1206 }
Tcl_HashEntry* Tcl_CreateHashEntry (Tcl_HashTable * tablePtr, CONST char * key, int * newPtr)

Definition at line 370 of file tclHash.c.
References Tcl_HashKeyType::allocEntryProc, ckalloc, Tcl_HashEntry::clientData, Tcl_HashKeyType::compareKeysProc, Tcl_HashKeyType::flags, Tcl_HashEntry::hash, hash(), Tcl_HashKeyType::hashKeyProc, Tcl_HashEntry::key, Tcl_HashEntry::nextPtr, Tcl_HashEntry::oneWordValue, RANDOM_INDEX, RebuildTable(), Tcl_HashEntry::tablePtr, TCL_CUSTOM_PTR_KEYS, TCL_CUSTOM_TYPE_KEYS, TCL_HASH_KEY_RANDOMIZE_HASH, TCL_ONE_WORD_KEYS, TCL_STRING_KEYS, tclArrayHashKeyType, tclOneWordHashKeyType, tclStringHashKeyType, and VOID.376 {
377     register Tcl_HashEntry *hPtr;
378     Tcl_HashKeyType *typePtr;
379     unsigned int hash;
380     int index;
381 
382 #if TCL_PRESERVE_BINARY_COMPATABILITY
383     if (tablePtr->keyType == TCL_STRING_KEYS) {
384   typePtr = &tclStringHashKeyType;
385     } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
386   typePtr = &tclOneWordHashKeyType;
387     } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
388          || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
389   typePtr = tablePtr->typePtr;
390     } else {
391   typePtr = &tclArrayHashKeyType;
392     }
393 #else
394     typePtr = tablePtr->typePtr;
395     if (typePtr == NULL) {
396   Tcl_Panic("called Tcl_CreateHashEntry on deleted table");
397   return NULL;
398     }
399 #endif
400 
401     if (typePtr->hashKeyProc) {
402   hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
403   if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
404       index = RANDOM_INDEX (tablePtr, hash);
405   } else {
406       index = hash & tablePtr->mask;
407   }
408     } else {
409   hash = (unsigned int) key;
410   index = RANDOM_INDEX (tablePtr, hash);
411     }
412 
413     /*
414      * Search all of the entries in the appropriate bucket.
415      */
416 
417     if (typePtr->compareKeysProc) {
418   Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;
419   for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
420           hPtr = hPtr->nextPtr) {
421 #if TCL_HASH_KEY_STORE_HASH
422       if (hash != (unsigned int) hPtr->hash) {
423     continue;
424       }
425 #endif
426       if (compareKeysProc ((VOID *) key, hPtr)) {
427     *newPtr = 0;
428     return hPtr;
429       }
430   }
431     } else {
432   for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
433           hPtr = hPtr->nextPtr) {
434 #if TCL_HASH_KEY_STORE_HASH
435       if (hash != (unsigned int) hPtr->hash) {
436     continue;
437       }
438 #endif
439       if (key == hPtr->key.oneWordValue) {
440     *newPtr = 0;
441     return hPtr;
442       }
443   }
444     }
445 
446     /*
447      * Entry not found.  Add a new one to the bucket.
448      */
449 
450     *newPtr = 1;
451     if (typePtr->allocEntryProc) {
452   hPtr = typePtr->allocEntryProc (tablePtr, (VOID *) key);
453     } else {
454   hPtr = (Tcl_HashEntry *) ckalloc((unsigned) sizeof(Tcl_HashEntry));
455   hPtr->key.oneWordValue = (char *) key;
456     }
457            
458     hPtr->tablePtr = tablePtr;
459 #if TCL_HASH_KEY_STORE_HASH
460 #   if TCL_PRESERVE_BINARY_COMPATABILITY
461     hPtr->hash = (VOID *) hash;
462 #   else
463     hPtr->hash = hash;
464 #   endif
465     hPtr->nextPtr = tablePtr->buckets[index];
466     tablePtr->buckets[index] = hPtr;
467 #else
468     hPtr->bucketPtr = &(tablePtr->buckets[index]);
469     hPtr->nextPtr = *hPtr->bucketPtr;
470     *hPtr->bucketPtr = hPtr;
471 #endif
472     hPtr->clientData = 0;
473     tablePtr->numEntries++;
474 
475     /*
476      * If the table has exceeded a decent size, rebuild it with many
477      * more buckets.
478      */
479 
480     if (tablePtr->numEntries >= tablePtr->rebuildSize) {
481   RebuildTable(tablePtr);
482     }
483     return hPtr;
484 }
void Tcl_DeleteHashEntry (Tcl_HashEntry * entryPtr)

Definition at line 506 of file tclHash.c.
References Tcl_HashTable::buckets, ckfree, Tcl_HashKeyType::flags, Tcl_HashKeyType::freeEntryProc, Tcl_HashKeyType::hashKeyProc, Tcl_HashTable::keyType, Tcl_HashTable::mask, Tcl_HashEntry::nextPtr, Tcl_HashTable::numEntries, panic, RANDOM_INDEX, TCL_CUSTOM_PTR_KEYS, TCL_CUSTOM_TYPE_KEYS, TCL_HASH_KEY_RANDOMIZE_HASH, TCL_ONE_WORD_KEYS, TCL_STRING_KEYS, tclArrayHashKeyType, tclOneWordHashKeyType, tclStringHashKeyType, and Tcl_HashTable::typePtr.
Referenced by AliasObjCmdDeleteProc(), CleanupVar(), DeleteChannelTable(), DeleteInterpProc(), DetachChannel(), FreeEncoding(), SlaveObjCmdDeleteProc(), Tcl_DeleteAssocData(), Tcl_DeleteCommandFromToken(), Tcl_DeleteNamespace(), Tcl_DontCallWhenDeleted(), Tcl_ExposeCommand(), Tcl_HideCommand(), Tcl_PackageObjCmd(), TclDeleteCompiledLocalVars(), TclDeleteNamespaceVars(), TclDeleteVars(), TclMacUnRegisterResourceFork(), tclOSAClose(), tclOSADeleteContext(), tclOSADeleteScript(), TclRegisterAuxDataType(), TclRenameCommand(), TclTeardownNamespace(), UnregisterTcpServerInterpCleanupProc(), and UnsetVarStruct().508 {
509     register Tcl_HashEntry *prevPtr;
510     Tcl_HashKeyType *typePtr;
511     Tcl_HashTable *tablePtr;
512     Tcl_HashEntry **bucketPtr;
513 #if TCL_HASH_KEY_STORE_HASH
514     int index;
515 #endif
516 
517     tablePtr = entryPtr->tablePtr;
518 
519 #if TCL_PRESERVE_BINARY_COMPATABILITY
520     if (tablePtr->keyType == TCL_STRING_KEYS) {
521   typePtr = &tclStringHashKeyType;
522     } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
523   typePtr = &tclOneWordHashKeyType;
524     } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
525          || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
526   typePtr = tablePtr->typePtr;
527     } else {
528   typePtr = &tclArrayHashKeyType;
529     }
530 #else
531     typePtr = tablePtr->typePtr;
532 #endif
533     
534 #if TCL_HASH_KEY_STORE_HASH
535     if (typePtr->hashKeyProc == NULL
536   || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
537   index = RANDOM_INDEX (tablePtr, entryPtr->hash);
538     } else {
539   index = ((unsigned int) entryPtr->hash) & tablePtr->mask;
540     }
541 
542     bucketPtr = &(tablePtr->buckets[index]);
543 #else
544     bucketPtr = entryPtr->bucketPtr;
545 #endif
546     
547     if (*bucketPtr == entryPtr) {
548   *bucketPtr = entryPtr->nextPtr;
549     } else {
550   for (prevPtr = *bucketPtr; ; prevPtr = prevPtr->nextPtr) {
551       if (prevPtr == NULL) {
552     panic("malformed bucket chain in Tcl_DeleteHashEntry");
553       }
554       if (prevPtr->nextPtr == entryPtr) {
555     prevPtr->nextPtr = entryPtr->nextPtr;
556     break;
557       }
558   }
559     }
560 
561     tablePtr->numEntries--;
562     if (typePtr->freeEntryProc) {
563   typePtr->freeEntryProc (entryPtr);
564     } else {
565   ckfree((char *) entryPtr);
566     }
567 }
void Tcl_DeleteHashTable (Tcl_HashTable * tablePtr)

Definition at line 587 of file tclHash.c.
References ckfree, Tcl_HashKeyType::freeEntryProc, Tcl_HashEntry::nextPtr, TCL_CUSTOM_PTR_KEYS, TCL_CUSTOM_TYPE_KEYS, TCL_ONE_WORD_KEYS, TCL_STRING_KEYS, tclArrayHashKeyType, tclOneWordHashKeyType, and tclStringHashKeyType.
Referenced by DeleteArray(), DeleteChannelTable(), DeleteInterpProc(), DeleteScanNumberCache(), InterpInfoDeleteProc(), Tcl_DeleteNamespace(), Tcl_GetEncodingNames(), Tcl_SplitObjCmd(), TclDeleteNamespaceVars(), TclDeleteVars(), TclFinalizeAuxDataTypeTable(), TclFinalizeCompilation(), TclFinalizeEncodingSubsystem(), TclFinalizeObjects(), TclFreePackageInfo(), TclTeardownNamespace(), and TcpAcceptCallbacksDeleteProc().589 {
590     register Tcl_HashEntry *hPtr, *nextPtr;
591     Tcl_HashKeyType *typePtr;
592     int i;
593 
594 #if TCL_PRESERVE_BINARY_COMPATABILITY
595     if (tablePtr->keyType == TCL_STRING_KEYS) {
596   typePtr = &tclStringHashKeyType;
597     } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
598   typePtr = &tclOneWordHashKeyType;
599     } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
600          || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
601   typePtr = tablePtr->typePtr;
602     } else {
603   typePtr = &tclArrayHashKeyType;
604     }
605 #else
606     typePtr = tablePtr->typePtr;
607 #endif
608 
609     /*
610      * Free up all the entries in the table.
611      */
612 
613     for (i = 0; i < tablePtr->numBuckets; i++) {
614   hPtr = tablePtr->buckets[i];
615   while (hPtr != NULL) {
616       nextPtr = hPtr->nextPtr;
617       if (typePtr->freeEntryProc) {
618     typePtr->freeEntryProc (hPtr);
619       } else {
620     ckfree((char *) hPtr);
621       }
622       hPtr = nextPtr;
623   }
624     }
625 
626     /*
627      * Free up the bucket array, if it was dynamically allocated.
628      */
629 
630     if (tablePtr->buckets != tablePtr->staticBuckets) {
631   ckfree((char *) tablePtr->buckets);
632     }
633 
634     /*
635      * Arrange for panics if the table is used again without
636      * re-initialization.
637      */
638 
639 #if TCL_PRESERVE_BINARY_COMPATABILITY
640     tablePtr->findProc = BogusFind;
641     tablePtr->createProc = BogusCreate;
642 #else
643     tablePtr->typePtr = NULL;
644 #endif
645 }
Tcl_HashEntry* Tcl_FindHashEntry (Tcl_HashTable * tablePtr, CONST char * key)

Definition at line 274 of file tclHash.c.
References Tcl_HashKeyType::compareKeysProc, Tcl_HashKeyType::flags, Tcl_HashEntry::hash, hash(), Tcl_HashKeyType::hashKeyProc, Tcl_HashEntry::key, Tcl_HashEntry::nextPtr, Tcl_HashEntry::oneWordValue, RANDOM_INDEX, TCL_CUSTOM_PTR_KEYS, TCL_CUSTOM_TYPE_KEYS, TCL_HASH_KEY_RANDOMIZE_HASH, TCL_ONE_WORD_KEYS, TCL_STRING_KEYS, tclArrayHashKeyType, tclOneWordHashKeyType, tclStringHashKeyType, and VOID.277 {
278     register Tcl_HashEntry *hPtr;
279     Tcl_HashKeyType *typePtr;
280     unsigned int hash;
281     int index;
282 
283 #if TCL_PRESERVE_BINARY_COMPATABILITY
284     if (tablePtr->keyType == TCL_STRING_KEYS) {
285   typePtr = &tclStringHashKeyType;
286     } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
287   typePtr = &tclOneWordHashKeyType;
288     } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
289          || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
290   typePtr = tablePtr->typePtr;
291     } else {
292   typePtr = &tclArrayHashKeyType;
293     }
294 #else
295     typePtr = tablePtr->typePtr;
296     if (typePtr == NULL) {
297   Tcl_Panic("called Tcl_FindHashEntry on deleted table");
298   return NULL;
299     }
300 #endif
301 
302     if (typePtr->hashKeyProc) {
303   hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
304   if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
305       index = RANDOM_INDEX (tablePtr, hash);
306   } else {
307       index = hash & tablePtr->mask;
308   }
309     } else {
310   hash = (unsigned int) key;
311   index = RANDOM_INDEX (tablePtr, hash);
312     }
313 
314     /*
315      * Search all of the entries in the appropriate bucket.
316      */
317 
318     if (typePtr->compareKeysProc) {
319   Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;
320   for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
321           hPtr = hPtr->nextPtr) {
322 #if TCL_HASH_KEY_STORE_HASH
323       if (hash != (unsigned int) hPtr->hash) {
324     continue;
325       }
326 #endif
327       if (compareKeysProc ((VOID *) key, hPtr)) {
328     return hPtr;
329       }
330   }
331     } else {
332   for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
333           hPtr = hPtr->nextPtr) {
334 #if TCL_HASH_KEY_STORE_HASH
335       if (hash != (unsigned int) hPtr->hash) {
336     continue;
337       }
338 #endif
339       if (key == hPtr->key.oneWordValue) {
340     return hPtr;
341       }
342   }
343     }
344     
345     return NULL;
346 }
Tcl_HashEntry* Tcl_FirstHashEntry (Tcl_HashTable * tablePtr, Tcl_HashSearch * searchPtr)

Definition at line 670 of file tclHash.c.
References Tcl_HashSearch::nextEntryPtr, Tcl_HashSearch::nextIndex, Tcl_HashSearch::tablePtr, and Tcl_NextHashEntry().
Referenced by AliasList(), AppendLocals(), BumpCmdRefEpochs(), DeleteArray(), DeleteChannelTable(), DeleteInterpProc(), DeleteScanNumberCache(), getSortedHashKeys(), InfoCommandsCmd(), InfoGlobalsCmd(), InfoProcsCmd(), InfoVarsCmd(), InterpInfoDeleteProc(), NamespaceChildrenCmd(), SlaveHidden(), Tcl_AppendAllObjTypes(), Tcl_ArrayObjCmd(), Tcl_DontCallWhenDeleted(), Tcl_ForgetImport(), Tcl_GetChannelNamesEx(), Tcl_GetEncodingNames(), Tcl_Import(), Tcl_InterpObjCmd(), Tcl_ListMathFuncs(), Tcl_OSACmd(), Tcl_PackageObjCmd(), TclDeleteNamespaceVars(), TclDeleteVars(), TclFinalizeEncodingSubsystem(), TclFreePackageInfo(), TclMacRegisterResourceFork(), tclOSAClose(), TclTeardownNamespace(), TcpAcceptCallbacksDeleteProc(), and TestChannelCmd().674 {
675     searchPtr->tablePtr = tablePtr;
676     searchPtr->nextIndex = 0;
677     searchPtr->nextEntryPtr = NULL;
678     return Tcl_NextHashEntry(searchPtr);
679 }
CONST char* Tcl_HashStats (Tcl_HashTable * tablePtr)

Definition at line 743 of file tclHash.c.
References Tcl_HashEntry::nextPtr, and NUM_COUNTERS.
Referenced by Tcl_ArrayObjCmd().745 {
746 #define NUM_COUNTERS 10
747     int count[NUM_COUNTERS], overflow, i, j;
748     double average, tmp;
749     register Tcl_HashEntry *hPtr;
750     char *result, *p;
751 
752     /*
753      * Compute a histogram of bucket usage.
754      */
755 
756     for (i = 0; i < NUM_COUNTERS; i++) {
757   count[i] = 0;
758     }
759     overflow = 0;
760     average = 0.0;
761     for (i = 0; i < tablePtr->numBuckets; i++) {
762   j = 0;
763   for (hPtr = tablePtr->buckets[i]; hPtr != NULL; hPtr = hPtr->nextPtr) {
764       j++;
765   }
766   if (j < NUM_COUNTERS) {
767       count[j]++;
768   } else {
769       overflow++;
770   }
771   tmp = j;
772   average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
773     }
774 
775     /*
776      * Print out the histogram and a few other pieces of information.
777      */
778 
779     result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
780     sprintf(result, "%d entries in table, %d buckets\n",
781       tablePtr->numEntries, tablePtr->numBuckets);
782     p = result + strlen(result);
783     for (i = 0; i < NUM_COUNTERS; i++) {
784   sprintf(p, "number of buckets with %d entries: %d\n",
785     i, count[i]);
786   p += strlen(p);
787     }
788     sprintf(p, "number of buckets with %d or more entries: %d\n",
789       NUM_COUNTERS, overflow);
790     p += strlen(p);
791     sprintf(p, "average search distance for entry: %.1f", average);
792     return result;
793 }
void Tcl_InitCustomHashTable (Tcl_HashTable * tablePtr, int keyType, Tcl_HashKeyType * typePtr)

Definition at line 183 of file tclHash.c.
References panic, REBUILD_MULTIPLIER, Tcl_CreateHashEntry, TCL_CUSTOM_PTR_KEYS, TCL_CUSTOM_TYPE_KEYS, Tcl_FindHashEntry, TCL_ONE_WORD_KEYS, TCL_SMALL_HASH_TABLE, TCL_STRING_KEYS, tclArrayHashKeyType, tclOneWordHashKeyType, and tclStringHashKeyType.
Referenced by Tcl_InitHashTable(), and Tcl_InitObjHashTable().186                                                      :
187            * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
188            * TCL_CUSTOM_TYPE_KEYS,
189            * TCL_CUSTOM_PTR_KEYS,  or an
190            * integer >= 2. */
191     Tcl_HashKeyType *typePtr;   /* Pointer to structure which defines
192            * the behaviour of this table. */
193 {
194 #if (TCL_SMALL_HASH_TABLE != 4) 
195     panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
196       TCL_SMALL_HASH_TABLE);
197 #endif
198     
199     tablePtr->buckets = tablePtr->staticBuckets;
200     tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
201     tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
202     tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
203     tablePtr->numEntries = 0;
204     tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
205     tablePtr->downShift = 28;
206     tablePtr->mask = 3;
207     tablePtr->keyType = keyType;
208 #if TCL_PRESERVE_BINARY_COMPATABILITY
209     tablePtr->findProc = Tcl_FindHashEntry;
210     tablePtr->createProc = Tcl_CreateHashEntry;
211 
212     if (typePtr == NULL) {
213   /*
214    * The caller has been rebuilt so the hash table is an extended
215    * version.
216    */
217     } else if (typePtr != (Tcl_HashKeyType *) -1) {
218   /*
219    * The caller is requesting a customized hash table so it must be
220    * an extended version.
221    */
222   tablePtr->typePtr = typePtr;
223     } else {
224   /*
225    * The caller has not been rebuilt so the hash table is not
226    * extended.
227    */
228     }
229 #else
230     if (typePtr == NULL) {
231   /*
232    * Use the key type to decide which key type is needed.
233    */
234   if (keyType == TCL_STRING_KEYS) {
235       typePtr = &tclStringHashKeyType;
236   } else if (keyType == TCL_ONE_WORD_KEYS) {
237       typePtr = &tclOneWordHashKeyType;
238   } else if (keyType == TCL_CUSTOM_TYPE_KEYS) {
239       Tcl_Panic ("No type structure specified for TCL_CUSTOM_TYPE_KEYS");
240   } else if (keyType == TCL_CUSTOM_PTR_KEYS) {
241       Tcl_Panic ("No type structure specified for TCL_CUSTOM_PTR_KEYS");
242   } else {
243       typePtr = &tclArrayHashKeyType;
244   }
245     } else if (typePtr == (Tcl_HashKeyType *) -1) {
246   /*
247    * If the caller has not been rebuilt then we cannot continue as
248    * the hash table is not an extended version.
249    */
250   Tcl_Panic ("Hash table is not compatible");
251     }
252     tablePtr->typePtr = typePtr;
253 #endif
254 }

void Tcl_InitHashTable (Tcl_HashTable * tablePtr, int keyType)

Definition at line 147 of file tclHash.c.
References Tcl_InitCustomHashTable().
Referenced by GetChannelTable(), RegisterTcpServerInterpCleanup(), ResourceInit(), SlaveCreate(), Tcl_BinaryObjCmd(), Tcl_CallWhenDeleted(), Tcl_CreateInterp(), Tcl_CreateNamespace(), Tcl_GetEncodingNames(), Tcl_HideCommand(), Tcl_SetAssocData(), Tcl_SplitObjCmd(), Tclapplescript_Init(), TclArraySet(), TclCompileExpr(), TclInitAuxDataTypeTable(), TclInitEncodingSubsystem(), TclInitObjSubsystem(), TclInterpInit(), TclLookupArrayElement(), TclLookupSimpleVar(), tclOSAMakeNewComponent(), and TclTeardownNamespace().150                                                      :
151            * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
152            * or an integer >= 2. */
153 {
154     /*
155      * Use a special value to inform the extended version that it must
156      * not access any of the new fields in the Tcl_HashTable. If an
157      * extension is rebuilt then any calls to this function will be
158      * redirected to the extended version by a macro.
159      */
160     Tcl_InitCustomHashTable(tablePtr, keyType, (Tcl_HashKeyType *) -1);
161 }

Tcl_HashEntry* Tcl_NextHashEntry (Tcl_HashSearch * searchPtr)

Definition at line 701 of file tclHash.c.
References Tcl_HashTable::buckets, Tcl_HashEntry::nextPtr, Tcl_HashTable::numBuckets, and Tcl_HashEntry::tablePtr.
Referenced by AliasList(), AppendLocals(), BumpCmdRefEpochs(), DeleteArray(), DeleteInterpProc(), DeleteScanNumberCache(), getSortedHashKeys(), InfoCommandsCmd(), InfoGlobalsCmd(), InfoProcsCmd(), InfoVarsCmd(), InterpInfoDeleteProc(), NamespaceChildrenCmd(), SlaveHidden(), Tcl_AppendAllObjTypes(), Tcl_ArrayObjCmd(), Tcl_DontCallWhenDeleted(), Tcl_FirstHashEntry(), Tcl_ForgetImport(), Tcl_GetChannelNamesEx(), Tcl_GetEncodingNames(), Tcl_Import(), Tcl_InterpObjCmd(), Tcl_ListMathFuncs(), Tcl_OSACmd(), Tcl_PackageObjCmd(), TclDeleteVars(), TclFreePackageInfo(), TclMacRegisterResourceFork(), tclOSAClose(), TcpAcceptCallbacksDeleteProc(), and TestChannelCmd().706 {
707     Tcl_HashEntry *hPtr;
708     Tcl_HashTable *tablePtr = searchPtr->tablePtr;
709 
710     while (searchPtr->nextEntryPtr == NULL) {
711   if (searchPtr->nextIndex >= tablePtr->numBuckets) {
712       return NULL;
713   }
714   searchPtr->nextEntryPtr =
715     tablePtr->buckets[searchPtr->nextIndex];
716   searchPtr->nextIndex++;
717     }
718     hPtr = searchPtr->nextEntryPtr;
719     searchPtr->nextEntryPtr = hPtr->nextPtr;
720     return hPtr;
721 }

Variable Documentation
Tcl_HashKeyType tclArrayHashKeyType
Initial value: {
    TCL_HASH_KEY_TYPE_VERSION,    
    TCL_HASH_KEY_RANDOMIZE_HASH,  
    HashArrayKey,     
    CompareArrayKeys,     
    AllocArrayEntry,      
    NULL        
}
Definition at line 99 of file tclHash.c.
Referenced by RebuildTable(), Tcl_CreateHashEntry(), Tcl_DeleteHashEntry(), Tcl_DeleteHashTable(), Tcl_FindHashEntry(), and Tcl_InitCustomHashTable().Tcl_HashKeyType tclOneWordHashKeyType
Initial value: {
    TCL_HASH_KEY_TYPE_VERSION,    
    0,          
    NULL,     
    NULL,   
    NULL,   
    NULL      
}
Definition at line 108 of file tclHash.c.
Referenced by RebuildTable(), Tcl_CreateHashEntry(), Tcl_DeleteHashEntry(), Tcl_DeleteHashTable(), Tcl_FindHashEntry(), and Tcl_InitCustomHashTable().Tcl_HashKeyType tclStringHashKeyType
Initial value: {
    TCL_HASH_KEY_TYPE_VERSION,    
    0,          
    HashStringKey,      
    CompareStringKeys,      
    AllocStringEntry,     
    NULL        
}
Definition at line 117 of file tclHash.c.
Referenced by RebuildTable(), Tcl_CreateHashEntry(), Tcl_DeleteHashEntry(), Tcl_DeleteHashTable(), Tcl_FindHashEntry(), and Tcl_InitCustomHashTable().

generic/tclHistory.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Functions
int Tcl_RecordAndEval (Tcl_Interp *interp, CONST char *cmd, int flags)
int Tcl_RecordAndEvalObj (Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags)

Function Documentation
int Tcl_RecordAndEval (Tcl_Interp * interp, CONST char * cmd, int flags)

Definition at line 42 of file tclHistory.c.
References Tcl_DecrRefCount, Tcl_GetObjResult(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_OK, Tcl_RecordAndEvalObj(), Tcl_ResetResult(), Tcl_SetResult(), TCL_VOLATILE, and TclGetString.47                       : don't execute command.
48          * TCL_EVAL_GLOBAL means use Tcl_GlobalEval
49          * instead of Tcl_Eval. */
50 {
51     register Tcl_Obj *cmdPtr;
52     int length = strlen(cmd);
53     int result;
54 
55     if (length > 0) {
56   /*
57    * Call Tcl_RecordAndEvalObj to do the actual work.
58    */
59 
60   cmdPtr = Tcl_NewStringObj(cmd, length);
61   Tcl_IncrRefCount(cmdPtr);
62   result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
63 
64   /*
65    * Move the interpreter's object result to the string result, 
66    * then reset the object result.
67    */
68 
69   Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
70           TCL_VOLATILE);
71 
72   /*
73    * Discard the Tcl object created to hold the command.
74    */
75   
76   Tcl_DecrRefCount(cmdPtr); 
77     } else {
78   /*
79    * An empty string. Just reset the interpreter's result.
80    */
81 
82   Tcl_ResetResult(interp);
83   result = TCL_OK;
84     }
85     return result;
86 }
int Tcl_RecordAndEvalObj (Tcl_Interp * interp, Tcl_Obj * cmdPtr, int flags)

Definition at line 108 of file tclHistory.c.
References Tcl_DecrRefCount, TCL_EVAL_GLOBAL, Tcl_EvalObjEx(), Tcl_IncrRefCount, Tcl_NewListObj(), Tcl_NewStringObj(), TCL_NO_EVAL, TCL_OK, and void().
Referenced by StdinProc(), Tcl_Main(), and Tcl_RecordAndEval().114                       : don't execute the command.
115          * TCL_EVAL_GLOBAL means evaluate the
116          * script in global variable context instead
117          * of the current procedure. */
118 {
119     int result;
120     Tcl_Obj *list[3];
121     register Tcl_Obj *objPtr;
122 
123     /*
124      * Do recording by eval'ing a tcl history command: history add $cmd.
125      */
126 
127     list[0] = Tcl_NewStringObj("history", -1);
128     list[1] = Tcl_NewStringObj("add", -1);
129     list[2] = cmdPtr;
130     
131     objPtr = Tcl_NewListObj(3, list);
132     Tcl_IncrRefCount(objPtr);
133     (void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
134     Tcl_DecrRefCount(objPtr);
135 
136     /*
137      * Execute the command.
138      */
139 
140     result = TCL_OK;
141     if (!(flags & TCL_NO_EVAL)) {
142   result = Tcl_EvalObjEx(interp, cmdPtr, flags & TCL_EVAL_GLOBAL);
143     }
144     return result;
145 }

generic/tclIndexObj.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Classes
struct IndexRep
Defines
#define STRING_AT(table, offset, index)  (*((CONST char * CONST *)(((char *)(table)) + ((offset) * (index)))))
#define NEXT_ENTRY(table, offset)  (&(STRING_AT(table, offset, 1)))
#define EXPAND_OF(indexRep)  STRING_AT((indexRep)->tablePtr, (indexRep)->offset, (indexRep)->index)
Functions
static int SetIndexFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
static void UpdateStringOfIndex _ANSI_ARGS_ ((Tcl_Obj *objPtr))
static void DupIndex _ANSI_ARGS_ ((Tcl_Obj *srcPtr, Tcl_Obj *dupPtr))
int Tcl_GetIndexFromObj (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST char **tablePtr, CONST char *msg, int flags, int *indexPtr)
int Tcl_GetIndexFromObjStruct (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST VOID *tablePtr, int offset, CONST char *msg, int flags, int *indexPtr)
static int SetIndexFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr)
static void UpdateStringOfIndex (Tcl_Obj *objPtr)
static void DupIndex (Tcl_Obj *srcPtr, Tcl_Obj *dupPtr)
static void FreeIndex (Tcl_Obj *objPtr)
void Tcl_WrongNumArgs (Tcl_Interp *interp, int objc, objv, CONST char *message)
Variables
Tcl_ObjType tclIndexType

Define Documentation
#define EXPAND_OF(indexRep)  STRING_AT((indexRep)->tablePtr, (indexRep)->offset, (indexRep)->index)

Definition at line 64 of file tclIndexObj.c.
Referenced by Tcl_WrongNumArgs(), and UpdateStringOfIndex().#define NEXT_ENTRY(table, offset)  (&(STRING_AT(table, offset, 1)))

Definition at line 62 of file tclIndexObj.c.
Referenced by Tcl_GetIndexFromObjStruct().#define STRING_AT(table, offset, index)  (*((CONST char * CONST *)(((char *)(table)) + ((offset) * (index)))))

Definition at line 60 of file tclIndexObj.c.
Function Documentation
static void DupIndex _ANSI_ARGS_ ((Tcl_Obj *srcPtr, Tcl_Obj *dupPtr)) [static]
static void UpdateStringOfIndex _ANSI_ARGS_ ((Tcl_Obj *objPtr)) [static]
static int SetIndexFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr)) [static]
static void DupIndex (Tcl_Obj * srcPtr, Tcl_Obj * dupPtr) [static]

Definition at line 372 of file tclIndexObj.c.
References ckalloc, tclIndexType, and VOID.374 {
375     IndexRep *srcIndexRep = (IndexRep *) srcPtr->internalRep.otherValuePtr;
376     IndexRep *dupIndexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
377 
378     memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));
379     dupPtr->internalRep.otherValuePtr = (VOID *) dupIndexRep;
380     dupPtr->typePtr = &tclIndexType;
381 }
static void FreeIndex (Tcl_Obj * objPtr) [static]

Definition at line 401 of file tclIndexObj.c.
References ckfree.403 {
404     ckfree((char *) objPtr->internalRep.otherValuePtr);
405 }
static int SetIndexFromAny (Tcl_Interp * interp, Tcl_Obj * objPtr) [static]

Definition at line 309 of file tclIndexObj.c.
References Tcl_AppendToObj(), TCL_ERROR, and Tcl_GetObjResult().312 {
313     Tcl_AppendToObj(Tcl_GetObjResult(interp),
314       "can't convert value to index except via Tcl_GetIndexFromObj API",
315       -1);
316     return TCL_ERROR;
317 }
int Tcl_GetIndexFromObj (Tcl_Interp * interp, Tcl_Obj * objPtr, CONST char ** tablePtr, CONST char * msg, int flags, int * indexPtr)

Definition at line 96 of file tclIndexObj.c.
References IndexRep::index, Tcl_Obj::internalRep, IndexRep::offset, Tcl_Obj::otherValuePtr, IndexRep::tablePtr, Tcl_GetIndexFromObjStruct(), TCL_OK, tclIndexType, Tcl_Obj::typePtr, and VOID.
Referenced by ParseKeyName(), RegistryObjCmd(), SetValue(), SlaveObjCmd(), Tcl_AfterObjCmd(), Tcl_ArrayObjCmd(), Tcl_BinaryObjCmd(), Tcl_DdeObjCmd(), TCL_DECLARE_MUTEX(), Tcl_EncodingObjCmd(), Tcl_ExecObjCmd(), Tcl_FcopyObjCmd(), Tcl_FileEventObjCmd(), Tcl_FileObjCmd(), Tcl_GlobObjCmd(), Tcl_InfoObjCmd(), Tcl_InterpObjCmd(), Tcl_LsearchObjCmd(), Tcl_LsortObjCmd(), Tcl_NamespaceObjCmd(), Tcl_PackageObjCmd(), Tcl_RegexpObjCmd(), Tcl_RegsubObjCmd(), Tcl_ResourceObjCmd(), Tcl_SeekObjCmd(), Tcl_SocketObjCmd(), Tcl_StringObjCmd(), Tcl_SubstObjCmd(), Tcl_SwitchObjCmd(), Tcl_TraceObjCmd(), Tcl_UpdateObjCmd(), TclCompileStringCmd(), TclFileAttrsCmd(), Tcltest_Init(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), TestencodingObjCmd(), TesteventObjCmd(), TestExceptionCmd(), TestindexobjCmd(), TestlocaleCmd(), TestregexpObjCmd(), TestsaveresultCmd(), and TeststringobjCmd().105 {
106 
107     /*
108      * See if there is a valid cached result from a previous lookup
109      * (doing the check here saves the overhead of calling
110      * Tcl_GetIndexFromObjStruct in the common case where the result
111      * is cached).
112      */
113 
114     if (objPtr->typePtr == &tclIndexType) {
115   IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
116   /*
117    * Here's hoping we don't get hit by unfortunate packing
118    * constraints on odd platforms like a Cray PVP...
119    */
120   if (indexRep->tablePtr == (VOID *)tablePtr &&
121     indexRep->offset == sizeof(char *)) {
122       *indexPtr = indexRep->index;
123       return TCL_OK;
124   }
125     }
126     return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *),
127       msg, flags, indexPtr);
128 }
int Tcl_GetIndexFromObjStruct (Tcl_Interp * interp, Tcl_Obj * objPtr, CONST VOID * tablePtr, int offset, CONST char * msg, int flags, int * indexPtr)

Definition at line 160 of file tclIndexObj.c.
References CONST, IndexRep::index, Tcl_Obj::internalRep, NEXT_ENTRY, NULL, IndexRep::offset, Tcl_Obj::otherValuePtr, IndexRep::tablePtr, TCL_EXACT, TCL_OK, TclGetString, tclIndexType, and Tcl_Obj::typePtr.
Referenced by Tcl_GetIndexFromObj(), and TestGetIndexFromObjStructObjCmd().173 {
174     int index, i, numAbbrev;
175     char *key, *p1;
176     CONST char *p2;
177     CONST char * CONST *entryPtr;
178     Tcl_Obj *resultPtr;
179     IndexRep *indexRep;
180 
181     /*
182      * See if there is a valid cached result from a previous lookup.
183      */
184 
185     if (objPtr->typePtr == &tclIndexType) {
186   indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
187   if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) {
188       *indexPtr = indexRep->index;
189       return TCL_OK;
190   }
191     }
192 
193     /*
194      * Lookup the value of the object in the table.  Accept unique
195      * abbreviations unless TCL_EXACT is set in flags.
196      */
197 
198     key = TclGetString(objPtr);
199     index = -1;
200     numAbbrev = 0;
201 
202     /*
203      * Scan the table looking for one of:
204      *  - An exact match (always preferred)
205      *  - A single abbreviation (allowed depending on flags)
206      *  - Several abbreviations (never allowed, but overridden by exact match)
207      */
208     for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; 
209       entryPtr = NEXT_ENTRY(entryPtr, offset), i++) {
210   for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) {
211       if (*p1 == '\0') {
212     index = i;
213     goto done;
214       }
215   }
216   if (*p1 == '\0') {
217       /*
218        * The value is an abbreviation for this entry.  Continue
219        * checking other entries to make sure it's unique.  If we
220        * get more than one unique abbreviation, keep searching to
221        * see if there is an exact match, but remember the number
222        * of unique abbreviations and don't allow either.
223        */
224 
225       numAbbrev++;
226       index = i;
227   }
228     }
229     /*
230      * Check if we were instructed to disallow abbreviations. 
231      */
232     if ((flags & TCL_EXACT) || (key[0] == '\0') || (numAbbrev != 1)) {
233   goto error;
234     }
235 
236     done:
237     /*
238      * Cache the found representation.  Note that we want to avoid
239      * allocating a new internal-rep if at all possible since that is
240      * potentially a slow operation.
241      */
242     if (objPtr->typePtr == &tclIndexType) {
243   indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
244     } else {
245   if ((objPtr->typePtr != NULL)
246     && (objPtr->typePtr->freeIntRepProc != NULL)) {
247       objPtr->typePtr->freeIntRepProc(objPtr);
248   }
249   indexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
250   objPtr->internalRep.otherValuePtr = (VOID *) indexRep;
251   objPtr->typePtr = &tclIndexType;
252     }
253     indexRep->tablePtr = (VOID*) tablePtr;
254     indexRep->offset = offset;
255     indexRep->index = index;
256 
257     *indexPtr = index;
258     return TCL_OK;
259 
260     error:
261     if (interp != NULL) {
262   /*
263    * Produce a fancy error message.
264    */
265   int count;
266 
267   TclNewObj(resultPtr);
268   Tcl_SetObjResult(interp, resultPtr);
269   Tcl_AppendStringsToObj(resultPtr, (numAbbrev > 1) &&
270     !(flags & TCL_EXACT) ? "ambiguous " : "bad ", msg, " \"",
271     key, "\": must be ", STRING_AT(tablePtr,offset,0), (char*)NULL);
272   for (entryPtr = NEXT_ENTRY(tablePtr, offset), count = 0;
273     *entryPtr != NULL;
274     entryPtr = NEXT_ENTRY(entryPtr, offset), count++) {
275       if (*NEXT_ENTRY(entryPtr, offset) == NULL) {
276     Tcl_AppendStringsToObj(resultPtr,
277       (count > 0) ? ", or " : " or ", *entryPtr,
278       (char *) NULL);
279       } else {
280     Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr,
281       (char *) NULL);
282       }
283   }
284     }
285     return TCL_ERROR;
286 }
void Tcl_WrongNumArgs (Tcl_Interp * interp, int objc, objv, CONST char * message)

Definition at line 432 of file tclIndexObj.c.
References EXPAND_OF, NULL, Tcl_AppendToObj(), Tcl_GetString(), Tcl_SetObjResult(), tclIndexType, and TclNewObj.
Referenced by BroadcastValue(), GetInterp2(), InfoArgsCmd(), InfoBodyCmd(), InfoCmdCountCmd(), InfoCommandsCmd(), InfoCompleteCmd(), InfoDefaultCmd(), InfoExistsCmd(), InfoFunctionsCmd(), InfoGlobalsCmd(), InfoHostnameCmd(), InfoLevelCmd(), InfoLibraryCmd(), InfoLoadedCmd(), InfoLocalsCmd(), InfoNameOfExecutableCmd(), InfoPatchLevelCmd(), InfoProcsCmd(), InfoScriptCmd(), InfoSharedlibCmd(), InfoTclVersionCmd(), InfoVarsCmd(), NamespaceChildrenCmd(), NamespaceCodeCmd(), NamespaceCurrentCmd(), NamespaceDeleteCmd(), NamespaceEvalCmd(), NamespaceExistsCmd(), NamespaceExportCmd(), NamespaceForgetCmd(), NamespaceImportCmd(), NamespaceInscopeCmd(), NamespaceOriginCmd(), NamespaceParentCmd(), NamespaceQualifiersCmd(), NamespaceTailCmd(), NamespaceWhichCmd(), Pkga_EqObjCmd(), Pkga_QuoteObjCmd(), Pkgb_SubObjCmd(), Pkgc_SubObjCmd(), Pkgd_SubObjCmd(), ProcBodyTestProcObjCmd(), RegistryObjCmd(), SlaveObjCmd(), Tcl_AfterObjCmd(), Tcl_AppendObjCmd(), Tcl_ArrayObjCmd(), Tcl_BeepObjCmd(), Tcl_BinaryObjCmd(), Tcl_BreakObjCmd(), Tcl_CaseObjCmd(), Tcl_CatchObjCmd(), Tcl_CdObjCmd(), Tcl_CloseObjCmd(), Tcl_ContinueObjCmd(), Tcl_DdeObjCmd(), TCL_DECLARE_MUTEX(), Tcl_EncodingObjCmd(), Tcl_EofObjCmd(), Tcl_ErrorObjCmd(), Tcl_EvalObjCmd(), Tcl_ExecObjCmd(), Tcl_ExitObjCmd(), Tcl_ExprObjCmd(), Tcl_FblockedObjCmd(), Tcl_FconfigureObjCmd(), Tcl_FcopyObjCmd(), Tcl_FileEventObjCmd(), Tcl_FileObjCmd(), Tcl_FlushObjCmd(), Tcl_ForeachObjCmd(), Tcl_FormatObjCmd(), Tcl_ForObjCmd(), Tcl_GetsObjCmd(), Tcl_GlobalObjCmd(), Tcl_GlobObjCmd(), Tcl_IncrObjCmd(), Tcl_InfoObjCmd(), Tcl_InterpObjCmd(), Tcl_JoinObjCmd(), Tcl_LappendObjCmd(), Tcl_LindexObjCmd(), Tcl_LinsertObjCmd(), Tcl_LlengthObjCmd(), Tcl_LoadObjCmd(), Tcl_LrangeObjCmd(), Tcl_LreplaceObjCmd(), Tcl_LsearchObjCmd(), Tcl_LsetObjCmd(), Tcl_LsortObjCmd(), Tcl_MacBGNotifyObjCmd(), Tcl_NamespaceObjCmd(), Tcl_OpenObjCmd(), Tcl_PackageObjCmd(), Tcl_PidObjCmd(), Tcl_ProcObjCmd(), Tcl_PutsObjCmd(), Tcl_PwdObjCmd(), Tcl_ReadObjCmd(), Tcl_RegexpObjCmd(), Tcl_RegsubObjCmd(), Tcl_RenameObjCmd(), Tcl_ResourceObjCmd(), Tcl_ScanObjCmd(), Tcl_SeekObjCmd(), Tcl_SetObjCmd(), Tcl_SourceObjCmd(), Tcl_SplitObjCmd(), Tcl_StringObjCmd(), Tcl_SubstObjCmd(), Tcl_SwitchObjCmd(), Tcl_TellObjCmd(), Tcl_TimeObjCmd(), Tcl_TraceObjCmd(), Tcl_UnsetObjCmd(), Tcl_UpdateObjCmd(), Tcl_UplevelObjCmd(), Tcl_UpvarObjCmd(), Tcl_VariableObjCmd(), Tcl_VwaitObjCmd(), Tcl_WhileObjCmd(), TclFileAttrsCmd(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), TestbooleanobjCmd(), TestconvertobjCmd(), TestdoubleobjCmd(), TestevalexObjCmd(), TestevalobjvObjCmd(), TesteventObjCmd(), TestExceptionCmd(), TestexprparserObjCmd(), TestfilelinkCmd(), TestFilesystemObjCmd(), TestGetIndexFromObjStructObjCmd(), TestgetvarfullnameCmd(), TestintobjCmd(), TestlocaleCmd(), TestobjCmd(), TestparserObjCmd(), TestparsevarnameObjCmd(), TestparsevarObjCmd(), TestregexpObjCmd(), TestsaveresultCmd(), TestSimpleFilesystemObjCmd(), TeststringobjCmd(), TestvolumetypeCmd(), TestwinclockCmd(), TestwincpuidCmd(), TestwinsleepCmd(), and TestWrongNumArgsObjCmd().442 {
443     Tcl_Obj *objPtr;
444     int i;
445     register IndexRep *indexRep;
446 
447     TclNewObj(objPtr);
448     Tcl_SetObjResult(interp, objPtr);
449     Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
450     for (i = 0; i < objc; i++) {
451   /*
452    * If the object is an index type use the index table which allows
453    * for the correct error message even if the subcommand was
454    * abbreviated.  Otherwise, just use the string rep.
455    */
456   
457   if (objv[i]->typePtr == &tclIndexType) {
458       indexRep = (IndexRep *) objv[i]->internalRep.otherValuePtr;
459       Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), (char *) NULL);
460   } else {
461       Tcl_AppendStringsToObj(objPtr, Tcl_GetString(objv[i]),
462         (char *) NULL);
463   }
464 
465   /*
466    * Append a space character (" ") if there is more text to follow
467    * (either another element from objv, or the message string).
468    */
469   if ((i < (objc - 1)) || message) {
470       Tcl_AppendStringsToObj(objPtr, " ", (char *) NULL);
471   }
472     }
473 
474     if (message) {
475   Tcl_AppendStringsToObj(objPtr, message, (char *) NULL);
476     }
477     Tcl_AppendStringsToObj(objPtr, "\"", (char *) NULL);
478 }
static void UpdateStringOfIndex (Tcl_Obj * objPtr) [static]

Definition at line 338 of file tclIndexObj.c.
References ckalloc, CONST, and EXPAND_OF.340 {
341     IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
342     register char *buf;
343     register unsigned len;
344     register CONST char *indexStr = EXPAND_OF(indexRep);
345 
346     len = strlen(indexStr);
347     buf = (char *) ckalloc(len + 1);
348     memcpy(buf, indexStr, len+1);
349     objPtr->bytes = buf;
350     objPtr->length = len;
351 }

Variable Documentation
Tcl_ObjType tclIndexType
Initial value: {
    "index",        
    FreeIndex,        
    DupIndex,       
    UpdateStringOfIndex,    
    SetIndexFromAny     
}
Definition at line 35 of file tclIndexObj.c.
Referenced by DupIndex(), Tcl_GetIndexFromObj(), Tcl_GetIndexFromObjStruct(), Tcl_WrongNumArgs(), and TclInitObjSubsystem().

generic/tclInitScript.h File Reference
Functions
char * TclSetPreInitScript (string) char *string
Variables
static char initScript []
static char * tclPreInitScript = NULL

Function Documentation
char* TclSetPreInitScript (string)

Variable Documentation
char initScript[] [static]

Definition at line 39 of file tclInitScript.h.
Referenced by Tcl_Init().char* tclPreInitScript = NULL [static]

Definition at line 85 of file tclInitScript.h.
Referenced by Tcl_Init().

generic/tclInt.h File Reference
#include "tcl.h"
#include <stdio.h>
#include <ctype.h>
#include <limits.h>
#include <stdlib.h>
#include <string.h>
#include "tclIntDecls.h"
Classes
struct Tcl_ResolvedVarInfo
struct Tcl_ResolverInfo
struct Namespace
struct VarTrace
struct CommandTrace
struct ActiveCommandTrace
struct ActiveVarTrace
struct ArraySearch
struct Var
struct CompiledLocal
struct Proc
struct Trace
struct ActiveInterpTrace
struct AssocData
struct CallFrame
struct MathFunc
struct ExecEnv
struct LiteralEntry
struct LiteralTable
struct ImportRef
struct ImportedCmdData
struct Command
struct ResolverScheme
struct Interp
struct List
struct TclFileAttrProcs
Defines
#define MODULE_SCOPE  extern
#define TCL_STORAGE_CLASS  DLLIMPORT
#define NS_DYING  0x01
#define NS_DEAD  0x02
#define NS_KILLED  0x04
#define CREATE_NS_IF_UNKNOWN  0x800
#define VAR_SCALAR  0x1
#define VAR_ARRAY  0x2
#define VAR_LINK  0x4
#define VAR_UNDEFINED  0x8
#define VAR_IN_HASHTABLE  0x10
#define VAR_TRACE_ACTIVE  0x20
#define VAR_ARRAY_ELEMENT  0x40
#define VAR_NAMESPACE_VAR  0x80
#define VAR_ARGUMENT  0x100
#define VAR_TEMPORARY  0x200
#define VAR_RESOLVED  0x400
#define TclSetVarScalar(varPtr)  (varPtr)->flags = ((varPtr)->flags & ~(VAR_ARRAY|VAR_LINK)) | VAR_SCALAR
#define TclSetVarArray(varPtr)  (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_LINK)) | VAR_ARRAY
#define TclSetVarLink(varPtr)  (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_ARRAY)) | VAR_LINK
#define TclSetVarArrayElement(varPtr)  (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT
#define TclSetVarUndefined(varPtr)  (varPtr)->flags |= VAR_UNDEFINED
#define TclClearVarUndefined(varPtr)  (varPtr)->flags &= ~VAR_UNDEFINED
#define TclIsVarScalar(varPtr)  ((varPtr)->flags & VAR_SCALAR)
#define TclIsVarLink(varPtr)  ((varPtr)->flags & VAR_LINK)
#define TclIsVarArray(varPtr)  ((varPtr)->flags & VAR_ARRAY)
#define TclIsVarUndefined(varPtr)  ((varPtr)->flags & VAR_UNDEFINED)
#define TclIsVarArrayElement(varPtr)  ((varPtr)->flags & VAR_ARRAY_ELEMENT)
#define TclIsVarTemporary(varPtr)  ((varPtr)->flags & VAR_TEMPORARY)
#define TclIsVarArgument(varPtr)  ((varPtr)->flags & VAR_ARGUMENT)
#define TclIsVarResolved(varPtr)  ((varPtr)->flags & VAR_RESOLVED)
#define MAX_MATH_ARGS  5
#define TCL_TSD_INIT(keyPtr)  (ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData))
#define TCL_OUT_LINE_COMPILE  (TCL_CONTINUE + 1)
#define CMD_IS_DELETED  0x1
#define CMD_TRACE_ACTIVE  0x2
#define CMD_HAS_EXEC_TRACES  0x4
#define TCL_BRACKET_TERM  1
#define TCL_ALLOW_EXCEPTIONS  4
#define DELETED  1
#define ERR_IN_PROGRESS  2
#define ERR_ALREADY_LOGGED  4
#define ERROR_CODE_SET  8
#define EXPR_INITIALIZED  0x10
#define DONT_COMPILE_CMDS_INLINE  0x20
#define RAND_SEED_INITIALIZED  0x40
#define SAFE_INTERP  0x80
#define USE_EVAL_DIRECT  0x100
#define INTERP_TRACE_IN_PROGRESS  0x200
#define MAX_NESTING_DEPTH  1000
#define UCHAR(c)  ((unsigned char) (c))
#define TCL_ALIGN(x)  (((int)(x) + 7) & ~7)
#define TCL_INVOKE_HIDDEN  (1<<0)
#define TCL_INVOKE_NO_UNKNOWN  (1<<1)
#define TCL_INVOKE_NO_TRACEBACK  (1<<2)
#define TCL_GLOBMODE_NO_COMPLAIN  1
#define TCL_GLOBMODE_JOIN  2
#define TCL_GLOBMODE_DIR  4
#define TCL_GLOBMODE_TAILS  8
#define TclIncrObjsAllocated()
#define TclIncrObjsFreed()
#define TclNewObj(objPtr)
#define TclDecrRefCount(objPtr)
#define TclAllocObjStorage(objPtr)
#define TclFreeObjStorage(objPtr)
#define TclInitStringRep(objPtr, bytePtr, len)
#define TclGetString(objPtr)  ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString((objPtr)))
#define TclGetWide(resultVar, objPtr)  (resultVar) = (objPtr)->internalRep.wideValue
#define TclGetLongFromWide(resultVar, objPtr)  (resultVar) = Tcl_WideAsLong((objPtr)->internalRep.wideValue)
#define TclUtfToUniChar(str, chPtr)
#define TclUniCharNcmp  Tcl_UniCharNcmp
#define TCL_STORAGE_CLASS  DLLIMPORT
Typedefs
typedef Tcl_ResolvedVarInfo * vinfoPtr
typedef CONST84 char * name
typedef CONST84 char int length
typedef CONST84 char int Tcl_Namespace * context
typedef CONST84 char int Tcl_Namespace Tcl_ResolvedVarInfo ** rPtr
typedef CONST84 char * name
typedef CONST84 char Tcl_Namespace * context
typedef CONST84 char Tcl_Namespace int flags
typedef CONST84 char Tcl_Namespace int Tcl_Var * rPtr
typedef CONST84 char * name
typedef CONST84 char Tcl_Namespace * context
typedef CONST84 char Tcl_Namespace int flags
typedef CONST84 char Tcl_Namespace int Tcl_Command * rPtr
typedef VOID ** TclHandle
typedef Tcl_Parse * parsePtr
typedef Tcl_Parse struct CompileEnv * compEnvPtr
typedef CompileEnv * compEnvPtr
typedef CompileEnv ClientData clientData
typedef int objIndex
typedef int Tcl_Obj * fileName
typedef int Tcl_Obj Tcl_Obj ** attrObjPtrPtr
typedef int objIndex
typedef int Tcl_Obj * fileName
typedef int Tcl_Obj Tcl_Obj * attrObjPtr
typedef TclFile_ * TclFile
typedef TclpTime_t_ * TclpTime_t
typedef stat * buf
typedef int mode
typedef CONST char * fileName
typedef CONST char CONST char * modeString
typedef CONST char CONST char int permissions
typedef Tcl_CmdProc * TclCmdProcType
typedef Tcl_ObjCmdProc * TclObjCmdProcType
Enumerations
enum TclPlatformType { TCL_PLATFORM_UNIX, TCL_PLATFORM_MAC, TCL_PLATFORM_WINDOWS }
enum TclEolTranslation { TCL_TRANSLATE_AUTO, TCL_TRANSLATE_CR, TCL_TRANSLATE_LF, TCL_TRANSLATE_CRLF }
Functions
typedef Tcl_Var (Tcl_ResolveRuntimeVarProc) _ANSI_ARGS_((Tcl_Interp *interp
typedef void (Tcl_ResolveVarDeleteProc) _ANSI_ARGS_((struct Tcl_ResolvedVarInfo *vinfoPtr))
typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((Tcl_Interp *interp
typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((Tcl_Interp *interp
typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((Tcl_Interp *interp
EXTERN VOID *TclThreadDataKeyGet _ANSI_ARGS_ ((Tcl_ThreadDataKey *keyPtr))
EXTERN void TclThreadDataKeySet _ANSI_ARGS_ ((Tcl_ThreadDataKey *keyPtr, VOID *data))
typedef int (CompileProc) _ANSI_ARGS_((Tcl_Interp *interp
typedef int (CompileHookProc) _ANSI_ARGS_((Tcl_Interp *interp
typedef int (TclGetFileAttrProc) _ANSI_ARGS_((Tcl_Interp *interp
typedef int (TclSetFileAttrProc) _ANSI_ARGS_((Tcl_Interp *interp
typedef int (TclStatProc_) _ANSI_ARGS_((CONST char *path
typedef int (TclAccessProc_) _ANSI_ARGS_((CONST char *path
typedef Tcl_Channel (TclOpenFileChannelProc_) _ANSI_ARGS_((Tcl_Interp *interp
EXTERN int TclArraySet _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj))
EXTERN int TclCheckBadOctal _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *value))
EXTERN void TclDeleteNamespaceVars _ANSI_ARGS_ ((Namespace *nsPtr))
EXTERN void TclExpandTokenArray _ANSI_ARGS_ ((Tcl_Parse *parsePtr))
EXTERN int TclFileAttrsCmd _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
EXTERN void TclFinalizeAllocSubsystem _ANSI_ARGS_ ((void))
EXTERN int TclGetEncodingFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr))
EXTERN int TclGlob _ANSI_ARGS_ ((Tcl_Interp *interp, char *pattern, Tcl_Obj *unquotedPrefix, int globFlags, Tcl_GlobTypeData *types))
EXTERN void TclInitSubsystems _ANSI_ARGS_ ((CONST char *argv0))
EXTERN int TclIsLocalScalar _ANSI_ARGS_ ((CONST char *src, int len))
EXTERN int TclJoinThread _ANSI_ARGS_ ((Tcl_ThreadId id, int *result))
EXTERN Tcl_Obj *TclLindexList _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *argPtr))
EXTERN Tcl_Obj *TclLindexFlat _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int indexCount, Tcl_Obj *CONST indexArray[]))
EXTERN Tcl_Obj *TclLsetList _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *indexPtr, Tcl_Obj *valuePtr))
EXTERN Tcl_Obj *TclLsetFlat _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int indexCount, Tcl_Obj *CONST indexArray[], Tcl_Obj *valuePtr))
EXTERN int TclParseBackslash _ANSI_ARGS_ ((CONST char *src, int numBytes, int *readPtr, char *dst))
EXTERN int TclParseHex _ANSI_ARGS_ ((CONST char *src, int numBytes, Tcl_UniChar *resultPtr))
EXTERN int TclParseInteger _ANSI_ARGS_ ((CONST char *string, int numBytes))
EXTERN int TclParseWhiteSpace _ANSI_ARGS_ ((CONST char *src, int numBytes, Tcl_Parse *parsePtr, char *typePtr))
EXTERN int TclpObjAccess _ANSI_ARGS_ ((Tcl_Obj *filename, int mode))
EXTERN int TclpObjLstat _ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_StatBuf *buf))
EXTERN Tcl_Obj *TclNewFSPathObj _ANSI_ARGS_ ((Tcl_Obj *dirPtr, CONST char *addStrRep, int len))
EXTERN int TclpDeleteFile _ANSI_ARGS_ ((CONST char *path))
EXTERN void TclpFinalizeCondition _ANSI_ARGS_ ((Tcl_Condition *condPtr))
EXTERN void TclpFinalizeMutex _ANSI_ARGS_ ((Tcl_Mutex *mutexPtr))
EXTERN int TclpFindVariable _ANSI_ARGS_ ((CONST char *name, int *lengthPtr))
EXTERN int TclpLoadFile _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *sym1, CONST char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr, Tcl_FSUnloadFileProc **unloadProcPtr))
EXTERN int TclpMatchFiles _ANSI_ARGS_ ((Tcl_Interp *interp, char *separators, Tcl_DString *dirPtr, char *pattern, char *tail))
EXTERN int TclpObjNormalizePath _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint))
EXTERN int TclpObjCreateDirectory _ANSI_ARGS_ ((Tcl_Obj *pathPtr))
EXTERN void TclpNativeJoinPath _ANSI_ARGS_ ((Tcl_Obj *prefix, char *joining))
EXTERN Tcl_Obj *TclpNativeSplitPath _ANSI_ARGS_ ((Tcl_Obj *pathPtr, int *lenPtr))
EXTERN Tcl_PathType TclpGetNativePathType _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr, int *driveNameLengthPtr, Tcl_Obj **driveNameRef))
EXTERN int TclCrossFilesystemCopy _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *source, Tcl_Obj *target))
EXTERN int TclpObjCopyDirectory _ANSI_ARGS_ ((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr))
EXTERN int TclpObjCopyFile _ANSI_ARGS_ ((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr))
EXTERN int TclpObjRemoveDirectory _ANSI_ARGS_ ((Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr))
EXTERN int TclpMatchInDirectory _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types))
EXTERN Tcl_Obj *TclpObjGetCwd _ANSI_ARGS_ ((Tcl_Interp *interp))
EXTERN Tcl_Obj *TclpObjLink _ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkType))
EXTERN Tcl_Obj *TclFileDirname _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr))
EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions))
EXTERN void TclpPanic _ANSI_ARGS_ (TCL_VARARGS(CONST char *, format))
EXTERN char *TclpReadlink _ANSI_ARGS_ ((CONST char *fileName, Tcl_DString *linkPtr))
EXTERN void TclpReleaseFile _ANSI_ARGS_ ((TclFile file))
EXTERN void TclpUnloadFile _ANSI_ARGS_ ((Tcl_LoadHandle loadHandle))
EXTERN int TclpThreadCreate _ANSI_ARGS_ ((Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags))
EXTERN void TclpThreadExit _ANSI_ARGS_ ((int status))
EXTERN void TclRememberCondition _ANSI_ARGS_ ((Tcl_Condition *mutex))
EXTERN void TclRememberDataKey _ANSI_ARGS_ ((Tcl_ThreadDataKey *mutex))
EXTERN VOID TclRememberJoinableThread _ANSI_ARGS_ ((Tcl_ThreadId id))
EXTERN void TclRememberMutex _ANSI_ARGS_ ((Tcl_Mutex *mutex))
EXTERN VOID TclSignalExitThread _ANSI_ARGS_ ((Tcl_ThreadId id, int result))
EXTERN void TclTransferResult _ANSI_ARGS_ ((Tcl_Interp *sourceInterp, int result, Tcl_Interp *targetInterp))
EXTERN Tcl_Obj *TclpNativeToNormalized _ANSI_ARGS_ ((ClientData clientData))
EXTERN Tcl_Obj *TclpFilesystemPathType _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr))
EXTERN Tcl_PackageInitProc *TclpFindSymbol _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_LoadHandle loadHandle, CONST char *symbol))
EXTERN int TclpDlopen _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr))
EXTERN int TclpUtime _ANSI_ARGS_ ((Tcl_Obj *pathPtr, struct utimbuf *tval))
EXTERN int Tcl_AfterObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
EXTERN int Tcl_FcopyObjCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
EXTERN int Tcl_InterpObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]))
EXTERN int TclCompileAppendCmd _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Parse *parsePtr, struct CompileEnv *envPtr))
EXTERN Var *TclLookupArrayElement _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *arrayName, CONST char *elName, CONST int flags, CONST char *msg, CONST int createPart1, CONST int createPart2, Var *arrayPtr))
EXTERN Var *TclObjLookupVar _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *part1Ptr, CONST char *part2, int flags, CONST char *msg, CONST int createPart1, CONST int createPart2, Var **arrayPtrPtr))
EXTERN Tcl_Obj *TclPtrGetVar _ANSI_ARGS_ ((Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, CONST char *part1, CONST char *part2, CONST int flags))
EXTERN Tcl_Obj *TclPtrSetVar _ANSI_ARGS_ ((Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, CONST char *part1, CONST char *part2, Tcl_Obj *newValuePtr, CONST int flags))
EXTERN Tcl_Obj *TclPtrIncrVar _ANSI_ARGS_ ((Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, CONST char *part1, CONST char *part2, CONST long i, CONST int flags))
Variables
Tcl_Time tclBlockTime
int tclBlockTimeSet
char * tclExecutableName
char * tclNativeExecutableName
char * tclDefaultEncodingDir
Tcl_ChannelType tclFileChannelType
char * tclMemDumpFileName
TclPlatformType tclPlatform
Tcl_NotifierProcs tclOriginalNotifier
Tcl_ObjType tclBooleanType
Tcl_ObjType tclByteArrayType
Tcl_ObjType tclByteCodeType
Tcl_ObjType tclDoubleType
Tcl_ObjType tclEndOffsetType
Tcl_ObjType tclIntType
Tcl_ObjType tclListType
Tcl_ObjType tclProcBodyType
Tcl_ObjType tclStringType
Tcl_ObjType tclArraySearchType
Tcl_ObjType tclIndexType
Tcl_ObjType tclNsNameType
Tcl_ObjType tclWideIntType
Tcl_HashKeyType tclArrayHashKeyType
Tcl_HashKeyType tclOneWordHashKeyType
Tcl_HashKeyType tclStringHashKeyType
Tcl_HashKeyType tclObjHashKeyType
Tcl_Obj * tclFreeObjList
char * tclEmptyStringRep
char tclEmptyString
EXTERN Tcl_FSDupInternalRepProc TclNativeDupInternalRep

Define Documentation
#define CMD_HAS_EXEC_TRACES  0x4

Definition at line 1130 of file tclInt.h.
Referenced by Tcl_TraceCommand(), Tcl_UntraceCommand(), TclCompileScript(), TclEvalObjvInternal(), and TclExecuteByteCode().#define CMD_IS_DELETED  0x1

Definition at line 1128 of file tclInt.h.
Referenced by Tcl_DeleteCommandFromToken(), and TclEvalObjvInternal().#define CMD_TRACE_ACTIVE  0x2

Definition at line 1129 of file tclInt.h.
Referenced by CallCommandTraces().#define CREATE_NS_IF_UNKNOWN  0x800

Definition at line 290 of file tclInt.h.
Referenced by Tcl_CreateCommand(), Tcl_CreateNamespace(), Tcl_CreateObjCommand(), TclGetNamespaceForQualName(), and TclRenameCommand().#define DELETED  1

Definition at line 1438 of file tclInt.h.
Referenced by DeleteInterpProc(), Tcl_CreateCommand(), Tcl_CreateObjCommand(), Tcl_DeleteInterp(), Tcl_DeleteNamespace(), Tcl_ExposeCommand(), Tcl_HideCommand(), Tcl_InterpDeleted(), and TclInterpReady().#define DONT_COMPILE_CMDS_INLINE  0x20

Definition at line 1443 of file tclInt.h.
Referenced by Tcl_CreateObjTrace(), Tcl_DeleteTrace(), and TclCompileScript().#define ERR_ALREADY_LOGGED  4

Definition at line 1440 of file tclInt.h.
Referenced by CallVarTraces(), LogCompilationInfo(), Tcl_ErrorObjCmd(), Tcl_EvalEx(), Tcl_EvalObjEx(), Tcl_LogCommandInfo(), Tcl_ResetResult(), TclCompEvalObj(), TclEvalObjvInternal(), TclExecuteByteCode(), TclObjInvoke(), and TclTransferResult().#define ERR_IN_PROGRESS  2

Definition at line 1439 of file tclInt.h.
Referenced by CallVarTraces(), Tcl_AddObjErrorInfo(), Tcl_LogCommandInfo(), Tcl_ResetResult(), TclEvalObjvInternal(), TclObjInvoke(), TclTransferResult(), and TclUpdateReturnInfo().#define ERROR_CODE_SET  8

Definition at line 1441 of file tclInt.h.
Referenced by CallVarTraces(), Tcl_AddObjErrorInfo(), Tcl_ErrorObjCmd(), Tcl_ResetResult(), Tcl_SetErrorCodeVA(), Tcl_SetObjErrorCode(), TclEvalObjvInternal(), and TclUpdateReturnInfo().#define EXPR_INITIALIZED  0x10

Definition at line 1442 of file tclInt.h.#define INTERP_TRACE_IN_PROGRESS  0x200

Definition at line 1447 of file tclInt.h.
Referenced by TclCheckInterpTraces(), and TraceExecutionProc().#define MAX_MATH_ARGS  5

Definition at line 829 of file tclInt.h.
Referenced by ExprCallMathFunc(), and Tcl_CreateMathFunc().#define MAX_NESTING_DEPTH  1000

Definition at line 1454 of file tclInt.h.
Referenced by Tcl_CreateInterp().#define MODULE_SCOPE  extern

Definition at line 89 of file tclInt.h.#define NS_DEAD  0x02

Definition at line 278 of file tclInt.h.
Referenced by FreeNsNameInternalRep(), GetNamespaceFromObj(), Tcl_DeleteNamespace(), Tcl_PushCallFrame(), and UpdateStringOfNsName().#define NS_DYING  0x01

Definition at line 277 of file tclInt.h.
Referenced by Tcl_DeleteNamespace(), and Tcl_PopCallFrame().#define NS_KILLED  0x04

Definition at line 279 of file tclInt.h.
Referenced by Tcl_DeleteNamespace().#define RAND_SEED_INITIALIZED  0x40

Definition at line 1444 of file tclInt.h.
Referenced by ExprRandFunc(), and ExprSrandFunc().#define SAFE_INTERP  0x80

Definition at line 1445 of file tclInt.h.
Referenced by SlaveMarkTrusted(), Tcl_IsSafe(), and Tcl_MakeSafe().#define TCL_ALIGN(x)  (((int)(x) + 7) & ~7)

Definition at line 1476 of file tclInt.h.
Referenced by TclInitByteCodeObj().#define TCL_ALLOW_EXCEPTIONS  4

Definition at line 1397 of file tclInt.h.
Referenced by Tcl_AllowExceptions(), Tcl_EvalEx(), Tcl_EvalObjEx(), and Tcl_EvalObjv().#define TCL_BRACKET_TERM  1

Definition at line 1396 of file tclInt.h.
Referenced by Tcl_EvalEx(), Tcl_SubstObj(), and TclSetByteCodeFromAny().#define TCL_GLOBMODE_DIR  4

Definition at line 1576 of file tclInt.h.
Referenced by Tcl_GlobObjCmd(), and TclGlob().#define TCL_GLOBMODE_JOIN  2

Definition at line 1575 of file tclInt.h.#define TCL_GLOBMODE_NO_COMPLAIN  1

Definition at line 1574 of file tclInt.h.
Referenced by Tcl_GlobObjCmd(), and TclGlob().#define TCL_GLOBMODE_TAILS  8

Definition at line 1577 of file tclInt.h.
Referenced by Tcl_GetEncodingNames(), Tcl_GlobObjCmd(), and TclGlob().#define TCL_INVOKE_HIDDEN  (1<<0)

Definition at line 1518 of file tclInt.h.
Referenced by HandleBgErrors(), SlaveInvokeHidden(), and TclObjInvoke().#define TCL_INVOKE_NO_TRACEBACK  (1<<2)

Definition at line 1520 of file tclInt.h.
Referenced by TclObjInvoke().#define TCL_INVOKE_NO_UNKNOWN  (1<<1)

Definition at line 1519 of file tclInt.h.
Referenced by TclObjInvoke().#define TCL_OUT_LINE_COMPILE  (TCL_CONTINUE + 1)

Definition at line 896 of file tclInt.h.
Referenced by TclCompileAppendCmd(), TclCompileCatchCmd(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileIfCmd(), TclCompileLappendCmd(), TclCompileLindexCmd(), TclCompileListCmd(), TclCompileLsetCmd(), TclCompileRegexpCmd(), TclCompileReturnCmd(), TclCompileScript(), TclCompileStringCmd(), TclCompileVariableCmd(), and TclCompileWhileCmd().#define TCL_STORAGE_CLASS  DLLIMPORT

Definition at line 2359 of file tclInt.h.#define TCL_STORAGE_CLASS  DLLIMPORT

Definition at line 2359 of file tclInt.h.#define TCL_TSD_INIT(keyPtr)  (ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData))

Definition at line 860 of file tclInt.h.
Referenced by CheckForStdChannelsBeingClosed(), CleanUpExitProc(), ClearZombieSockets(), CloseChannel(), CompileRegexp(), ComputeGMT(), ConsoleCheckProc(), ConsoleCloseProc(), ConsoleEventProc(), ConsoleInit(), ConsoleSetupProc(), ConsoleWatchProc(), DdeServerProc(), DdeSetServerName(), DeleteProc(), FileCheckProc(), FileCloseProc(), FileEventProc(), FileHandlerEventProc(), FileInit(), FileNameCleanup(), FileNameInit(), FileSetupProc(), FileThreadActionProc(), FinalizeRegexp(), FreeSocketInfo(), FsGetFirstFilesystem(), FsUpdateCwd(), Initialize(), InitSockets(), InitTimer(), NewSocketInfo(), NotifierProc(), PipeCheckProc(), PipeClose2Proc(), PipeEventProc(), PipeInit(), PipeSetupProc(), PipeWatchProc(), SerialCheckProc(), SerialCloseProc(), SerialEventProc(), SerialExitHandler(), SerialInit(), SerialSetupProc(), SerialWatchProc(), SetFsPathFromAny(), SocketCheckProc(), SocketEventProc(), SocketSetupProc(), SplitMacPath(), StdIOClose(), Tcl_AsyncCreate(), Tcl_AsyncDelete(), Tcl_AsyncInvoke(), Tcl_AsyncReady(), Tcl_ClearChannelHandlers(), Tcl_CreateChannel(), Tcl_CreateEventSource(), Tcl_CreateFileHandler(), Tcl_CreateThreadExitHandler(), Tcl_CutChannel(), Tcl_DdeObjCmd(), TCL_DECLARE_MUTEX(), Tcl_DeleteChannelHandler(), Tcl_DeleteEvents(), Tcl_DeleteEventSource(), Tcl_DeleteFileHandler(), Tcl_DeleteThreadExitHandler(), Tcl_DoOneEvent(), Tcl_Finalize(), Tcl_FinalizeNotifier(), Tcl_FSConvertToPathType(), Tcl_FSGetCwd(), Tcl_FSNewNativePath(), Tcl_GetChannelNamesEx(), Tcl_GetServiceMode(), Tcl_GetStdChannel(), Tcl_InitNotifier(), Tcl_IsChannelExisting(), Tcl_IsStandardChannel(), Tcl_MakeFileChannel(), Tcl_NotifyChannel(), Tcl_QueueEvent(), Tcl_ServiceAll(), Tcl_ServiceEvent(), Tcl_ServiceModeHook(), Tcl_SetMaxBlockTime(), Tcl_SetServiceMode(), Tcl_SetStdChannel(), Tcl_SetTimer(), Tcl_SpliceChannel(), Tcl_StackChannel(), Tcl_WaitForEvent(), TclFinalizeAsync(), TclFinalizeIOSubsystem(), TclFinalizeNotifier(), TclFSCwdPointerEquals(), TclFSEnsureEpochOk(), TclFSMakePathFromNormalized(), TclFSMakePathRelative(), TclFSSetPathDetails(), TclGetLibraryPath(), TclInitIOSubsystem(), TclInitSubsystems(), TclNewFSPathObj(), TclpGetGrGid(), TclpGetGrNam(), TclpGetHostByAddr(), TclpGetHostByName(), TclpGetNativePathType(), TclpGetPwNam(), TclpGetPwUid(), TclpGetTZName(), TclpGmtime(), TclpInetNtoa(), TclpLocaltime(), TclpOpenFileChannel(), TclSetLibraryPath(), TcpCloseProc(), and TcpThreadActionProc().#define TclAllocObjStorage(objPtr)
Value:Tcl_MutexLock(&tclObjMutex); \
       if (tclFreeObjList == NULL) { \
     TclAllocateFreeObjects(); \
       } \
       (objPtr) = tclFreeObjList; \
       tclFreeObjList = (Tcl_Obj *) \
     tclFreeObjList->internalRep.otherValuePtr; \
       Tcl_MutexUnlock(&tclObjMutex)
Definition at line 2240 of file tclInt.h.#define TclClearVarUndefined(varPtr)  (varPtr)->flags &= ~VAR_UNDEFINED

Definition at line 563 of file tclInt.h.
Referenced by ObjMakeUpvar(), TclArraySet(), TclExecuteByteCode(), TclLookupArrayElement(), TclObjInterpProc(), and TclPtrSetVar().#define TclDecrRefCount(objPtr)
Value:if (--(objPtr)->refCount <= 0) { \
  if (((objPtr)->typePtr != NULL) \
    && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
      (objPtr)->typePtr->freeIntRepProc(objPtr); \
  } \
  if (((objPtr)->bytes != NULL) \
    && ((objPtr)->bytes != tclEmptyStringRep)) { \
      ckfree((char *) (objPtr)->bytes); \
  } \
        TclFreeObjStorage(objPtr); \
  TclIncrObjsFreed(); \
    }
Definition at line 2163 of file tclInt.h.
Referenced by CallCommandTraces(), DeleteArray(), ExprAbsFunc(), ExprBinaryFunc(), ExprDoubleFunc(), ExprIntFunc(), ExprRoundFunc(), ExprSrandFunc(), ExprUnaryFunc(), ExprWideFunc(), FreeParsedVarName(), ResetObjResult(), Tcl_DiscardResult(), Tcl_EvalObjEx(), Tcl_FSJoinPath(), Tcl_ListObjReplace(), Tcl_SetObjResult(), Tcl_UnsetVar2(), Tcl_UpVar2(), TclDeleteExecEnv(), TclDeleteVars(), TclExecuteByteCode(), TclProcInterpProc(), TclPtrSetVar(), TclReleaseLiteral(), TclRenameCommand(), and UnsetVarStruct().#define TclFreeObjStorage(objPtr)
Value:Tcl_MutexLock(&tclObjMutex); \
       (objPtr)->internalRep.otherValuePtr = (VOID *) tclFreeObjList; \
       tclFreeObjList = (objPtr); \
       Tcl_MutexUnlock(&tclObjMutex)
Definition at line 2250 of file tclInt.h.#define TclGetLongFromWide(resultVar, objPtr)  (resultVar) = Tcl_WideAsLong((objPtr)->internalRep.wideValue)

Definition at line 2316 of file tclInt.h.
Referenced by ExprIntFunc(), Tcl_IncrObjCmd(), and TclExecuteByteCode().#define TclGetString(objPtr)  ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString((objPtr)))

Definition at line 2297 of file tclInt.h.
Referenced by CallCommandTraces(), CompareObjKeys(), ComparePkgVersions(), ExprCallMathFunc(), GetTimesCmd(), HashObjKey(), Tcl_AppendElement(), Tcl_AppendObjCmd(), Tcl_AppendResultVA(), Tcl_ArrayObjCmd(), Tcl_DStringGetResult(), Tcl_Eval(), Tcl_ExprBoolean(), Tcl_ExprDouble(), Tcl_ExprLong(), Tcl_ExprString(), Tcl_GetIndexFromObjStruct(), Tcl_GetStringResult(), Tcl_GetVar2(), Tcl_GlobalObjCmd(), Tcl_LappendObjCmd(), Tcl_ObjSetVar2(), Tcl_ParseVar(), Tcl_ProcObjCmd(), Tcl_RecordAndEval(), Tcl_SetVar2(), Tcl_UnsetObjCmd(), Tcl_UplevelObjCmd(), Tcl_UpvarObjCmd(), Tcl_VariableObjCmd(), TclArraySet(), TclExecuteByteCode(), TclIncrVar2(), TclInvoke(), TclInvokeObjectCommand(), TclObjLookupVar(), TclObjUnsetVar2(), and TclProcInterpProc().#define TclGetWide(resultVar, objPtr)  (resultVar) = (objPtr)->internalRep.wideValue

Definition at line 2314 of file tclInt.h.
Referenced by ExprAbsFunc(), ExprWideFunc(), TclExecuteByteCode(), and TclPtrIncrVar().#define TclIncrObjsAllocated()

Definition at line 2151 of file tclInt.h.#define TclIncrObjsFreed()

Definition at line 2152 of file tclInt.h.#define TclInitStringRep(objPtr, bytePtr, len)
Value:if ((len) == 0) { \
  (objPtr)->bytes  = tclEmptyStringRep; \
  (objPtr)->length = 0; \
    } else { \
  (objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
  memcpy((VOID *) (objPtr)->bytes, (VOID *) (bytePtr), \
    (unsigned) (len)); \
  (objPtr)->bytes[len] = '\0'; \
  (objPtr)->length = (len); \
    }
Definition at line 2272 of file tclInt.h.
Referenced by Tcl_DuplicateObj(), Tcl_ExprString(), Tcl_GetObjResult(), Tcl_NewStringObj(), Tcl_SetStringObj(), TclInvokeObjectCommand(), and TclRegisterLiteral().#define TclIsVarArgument(varPtr)  ((varPtr)->flags & VAR_ARGUMENT)

Definition at line 598 of file tclInt.h.
Referenced by InfoArgsCmd(), InfoDefaultCmd(), and TclObjInterpProc().#define TclIsVarArray(varPtr)  ((varPtr)->flags & VAR_ARRAY)

Definition at line 586 of file tclInt.h.
Referenced by Tcl_ArrayObjCmd(), TclArraySet(), TclDeleteVars(), TclLookupArrayElement(), TclPtrGetVar(), TclPtrSetVar(), and UnsetVarStruct().#define TclIsVarArrayElement(varPtr)  ((varPtr)->flags & VAR_ARRAY_ELEMENT)

Definition at line 592 of file tclInt.h.
Referenced by Tcl_GetVariableFullName(), TclArraySet(), TclLookupArrayElement(), and TclPtrSetVar().#define TclIsVarLink(varPtr)  ((varPtr)->flags & VAR_LINK)

Definition at line 583 of file tclInt.h.
Referenced by AppendLocals(), FreeNsVarName(), ObjMakeUpvar(), TclDeleteCompiledLocalVars(), TclDeleteVars(), TclExecuteByteCode(), TclLookupVar(), TclObjLookupVar(), and UnsetVarStruct().#define TclIsVarResolved(varPtr)  ((varPtr)->flags & VAR_RESOLVED)

Definition at line 601 of file tclInt.h.#define TclIsVarScalar(varPtr)  ((varPtr)->flags & VAR_SCALAR)

Definition at line 580 of file tclInt.h.
Referenced by DeleteArray(), TclDeleteVars(), TclExecuteByteCode(), TclPtrGetVar(), TclPtrSetVar(), and UnsetVarStruct().#define TclIsVarTemporary(varPtr)  ((varPtr)->flags & VAR_TEMPORARY)

Definition at line 595 of file tclInt.h.
Referenced by AppendLocals(), TclFindCompiledLocal(), TclLookupSimpleVar(), TclObjInterpProc(), and TclPrintInstruction().#define TclIsVarUndefined(varPtr)  ((varPtr)->flags & VAR_UNDEFINED)

Definition at line 589 of file tclInt.h.
Referenced by AppendLocals(), CleanupVar(), FreeNsVarName(), InfoExistsCmd(), InfoGlobalsCmd(), InfoVarsCmd(), ObjMakeUpvar(), Tcl_ArrayObjCmd(), Tcl_UntraceVar2(), TclArraySet(), TclDeleteCompiledLocalVars(), TclDeleteVars(), TclExecuteByteCode(), TclLookupArrayElement(), TclObjUnsetVar2(), TclPtrGetVar(), TclPtrSetVar(), TclVarTraceExists(), and UnsetVarStruct().#define TclNewObj(objPtr)
Value:TclAllocObjStorage(objPtr); \
    TclIncrObjsAllocated(); \
    (objPtr)->refCount = 0; \
    (objPtr)->bytes    = tclEmptyStringRep; \
    (objPtr)->length   = 0; \
    (objPtr)->typePtr  = NULL
Definition at line 2155 of file tclInt.h.
Referenced by CallCommandTraces(), ResetObjResult(), SetListFromAny(), Tcl_DuplicateObj(), Tcl_ExprString(), Tcl_NewBooleanObj(), Tcl_NewByteArrayObj(), Tcl_NewDoubleObj(), Tcl_NewIntObj(), Tcl_NewListObj(), Tcl_NewLongObj(), Tcl_NewObj(), Tcl_NewStringObj(), Tcl_NewUnicodeObj(), Tcl_NewWideIntObj(), Tcl_WrongNumArgs(), TclExecuteByteCode(), TclInvokeObjectCommand(), TclPtrSetVar(), and TclRegisterLiteral().#define TclSetVarArray(varPtr)  (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_LINK)) | VAR_ARRAY

Definition at line 551 of file tclInt.h.
Referenced by TclArraySet(), and TclLookupArrayElement().#define TclSetVarArrayElement(varPtr)  (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT

Definition at line 557 of file tclInt.h.
Referenced by TclLookupArrayElement().#define TclSetVarLink(varPtr)  (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_ARRAY)) | VAR_LINK

Definition at line 554 of file tclInt.h.
Referenced by ObjMakeUpvar(), and TclInitCompiledLocals().#define TclSetVarScalar(varPtr)  (varPtr)->flags = ((varPtr)->flags & ~(VAR_ARRAY|VAR_LINK)) | VAR_SCALAR

Definition at line 548 of file tclInt.h.
Referenced by DeleteArray(), TclDeleteNamespaceVars(), TclDeleteVars(), TclExecuteByteCode(), TclPtrSetVar(), and UnsetVarStruct().#define TclSetVarUndefined(varPtr)  (varPtr)->flags |= VAR_UNDEFINED

Definition at line 560 of file tclInt.h.
Referenced by DeleteArray(), TclDeleteNamespaceVars(), TclDeleteVars(), TclPtrSetVar(), and UnsetVarStruct().#define TclUniCharNcmp  Tcl_UniCharNcmp

Definition at line 2353 of file tclInt.h.
Referenced by Tcl_StringObjCmd(), and TclExecuteByteCode().#define TclUtfToUniChar(str, chPtr)
Value:((((unsigned char) *(str)) < 0xC0) ? \
      ((*(chPtr) = (Tcl_UniChar) *(str)), 1) \
      : Tcl_UtfToUniChar(str, chPtr))
Definition at line 2334 of file tclInt.h.
Referenced by EscapeFromUtfProc(), FillUnicodeRep(), TableFromUtfProc(), Tcl_Backslash(), Tcl_NumUtfChars(), Tcl_SplitObjCmd(), Tcl_StringCaseMatch(), Tcl_StringObjCmd(), Tcl_UniCharAtIndex(), Tcl_UtfAtIndex(), Tcl_UtfFindFirst(), Tcl_UtfFindLast(), Tcl_UtfNcasecmp(), Tcl_UtfNcmp(), Tcl_UtfNext(), Tcl_UtfToLower(), Tcl_UtfToTitle(), Tcl_UtfToUniCharDString(), Tcl_UtfToUpper(), and UtfToUnicodeProc().#define UCHAR(c)  ((unsigned char) (c))

Definition at line 1462 of file tclInt.h.
Referenced by CheckVersion(), ConvertFileNameFormat(), DictionaryCompare(), GetFormatSpec(), GetLexeme(), IllegalExprOperandType(), LoadEscapeEncoding(), SetBooleanFromAny(), SetDoubleFromAny(), SetIntOrWideFromAny(), SetListFromAny(), SetWideIntFromAny(), SplitUnixPath(), SplitWinPath(), strtod(), strtol(), strtoll(), strtoul(), strtoull(), Tcl_AfterObjCmd(), Tcl_BinaryObjCmd(), Tcl_Concat(), Tcl_FormatObjCmd(), Tcl_GetDouble(), Tcl_GetInt(), Tcl_NumUtfChars(), Tcl_ParseBraces(), Tcl_ParseVarName(), Tcl_PrintDouble(), Tcl_ProcObjCmd(), Tcl_ReadObjCmd(), Tcl_ScanObjCmd(), Tcl_SplitList(), Tcl_StringCaseMatch(), Tcl_UniCharIsSpace(), TclCheckBadOctal(), TclDatelex(), TclFindElement(), TclGetFrame(), TclGetLong(), TclGetOpenMode(), TclLooksLikeInt(), TclParseBackslash(), TclParseHex(), TclParseInteger(), TclpFindExecutable(), TclpGetNativePathType(), TclpNativeJoinPath(), TclpSetVariables(), TclpUtfNcmp2(), TestplatformChmod(), UtfToUtfProc(), and ValidateFormat().#define USE_EVAL_DIRECT  0x100

Definition at line 1446 of file tclInt.h.
Referenced by Tcl_EvalObjEx(), and TestevalexObjCmd().#define VAR_ARGUMENT  0x100

Definition at line 532 of file tclInt.h.
Referenced by TclCreateProc(), and TclInitCompiledLocals().#define VAR_ARRAY  0x2

Definition at line 524 of file tclInt.h.#define VAR_ARRAY_ELEMENT  0x40

Definition at line 529 of file tclInt.h.#define VAR_IN_HASHTABLE  0x10

Definition at line 527 of file tclInt.h.
Referenced by CleanupVar(), NewVar(), TclDeleteCompiledLocalVars(), TclDeleteVars(), TclExecuteByteCode(), TclLookupArrayElement(), TclPtrSetVar(), and UnsetVarStruct().#define VAR_LINK  0x4

Definition at line 525 of file tclInt.h.#define VAR_NAMESPACE_VAR  0x80

Definition at line 530 of file tclInt.h.
Referenced by DeleteArray(), InfoVarsCmd(), Tcl_VariableObjCmd(), TclDeleteVars(), and UnsetVarStruct().#define VAR_RESOLVED  0x400

Definition at line 534 of file tclInt.h.
Referenced by TclInitCompiledLocals().#define VAR_SCALAR  0x1

Definition at line 523 of file tclInt.h.
Referenced by NewVar(), TclCompileCatchCmd(), TclCompileForeachCmd(), and TclCreateProc().#define VAR_TEMPORARY  0x200

Definition at line 533 of file tclInt.h.
Referenced by TclFindCompiledLocal(), and TclInitCompiledLocals().#define VAR_TRACE_ACTIVE  0x20

Definition at line 528 of file tclInt.h.
Referenced by CallVarTraces(), DeleteArray(), and UnsetVarStruct().#define VAR_UNDEFINED  0x8

Definition at line 526 of file tclInt.h.
Referenced by NewVar(), TclCreateProc(), TclFindCompiledLocal(), and TclObjLookupVar().
Typedef Documentation
typedef int Tcl_Obj Tcl_Obj* attrObjPtr

Definition at line 1549 of file tclInt.h.typedef int Tcl_Obj Tcl_Obj** attrObjPtrPtr

Definition at line 1547 of file tclInt.h.typedef struct stat* buf

Definition at line 1585 of file tclInt.h.typedef struct CompileEnv ClientData clientData

Definition at line 907 of file tclInt.h.typedef struct CompileEnv* compEnvPtr

Definition at line 907 of file tclInt.h.typedef Tcl_Parse struct CompileEnv* compEnvPtr

Definition at line 899 of file tclInt.h.typedef CONST84 char Tcl_Namespace* context

Definition at line 141 of file tclInt.h.typedef CONST84 char Tcl_Namespace* context

Definition at line 137 of file tclInt.h.typedef CONST84 char int Tcl_Namespace* context

Definition at line 133 of file tclInt.h.typedef CONST char* fileName

Definition at line 1588 of file tclInt.h.typedef int Tcl_Obj* fileName

Definition at line 1549 of file tclInt.h.typedef int Tcl_Obj* fileName

Definition at line 1547 of file tclInt.h.typedef CONST84 char Tcl_Namespace int flags

Definition at line 141 of file tclInt.h.typedef CONST84 char Tcl_Namespace int flags

Definition at line 137 of file tclInt.h.typedef CONST84 char int length

Definition at line 133 of file tclInt.h.typedef int mode

Definition at line 1586 of file tclInt.h.typedef CONST char CONST char* modeString

Definition at line 1588 of file tclInt.h.typedef CONST84 char* name

Definition at line 141 of file tclInt.h.typedef CONST84 char* name

Definition at line 137 of file tclInt.h.typedef CONST84 char* name

Definition at line 133 of file tclInt.h.typedef int objIndex

Definition at line 1549 of file tclInt.h.typedef int objIndex

Definition at line 1547 of file tclInt.h.typedef Tcl_Parse* parsePtr

Definition at line 899 of file tclInt.h.typedef CONST char CONST char int permissions

Definition at line 1588 of file tclInt.h.typedef CONST84 char Tcl_Namespace int Tcl_Command* rPtr

Definition at line 141 of file tclInt.h.typedef CONST84 char Tcl_Namespace int Tcl_Var* rPtr

Definition at line 137 of file tclInt.h.typedef CONST84 char int Tcl_Namespace Tcl_ResolvedVarInfo** rPtr

Definition at line 133 of file tclInt.h.typedef Tcl_CmdProc* TclCmdProcType

Definition at line 1598 of file tclInt.h.typedef struct TclFile_* TclFile

Definition at line 1561 of file tclInt.h.typedef VOID** TclHandle

Definition at line 815 of file tclInt.h.typedef Tcl_ObjCmdProc* TclObjCmdProcType

Definition at line 1599 of file tclInt.h.typedef struct TclpTime_t_* TclpTime_t

Definition at line 1567 of file tclInt.h.typedef struct Tcl_ResolvedVarInfo* vinfoPtr

Definition at line 113 of file tclInt.h.
Enumeration Type Documentation
enum TclEolTranslation

Enumerator: 
TCL_TRANSLATE_AUTO  
TCL_TRANSLATE_CR  
TCL_TRANSLATE_LF  
TCL_TRANSLATE_CRLF  

Definition at line 1495 of file tclInt.h.1495                                {
1496     TCL_TRANSLATE_AUTO,                 /* Eol == \r, \n and \r\n. */
1497     TCL_TRANSLATE_CR,                   /* Eol == \r. */
1498     TCL_TRANSLATE_LF,                   /* Eol == \n. */
1499     TCL_TRANSLATE_CRLF                  /* Eol == \r\n. */
1500 } TclEolTranslation;
enum TclPlatformType

Enumerator: 
TCL_PLATFORM_UNIX  
TCL_PLATFORM_MAC  
TCL_PLATFORM_WINDOWS  

Definition at line 1483 of file tclInt.h.1483              {
1484     TCL_PLATFORM_UNIX,    /* Any Unix-like OS. */
1485     TCL_PLATFORM_MAC,   /* MacOS. */
1486     TCL_PLATFORM_WINDOWS  /* Any Microsoft Windows OS. */
1487 } TclPlatformType;

Function Documentation
EXTERN Tcl_Obj* TclPtrIncrVar _ANSI_ARGS_ ((Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, CONST char *part1, CONST char *part2, CONST long i, CONST int flags))
EXTERN Tcl_Obj* TclPtrSetVar _ANSI_ARGS_ ((Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, CONST char *part1, CONST char *part2, Tcl_Obj *newValuePtr, CONST int flags))
EXTERN Tcl_Obj* TclPtrGetVar _ANSI_ARGS_ ((Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, CONST char *part1, CONST char *part2, CONST int flags))
EXTERN Var* TclObjLookupVar _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *part1Ptr, CONST char *part2, int flags, CONST char *msg, CONST int createPart1, CONST int createPart2, Var **arrayPtrPtr))
EXTERN Var* TclLookupArrayElement _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *arrayName, CONST char *elName, CONST int flags, CONST char *msg, CONST int createPart1, CONST int createPart2, Var *arrayPtr))
EXTERN int TclCompileAppendCmd _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Parse *parsePtr, struct CompileEnv *envPtr))
EXTERN int Tcl_InterpObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]))
EXTERN int Tcl_FcopyObjCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
EXTERN int Tcl_AfterObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
EXTERN int TclpUtime _ANSI_ARGS_ ((Tcl_Obj *pathPtr, struct utimbuf *tval))
EXTERN int TclpDlopen _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr))
EXTERN Tcl_PackageInitProc* TclpFindSymbol _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_LoadHandle loadHandle, CONST char *symbol))
EXTERN Tcl_Obj* TclpFilesystemPathType _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr))
EXTERN Tcl_Obj* TclpNativeToNormalized _ANSI_ARGS_ ((ClientData clientData))
EXTERN void TclTransferResult _ANSI_ARGS_ ((Tcl_Interp *sourceInterp, int result, Tcl_Interp *targetInterp))
EXTERN VOID TclSignalExitThread _ANSI_ARGS_ ((Tcl_ThreadId id, int result))
EXTERN void TclRememberMutex _ANSI_ARGS_ ((Tcl_Mutex *mutex))
EXTERN VOID TclRememberJoinableThread _ANSI_ARGS_ ((Tcl_ThreadId id))
EXTERN void TclRememberDataKey _ANSI_ARGS_ ((Tcl_ThreadDataKey *mutex))
EXTERN void TclRememberCondition _ANSI_ARGS_ ((Tcl_Condition *mutex))
EXTERN void TclpThreadExit _ANSI_ARGS_ ((int status))
EXTERN int TclpThreadCreate _ANSI_ARGS_ ((Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags))
EXTERN void TclpUnloadFile _ANSI_ARGS_ ((Tcl_LoadHandle loadHandle))
EXTERN void TclpReleaseFile _ANSI_ARGS_ ((TclFile file))
EXTERN char* TclpReadlink _ANSI_ARGS_ ((CONST char *fileName, Tcl_DString *linkPtr))
EXTERN void TclpPanic _ANSI_ARGS_ (TCL_VARARGS(CONST char *, format))
EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions))
EXTERN Tcl_Obj* TclFileDirname _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr))
EXTERN Tcl_Obj* TclpObjLink _ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkType))
EXTERN Tcl_Obj* TclpObjGetCwd _ANSI_ARGS_ ((Tcl_Interp *interp))
EXTERN int TclpMatchInDirectory _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types))
EXTERN int TclpObjRemoveDirectory _ANSI_ARGS_ ((Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr))
EXTERN int TclpObjCopyFile _ANSI_ARGS_ ((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr))
EXTERN int TclpObjCopyDirectory _ANSI_ARGS_ ((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr))
EXTERN int TclCrossFilesystemCopy _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *source, Tcl_Obj *target))
EXTERN Tcl_PathType TclpGetNativePathType _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr, int *driveNameLengthPtr, Tcl_Obj **driveNameRef))
EXTERN Tcl_Obj* TclpNativeSplitPath _ANSI_ARGS_ ((Tcl_Obj *pathPtr, int *lenPtr))
EXTERN void TclpNativeJoinPath _ANSI_ARGS_ ((Tcl_Obj *prefix, char *joining))
EXTERN int TclpObjCreateDirectory _ANSI_ARGS_ ((Tcl_Obj *pathPtr))
EXTERN int TclpObjNormalizePath _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint))
EXTERN int TclpMatchFiles _ANSI_ARGS_ ((Tcl_Interp *interp, char *separators, Tcl_DString *dirPtr, char *pattern, char *tail))
EXTERN int TclpLoadFile _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *sym1, CONST char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr, Tcl_FSUnloadFileProc **unloadProcPtr))
EXTERN int TclpFindVariable _ANSI_ARGS_ ((CONST char *name, int *lengthPtr))
EXTERN void TclpFinalizeMutex _ANSI_ARGS_ ((Tcl_Mutex *mutexPtr))
EXTERN void TclpFinalizeCondition _ANSI_ARGS_ ((Tcl_Condition *condPtr))
EXTERN int TclpDeleteFile _ANSI_ARGS_ ((CONST char *path))
EXTERN Tcl_Obj* TclNewFSPathObj _ANSI_ARGS_ ((Tcl_Obj *dirPtr, CONST char *addStrRep, int len))
EXTERN int TclpObjLstat _ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_StatBuf *buf))
EXTERN int TclpObjAccess _ANSI_ARGS_ ((Tcl_Obj *filename, int mode))
EXTERN int TclParseWhiteSpace _ANSI_ARGS_ ((CONST char *src, int numBytes, Tcl_Parse *parsePtr, char *typePtr))
EXTERN int TclParseInteger _ANSI_ARGS_ ((CONST char *string, int numBytes))
EXTERN int TclParseHex _ANSI_ARGS_ ((CONST char *src, int numBytes, Tcl_UniChar *resultPtr))
EXTERN int TclParseBackslash _ANSI_ARGS_ ((CONST char *src, int numBytes, int *readPtr, char *dst))
EXTERN Tcl_Obj* TclLsetFlat _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int indexCount, Tcl_Obj *CONST indexArray[], Tcl_Obj *valuePtr))
EXTERN Tcl_Obj* TclLsetList _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *indexPtr, Tcl_Obj *valuePtr))
EXTERN Tcl_Obj* TclLindexFlat _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int indexCount, Tcl_Obj *CONST indexArray[]))
EXTERN Tcl_Obj* TclLindexList _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *argPtr))
EXTERN int TclJoinThread _ANSI_ARGS_ ((Tcl_ThreadId id, int *result))
EXTERN int TclIsLocalScalar _ANSI_ARGS_ ((CONST char *src, int len))
EXTERN void TclInitSubsystems _ANSI_ARGS_ ((CONST char *argv0))
EXTERN int TclGlob _ANSI_ARGS_ ((Tcl_Interp *interp, char *pattern, Tcl_Obj *unquotedPrefix, int globFlags, Tcl_GlobTypeData *types))
EXTERN int TclGetEncodingFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr))
EXTERN void TclFinalizeAllocSubsystem _ANSI_ARGS_ ((void))
EXTERN int TclFileAttrsCmd _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
EXTERN void TclExpandTokenArray _ANSI_ARGS_ ((Tcl_Parse *parsePtr))
EXTERN void TclDeleteNamespaceVars _ANSI_ARGS_ ((Namespace *nsPtr))
EXTERN int TclCheckBadOctal _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *value))
EXTERN int TclArraySet _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj))
EXTERN void TclThreadDataKeySet _ANSI_ARGS_ ((Tcl_ThreadDataKey *keyPtr, VOID *data))
EXTERN VOID* TclThreadDataKeyGet _ANSI_ARGS_ ((Tcl_ThreadDataKey *keyPtr))
typedef int (TclAccessProc_)
typedef int (TclStatProc_)
typedef int (TclSetFileAttrProc)
typedef int (TclGetFileAttrProc)
typedef int (CompileHookProc)
typedef int (CompileProc)
typedef int (Tcl_ResolveCmdProc)
typedef int (Tcl_ResolveVarProc)
typedef int (Tcl_ResolveCompiledVarProc)
typedef Tcl_Channel (TclOpenFileChannelProc_)
typedef Tcl_Var (Tcl_ResolveRuntimeVarProc)
typedef void (Tcl_ResolveVarDeleteProc)

Variable Documentation
Tcl_HashKeyType tclArrayHashKeyType

Definition at line 99 of file tclHash.c.
Referenced by RebuildTable(), Tcl_CreateHashEntry(), Tcl_DeleteHashEntry(), Tcl_DeleteHashTable(), Tcl_FindHashEntry(), and Tcl_InitCustomHashTable().Tcl_ObjType tclArraySearchType

Definition at line 140 of file tclVar.c.
Referenced by ParseSearchId(), SetArraySearchObj(), and TclInitObjSubsystem().Tcl_Time tclBlockTime
int tclBlockTimeSet
Tcl_ObjType tclBooleanType

Referenced by ParsePrimaryExpr(), TCL_DECLARE_MUTEX(), and TclExecuteByteCode().Tcl_ObjType tclByteArrayType

Definition at line 94 of file tclBinary.c.
Referenced by DupByteArrayInternalRep(), SetByteArrayFromAny(), Tcl_SetByteArrayLength(), Tcl_SetByteArrayObj(), Tcl_StringObjCmd(), TclExecuteByteCode(), and TclInitObjSubsystem().Tcl_ObjType tclByteCodeType

Definition at line 309 of file tclCompile.c.
Referenced by ProcCompileProc(), Tcl_ExprObj(), TclCompEvalObj(), TclInitByteCodeObj(), TclInitObjSubsystem(), and TclReleaseLiteral().char* tclDefaultEncodingDir

Definition at line 144 of file tclEncoding.c.
Referenced by Tcl_Finalize(), Tcl_GetDefaultEncodingDir(), Tcl_SetDefaultEncodingDir(), TestgetdefencdirCmd(), and TestsetdefencdirCmd().Tcl_ObjType tclDoubleType

Definition at line 116 of file tclObj.c.
Referenced by SetBooleanFromAny(), SetDoubleFromAny(), Tcl_ExprBoolean(), Tcl_ExprBooleanObj(), Tcl_ExprDouble(), Tcl_ExprDoubleObj(), Tcl_ExprLong(), Tcl_ExprLongObj(), Tcl_ExprString(), Tcl_GetDoubleFromObj(), Tcl_NewDoubleObj(), Tcl_SetDoubleObj(), Tcl_StringObjCmd(), TclExecuteByteCode(), and TclInitObjSubsystem().char tclEmptyString

Referenced by TCL_DECLARE_MUTEX(), and Tcl_PkgRequireEx().char* tclEmptyStringRep

Referenced by ResetObjResult(), Tcl_AttemptSetObjLength(), TCL_DECLARE_MUTEX(), Tcl_PkgRequireEx(), Tcl_SetListObj(), Tcl_SetObjLength(), UpdateStringOfFsPath(), UpdateStringOfNsName(), and UpdateStringOfString().Tcl_ObjType tclEndOffsetType

Referenced by SetEndOffsetFromAny(), and TclInitObjSubsystem().char* tclExecutableName

Definition at line 27 of file tclUtil.c.
Referenced by Tcl_Finalize(), Tcl_FindExecutable(), Tcl_GetNameOfExecutable(), TclInitSubsystems(), TclpDlopen(), TclpFindExecutable(), and TestfindexecutableCmd().Tcl_ChannelType tclFileChannelType
Tcl_Obj* tclFreeObjList

Referenced by TclAllocateFreeObjects(), TclFinalizeObjects(), and TclFreeObj().Tcl_ObjType tclIndexType

Definition at line 35 of file tclIndexObj.c.
Referenced by DupIndex(), Tcl_GetIndexFromObj(), Tcl_GetIndexFromObjStruct(), Tcl_WrongNumArgs(), and TclInitObjSubsystem().Tcl_ObjType tclIntType

Definition at line 124 of file tclObj.c.
Referenced by ExprAbsFunc(), ExprCallMathFunc(), ExprIntFunc(), ExprRoundFunc(), ExprWideFunc(), SetBooleanFromAny(), SetIntFromAny(), SetIntOrWideFromAny(), Tcl_AfterObjCmd(), Tcl_ExprBoolean(), Tcl_ExprBooleanObj(), Tcl_ExprDouble(), Tcl_ExprDoubleObj(), Tcl_ExprLong(), Tcl_ExprLongObj(), Tcl_ExprString(), Tcl_GetIntFromObj(), Tcl_GetLongFromObj(), Tcl_GetWideIntFromObj(), Tcl_IncrObjCmd(), Tcl_NewIntObj(), Tcl_NewLongObj(), Tcl_SetIntObj(), Tcl_SetLongObj(), Tcl_StringObjCmd(), TclExecuteByteCode(), TclInitObjSubsystem(), TclPtrIncrVar(), and TclRegisterLiteral().Tcl_ObjType tclListType

Definition at line 44 of file tclListObj.c.
Referenced by DupListInternalRep(), SetListFromAny(), Tcl_ConcatObj(), Tcl_EvalObjEx(), Tcl_LappendObjCmd(), Tcl_ListObjAppendElement(), Tcl_ListObjAppendList(), Tcl_ListObjGetElements(), Tcl_ListObjIndex(), Tcl_ListObjLength(), Tcl_ListObjReplace(), Tcl_LrangeObjCmd(), Tcl_NewListObj(), Tcl_SetListObj(), TclExecuteByteCode(), TclInitObjSubsystem(), TclLindexFlat(), TclLindexList(), TclListObjSetElement(), and TclLsetList().char* tclMemDumpFileName

Referenced by Tcl_Main(), and TclFinalizeMemorySubsystem().EXTERN Tcl_FSDupInternalRepProc TclNativeDupInternalRep

Definition at line 1815 of file tclInt.h.
Referenced by TCL_DECLARE_MUTEX(), and Tcl_FSLoadFile().char* tclNativeExecutableName

Definition at line 28 of file tclUtil.c.
Referenced by Tcl_Finalize(), TclpFindExecutable(), and TestfindexecutableCmd().Tcl_ObjType tclNsNameType

Definition at line 149 of file tclNamesp.c.
Referenced by DupNsNameInternalRep(), GetNamespaceFromObj(), SetNsNameFromAny(), and TclInitObjSubsystem().Tcl_HashKeyType tclObjHashKeyType

Definition at line 147 of file tclObj.c.
Referenced by Tcl_InitObjHashTable().Tcl_HashKeyType tclOneWordHashKeyType

Definition at line 108 of file tclHash.c.
Referenced by RebuildTable(), Tcl_CreateHashEntry(), Tcl_DeleteHashEntry(), Tcl_DeleteHashTable(), Tcl_FindHashEntry(), and Tcl_InitCustomHashTable().Tcl_NotifierProcs tclOriginalNotifier

Definition at line 46 of file tclStubInit.c.
Referenced by Tcl_CreateFileHandler(), Tcl_DeleteFileHandler(), Tcl_SetTimer(), and Tcl_WaitForEvent().TclPlatformType tclPlatform

Definition at line 67 of file tclFileName.c.
Referenced by FindSplitPos(), MakeFolderEnvVar(), NativeFilesystemSeparator(), SetFsPathFromAny(), Tcl_FileObjCmd(), Tcl_FSGetNormalizedPath(), Tcl_FSJoinPath(), TclFSMakePathRelative(), TclNewFSPathObj(), TclpInitPlatform(), TclWinGetPlatform(), TestgetplatformCmd(), TestsetplatformCmd(), and UpdateStringOfFsPath().Tcl_ObjType tclProcBodyType

Definition at line 41 of file tclProc.c.
Referenced by ProcBodyDup(), Tcl_ProcObjCmd(), TclCreateProc(), TclInitObjSubsystem(), and TclNewProcBodyObj().Tcl_HashKeyType tclStringHashKeyType

Definition at line 117 of file tclHash.c.
Referenced by RebuildTable(), Tcl_CreateHashEntry(), Tcl_DeleteHashEntry(), Tcl_DeleteHashTable(), Tcl_FindHashEntry(), and Tcl_InitCustomHashTable().Tcl_ObjType tclStringType

Definition at line 69 of file tclStringObj.c.
Referenced by DupStringInternalRep(), SetStringFromAny(), Tcl_AppendObjToObj(), Tcl_NewUnicodeObj(), Tcl_SetUnicodeObj(), Tcl_StringObjCmd(), TclExecuteByteCode(), and TclInitObjSubsystem().Tcl_ObjType tclWideIntType

Definition at line 132 of file tclObj.c.
Referenced by ExprAbsFunc(), ExprIntFunc(), ExprRoundFunc(), ExprWideFunc(), SetBooleanFromAny(), SetIntOrWideFromAny(), SetWideIntFromAny(), Tcl_ExprBoolean(), Tcl_ExprDouble(), Tcl_ExprLong(), Tcl_GetIntFromObj(), Tcl_GetLongFromObj(), Tcl_GetWideIntFromObj(), Tcl_IncrObjCmd(), Tcl_NewWideIntObj(), Tcl_SetWideIntObj(), TclExecuteByteCode(), TclInitObjSubsystem(), and TclPtrIncrVar().

generic/tclIntDecls.h File Reference
Classes
struct TclIntStubs
Functions
EXTERN int TclAccessDeleteProc _ANSI_ARGS_ ((TclAccessProc_ *proc))
EXTERN void TclAllocateFreeObjects _ANSI_ARGS_ ((void))
EXTERN int TclCleanupChildren _ANSI_ARGS_ ((Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan))
EXTERN void TclCleanupCommand _ANSI_ARGS_ ((Command *cmdPtr))
EXTERN int TclCopyAndCollapse _ANSI_ARGS_ ((int count, CONST char *src, char *dst))
EXTERN int TclCopyChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr))
EXTERN int TclCreatePipeline _ANSI_ARGS_ ((Tcl_Interp *interp, int argc, CONST char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr))
EXTERN int TclCreateProc _ANSI_ARGS_ ((Tcl_Interp *interp, Namespace *nsPtr, CONST char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr))
EXTERN void TclDeleteCompiledLocalVars _ANSI_ARGS_ ((Interp *iPtr, CallFrame *framePtr))
EXTERN void TclDeleteVars _ANSI_ARGS_ ((Interp *iPtr, Tcl_HashTable *tablePtr))
EXTERN int TclDoGlob _ANSI_ARGS_ ((Tcl_Interp *interp, char *separators, Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types))
EXTERN void TclDumpMemoryInfo _ANSI_ARGS_ ((FILE *outFile))
EXTERN void TclExprFloatError _ANSI_ARGS_ ((Tcl_Interp *interp, double value))
EXTERN int TclFindElement _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *listStr, int listLength, CONST char **elementPtr, CONST char **nextPtr, int *sizePtr, int *bracePtr))
EXTERN Proc *TclFindProc _ANSI_ARGS_ ((Interp *iPtr, CONST char *procName))
EXTERN int TclFormatInt _ANSI_ARGS_ ((char *buffer, long n))
EXTERN void TclFreePackageInfo _ANSI_ARGS_ ((Interp *iPtr))
EXTERN int TclGetDate _ANSI_ARGS_ ((char *p, Tcl_WideInt now, long zone, Tcl_WideInt *timePtr))
EXTERN Tcl_Channel TclpGetDefaultStdChannel _ANSI_ARGS_ ((int type))
EXTERN char *TclGetExtension _ANSI_ARGS_ ((char *name))
EXTERN int TclGetFrame _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, CallFrame **framePtrPtr))
EXTERN int TclGetIntForIndex _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr))
EXTERN int TclGetLong _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, long *longPtr))
EXTERN int TclGetLoadedPackages _ANSI_ARGS_ ((Tcl_Interp *interp, char *targetName))
EXTERN int TclGetNamespaceForQualName _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, CONST char **simpleNamePtr))
EXTERN int TclGetOpenMode _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int *seekFlagPtr))
EXTERN Tcl_Command TclGetOriginalCommand _ANSI_ARGS_ ((Tcl_Command command))
EXTERN char *TclpGetUserHome _ANSI_ARGS_ ((CONST char *name, Tcl_DString *bufferPtr))
EXTERN int TclGlobalInvoke _ANSI_ARGS_ ((Tcl_Interp *interp, int argc, CONST84 char **argv, int flags))
EXTERN int TclGuessPackageName _ANSI_ARGS_ ((CONST char *fileName, Tcl_DString *bufPtr))
EXTERN int TclHideUnsafeCommands _ANSI_ARGS_ ((Tcl_Interp *interp))
EXTERN Tcl_Obj *TclIncrVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, long incrAmount, int part1NotParsed))
EXTERN void TclInitCompiledLocals _ANSI_ARGS_ ((Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr))
EXTERN int TclInvokeObjectCommand _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv))
EXTERN int TclInvokeStringCommand _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
EXTERN Var *TclLookupVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, CONST char *msg, int createPart1, int createPart2, Var **arrayPtrPtr))
EXTERN int TclNeedSpace _ANSI_ARGS_ ((CONST char *start, CONST char *end))
EXTERN Tcl_Obj *TclNewProcBodyObj _ANSI_ARGS_ ((Proc *procPtr))
EXTERN int TclObjCommandComplete _ANSI_ARGS_ ((Tcl_Obj *cmdPtr))
EXTERN int TclObjInvoke _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags))
EXTERN int TclOpenFileChannelDeleteProc _ANSI_ARGS_ ((TclOpenFileChannelProc_ *proc))
EXTERN char *TclpAlloc _ANSI_ARGS_ ((unsigned int size))
EXTERN void TclpFree _ANSI_ARGS_ ((char *ptr))
EXTERN void TclpGetTime _ANSI_ARGS_ ((Tcl_Time *time))
EXTERN int TclpGetTimeZone _ANSI_ARGS_ ((Tcl_WideInt time))
EXTERN char *TclpRealloc _ANSI_ARGS_ ((char *ptr, unsigned int size))
EXTERN char *TclPrecTraceProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags))
EXTERN int TclPreventAliasLoop _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd))
EXTERN int TclProcCompileProc _ANSI_ARGS_ ((Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description, CONST char *procName))
EXTERN void TclProcDeleteProc _ANSI_ARGS_ ((ClientData clientData))
EXTERN int TclRenameCommand _ANSI_ARGS_ ((Tcl_Interp *interp, char *oldName, char *newName))
EXTERN void TclResetShadowedCmdRefs _ANSI_ARGS_ ((Tcl_Interp *interp, Command *newCmdPtr))
EXTERN char *TclSetPreInitScript _ANSI_ARGS_ ((char *string))
EXTERN int TclSockGetPort _ANSI_ARGS_ ((Tcl_Interp *interp, char *str, char *proto, int *portPtr))
EXTERN int TclSockMinimumBuffers _ANSI_ARGS_ ((int sock, int size))
EXTERN int TclStatDeleteProc _ANSI_ARGS_ ((TclStatProc_ *proc))
EXTERN void TclTeardownNamespace _ANSI_ARGS_ ((Namespace *nsPtr))
EXTERN void Tcl_AddInterpResolvers _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc))
EXTERN int Tcl_AppendExportList _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr))
EXTERN Tcl_Namespace *Tcl_CreateNamespace _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc))
EXTERN void Tcl_DeleteNamespace _ANSI_ARGS_ ((Tcl_Namespace *nsPtr))
EXTERN int Tcl_Export _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int resetListFirst))
EXTERN Tcl_Command Tcl_FindCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags))
EXTERN int Tcl_GetInterpResolvers _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_ResolverInfo *resInfo))
EXTERN int Tcl_GetNamespaceResolvers _ANSI_ARGS_ ((Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo))
EXTERN int Tcl_ForgetImport _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern))
EXTERN Tcl_Command Tcl_GetCommandFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
EXTERN void Tcl_GetCommandFullName _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr))
EXTERN void Tcl_GetVariableFullName _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr))
EXTERN int Tcl_Import _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int allowOverwrite))
EXTERN int Tcl_PushCallFrame _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame))
EXTERN int Tcl_RemoveInterpResolvers _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name))
EXTERN void Tcl_SetNamespaceResolvers _ANSI_ARGS_ ((Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc))
EXTERN struct tm *TclpGetDate _ANSI_ARGS_ ((TclpTime_t time, int useGMT))
EXTERN size_t TclpStrftime _ANSI_ARGS_ ((char *s, size_t maxsize, CONST char *format, CONST struct tm *t, int useGMT))
EXTERN CONST84_RETURN char *TclGetEnv _ANSI_ARGS_ ((CONST char *name, Tcl_DString *valuePtr))
EXTERN int TclLooksLikeInt _ANSI_ARGS_ ((CONST char *bytes, int length))
EXTERN CONST84_RETURN char *TclpGetCwd _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_DString *cwdPtr))
EXTERN int TclSetByteCodeFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData))
EXTERN int TclAddLiteralObj _ANSI_ARGS_ ((struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr))
EXTERN void TclHideLiteral _ANSI_ARGS_ ((Tcl_Interp *interp, struct CompileEnv *envPtr, int index))
EXTERN struct AuxDataType *TclGetAuxDataType _ANSI_ARGS_ ((char *typeName))
EXTERN TclHandle TclHandleCreate _ANSI_ARGS_ ((VOID *ptr))
EXTERN void TclHandleFree _ANSI_ARGS_ ((TclHandle handle))
EXTERN int TclRegAbout _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_RegExp re))
EXTERN void TclRegExpRangeUniChar _ANSI_ARGS_ ((Tcl_RegExp re, int index, int *startPtr, int *endPtr))
EXTERN void TclSetLibraryPath _ANSI_ARGS_ ((Tcl_Obj *pathPtr))
EXTERN void TclRegError _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *msg, int status))
EXTERN Var *TclVarTraceExists _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName))
EXTERN void TclSetStartupScriptFileName _ANSI_ARGS_ ((CONST char *filename))
EXTERN int TclChannelTransform _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr))
EXTERN void TclChannelEventScriptInvoker _ANSI_ARGS_ ((ClientData clientData, int flags))
EXTERN void TclExpandCodeArray _ANSI_ARGS_ ((void *envPtr))
EXTERN int TclListObjSetElement _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr))
EXTERN int TclpUtfNcmp2 _ANSI_ARGS_ ((CONST char *s1, CONST char *s2, unsigned long n))
EXTERN int TclCheckInterpTraces _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[]))
EXTERN int TclUniCharMatch _ANSI_ARGS_ ((CONST Tcl_UniChar *string, int strLen, CONST Tcl_UniChar *pattern, int ptnLen, int nocase))
EXTERN struct tm *TclpLocaltime _ANSI_ARGS_ ((CONST TclpTime_t clock))
EXTERN int TclMatchIsTrivial _ANSI_ARGS_ ((CONST char *pattern))
Variables
TclIntStubs * tclIntStubsPtr

Function Documentation
EXTERN int TclMatchIsTrivial _ANSI_ARGS_ ((CONST char *pattern))
EXTERN struct tm* TclpLocaltime _ANSI_ARGS_ ((CONST TclpTime_t clock))
EXTERN int TclUniCharMatch _ANSI_ARGS_ ((CONST Tcl_UniChar *string, int strLen, CONST Tcl_UniChar *pattern, int ptnLen, int nocase))
EXTERN int TclCheckInterpTraces _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[]))
EXTERN int TclpUtfNcmp2 _ANSI_ARGS_ ((CONST char *s1, CONST char *s2, unsigned long n))
EXTERN int TclListObjSetElement _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr))
EXTERN void TclExpandCodeArray _ANSI_ARGS_ ((void *envPtr))
EXTERN void TclChannelEventScriptInvoker _ANSI_ARGS_ ((ClientData clientData, int flags))
EXTERN int TclChannelTransform _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr))
EXTERN void TclSetStartupScriptFileName _ANSI_ARGS_ ((CONST char *filename))
EXTERN Var* TclVarTraceExists _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName))
EXTERN void TclRegError _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *msg, int status))
EXTERN void TclSetLibraryPath _ANSI_ARGS_ ((Tcl_Obj *pathPtr))
EXTERN void TclRegExpRangeUniChar _ANSI_ARGS_ ((Tcl_RegExp re, int index, int *startPtr, int *endPtr))
EXTERN int TclRegAbout _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_RegExp re))
EXTERN void TclHandleFree _ANSI_ARGS_ ((TclHandle handle))
EXTERN TclHandle TclHandleCreate _ANSI_ARGS_ ((VOID *ptr))
EXTERN struct AuxDataType* TclGetAuxDataType _ANSI_ARGS_ ((char *typeName))
EXTERN void TclHideLiteral _ANSI_ARGS_ ((Tcl_Interp *interp, struct CompileEnv *envPtr, int index))
EXTERN int TclAddLiteralObj _ANSI_ARGS_ ((struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr))
EXTERN int TclSetByteCodeFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData))
EXTERN CONST84_RETURN char* TclpGetCwd _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_DString *cwdPtr))
EXTERN int TclLooksLikeInt _ANSI_ARGS_ ((CONST char *bytes, int length))
EXTERN CONST84_RETURN char* TclGetEnv _ANSI_ARGS_ ((CONST char *name, Tcl_DString *valuePtr))
EXTERN size_t TclpStrftime _ANSI_ARGS_ ((char *s, size_t maxsize, CONST char *format, CONST struct tm *t, int useGMT))
EXTERN struct tm* TclpGetDate _ANSI_ARGS_ ((TclpTime_t time, int useGMT))
EXTERN void Tcl_SetNamespaceResolvers _ANSI_ARGS_ ((Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc))
EXTERN int Tcl_RemoveInterpResolvers _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name))
EXTERN int Tcl_PushCallFrame _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame))
EXTERN int Tcl_Import _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int allowOverwrite))
EXTERN void Tcl_GetVariableFullName _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr))
EXTERN void Tcl_GetCommandFullName _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr))
EXTERN Tcl_Command Tcl_GetCommandFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
EXTERN int Tcl_ForgetImport _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern))
EXTERN int Tcl_GetNamespaceResolvers _ANSI_ARGS_ ((Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo))
EXTERN int Tcl_GetInterpResolvers _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_ResolverInfo *resInfo))
EXTERN Tcl_Command Tcl_FindCommand _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags))
EXTERN int Tcl_Export _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int resetListFirst))
EXTERN void Tcl_DeleteNamespace _ANSI_ARGS_ ((Tcl_Namespace *nsPtr))
EXTERN Tcl_Namespace* Tcl_CreateNamespace _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc))
EXTERN int Tcl_AppendExportList _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr))
EXTERN void Tcl_AddInterpResolvers _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc))
EXTERN void TclTeardownNamespace _ANSI_ARGS_ ((Namespace *nsPtr))
EXTERN int TclStatDeleteProc _ANSI_ARGS_ ((TclStatProc_ *proc))
EXTERN int TclSockMinimumBuffers _ANSI_ARGS_ ((int sock, int size))
EXTERN int TclSockGetPort _ANSI_ARGS_ ((Tcl_Interp *interp, char *str, char *proto, int *portPtr))
EXTERN char* TclSetPreInitScript _ANSI_ARGS_ ((char *string))
EXTERN void TclResetShadowedCmdRefs _ANSI_ARGS_ ((Tcl_Interp *interp, Command *newCmdPtr))
EXTERN int TclRenameCommand _ANSI_ARGS_ ((Tcl_Interp *interp, char *oldName, char *newName))
EXTERN void TclProcDeleteProc _ANSI_ARGS_ ((ClientData clientData))
EXTERN int TclProcCompileProc _ANSI_ARGS_ ((Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description, CONST char *procName))
EXTERN int TclPreventAliasLoop _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd))
EXTERN char* TclPrecTraceProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags))
EXTERN char* TclpRealloc _ANSI_ARGS_ ((char *ptr, unsigned int size))
EXTERN int TclpGetTimeZone _ANSI_ARGS_ ((Tcl_WideInt time))
EXTERN void TclpGetTime _ANSI_ARGS_ ((Tcl_Time *time))
EXTERN void TclpFree _ANSI_ARGS_ ((char *ptr))
EXTERN char* TclpAlloc _ANSI_ARGS_ ((unsigned int size))
EXTERN int TclOpenFileChannelDeleteProc _ANSI_ARGS_ ((TclOpenFileChannelProc_ *proc))
EXTERN int TclObjInvoke _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags))
EXTERN int TclObjCommandComplete _ANSI_ARGS_ ((Tcl_Obj *cmdPtr))
EXTERN Tcl_Obj* TclNewProcBodyObj _ANSI_ARGS_ ((Proc *procPtr))
EXTERN int TclNeedSpace _ANSI_ARGS_ ((CONST char *start, CONST char *end))
EXTERN Var* TclLookupVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, CONST char *msg, int createPart1, int createPart2, Var **arrayPtrPtr))
EXTERN int TclInvokeStringCommand _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
EXTERN int TclInvokeObjectCommand _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv))
EXTERN void TclInitCompiledLocals _ANSI_ARGS_ ((Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr))
EXTERN Tcl_Obj* TclIncrVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, long incrAmount, int part1NotParsed))
EXTERN int TclHideUnsafeCommands _ANSI_ARGS_ ((Tcl_Interp *interp))
EXTERN int TclGuessPackageName _ANSI_ARGS_ ((CONST char *fileName, Tcl_DString *bufPtr))
EXTERN int TclGlobalInvoke _ANSI_ARGS_ ((Tcl_Interp *interp, int argc, CONST84 char **argv, int flags))
EXTERN char* TclpGetUserHome _ANSI_ARGS_ ((CONST char *name, Tcl_DString *bufferPtr))
EXTERN Tcl_Command TclGetOriginalCommand _ANSI_ARGS_ ((Tcl_Command command))
EXTERN int TclGetOpenMode _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, int *seekFlagPtr))
EXTERN int TclGetNamespaceForQualName _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, CONST char **simpleNamePtr))
EXTERN int TclGetLoadedPackages _ANSI_ARGS_ ((Tcl_Interp *interp, char *targetName))
EXTERN int TclGetLong _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, long *longPtr))
EXTERN int TclGetIntForIndex _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr))
EXTERN int TclGetFrame _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *str, CallFrame **framePtrPtr))
EXTERN char* TclGetExtension _ANSI_ARGS_ ((char *name))
EXTERN Tcl_Channel TclpGetDefaultStdChannel _ANSI_ARGS_ ((int type))
EXTERN int TclGetDate _ANSI_ARGS_ ((char *p, Tcl_WideInt now, long zone, Tcl_WideInt *timePtr))
EXTERN void TclFreePackageInfo _ANSI_ARGS_ ((Interp *iPtr))
EXTERN int TclFormatInt _ANSI_ARGS_ ((char *buffer, long n))
EXTERN Proc* TclFindProc _ANSI_ARGS_ ((Interp *iPtr, CONST char *procName))
EXTERN int TclFindElement _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *listStr, int listLength, CONST char **elementPtr, CONST char **nextPtr, int *sizePtr, int *bracePtr))
EXTERN void TclExprFloatError _ANSI_ARGS_ ((Tcl_Interp *interp, double value))
EXTERN void TclDumpMemoryInfo _ANSI_ARGS_ ((FILE *outFile))
EXTERN int TclDoGlob _ANSI_ARGS_ ((Tcl_Interp *interp, char *separators, Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types))
EXTERN void TclDeleteVars _ANSI_ARGS_ ((Interp *iPtr, Tcl_HashTable *tablePtr))
EXTERN void TclDeleteCompiledLocalVars _ANSI_ARGS_ ((Interp *iPtr, CallFrame *framePtr))
EXTERN int TclCreateProc _ANSI_ARGS_ ((Tcl_Interp *interp, Namespace *nsPtr, CONST char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr))
EXTERN int TclCreatePipeline _ANSI_ARGS_ ((Tcl_Interp *interp, int argc, CONST char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr))
EXTERN int TclCopyChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr))
EXTERN int TclCopyAndCollapse _ANSI_ARGS_ ((int count, CONST char *src, char *dst))
EXTERN void TclCleanupCommand _ANSI_ARGS_ ((Command *cmdPtr))
EXTERN int TclCleanupChildren _ANSI_ARGS_ ((Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan))
EXTERN void TclAllocateFreeObjects _ANSI_ARGS_ ((void))
EXTERN int TclAccessDeleteProc _ANSI_ARGS_ ((TclAccessProc_ *proc))

Variable Documentation
TclIntStubs* tclIntStubsPtr

Definition at line 38 of file tclStubLib.c.
Referenced by Tcl_InitStubs().

generic/tclInterp.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include <stdio.h>
Classes
struct Slave
struct Target
struct Master
struct InterpInfo
Defines
#define ALIAS_CMDV_PREALLOC  10
Functions
TCL_DECLARE_MUTEX (cntMutex)
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))
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))
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 SlaveInvokeHidden _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Interp *slaveInterp, int global, int objc, Tcl_Obj *CONST objv[]))
static int SlaveObjCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
int TclInterpInit (Tcl_Interp *interp)
static void InterpInfoDeleteProc (ClientData clientData, Tcl_Interp *interp)
int Tcl_InterpObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static Tcl_Interp * GetInterp2 (Tcl_Interp *interp, int objc, objv)
int Tcl_CreateAlias (Tcl_Interp *slaveInterp, CONST char *slaveCmd, Tcl_Interp *targetInterp, CONST char *targetCmd, int argc, CONST char *CONST *argv)
int Tcl_CreateAliasObj (Tcl_Interp *slaveInterp, CONST char *slaveCmd, Tcl_Interp *targetInterp, CONST char *targetCmd, int objc, objv)
int Tcl_GetAlias (Tcl_Interp *interp, CONST char *aliasName, Tcl_Interp **targetInterpPtr, CONST char **targetNamePtr, int *argcPtr, CONST char ***argvPtr)
int Tcl_GetAliasObj (Tcl_Interp *interp, CONST char *aliasName, Tcl_Interp **targetInterpPtr, CONST char **targetNamePtr, int *objcPtr, Tcl_Obj ***objvPtr)
int TclPreventAliasLoop (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd)
static int AliasCreate (Tcl_Interp *interp, Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp, Tcl_Obj *namePtr, Tcl_Obj *targetNamePtr, int objc, objv)
static int AliasDelete (Tcl_Interp *interp, Tcl_Interp *slaveInterp, Tcl_Obj *namePtr)
static int AliasDescribe (Tcl_Interp *interp, Tcl_Interp *slaveInterp, Tcl_Obj *namePtr)
static int AliasList (Tcl_Interp *interp, Tcl_Interp *slaveInterp)
static int AliasObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static void AliasObjCmdDeleteProc (ClientData clientData)
Tcl_Interp * Tcl_CreateSlave (Tcl_Interp *interp, CONST char *slavePath, int isSafe)
Tcl_Interp * Tcl_GetSlave (Tcl_Interp *interp, CONST char *slavePath)
Tcl_Interp * Tcl_GetMaster (Tcl_Interp *interp)
int Tcl_GetInterpPath (Tcl_Interp *askingInterp, Tcl_Interp *targetInterp)
static Tcl_Interp * GetInterp (Tcl_Interp *interp, Tcl_Obj *pathPtr)
static Tcl_Interp * SlaveCreate (Tcl_Interp *interp, Tcl_Obj *pathPtr, int safe)
static int SlaveObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static void SlaveObjCmdDeleteProc (ClientData clientData)
static int SlaveEval (Tcl_Interp *interp, Tcl_Interp *slaveInterp, int objc, objv)
static int SlaveExpose (Tcl_Interp *interp, Tcl_Interp *slaveInterp, int objc, objv)
static int SlaveRecursionLimit (Tcl_Interp *interp, Tcl_Interp *slaveInterp, int objc, objv)
static int SlaveHide (Tcl_Interp *interp, Tcl_Interp *slaveInterp, int objc, objv)
static int SlaveHidden (Tcl_Interp *interp, Tcl_Interp *slaveInterp)
static int SlaveInvokeHidden (Tcl_Interp *interp, Tcl_Interp *slaveInterp, int global, int objc, objv)
static int SlaveMarkTrusted (Tcl_Interp *interp, Tcl_Interp *slaveInterp)
int Tcl_IsSafe (Tcl_Interp *interp)
int Tcl_MakeSafe (Tcl_Interp *interp)
Variables
static int aliasCounter = 0
Alias

Define Documentation
#define ALIAS_CMDV_PREALLOC  10

Referenced by AliasObjCmd().
Function Documentation
static int SlaveObjCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])) [static]
static int SlaveInvokeHidden _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Interp *slaveInterp, int global, int objc, Tcl_Obj *CONST objv[])) [static]
static int SlaveEval _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Interp *slaveInterp, int objc, Tcl_Obj *CONST objv[])) [static]
static Tcl_Interp* SlaveCreate _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, int safe)) [static]
static void InterpInfoDeleteProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp)) [static]
static Tcl_Interp* GetInterp2 _ANSI_ARGS_ ((Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])) [static]
static Tcl_Interp* GetInterp _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr)) [static]
static void AliasObjCmdDeleteProc _ANSI_ARGS_ ((ClientData clientData)) [static]
static int AliasObjCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *currentInterp, int objc, Tcl_Obj *CONST objv[])) [static]
static int AliasList _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Interp *slaveInterp)) [static]
static int AliasDescribe _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Interp *slaveInterp, Tcl_Obj *objPtr)) [static]
static int AliasDelete _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Interp *slaveInterp, Tcl_Obj *namePtr)) [static]
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]
static int AliasCreate (Tcl_Interp * interp, Tcl_Interp * slaveInterp, Tcl_Interp * masterInterp, Tcl_Obj * namePtr, Tcl_Obj * targetNamePtr, int objc, objv) [static]

Definition at line 1156 of file tclInterp.c.
References Alias, aliasCounter, AliasObjCmd(), AliasObjCmdDeleteProc(), Slave::aliasTable, ckalloc, ckfree, Command::clientData, Command::deleteData, Command::deleteProc, NULL, Target::slaveCmd, Target::slaveInterp, Master::targetTable, Tcl_CreateHashEntry, Tcl_CreateObjCommand(), Tcl_DecrRefCount, Tcl_DeleteCommandFromToken(), TCL_ERROR, Tcl_GetHashValue, Tcl_GetString(), Tcl_IncrRefCount, Tcl_MutexLock, Tcl_MutexUnlock, TCL_OK, Tcl_Preserve(), Tcl_Release(), Tcl_SetHashValue, Tcl_SetObjResult(), and TclPreventAliasLoop().
Referenced by SlaveObjCmd(), Tcl_CreateAlias(), Tcl_CreateAliasObj(), and Tcl_InterpObjCmd().1167 {
1168     Alias *aliasPtr;
1169     Tcl_HashEntry *hPtr;
1170     Target *targetPtr;
1171     Slave *slavePtr;
1172     Master *masterPtr;
1173     Tcl_Obj **prefv;
1174     int new, i;
1175 
1176     aliasPtr = (Alias *) ckalloc((unsigned) (sizeof(Alias) 
1177             + objc * sizeof(Tcl_Obj *)));
1178     aliasPtr->namePtr   = namePtr;
1179     Tcl_IncrRefCount(aliasPtr->namePtr);
1180     aliasPtr->targetInterp  = masterInterp;
1181 
1182     aliasPtr->objc = objc + 1;
1183     prefv = &aliasPtr->objPtr;
1184 
1185     *prefv = targetNamePtr;
1186     Tcl_IncrRefCount(targetNamePtr);
1187     for (i = 0; i < objc; i++) {
1188   *(++prefv) = objv[i];
1189   Tcl_IncrRefCount(objv[i]);
1190     }
1191 
1192     Tcl_Preserve(slaveInterp);
1193     Tcl_Preserve(masterInterp);
1194 
1195     aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
1196       Tcl_GetString(namePtr), AliasObjCmd, (ClientData) aliasPtr,
1197       AliasObjCmdDeleteProc);
1198 
1199     if (TclPreventAliasLoop(interp, slaveInterp,
1200       aliasPtr->slaveCmd) != TCL_OK) {
1201   /*
1202    * Found an alias loop!  The last call to Tcl_CreateObjCommand made
1203    * the alias point to itself.  Delete the command and its alias
1204    * record.  Be careful to wipe out its client data first, so the
1205    * command doesn't try to delete itself.
1206    */
1207 
1208   Command *cmdPtr;
1209   
1210   Tcl_DecrRefCount(aliasPtr->namePtr);
1211   Tcl_DecrRefCount(targetNamePtr);
1212   for (i = 0; i < objc; i++) {
1213       Tcl_DecrRefCount(objv[i]);
1214   }
1215   
1216   cmdPtr = (Command *) aliasPtr->slaveCmd;
1217   cmdPtr->clientData = NULL;
1218   cmdPtr->deleteProc = NULL;
1219   cmdPtr->deleteData = NULL;
1220   Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
1221 
1222   ckfree((char *) aliasPtr);
1223 
1224   /*
1225    * The result was already set by TclPreventAliasLoop.
1226    */
1227 
1228   Tcl_Release(slaveInterp);
1229   Tcl_Release(masterInterp);
1230   return TCL_ERROR;
1231     }
1232 
1233     /*
1234      * Make an entry in the alias table. If it already exists delete
1235      * the alias command. Then retry.
1236      */
1237 
1238     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
1239     while (1) {
1240   Alias *oldAliasPtr;
1241   char *string;
1242   
1243   string = Tcl_GetString(namePtr);
1244   hPtr = Tcl_CreateHashEntry(&slavePtr->aliasTable, string, &new);
1245   if (new != 0) {
1246       break;
1247   }
1248 
1249   oldAliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
1250   Tcl_DeleteCommandFromToken(slaveInterp, oldAliasPtr->slaveCmd);
1251     }
1252 
1253     aliasPtr->aliasEntryPtr = hPtr;
1254     Tcl_SetHashValue(hPtr, (ClientData) aliasPtr);
1255     
1256     /*
1257      * Create the new command. We must do it after deleting any old command,
1258      * because the alias may be pointing at a renamed alias, as in:
1259      *
1260      * interp alias {} foo {} bar   # Create an alias "foo"
1261      * rename foo zop       # Now rename the alias
1262      * interp alias {} foo {} zop   # Now recreate "foo"...
1263      */
1264 
1265     targetPtr = (Target *) ckalloc((unsigned) sizeof(Target));
1266     targetPtr->slaveCmd = aliasPtr->slaveCmd;
1267     targetPtr->slaveInterp = slaveInterp;
1268 
1269     Tcl_MutexLock(&cntMutex);
1270     masterPtr = &((InterpInfo *) ((Interp *) masterInterp)->interpInfo)->master;
1271     do {
1272         hPtr = Tcl_CreateHashEntry(&masterPtr->targetTable,
1273                 (char *) aliasCounter, &new);
1274   aliasCounter++;
1275     } while (new == 0);
1276     Tcl_MutexUnlock(&cntMutex);
1277 
1278     Tcl_SetHashValue(hPtr, (ClientData) targetPtr);
1279     aliasPtr->targetEntryPtr = hPtr;
1280 
1281     Tcl_SetObjResult(interp, namePtr);
1282 
1283     Tcl_Release(slaveInterp);
1284     Tcl_Release(masterInterp);
1285     return TCL_OK;
1286 }
static int AliasDelete (Tcl_Interp * interp, Tcl_Interp * slaveInterp, Tcl_Obj * namePtr) [static]

Definition at line 1305 of file tclInterp.c.
References Alias, Slave::aliasTable, NULL, Tcl_DeleteCommandFromToken(), TCL_ERROR, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_GetObjResult(), Tcl_GetString(), and TCL_OK.
Referenced by SlaveObjCmd(), and Tcl_InterpObjCmd().1309 {
1310     Slave *slavePtr;
1311     Alias *aliasPtr;
1312     Tcl_HashEntry *hPtr;
1313 
1314     /*
1315      * If the alias has been renamed in the slave, the master can still use
1316      * the original name (with which it was created) to find the alias to
1317      * delete it.
1318      */
1319 
1320     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
1321     hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, Tcl_GetString(namePtr));
1322     if (hPtr == NULL) {
1323   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "alias \"",
1324     Tcl_GetString(namePtr), "\" not found", NULL);
1325         return TCL_ERROR;
1326     }
1327     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
1328     Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
1329     return TCL_OK;
1330 }
static int AliasDescribe (Tcl_Interp * interp, Tcl_Interp * slaveInterp, Tcl_Obj * namePtr) [static]

Definition at line 1352 of file tclInterp.c.
References Alias, Slave::aliasTable, NULL, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_GetString(), Tcl_NewListObj(), TCL_OK, and Tcl_SetObjResult().
Referenced by SlaveObjCmd(), and Tcl_InterpObjCmd().1356 {
1357     Slave *slavePtr;
1358     Tcl_HashEntry *hPtr;
1359     Alias *aliasPtr;  
1360     Tcl_Obj *prefixPtr;
1361 
1362     /*
1363      * If the alias has been renamed in the slave, the master can still use
1364      * the original name (with which it was created) to find the alias to
1365      * describe it.
1366      */
1367 
1368     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
1369     hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, Tcl_GetString(namePtr));
1370     if (hPtr == NULL) {
1371         return TCL_OK;
1372     }
1373     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
1374     prefixPtr = Tcl_NewListObj(aliasPtr->objc, &aliasPtr->objPtr);
1375     Tcl_SetObjResult(interp, prefixPtr);
1376     return TCL_OK;
1377 }
static int AliasList (Tcl_Interp * interp, Tcl_Interp * slaveInterp) [static]

Definition at line 1396 of file tclInterp.c.
References Alias, Slave::aliasTable, NULL, Tcl_FirstHashEntry(), Tcl_GetHashValue, Tcl_GetObjResult(), Tcl_ListObjAppendElement(), Tcl_NextHashEntry(), and TCL_OK.
Referenced by SlaveObjCmd(), and Tcl_InterpObjCmd().1399 {
1400     Tcl_HashEntry *entryPtr;
1401     Tcl_HashSearch hashSearch;
1402     Tcl_Obj *resultPtr; 
1403     Alias *aliasPtr;
1404     Slave *slavePtr;
1405 
1406     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
1407     resultPtr = Tcl_GetObjResult(interp);
1408 
1409     entryPtr = Tcl_FirstHashEntry(&slavePtr->aliasTable, &hashSearch);
1410     for ( ; entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&hashSearch)) {
1411         aliasPtr = (Alias *) Tcl_GetHashValue(entryPtr);
1412         Tcl_ListObjAppendElement(NULL, resultPtr, aliasPtr->namePtr);
1413     }
1414     return TCL_OK;
1415 }
static int AliasObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1440 of file tclInterp.c.
References Alias, ALIAS_CMDV_PREALLOC, ckalloc, ckfree, size_t(), Tcl_DecrRefCount, TCL_EVAL_INVOKE, Tcl_EvalObjv(), Tcl_IncrRefCount, Tcl_Preserve(), Tcl_Release(), Tcl_ResetResult(), TclTransferResult(), and VOID.
Referenced by AliasCreate(), and TclPreventAliasLoop().1445 {
1446 #define ALIAS_CMDV_PREALLOC 10
1447     Tcl_Interp *targetInterp; 
1448     Alias *aliasPtr;    
1449     int result, prefc, cmdc, i;
1450     Tcl_Obj **prefv, **cmdv;
1451     Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
1452     aliasPtr = (Alias *) clientData;
1453     targetInterp = aliasPtr->targetInterp;
1454 
1455     /*
1456      * Append the arguments to the command prefix and invoke the command
1457      * in the target interp's global namespace.
1458      */
1459      
1460     prefc = aliasPtr->objc;
1461     prefv = &aliasPtr->objPtr;
1462     cmdc = prefc + objc - 1;
1463     if (cmdc <= ALIAS_CMDV_PREALLOC) {
1464   cmdv = cmdArr;
1465     } else {
1466   cmdv = (Tcl_Obj **) ckalloc((unsigned) (cmdc * sizeof(Tcl_Obj *)));
1467     }
1468 
1469     prefv = &aliasPtr->objPtr;
1470     memcpy((VOID *) cmdv, (VOID *) prefv, 
1471             (size_t) (prefc * sizeof(Tcl_Obj *)));
1472     memcpy((VOID *) (cmdv+prefc), (VOID *) (objv+1), 
1473       (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
1474 
1475     Tcl_ResetResult(targetInterp);
1476 
1477     for (i=0; i<cmdc; i++) {
1478   Tcl_IncrRefCount(cmdv[i]);
1479     }
1480     if (targetInterp != interp) {
1481   Tcl_Preserve((ClientData) targetInterp);
1482   result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);
1483   TclTransferResult(targetInterp, result, interp);  
1484   Tcl_Release((ClientData) targetInterp);
1485     } else {
1486   result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);
1487     }
1488     for (i=0; i<cmdc; i++) {
1489   Tcl_DecrRefCount(cmdv[i]);
1490     }
1491 
1492     if (cmdv != cmdArr) {
1493   ckfree((char *) cmdv);
1494     }
1495     return result;        
1496 #undef ALIAS_CMDV_PREALLOC
1497 }
static void AliasObjCmdDeleteProc (ClientData clientData) [static]

Definition at line 1518 of file tclInterp.c.
References Alias, ckfree, Tcl_DecrRefCount, Tcl_DeleteHashEntry(), and Tcl_GetHashValue.
Referenced by AliasCreate().1520 {
1521     Alias *aliasPtr;    
1522     Target *targetPtr;    
1523     int i;
1524     Tcl_Obj **objv;
1525 
1526     aliasPtr = (Alias *) clientData;
1527     
1528     Tcl_DecrRefCount(aliasPtr->namePtr);
1529     objv = &aliasPtr->objPtr;
1530     for (i = 0; i < aliasPtr->objc; i++) {
1531   Tcl_DecrRefCount(objv[i]);
1532     }
1533     Tcl_DeleteHashEntry(aliasPtr->aliasEntryPtr);
1534 
1535     targetPtr = (Target *) Tcl_GetHashValue(aliasPtr->targetEntryPtr);
1536     ckfree((char *) targetPtr);
1537     Tcl_DeleteHashEntry(aliasPtr->targetEntryPtr);
1538 
1539     ckfree((char *) aliasPtr);
1540 }
static Tcl_Interp* GetInterp (Tcl_Interp * interp, Tcl_Obj * pathPtr) [static]

Definition at line 1709 of file tclInterp.c.
References InterpInfo::master, NULL, Slave::slaveInterp, Master::slaveTable, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_GetObjResult(), Tcl_GetString(), Tcl_ListObjGetElements(), and TCL_OK.
Referenced by GetInterp2(), SlaveCreate(), Tcl_GetSlave(), and Tcl_InterpObjCmd().1713 {
1714     Tcl_HashEntry *hPtr;  /* Search element. */
1715     Slave *slavePtr;    /* Interim slave record. */
1716     Tcl_Obj **objv;
1717     int objc, i;  
1718     Tcl_Interp *searchInterp; /* Interim storage for interp. to find. */
1719     InterpInfo *masterInfoPtr;
1720 
1721     if (Tcl_ListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
1722   return NULL;
1723     }
1724 
1725     searchInterp = interp;
1726     for (i = 0; i < objc; i++) {
1727   masterInfoPtr = (InterpInfo *) ((Interp *) searchInterp)->interpInfo;
1728         hPtr = Tcl_FindHashEntry(&masterInfoPtr->master.slaveTable,
1729     Tcl_GetString(objv[i]));
1730         if (hPtr == NULL) {
1731       searchInterp = NULL;
1732       break;
1733   }
1734         slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
1735         searchInterp = slavePtr->slaveInterp;
1736         if (searchInterp == NULL) {
1737       break;
1738   }
1739     }
1740     if (searchInterp == NULL) {
1741   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1742     "could not find interpreter \"",
1743                 Tcl_GetString(pathPtr), "\"", (char *) NULL);
1744     }
1745     return searchInterp;
1746 }
static Tcl_Interp* GetInterp2 (Tcl_Interp * interp, int objc, objv) [static]

Definition at line 801 of file tclInterp.c.
References GetInterp(), NULL, and Tcl_WrongNumArgs().
Referenced by Tcl_InterpObjCmd().806 {
807     if (objc == 2) {
808   return interp;
809     } else if (objc == 3) {
810   return GetInterp(interp, objv[2]);
811     } else {
812   Tcl_WrongNumArgs(interp, 2, objv, "?path?");
813   return NULL;
814     }
815 }
static void InterpInfoDeleteProc (ClientData clientData, Tcl_Interp * interp) [static]

Definition at line 268 of file tclInterp.c.
References Slave::aliasTable, ckfree, Slave::interpCmd, InterpInfo::master, Slave::masterInterp, NULL, Tcl_HashTable::numEntries, panic, InterpInfo::slave, Target::slaveCmd, Slave::slaveInterp, Target::slaveInterp, Master::slaveTable, Master::targetTable, Tcl_DeleteCommandFromToken(), Tcl_DeleteHashTable(), Tcl_FirstHashEntry(), Tcl_GetHashValue, and Tcl_NextHashEntry().
Referenced by TclInterpInit().272 {
273     InterpInfo *interpInfoPtr;
274     Slave *slavePtr;
275     Master *masterPtr;
276     Tcl_HashSearch hSearch;
277     Tcl_HashEntry *hPtr;
278     Target *targetPtr;
279 
280     interpInfoPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
281 
282     /*
283      * There shouldn't be any commands left.
284      */
285 
286     masterPtr = &interpInfoPtr->master;
287     if (masterPtr->slaveTable.numEntries != 0) {
288   panic("InterpInfoDeleteProc: still exist commands");
289     }
290     Tcl_DeleteHashTable(&masterPtr->slaveTable);
291 
292     /*
293      * Tell any interps that have aliases to this interp that they should
294      * delete those aliases.  If the other interp was already dead, it
295      * would have removed the target record already. 
296      */
297 
298     hPtr = Tcl_FirstHashEntry(&masterPtr->targetTable, &hSearch);
299     while (hPtr != NULL) {
300   targetPtr = (Target *) Tcl_GetHashValue(hPtr);
301   Tcl_DeleteCommandFromToken(targetPtr->slaveInterp,
302     targetPtr->slaveCmd);
303   hPtr = Tcl_NextHashEntry(&hSearch);
304     }
305     Tcl_DeleteHashTable(&masterPtr->targetTable);
306 
307     slavePtr = &interpInfoPtr->slave;
308     if (slavePtr->interpCmd != NULL) {
309   /*
310    * Tcl_DeleteInterp() was called on this interpreter, rather
311    * "interp delete" or the equivalent deletion of the command in the
312    * master.  First ensure that the cleanup callback doesn't try to
313    * delete the interp again.
314    */
315 
316   slavePtr->slaveInterp = NULL;
317         Tcl_DeleteCommandFromToken(slavePtr->masterInterp,
318     slavePtr->interpCmd);
319     }
320 
321     /*
322      * There shouldn't be any aliases left.
323      */
324 
325     if (slavePtr->aliasTable.numEntries != 0) {
326   panic("InterpInfoDeleteProc: still exist aliases");
327     }
328     Tcl_DeleteHashTable(&slavePtr->aliasTable);
329 
330     ckfree((char *) interpInfoPtr);    
331 }
static Tcl_Interp* SlaveCreate (Tcl_Interp * interp, Tcl_Obj * pathPtr, int safe) [static]

Definition at line 1768 of file tclInterp.c.
References Slave::aliasTable, GetInterp(), Slave::interpCmd, InterpInfo::master, Slave::masterInterp, NULL, Slave::slaveEntryPtr, Slave::slaveInterp, SlaveObjCmd(), SlaveObjCmdDeleteProc(), Master::slaveTable, Tcl_CreateHashEntry, Tcl_CreateInterp(), Tcl_CreateObjCommand(), Tcl_DecrRefCount, Tcl_DeleteInterp(), TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), TCL_GLOBAL_ONLY, Tcl_Init(), Tcl_InitHashTable(), Tcl_InitMemory, Tcl_IsSafe(), Tcl_ListObjGetElements(), Tcl_MakeSafe(), Tcl_NewListObj(), TCL_OK, Tcl_SetHashValue, Tcl_SetVar(), TCL_STRING_KEYS, and TclTransferResult().
Referenced by Tcl_CreateSlave(), and Tcl_InterpObjCmd().1772 {
1773     Tcl_Interp *masterInterp, *slaveInterp;
1774     Slave *slavePtr;
1775     InterpInfo *masterInfoPtr;
1776     Tcl_HashEntry *hPtr;
1777     char *path;
1778     int new, objc;
1779     Tcl_Obj **objv;
1780 
1781     if (Tcl_ListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
1782   return NULL;
1783     }
1784     if (objc < 2) {
1785   masterInterp = interp;
1786   path = Tcl_GetString(pathPtr);
1787     } else {
1788   Tcl_Obj *objPtr;
1789   
1790   objPtr = Tcl_NewListObj(objc - 1, objv);
1791   masterInterp = GetInterp(interp, objPtr);
1792   Tcl_DecrRefCount(objPtr);
1793   if (masterInterp == NULL) {
1794       return NULL;
1795   }
1796   path = Tcl_GetString(objv[objc - 1]);
1797     }
1798     if (safe == 0) {
1799   safe = Tcl_IsSafe(masterInterp);
1800     }
1801 
1802     masterInfoPtr = (InterpInfo *) ((Interp *) masterInterp)->interpInfo;
1803     hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path, &new);
1804     if (new == 0) {
1805         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1806                 "interpreter named \"", path,
1807     "\" already exists, cannot create", (char *) NULL);
1808         return NULL;
1809     }
1810 
1811     slaveInterp = Tcl_CreateInterp();
1812     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
1813     slavePtr->masterInterp = masterInterp;
1814     slavePtr->slaveEntryPtr = hPtr;
1815     slavePtr->slaveInterp = slaveInterp;
1816     slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, path,
1817             SlaveObjCmd, (ClientData) slaveInterp, SlaveObjCmdDeleteProc);
1818     Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
1819     Tcl_SetHashValue(hPtr, (ClientData) slavePtr);
1820     Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
1821     
1822     /*
1823      * Inherit the recursion limit.
1824      */
1825     ((Interp *) slaveInterp)->maxNestingDepth =
1826   ((Interp *) masterInterp)->maxNestingDepth ;
1827 
1828     if (safe) {
1829         if (Tcl_MakeSafe(slaveInterp) == TCL_ERROR) {
1830             goto error;
1831         }
1832     } else {
1833         if (Tcl_Init(slaveInterp) == TCL_ERROR) {
1834             goto error;
1835         }
1836   /*
1837    * This will create the "memory" command in slave interpreters
1838    * if we compiled with TCL_MEM_DEBUG, otherwise it does nothing.
1839    */
1840   Tcl_InitMemory(slaveInterp);
1841     }
1842     return slaveInterp;
1843 
1844     error:
1845     TclTransferResult(slaveInterp, TCL_ERROR, interp);
1846     Tcl_DeleteInterp(slaveInterp);
1847 
1848     return NULL;
1849 }
static int SlaveEval (Tcl_Interp * interp, Tcl_Interp * slaveInterp, int objc, objv) [static]

Definition at line 2080 of file tclInterp.c.
References Tcl_AllowExceptions(), Tcl_ConcatObj(), Tcl_DecrRefCount, Tcl_EvalObjEx(), Tcl_IncrRefCount, Tcl_Preserve(), Tcl_Release(), and TclTransferResult().
Referenced by SlaveObjCmd(), and Tcl_InterpObjCmd().2086 {
2087     int result;
2088     Tcl_Obj *objPtr;
2089     
2090     Tcl_Preserve((ClientData) slaveInterp);
2091     Tcl_AllowExceptions(slaveInterp);
2092 
2093     if (objc == 1) {
2094   result = Tcl_EvalObjEx(slaveInterp, objv[0], 0);
2095     } else {
2096   objPtr = Tcl_ConcatObj(objc, objv);
2097   Tcl_IncrRefCount(objPtr);
2098   result = Tcl_EvalObjEx(slaveInterp, objPtr, 0);
2099   Tcl_DecrRefCount(objPtr);
2100     }
2101     TclTransferResult(slaveInterp, result, interp);
2102 
2103     Tcl_Release((ClientData) slaveInterp);
2104     return result;
2105 }
static int SlaveExpose (Tcl_Interp * interp, Tcl_Interp	* slaveInterp, int objc, objv) [static]

Definition at line 2125 of file tclInterp.c.
References NULL, TCL_ERROR, Tcl_ExposeCommand(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_IsSafe(), TCL_OK, and TclTransferResult().
Referenced by SlaveObjCmd(), and Tcl_InterpObjCmd().2130 {
2131     char *name;
2132     
2133     if (Tcl_IsSafe(interp)) {
2134   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
2135     "permission denied: safe interpreter cannot expose commands",
2136     (char *) NULL);
2137   return TCL_ERROR;
2138     }
2139 
2140     name = Tcl_GetString(objv[(objc == 1) ? 0 : 1]);
2141     if (Tcl_ExposeCommand(slaveInterp, Tcl_GetString(objv[0]),
2142       name) != TCL_OK) {
2143   TclTransferResult(slaveInterp, TCL_ERROR, interp);
2144   return TCL_ERROR;
2145     }
2146     return TCL_OK;
2147 }
static int SlaveHidden (Tcl_Interp * interp, Tcl_Interp * slaveInterp) [static]

Definition at line 2268 of file tclInterp.c.
References NULL, Tcl_FirstHashEntry(), Tcl_GetHashKey, Tcl_GetObjResult(), Tcl_ListObjAppendElement(), Tcl_NewStringObj(), Tcl_NextHashEntry(), and TCL_OK.
Referenced by SlaveObjCmd(), and Tcl_InterpObjCmd().2271 {
2272     Tcl_Obj *listObjPtr;    /* Local object pointer. */
2273     Tcl_HashTable *hTblPtr;   /* For local searches. */
2274     Tcl_HashEntry *hPtr;    /* For local searches. */
2275     Tcl_HashSearch hSearch;   /* For local searches. */
2276     
2277     listObjPtr = Tcl_GetObjResult(interp);
2278     hTblPtr = ((Interp *) slaveInterp)->hiddenCmdTablePtr;
2279     if (hTblPtr != (Tcl_HashTable *) NULL) {
2280   for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
2281        hPtr != (Tcl_HashEntry *) NULL;
2282        hPtr = Tcl_NextHashEntry(&hSearch)) {
2283 
2284       Tcl_ListObjAppendElement(NULL, listObjPtr,
2285         Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1));
2286   }
2287     }
2288     return TCL_OK;
2289 }
static int SlaveHide (Tcl_Interp * interp, Tcl_Interp	* slaveInterp, int objc, objv) [static]

Definition at line 2226 of file tclInterp.c.
References NULL, TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), Tcl_HideCommand(), Tcl_IsSafe(), TCL_OK, and TclTransferResult().
Referenced by SlaveObjCmd(), and Tcl_InterpObjCmd().2231 {
2232     char *name;
2233     
2234     if (Tcl_IsSafe(interp)) {
2235   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
2236     "permission denied: safe interpreter cannot hide commands",
2237     (char *) NULL);
2238   return TCL_ERROR;
2239     }
2240 
2241     name = Tcl_GetString(objv[(objc == 1) ? 0 : 1]);
2242     if (Tcl_HideCommand(slaveInterp, Tcl_GetString(objv[0]),
2243       name) != TCL_OK) {
2244   TclTransferResult(slaveInterp, TCL_ERROR, interp);
2245   return TCL_ERROR;
2246     }
2247     return TCL_OK;
2248 }
static int SlaveInvokeHidden (Tcl_Interp * interp, Tcl_Interp * slaveInterp, int global, int objc, objv) [static]

Definition at line 2308 of file tclInterp.c.
References Tcl_AllowExceptions(), TCL_ERROR, Tcl_GetObjResult(), TCL_INVOKE_HIDDEN, Tcl_IsSafe(), Tcl_Preserve(), Tcl_Release(), Tcl_SetStringObj(), TclObjInvoke(), TclObjInvokeGlobal(), and TclTransferResult().
Referenced by SlaveObjCmd(), and Tcl_InterpObjCmd().2315 {
2316     int result;
2317     
2318     if (Tcl_IsSafe(interp)) {
2319   Tcl_SetStringObj(Tcl_GetObjResult(interp),
2320     "not allowed to invoke hidden commands from safe interpreter",
2321     -1);
2322   return TCL_ERROR;
2323     }
2324 
2325     Tcl_Preserve((ClientData) slaveInterp);
2326     Tcl_AllowExceptions(slaveInterp);
2327     
2328     if (global) {
2329         result = TclObjInvokeGlobal(slaveInterp, objc, objv,
2330                 TCL_INVOKE_HIDDEN);
2331     } else {
2332         result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN);
2333     }
2334 
2335     TclTransferResult(slaveInterp, result, interp);
2336 
2337     Tcl_Release((ClientData) slaveInterp);
2338     return result;        
2339 }
static int SlaveMarkTrusted (Tcl_Interp * interp, Tcl_Interp * slaveInterp) [static]

Definition at line 2359 of file tclInterp.c.
References NULL, SAFE_INTERP, TCL_ERROR, Tcl_GetObjResult(), Tcl_IsSafe(), and TCL_OK.
Referenced by SlaveObjCmd(), and Tcl_InterpObjCmd().2363 {
2364     if (Tcl_IsSafe(interp)) {
2365   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
2366     "permission denied: safe interpreter cannot mark trusted",
2367     (char *) NULL);
2368   return TCL_ERROR;
2369     }
2370     ((Interp *) slaveInterp)->flags &= ~SAFE_INTERP;
2371     return TCL_OK;
2372 }
static int SlaveObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1869 of file tclInterp.c.
References AliasCreate(), AliasDelete(), AliasDescribe(), AliasList(), CONST, NULL, panic, SlaveEval(), SlaveExpose(), SlaveHidden(), SlaveHide(), SlaveInvokeHidden(), SlaveMarkTrusted(), SlaveRecursionLimit(), TCL_ERROR, Tcl_GetIndexFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_IsSafe(), TCL_OK, Tcl_SetIntObj(), and Tcl_WrongNumArgs().
Referenced by SlaveCreate().1874 {
1875     Tcl_Interp *slaveInterp;
1876     int index;
1877     static CONST char *options[] = {
1878         "alias",  "aliases",  "eval",   "expose",
1879         "hide",   "hidden", "issafe", "invokehidden",
1880         "marktrusted",  "recursionlimit", NULL
1881     };
1882     enum options {
1883   OPT_ALIAS,  OPT_ALIASES,  OPT_EVAL, OPT_EXPOSE,
1884   OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHIDDEN,
1885   OPT_MARKTRUSTED, OPT_RECLIMIT
1886     };
1887     
1888     slaveInterp = (Tcl_Interp *) clientData;
1889     if (slaveInterp == NULL) {
1890   panic("SlaveObjCmd: interpreter has been deleted");
1891     }
1892 
1893     if (objc < 2) {
1894         Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
1895         return TCL_ERROR;
1896     }
1897     if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
1898       &index) != TCL_OK) {
1899   return TCL_ERROR;
1900     }
1901 
1902     switch ((enum options) index) {
1903   case OPT_ALIAS: {
1904       if (objc > 2) {
1905     if (objc == 3) {
1906         return AliasDescribe(interp, slaveInterp, objv[2]);
1907     }
1908     if (Tcl_GetString(objv[3])[0] == '\0') {
1909         if (objc == 4) {
1910       return AliasDelete(interp, slaveInterp, objv[2]);
1911         }
1912     } else {
1913         return AliasCreate(interp, slaveInterp, interp, objv[2],
1914           objv[3], objc - 4, objv + 4);
1915     }
1916       }
1917       Tcl_WrongNumArgs(interp, 2, objv,
1918         "aliasName ?targetName? ?args..?");
1919             return TCL_ERROR;
1920   }
1921   case OPT_ALIASES: {
1922       if (objc != 2) {
1923     Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
1924     return TCL_ERROR;
1925       }
1926       return AliasList(interp, slaveInterp);
1927   }
1928   case OPT_EVAL: {
1929       if (objc < 3) {
1930     Tcl_WrongNumArgs(interp, 2, objv, "arg ?arg ...?");
1931     return TCL_ERROR;
1932       }
1933       return SlaveEval(interp, slaveInterp, objc - 2, objv + 2);
1934   }
1935         case OPT_EXPOSE: {
1936       if ((objc < 3) || (objc > 4)) {
1937     Tcl_WrongNumArgs(interp, 2, objv, "hiddenCmdName ?cmdName?");
1938     return TCL_ERROR;
1939       }
1940             return SlaveExpose(interp, slaveInterp, objc - 2, objv + 2);
1941   }
1942   case OPT_HIDE: {
1943       if ((objc < 3) || (objc > 4)) {
1944     Tcl_WrongNumArgs(interp, 2, objv, "cmdName ?hiddenCmdName?");
1945     return TCL_ERROR;
1946       }
1947             return SlaveHide(interp, slaveInterp, objc - 2, objv + 2);
1948   }
1949         case OPT_HIDDEN: {
1950       if (objc != 2) {
1951     Tcl_WrongNumArgs(interp, 2, objv, NULL);
1952     return TCL_ERROR;
1953       }
1954             return SlaveHidden(interp, slaveInterp);
1955   }
1956         case OPT_ISSAFE: {
1957       if (objc != 2) {
1958     Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
1959     return TCL_ERROR;
1960       }
1961       Tcl_SetIntObj(Tcl_GetObjResult(interp), Tcl_IsSafe(slaveInterp));
1962       return TCL_OK;
1963   }
1964         case OPT_INVOKEHIDDEN: {
1965       int global, i, index;
1966       static CONST char *hiddenOptions[] = {
1967     "-global",  "--",   NULL
1968       };
1969       enum hiddenOption {
1970     OPT_GLOBAL, OPT_LAST
1971       };
1972       global = 0;
1973       for (i = 2; i < objc; i++) {
1974     if (Tcl_GetString(objv[i])[0] != '-') {
1975         break;
1976     }
1977     if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions,
1978       "option", 0, &index) != TCL_OK) {
1979         return TCL_ERROR;
1980     }
1981     if (index == OPT_GLOBAL) {
1982         global = 1;
1983     } else {
1984         i++;
1985         break;
1986     }
1987       }
1988       if (objc - i < 1) {
1989     Tcl_WrongNumArgs(interp, 2, objv,
1990       "?-global? ?--? cmd ?arg ..?");
1991     return TCL_ERROR;
1992       }
1993       return SlaveInvokeHidden(interp, slaveInterp, global, objc - i,
1994         objv + i);
1995   }
1996   case OPT_MARKTRUSTED: {
1997       if (objc != 2) {
1998     Tcl_WrongNumArgs(interp, 2, objv, NULL);
1999     return TCL_ERROR;
2000       }
2001             return SlaveMarkTrusted(interp, slaveInterp);
2002   }
2003   case OPT_RECLIMIT: {
2004       if (objc != 2 && objc != 3) {
2005     Tcl_WrongNumArgs(interp, 2, objv, "?newlimit?");
2006     return TCL_ERROR;
2007       }
2008       return SlaveRecursionLimit(interp, slaveInterp, objc - 2, objv + 2);
2009   }
2010     }
2011 
2012     return TCL_ERROR;
2013 }
static void SlaveObjCmdDeleteProc (ClientData clientData) [static]

Definition at line 2035 of file tclInterp.c.
References Slave::interpCmd, NULL, Slave::slaveEntryPtr, Slave::slaveInterp, Tcl_DeleteHashEntry(), and Tcl_DeleteInterp().
Referenced by SlaveCreate().2037 {
2038     Slave *slavePtr;      /* Interim storage for Slave record. */
2039     Tcl_Interp *slaveInterp;    /* And for a slave interp. */
2040 
2041     slaveInterp = (Tcl_Interp *) clientData;
2042     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
2043 
2044     /*
2045      * Unlink the slave from its master interpreter.
2046      */
2047 
2048     Tcl_DeleteHashEntry(slavePtr->slaveEntryPtr);
2049 
2050     /*
2051      * Set to NULL so that when the InterpInfo is cleaned up in the slave
2052      * it does not try to delete the command causing all sorts of grief.
2053      * See SlaveRecordDeleteProc().
2054      */
2055 
2056     slavePtr->interpCmd = NULL;
2057 
2058     if (slavePtr->slaveInterp != NULL) {
2059   Tcl_DeleteInterp(slavePtr->slaveInterp);
2060     }
2061 }
static int SlaveRecursionLimit (Tcl_Interp * interp, Tcl_Interp	* slaveInterp, int objc, objv) [static]

Definition at line 2167 of file tclInterp.c.
References NULL, Interp::numLevels, TCL_ERROR, Tcl_GetIntFromObj(), Tcl_GetObjResult(), Tcl_IsSafe(), Tcl_NewIntObj(), Tcl_NewStringObj(), TCL_OK, Tcl_SetObjResult(), and Tcl_SetRecursionLimit().
Referenced by SlaveObjCmd(), and Tcl_InterpObjCmd().2172 {
2173     Interp *iPtr;
2174     int limit;
2175 
2176     if (objc) {
2177   if (Tcl_IsSafe(interp)) {
2178       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
2179         "permission denied: ",
2180         "safe interpreters cannot change recursion limit",
2181         (char *) NULL);
2182       return TCL_ERROR;
2183   }
2184   if (Tcl_GetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) {
2185       return TCL_ERROR;
2186   }
2187   if (limit <= 0) {
2188       Tcl_SetObjResult(interp, Tcl_NewStringObj(
2189         "recursion limit must be > 0", -1));
2190       return TCL_ERROR;
2191   }
2192   Tcl_SetRecursionLimit(slaveInterp, limit);
2193   iPtr = (Interp *) slaveInterp;
2194   if (interp == slaveInterp && iPtr->numLevels > limit) {
2195       Tcl_SetObjResult(interp, Tcl_NewStringObj(
2196         "falling back due to new recursion limit", -1));
2197       return TCL_ERROR;
2198   }
2199   Tcl_SetObjResult(interp, objv[0]);
2200         return TCL_OK;
2201     } else {
2202   limit = Tcl_SetRecursionLimit(slaveInterp, 0);
2203   Tcl_SetObjResult(interp, Tcl_NewIntObj(limit));
2204         return TCL_OK;
2205     }
2206 }
int Tcl_CreateAlias (Tcl_Interp * slaveInterp, CONST char * slaveCmd, Tcl_Interp * targetInterp, CONST char * targetCmd, int argc, CONST char * CONST * argv)

Definition at line 834 of file tclInterp.c.
References AliasCreate(), ckalloc, ckfree, Tcl_DecrRefCount, Tcl_IncrRefCount, and Tcl_NewStringObj().841 {
842     Tcl_Obj *slaveObjPtr, *targetObjPtr;
843     Tcl_Obj **objv;
844     int i;
845     int result;
846     
847     objv = (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) * argc);
848     for (i = 0; i < argc; i++) {
849         objv[i] = Tcl_NewStringObj(argv[i], -1);
850         Tcl_IncrRefCount(objv[i]);
851     }
852     
853     slaveObjPtr = Tcl_NewStringObj(slaveCmd, -1);
854     Tcl_IncrRefCount(slaveObjPtr);
855 
856     targetObjPtr = Tcl_NewStringObj(targetCmd, -1);
857     Tcl_IncrRefCount(targetObjPtr);
858 
859     result = AliasCreate(slaveInterp, slaveInterp, targetInterp, slaveObjPtr,
860       targetObjPtr, argc, objv);
861 
862     for (i = 0; i < argc; i++) {
863   Tcl_DecrRefCount(objv[i]);
864     }
865     ckfree((char *) objv);
866     Tcl_DecrRefCount(targetObjPtr);
867     Tcl_DecrRefCount(slaveObjPtr);
868 
869     return result;
870 }
int Tcl_CreateAliasObj (Tcl_Interp * slaveInterp, CONST char * slaveCmd, Tcl_Interp * targetInterp, CONST char * targetCmd, int objc, objv)

Definition at line 889 of file tclInterp.c.
References AliasCreate(), Tcl_DecrRefCount, Tcl_IncrRefCount, and Tcl_NewStringObj().896 {
897     Tcl_Obj *slaveObjPtr, *targetObjPtr;
898     int result;
899 
900     slaveObjPtr = Tcl_NewStringObj(slaveCmd, -1);
901     Tcl_IncrRefCount(slaveObjPtr);
902 
903     targetObjPtr = Tcl_NewStringObj(targetCmd, -1);
904     Tcl_IncrRefCount(targetObjPtr);
905 
906     result = AliasCreate(slaveInterp, slaveInterp, targetInterp, slaveObjPtr,
907       targetObjPtr, objc, objv);
908 
909     Tcl_DecrRefCount(slaveObjPtr);
910     Tcl_DecrRefCount(targetObjPtr);
911     return result;
912 }
Tcl_Interp* Tcl_CreateSlave (Tcl_Interp * interp, CONST char * slavePath, int isSafe)

Definition at line 1566 of file tclInterp.c.
References SlaveCreate(), Tcl_DecrRefCount, and Tcl_NewStringObj().1570 {
1571     Tcl_Obj *pathPtr;
1572     Tcl_Interp *slaveInterp;
1573 
1574     pathPtr = Tcl_NewStringObj(slavePath, -1);
1575     slaveInterp = SlaveCreate(interp, pathPtr, isSafe);
1576     Tcl_DecrRefCount(pathPtr);
1577 
1578     return slaveInterp;
1579 }
TCL_DECLARE_MUTEX (cntMutex)

Definition at line 24 of file tclInterp.c.27                :
28  *
29  * Stores information about an alias. Is stored in the slave interpreter
30  * and used by the source command to find the target command in the master
31  * when the source command is invoked.
32  */
33 
34 typedef struct Alias {
35     Tcl_Obj *namePtr;   /* Name of alias command in slave interp. */
36     Tcl_Interp *targetInterp; /* Interp in which target command will be
37          * invoked. */
38     Tcl_Command slaveCmd; /* Source command in slave interpreter,
39          * bound to command that invokes the target
40          * command in the target interpreter. */
41     Tcl_HashEntry *aliasEntryPtr;
42         /* Entry for the alias hash table in slave.
43                                  * This is used by alias deletion to remove
44                                  * the alias from the slave interpreter
45                                  * alias table. */
46     Tcl_HashEntry *targetEntryPtr;
47         /* Entry for target command in master.
48                                  * This is used in the master interpreter to
49                                  * map back from the target command to aliases
50                                  * redirecting to it. Random access to this
51                                  * hash table is never required - we are using
52                                  * a hash table only for convenience. */
53     int objc;                   /* Count of Tcl_Obj in the prefix of the
54          * target command to be invoked in the
55          * target interpreter. Additional arguments
56          * specified when calling the alias in the
57          * slave interp will be appended to the prefix
58          * before the command is invoked. */
59     Tcl_Obj *objPtr;            /* The first actual prefix object - the target
60          * command name; this has to be at the end of the 
61          * structure, which will be extended to accomodate 
62          * the remaining objects in the prefix. */
63 } Alias;

int Tcl_GetAlias (Tcl_Interp * interp, CONST char * aliasName, Tcl_Interp ** targetInterpPtr, CONST char ** targetNamePtr, int * argcPtr, CONST char *** argvPtr)

Definition at line 931 of file tclInterp.c.
References Alias, Slave::aliasTable, ckalloc, CONST, NULL, InterpInfo::slave, TCL_ERROR, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_GetObjResult(), Tcl_GetString(), and TCL_OK.939 {
940     InterpInfo *iiPtr;
941     Tcl_HashEntry *hPtr;
942     Alias *aliasPtr;
943     int i, objc;
944     Tcl_Obj **objv;
945     
946     iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
947     hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
948     if (hPtr == NULL) {
949         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
950                 "alias \"", aliasName, "\" not found", (char *) NULL);
951   return TCL_ERROR;
952     }
953     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
954     objc = aliasPtr->objc;
955     objv = &aliasPtr->objPtr;
956 
957     if (targetInterpPtr != NULL) {
958   *targetInterpPtr = aliasPtr->targetInterp;
959     }
960     if (targetNamePtr != NULL) {
961   *targetNamePtr = Tcl_GetString(objv[0]);
962     }
963     if (argcPtr != NULL) {
964   *argcPtr = objc - 1;
965     }
966     if (argvPtr != NULL) {
967         *argvPtr = (CONST char **) 
968     ckalloc((unsigned) sizeof(CONST char *) * (objc - 1));
969         for (i = 1; i < objc; i++) {
970             *argvPtr[i - 1] = Tcl_GetString(objv[i]);
971         }
972     }
973     return TCL_OK;
974 }
int Tcl_GetAliasObj (Tcl_Interp * interp, CONST char * aliasName, Tcl_Interp ** targetInterpPtr, CONST char ** targetNamePtr, int * objcPtr, Tcl_Obj *** objvPtr)

Definition at line 993 of file tclInterp.c.
References Alias, Slave::aliasTable, CONST, NULL, InterpInfo::slave, TCL_ERROR, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_GetObjResult(), Tcl_GetString(), and TCL_OK.1001 {
1002     InterpInfo *iiPtr;
1003     Tcl_HashEntry *hPtr;
1004     Alias *aliasPtr;  
1005     int objc;
1006     Tcl_Obj **objv;
1007 
1008     iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
1009     hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
1010     if (hPtr == (Tcl_HashEntry *) NULL) {
1011         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1012                 "alias \"", aliasName, "\" not found", (char *) NULL);
1013         return TCL_ERROR;
1014     }
1015     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
1016     objc = aliasPtr->objc;
1017     objv = &aliasPtr->objPtr;
1018 
1019     if (targetInterpPtr != (Tcl_Interp **) NULL) {
1020         *targetInterpPtr = aliasPtr->targetInterp;
1021     }
1022     if (targetNamePtr != (CONST char **) NULL) {
1023         *targetNamePtr = Tcl_GetString(objv[0]);
1024     }
1025     if (objcPtr != (int *) NULL) {
1026         *objcPtr = objc - 1;
1027     }
1028     if (objvPtr != (Tcl_Obj ***) NULL) {
1029         *objvPtr = objv + 1;
1030     }
1031     return TCL_OK;
1032 }
int Tcl_GetInterpPath (Tcl_Interp * askingInterp, Tcl_Interp * targetInterp)

Definition at line 1669 of file tclInterp.c.
References InterpInfo::master, Slave::masterInterp, NULL, InterpInfo::slave, Slave::slaveEntryPtr, Master::slaveTable, Tcl_AppendElement(), TCL_ERROR, Tcl_GetHashKey, and TCL_OK.
Referenced by Tcl_InterpObjCmd().1672 {
1673     InterpInfo *iiPtr;
1674     
1675     if (targetInterp == askingInterp) {
1676         return TCL_OK;
1677     }
1678     if (targetInterp == NULL) {
1679   return TCL_ERROR;
1680     }
1681     iiPtr = (InterpInfo *) ((Interp *) targetInterp)->interpInfo;
1682     if (Tcl_GetInterpPath(askingInterp, iiPtr->slave.masterInterp) != TCL_OK) {
1683         return TCL_ERROR;
1684     }
1685     Tcl_AppendElement(askingInterp,
1686       Tcl_GetHashKey(&iiPtr->master.slaveTable,
1687         iiPtr->slave.slaveEntryPtr));
1688     return TCL_OK;
1689 }
Tcl_Interp* Tcl_GetMaster (Tcl_Interp * interp)

Definition at line 1630 of file tclInterp.c.
References Slave::masterInterp, and NULL.1632 {
1633     Slave *slavePtr;    /* Slave record of this interpreter. */
1634 
1635     if (interp == (Tcl_Interp *) NULL) {
1636         return NULL;
1637     }
1638     slavePtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->slave;
1639     return slavePtr->masterInterp;
1640 }
Tcl_Interp* Tcl_GetSlave (Tcl_Interp * interp, CONST char * slavePath)

Definition at line 1599 of file tclInterp.c.
References GetInterp(), Tcl_DecrRefCount, and Tcl_NewStringObj().
Referenced by Tcl_LoadObjCmd(), TclGetLoadedPackages(), TestdelCmd(), and TestinterpdeleteCmd().1602 {
1603     Tcl_Obj *pathPtr;
1604     Tcl_Interp *slaveInterp;
1605 
1606     pathPtr = Tcl_NewStringObj(slavePath, -1);
1607     slaveInterp = GetInterp(interp, pathPtr);
1608     Tcl_DecrRefCount(pathPtr);
1609 
1610     return slaveInterp;
1611 }
int Tcl_InterpObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv)

Definition at line 351 of file tclInterp.c.
References Alias, AliasCreate(), AliasDelete(), AliasDescribe(), AliasList(), Slave::aliasTable, CONST, GetInterp(), GetInterp2(), Slave::interpCmd, InterpInfo::master, Slave::masterInterp, NULL, InterpInfo::slave, SlaveCreate(), SlaveEval(), SlaveExpose(), SlaveHidden(), SlaveHide(), SlaveInvokeHidden(), SlaveMarkTrusted(), SlaveRecursionLimit(), Master::slaveTable, Tcl_DecrRefCount, Tcl_DeleteCommandFromToken(), TCL_ERROR, Tcl_FindHashEntry, Tcl_FirstHashEntry(), Tcl_GetChannel(), Tcl_GetCommandInfo(), Tcl_GetHashKey, Tcl_GetHashValue, Tcl_GetIndexFromObj(), Tcl_GetInterpPath(), Tcl_GetObjResult(), Tcl_GetString(), TCL_INTEGER_SPACE, Tcl_IsSafe(), Tcl_ListObjAppendElement(), Tcl_NewStringObj(), Tcl_NextHashEntry(), TCL_OK, Tcl_RegisterChannel(), Tcl_ResetResult(), Tcl_SetIntObj(), Tcl_SetObjResult(), Tcl_UnregisterChannel(), Tcl_WrongNumArgs(), and TclTransferResult().
Referenced by TclInterpInit().356 {
357     int index;
358     static CONST char *options[] = {
359         "alias",  "aliases",  "create", "delete", 
360   "eval",   "exists", "expose", "hide", 
361   "hidden", "issafe", "invokehidden", "marktrusted", 
362   "recursionlimit",   "slaves", "share",
363   "target", "transfer",
364         NULL
365     };
366     enum option {
367   OPT_ALIAS,  OPT_ALIASES,  OPT_CREATE, OPT_DELETE,
368   OPT_EVAL, OPT_EXISTS, OPT_EXPOSE, OPT_HIDE,
369   OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHID,  OPT_MARKTRUSTED,
370   OPT_RECLIMIT,     OPT_SLAVES, OPT_SHARE,
371   OPT_TARGET, OPT_TRANSFER
372     };
373 
374 
375     if (objc < 2) {
376         Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
377         return TCL_ERROR;
378     }
379     if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, 
380       &index) != TCL_OK) {
381   return TCL_ERROR;
382     }
383     switch ((enum option) index) {
384   case OPT_ALIAS: {
385       Tcl_Interp *slaveInterp, *masterInterp;
386 
387       if (objc < 4) {
388     aliasArgs:
389     Tcl_WrongNumArgs(interp, 2, objv,
390       "slavePath slaveCmd ?masterPath masterCmd? ?args ..?");
391     return TCL_ERROR;
392       }
393       slaveInterp = GetInterp(interp, objv[2]);
394       if (slaveInterp == (Tcl_Interp *) NULL) {
395     return TCL_ERROR;
396       }
397       if (objc == 4) {
398     return AliasDescribe(interp, slaveInterp, objv[3]);
399       }
400       if ((objc == 5) && (Tcl_GetString(objv[4])[0] == '\0')) {
401     return AliasDelete(interp, slaveInterp, objv[3]);
402       }
403       if (objc > 5) {
404     masterInterp = GetInterp(interp, objv[4]);
405     if (masterInterp == (Tcl_Interp *) NULL) {
406         return TCL_ERROR;
407     }
408     if (Tcl_GetString(objv[5])[0] == '\0') {
409         if (objc == 6) {
410       return AliasDelete(interp, slaveInterp, objv[3]);
411         }
412     } else {
413         return AliasCreate(interp, slaveInterp, masterInterp,
414           objv[3], objv[5], objc - 6, objv + 6);
415     }
416       }
417       goto aliasArgs;
418   }
419   case OPT_ALIASES: {
420       Tcl_Interp *slaveInterp;
421 
422       slaveInterp = GetInterp2(interp, objc, objv);
423       if (slaveInterp == NULL) {
424     return TCL_ERROR;
425       }
426       return AliasList(interp, slaveInterp);
427   }
428   case OPT_CREATE: {
429       int i, last, safe;
430       Tcl_Obj *slavePtr;
431       char buf[16 + TCL_INTEGER_SPACE];
432       static CONST char *options[] = {
433     "-safe",  "--",   NULL
434       };
435       enum option {
436     OPT_SAFE, OPT_LAST
437       };
438 
439       safe = Tcl_IsSafe(interp);
440       
441       /*
442        * Weird historical rules: "-safe" is accepted at the end, too.
443        */
444 
445       slavePtr = NULL;
446       last = 0;
447       for (i = 2; i < objc; i++) {
448     if ((last == 0) && (Tcl_GetString(objv[i])[0] == '-')) {
449         if (Tcl_GetIndexFromObj(interp, objv[i], options, "option",
450           0, &index) != TCL_OK) {
451       return TCL_ERROR;
452         }
453         if (index == OPT_SAFE) {
454       safe = 1;
455       continue;
456         }
457         i++;
458         last = 1;
459     }
460     if (slavePtr != NULL) {
461         Tcl_WrongNumArgs(interp, 2, objv, "?-safe? ?--? ?path?");
462         return TCL_ERROR;
463     }
464     if (i < objc) {
465         slavePtr = objv[i];
466     }
467       }
468       buf[0] = '\0';
469       if (slavePtr == NULL) {
470     /*
471      * Create an anonymous interpreter -- we choose its name and
472      * the name of the command. We check that the command name
473      * that we use for the interpreter does not collide with an
474      * existing command in the master interpreter.
475      */
476     
477     for (i = 0; ; i++) {
478         Tcl_CmdInfo cmdInfo;
479         
480         sprintf(buf, "interp%d", i);
481         if (Tcl_GetCommandInfo(interp, buf, &cmdInfo) == 0) {
482       break;
483         }
484     }
485     slavePtr = Tcl_NewStringObj(buf, -1);
486       }
487       if (SlaveCreate(interp, slavePtr, safe) == NULL) {
488     if (buf[0] != '\0') {
489         Tcl_DecrRefCount(slavePtr);
490     }
491     return TCL_ERROR;
492       }
493       Tcl_SetObjResult(interp, slavePtr);
494       return TCL_OK;
495   }
496   case OPT_DELETE: {
497       int i;
498       InterpInfo *iiPtr;
499       Tcl_Interp *slaveInterp;
500       
501       for (i = 2; i < objc; i++) {
502     slaveInterp = GetInterp(interp, objv[i]);
503     if (slaveInterp == NULL) {
504         return TCL_ERROR;
505     } else if (slaveInterp == interp) {
506         Tcl_ResetResult(interp);
507         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
508           "cannot delete the current interpreter",
509           (char *) NULL);
510         return TCL_ERROR;
511     }
512     iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
513     Tcl_DeleteCommandFromToken(iiPtr->slave.masterInterp,
514       iiPtr->slave.interpCmd);
515       }
516       return TCL_OK;
517   }
518   case OPT_EVAL: {
519       Tcl_Interp *slaveInterp;
520 
521       if (objc < 4) {
522     Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?");
523     return TCL_ERROR;
524       }
525       slaveInterp = GetInterp(interp, objv[2]);
526       if (slaveInterp == NULL) {
527     return TCL_ERROR;
528       }
529       return SlaveEval(interp, slaveInterp, objc - 3, objv + 3);
530   }
531   case OPT_EXISTS: {
532       int exists;
533       Tcl_Interp *slaveInterp;
534 
535       exists = 1;
536       slaveInterp = GetInterp2(interp, objc, objv);
537       if (slaveInterp == NULL) {
538     if (objc > 3) {
539         return TCL_ERROR;
540     }
541     Tcl_ResetResult(interp);
542     exists = 0;
543       }
544       Tcl_SetIntObj(Tcl_GetObjResult(interp), exists);
545       return TCL_OK;
546   }
547   case OPT_EXPOSE: {
548       Tcl_Interp *slaveInterp;
549 
550       if ((objc < 4) || (objc > 5)) {
551     Tcl_WrongNumArgs(interp, 2, objv,
552       "path hiddenCmdName ?cmdName?");
553     return TCL_ERROR;
554       }
555       slaveInterp = GetInterp(interp, objv[2]);
556       if (slaveInterp == NULL) {
557     return TCL_ERROR;
558       }
559       return SlaveExpose(interp, slaveInterp, objc - 3, objv + 3);
560   }
561   case OPT_HIDE: {
562       Tcl_Interp *slaveInterp;    /* A slave. */
563 
564       if ((objc < 4) || (objc > 5)) {
565     Tcl_WrongNumArgs(interp, 2, objv,
566       "path cmdName ?hiddenCmdName?");
567     return TCL_ERROR;
568       }
569       slaveInterp = GetInterp(interp, objv[2]);
570       if (slaveInterp == (Tcl_Interp *) NULL) {
571     return TCL_ERROR;
572       }
573       return SlaveHide(interp, slaveInterp, objc - 3, objv + 3);
574   }
575   case OPT_HIDDEN: {
576       Tcl_Interp *slaveInterp;    /* A slave. */
577 
578       slaveInterp = GetInterp2(interp, objc, objv);
579       if (slaveInterp == NULL) {
580     return TCL_ERROR;
581       }
582       return SlaveHidden(interp, slaveInterp);
583   }
584   case OPT_ISSAFE: {
585       Tcl_Interp *slaveInterp;
586 
587       slaveInterp = GetInterp2(interp, objc, objv);
588       if (slaveInterp == NULL) {
589     return TCL_ERROR;
590       }
591       Tcl_SetIntObj(Tcl_GetObjResult(interp), Tcl_IsSafe(slaveInterp));
592       return TCL_OK;
593   }
594   case OPT_INVOKEHID: {
595       int i, index, global;
596       Tcl_Interp *slaveInterp;
597       static CONST char *hiddenOptions[] = {
598     "-global",  "--",   NULL
599       };
600       enum hiddenOption {
601     OPT_GLOBAL, OPT_LAST
602       };
603 
604       global = 0;
605       for (i = 3; i < objc; i++) {
606     if (Tcl_GetString(objv[i])[0] != '-') {
607         break;
608     }
609     if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions,
610       "option", 0, &index) != TCL_OK) {
611         return TCL_ERROR;
612     }
613     if (index == OPT_GLOBAL) {
614         global = 1;
615     } else {
616         i++;
617         break;
618     }
619       }
620       if (objc - i < 1) {
621     Tcl_WrongNumArgs(interp, 2, objv,
622       "path ?-global? ?--? cmd ?arg ..?");
623     return TCL_ERROR;
624       }
625       slaveInterp = GetInterp(interp, objv[2]);
626       if (slaveInterp == (Tcl_Interp *) NULL) {
627     return TCL_ERROR;
628       }
629       return SlaveInvokeHidden(interp, slaveInterp, global, objc - i,
630         objv + i);
631   }
632   case OPT_MARKTRUSTED: {
633       Tcl_Interp *slaveInterp;
634 
635       if (objc != 3) {
636     Tcl_WrongNumArgs(interp, 2, objv, "path");
637     return TCL_ERROR;
638       }
639       slaveInterp = GetInterp(interp, objv[2]);
640       if (slaveInterp == NULL) {
641     return TCL_ERROR;
642       }
643       return SlaveMarkTrusted(interp, slaveInterp);
644   }
645   case OPT_RECLIMIT: {
646       Tcl_Interp *slaveInterp;
647 
648       if (objc != 3 && objc != 4) {
649     Tcl_WrongNumArgs(interp, 2, objv, "path ?newlimit?");
650     return TCL_ERROR;
651       }
652       slaveInterp = GetInterp(interp, objv[2]);
653       if (slaveInterp == NULL) {
654     return TCL_ERROR;
655       }
656       return SlaveRecursionLimit(interp, slaveInterp, objc - 3, objv + 3);
657   }
658   case OPT_SLAVES: {
659       Tcl_Interp *slaveInterp;
660       InterpInfo *iiPtr;
661       Tcl_Obj *resultPtr;
662       Tcl_HashEntry *hPtr;
663       Tcl_HashSearch hashSearch;
664       char *string;
665       
666       slaveInterp = GetInterp2(interp, objc, objv);
667       if (slaveInterp == NULL) {
668     return TCL_ERROR;
669       }
670       iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
671       resultPtr = Tcl_GetObjResult(interp);
672       hPtr = Tcl_FirstHashEntry(&iiPtr->master.slaveTable, &hashSearch);
673       for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) {
674     string = Tcl_GetHashKey(&iiPtr->master.slaveTable, hPtr);
675     Tcl_ListObjAppendElement(NULL, resultPtr,
676       Tcl_NewStringObj(string, -1));
677       }
678       return TCL_OK;
679   }
680   case OPT_SHARE: {
681       Tcl_Interp *slaveInterp;    /* A slave. */
682       Tcl_Interp *masterInterp;   /* Its master. */
683       Tcl_Channel chan;
684 
685       if (objc != 5) {
686     Tcl_WrongNumArgs(interp, 2, objv, "srcPath channelId destPath");
687     return TCL_ERROR;
688       }
689       masterInterp = GetInterp(interp, objv[2]);
690       if (masterInterp == NULL) {
691     return TCL_ERROR;
692       }
693       chan = Tcl_GetChannel(masterInterp, Tcl_GetString(objv[3]),
694         NULL);
695       if (chan == NULL) {
696     TclTransferResult(masterInterp, TCL_OK, interp);
697     return TCL_ERROR;
698       }
699       slaveInterp = GetInterp(interp, objv[4]);
700       if (slaveInterp == NULL) {
701     return TCL_ERROR;
702       }
703       Tcl_RegisterChannel(slaveInterp, chan);
704       return TCL_OK;
705   }
706   case OPT_TARGET: {
707       Tcl_Interp *slaveInterp;
708       InterpInfo *iiPtr;
709       Tcl_HashEntry *hPtr;  
710       Alias *aliasPtr;    
711       char *aliasName;
712 
713       if (objc != 4) {
714     Tcl_WrongNumArgs(interp, 2, objv, "path alias");
715     return TCL_ERROR;
716       }
717 
718       slaveInterp = GetInterp(interp, objv[2]);
719       if (slaveInterp == NULL) {
720     return TCL_ERROR;
721       }
722 
723       aliasName = Tcl_GetString(objv[3]);
724 
725       iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
726       hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
727       if (hPtr == NULL) {
728     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
729       "alias \"", aliasName, "\" in path \"",
730       Tcl_GetString(objv[2]), "\" not found",
731       (char *) NULL);
732     return TCL_ERROR;
733       }
734       aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
735       if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) {
736     Tcl_ResetResult(interp);
737     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
738       "target interpreter for alias \"", aliasName,
739       "\" in path \"", Tcl_GetString(objv[2]),
740       "\" is not my descendant", (char *) NULL);
741     return TCL_ERROR;
742       }
743       return TCL_OK;
744   }
745   case OPT_TRANSFER: {
746       Tcl_Interp *slaveInterp;    /* A slave. */
747       Tcl_Interp *masterInterp;   /* Its master. */
748       Tcl_Channel chan;
749         
750       if (objc != 5) {
751     Tcl_WrongNumArgs(interp, 2, objv,
752       "srcPath channelId destPath");
753     return TCL_ERROR;
754       }
755       masterInterp = GetInterp(interp, objv[2]);
756       if (masterInterp == NULL) {
757     return TCL_ERROR;
758       }
759       chan = Tcl_GetChannel(masterInterp, Tcl_GetString(objv[3]), NULL);
760       if (chan == NULL) {
761     TclTransferResult(masterInterp, TCL_OK, interp);
762     return TCL_ERROR;
763       }
764       slaveInterp = GetInterp(interp, objv[4]);
765       if (slaveInterp == NULL) {
766     return TCL_ERROR;
767       }
768       Tcl_RegisterChannel(slaveInterp, chan);
769       if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
770     TclTransferResult(masterInterp, TCL_OK, interp);
771     return TCL_ERROR;
772       }
773       return TCL_OK;
774   }
775     }
776     return TCL_OK;
777 }
int Tcl_IsSafe (Tcl_Interp * interp)

Definition at line 2391 of file tclInterp.c.
References Interp::flags, NULL, and SAFE_INTERP.
Referenced by DdeSetServerName(), GetChannelTable(), HandleBgErrors(), SlaveCreate(), SlaveExpose(), SlaveHide(), SlaveInvokeHidden(), SlaveMarkTrusted(), SlaveObjCmd(), SlaveRecursionLimit(), Tcl_InterpObjCmd(), and TclPrecTraceProc().2393 {
2394     Interp *iPtr;
2395 
2396     if (interp == (Tcl_Interp *) NULL) {
2397         return 0;
2398     }
2399     iPtr = (Interp *) interp;
2400 
2401     return ( (iPtr->flags) & SAFE_INTERP ) ? 1 : 0 ;
2402 }
int Tcl_MakeSafe (Tcl_Interp * interp)

Definition at line 2424 of file tclInterp.c.
References Interp::flags, NULL, SAFE_INTERP, Tcl_GetStdChannel(), TCL_GLOBAL_ONLY, TCL_OK, TCL_STDERR, TCL_STDIN, TCL_STDOUT, Tcl_UnregisterChannel(), Tcl_UnsetVar(), Tcl_UnsetVar2(), and TclHideUnsafeCommands().
Referenced by SlaveCreate().2426 {
2427     Tcl_Channel chan;       /* Channel to remove from
2428                                                  * safe interpreter. */
2429     Interp *iPtr = (Interp *) interp;
2430 
2431     TclHideUnsafeCommands(interp);
2432     
2433     iPtr->flags |= SAFE_INTERP;
2434 
2435     /*
2436      *  Unsetting variables : (which should not have been set 
2437      *  in the first place, but...)
2438      */
2439 
2440     /*
2441      * No env array in a safe slave.
2442      */
2443 
2444     Tcl_UnsetVar(interp, "env", TCL_GLOBAL_ONLY);
2445 
2446     /* 
2447      * Remove unsafe parts of tcl_platform
2448      */
2449 
2450     Tcl_UnsetVar2(interp, "tcl_platform", "os", TCL_GLOBAL_ONLY);
2451     Tcl_UnsetVar2(interp, "tcl_platform", "osVersion", TCL_GLOBAL_ONLY);
2452     Tcl_UnsetVar2(interp, "tcl_platform", "machine", TCL_GLOBAL_ONLY);
2453     Tcl_UnsetVar2(interp, "tcl_platform", "user", TCL_GLOBAL_ONLY);
2454 
2455     /*
2456      * Unset path informations variables
2457      * (the only one remaining is [info nameofexecutable])
2458      */
2459 
2460     Tcl_UnsetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY);
2461     Tcl_UnsetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
2462     Tcl_UnsetVar(interp, "tcl_pkgPath", TCL_GLOBAL_ONLY);
2463     
2464     /*
2465      * Remove the standard channels from the interpreter; safe interpreters
2466      * do not ordinarily have access to stdin, stdout and stderr.
2467      *
2468      * NOTE: These channels are not added to the interpreter by the
2469      * Tcl_CreateInterp call, but may be added later, by another I/O
2470      * operation. We want to ensure that the interpreter does not have
2471      * these channels even if it is being made safe after being used for
2472      * some time..
2473      */
2474 
2475     chan = Tcl_GetStdChannel(TCL_STDIN);
2476     if (chan != (Tcl_Channel) NULL) {
2477         Tcl_UnregisterChannel(interp, chan);
2478     }
2479     chan = Tcl_GetStdChannel(TCL_STDOUT);
2480     if (chan != (Tcl_Channel) NULL) {
2481         Tcl_UnregisterChannel(interp, chan);
2482     }
2483     chan = Tcl_GetStdChannel(TCL_STDERR);
2484     if (chan != (Tcl_Channel) NULL) {
2485         Tcl_UnregisterChannel(interp, chan);
2486     }
2487 
2488     return TCL_OK;
2489 }
int TclInterpInit (Tcl_Interp * interp)

Definition at line 222 of file tclInterp.c.
References Slave::aliasTable, ckalloc, Slave::interpCmd, InterpInfoDeleteProc(), InterpInfo::master, Slave::masterInterp, NULL, InterpInfo::slave, Slave::slaveEntryPtr, Slave::slaveInterp, Master::slaveTable, Master::targetTable, Tcl_CallWhenDeleted(), Tcl_CreateObjCommand(), Tcl_InitHashTable(), Tcl_InterpObjCmd(), TCL_OK, TCL_ONE_WORD_KEYS, and TCL_STRING_KEYS.224 {
225     InterpInfo *interpInfoPtr;
226     Master *masterPtr;
227     Slave *slavePtr;  
228 
229     interpInfoPtr = (InterpInfo *) ckalloc(sizeof(InterpInfo));
230     ((Interp *) interp)->interpInfo = (ClientData) interpInfoPtr;
231 
232     masterPtr = &interpInfoPtr->master;
233     Tcl_InitHashTable(&masterPtr->slaveTable, TCL_STRING_KEYS);
234     Tcl_InitHashTable(&masterPtr->targetTable, TCL_ONE_WORD_KEYS);
235 
236     slavePtr = &interpInfoPtr->slave;
237     slavePtr->masterInterp  = NULL;
238     slavePtr->slaveEntryPtr = NULL;
239     slavePtr->slaveInterp = interp;
240     slavePtr->interpCmd   = NULL;
241     Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
242 
243     Tcl_CreateObjCommand(interp, "interp", Tcl_InterpObjCmd, NULL, NULL);
244 
245     Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc, NULL);
246     return TCL_OK;
247 }
int TclPreventAliasLoop (Tcl_Interp * interp, Tcl_Interp * cmdInterp, Tcl_Command cmd)

Definition at line 1057 of file tclInterp.c.
References Alias, AliasObjCmd(), NULL, Command::objClientData, Command::objProc, TCL_ERROR, Tcl_FindCommand(), Tcl_GetGlobalNamespace(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_InterpDeleted(), and TCL_OK.
Referenced by AliasCreate(), and TclRenameCommand().1063 {
1064     Command *cmdPtr = (Command *) cmd;
1065     Alias *aliasPtr, *nextAliasPtr;
1066     Tcl_Command aliasCmd;
1067     Command *aliasCmdPtr;
1068 
1069     /*
1070      * If we are not creating or renaming an alias, then it is
1071      * always OK to create or rename the command.
1072      */
1073     
1074     if (cmdPtr->objProc != AliasObjCmd) {
1075         return TCL_OK;
1076     }
1077 
1078     /*
1079      * OK, we are dealing with an alias, so traverse the chain of aliases.
1080      * If we encounter the alias we are defining (or renaming to) any in
1081      * the chain then we have a loop.
1082      */
1083 
1084     aliasPtr = (Alias *) cmdPtr->objClientData;
1085     nextAliasPtr = aliasPtr;
1086     while (1) {
1087   Tcl_Obj *cmdNamePtr;
1088 
1089         /*
1090          * If the target of the next alias in the chain is the same as
1091          * the source alias, we have a loop.
1092    */
1093 
1094   if (Tcl_InterpDeleted(nextAliasPtr->targetInterp)) {
1095       /*
1096        * The slave interpreter can be deleted while creating the alias.
1097        * [Bug #641195]
1098        */
1099 
1100       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1101         "cannot define or rename alias \"",
1102         Tcl_GetString(aliasPtr->namePtr),
1103         "\": interpreter deleted", (char *) NULL);
1104       return TCL_ERROR;
1105   }
1106   cmdNamePtr = nextAliasPtr->objPtr;
1107   aliasCmd = Tcl_FindCommand(nextAliasPtr->targetInterp,
1108                 Tcl_GetString(cmdNamePtr),
1109     Tcl_GetGlobalNamespace(nextAliasPtr->targetInterp),
1110     /*flags*/ 0);
1111         if (aliasCmd == (Tcl_Command) NULL) {
1112             return TCL_OK;
1113         }
1114   aliasCmdPtr = (Command *) aliasCmd;
1115         if (aliasCmdPtr == cmdPtr) {
1116             Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1117         "cannot define or rename alias \"",
1118         Tcl_GetString(aliasPtr->namePtr),
1119         "\": would create a loop", (char *) NULL);
1120             return TCL_ERROR;
1121         }
1122 
1123         /*
1124    * Otherwise, follow the chain one step further. See if the target
1125          * command is an alias - if so, follow the loop to its target
1126          * command. Otherwise we do not have a loop.
1127    */
1128 
1129         if (aliasCmdPtr->objProc != AliasObjCmd) {
1130             return TCL_OK;
1131         }
1132         nextAliasPtr = (Alias *) aliasCmdPtr->objClientData;
1133     }
1134 
1135     /* NOTREACHED */
1136 }

Variable Documentation
Alias

Definition at line 63 of file tclInterp.c.
Referenced by AliasCreate(), AliasDelete(), AliasDescribe(), AliasList(), AliasObjCmd(), AliasObjCmdDeleteProc(), Tcl_GetAlias(), Tcl_GetAliasObj(), Tcl_InterpObjCmd(), and TclPreventAliasLoop().int aliasCounter = 0 [static]

Definition at line 23 of file tclInterp.c.
Referenced by AliasCreate().

generic/tclIntPlatDecls.h File Reference
Classes
struct TclIntPlatStubs
Functions
EXTERN void TclGetAndDetachPids _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan))
EXTERN int TclpCloseFile _ANSI_ARGS_ ((TclFile file))
EXTERN Tcl_Channel TclpCreateCommandChannel _ANSI_ARGS_ ((TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr))
EXTERN int TclpCreatePipe _ANSI_ARGS_ ((TclFile *readPipe, TclFile *writePipe))
EXTERN int TclpCreateProcess _ANSI_ARGS_ ((Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr))
EXTERN TclFile TclpMakeFile _ANSI_ARGS_ ((Tcl_Channel channel, int direction))
EXTERN TclFile TclpOpenFile _ANSI_ARGS_ ((CONST char *fname, int mode))
EXTERN int TclUnixWaitForFile _ANSI_ARGS_ ((int fd, int mask, int timeout))
EXTERN TclFile TclpCreateTempFile _ANSI_ARGS_ ((CONST char *contents))
EXTERN Tcl_DirEntry *TclpReaddir _ANSI_ARGS_ ((DIR *dir))
EXTERN struct tm *TclpLocaltime_unix _ANSI_ARGS_ ((CONST TclpTime_t clock))
EXTERN char *TclpInetNtoa _ANSI_ARGS_ ((struct in_addr addr))
Variables
TclIntPlatStubs * tclIntPlatStubsPtr

Function Documentation
EXTERN char* TclpInetNtoa _ANSI_ARGS_ ((struct in_addr addr))
EXTERN struct tm* TclpLocaltime_unix _ANSI_ARGS_ ((CONST TclpTime_t clock))
EXTERN Tcl_DirEntry* TclpReaddir _ANSI_ARGS_ ((DIR *dir))
EXTERN TclFile TclpCreateTempFile _ANSI_ARGS_ ((CONST char *contents))
EXTERN int TclUnixWaitForFile _ANSI_ARGS_ ((int fd, int mask, int timeout))
EXTERN TclFile TclpOpenFile _ANSI_ARGS_ ((CONST char *fname, int mode))
EXTERN TclFile TclpMakeFile _ANSI_ARGS_ ((Tcl_Channel channel, int direction))
EXTERN int TclpCreateProcess _ANSI_ARGS_ ((Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr))
EXTERN int TclpCreatePipe _ANSI_ARGS_ ((TclFile *readPipe, TclFile *writePipe))
EXTERN Tcl_Channel TclpCreateCommandChannel _ANSI_ARGS_ ((TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr))
EXTERN int TclpCloseFile _ANSI_ARGS_ ((TclFile file))
EXTERN void TclGetAndDetachPids _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan))

Variable Documentation
TclIntPlatStubs* tclIntPlatStubsPtr

Definition at line 39 of file tclStubLib.c.
Referenced by Tcl_InitStubs().

generic/tclIO.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include "tclIO.h"
#include <assert.h>
Classes
struct ThreadSpecificData
Defines
#define TCL_INHERIT_STD_CHANNELS  1
#define ENCODING_LINESIZE  20
#define UTF_EXPANSION_FACTOR  1024
Functions
static ChannelBuffer *AllocChannelBuffer _ANSI_ARGS_ ((int length))
static void ChannelTimerProc _ANSI_ARGS_ ((ClientData clientData))
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))
static void CleanupChannelHandlers _ANSI_ARGS_ ((Tcl_Interp *interp, Channel *chanPtr))
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))
static int CopyData _ANSI_ARGS_ ((CopyState *csPtr, int mask))
static void CopyEventProc _ANSI_ARGS_ ((ClientData clientData, int mask))
static void CreateScriptRecord _ANSI_ARGS_ ((Tcl_Interp *interp, Channel *chanPtr, int mask, Tcl_Obj *scriptPtr))
static void DeleteChannelTable _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp))
static void DeleteScriptRecord _ANSI_ARGS_ ((Tcl_Interp *interp, Channel *chanPtr, int mask))
static int DetachChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan))
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, CONST char *src, int srcLen))
static int DoReadChars _ANSI_ARGS_ ((Channel *chan, Tcl_Obj *objPtr, int toRead, int appendFlag))
static int DoWriteChars _ANSI_ARGS_ ((Channel *chan, CONST char *src, int len))
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 int HaveVersion _ANSI_ARGS_ ((Tcl_ChannelType *typePtr, Tcl_ChannelTypeVersion minimumVersion))
static void PeekAhead _ANSI_ARGS_ ((Channel *chanPtr, char **dstEndPtr, GetsState *gsPtr))
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))
static void RecycleBuffer _ANSI_ARGS_ ((ChannelState *statePtr, ChannelBuffer *bufPtr, int mustDiscard))
static int StackSetBlockMode _ANSI_ARGS_ ((Channel *chanPtr, int mode))
static void StopCopy _ANSI_ARGS_ ((CopyState *csPtr))
static int TranslateInputEOL _ANSI_ARGS_ ((ChannelState *statePtr, char *dst, CONST char *src, int *dstLenPtr, int *srcLenPtr))
void TclInitIOSubsystem ()
void TclFinalizeIOSubsystem ()
void Tcl_SetStdChannel (Tcl_Channel channel, int type)
Tcl_Channel Tcl_GetStdChannel (int type)
void Tcl_CreateCloseHandler (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData)
void Tcl_DeleteCloseHandler (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData)
static Tcl_HashTable * GetChannelTable (Tcl_Interp *interp)
static void DeleteChannelTable (ClientData clientData, Tcl_Interp *interp)
static void CheckForStdChannelsBeingClosed (Tcl_Channel chan)
int Tcl_IsStandardChannel (Tcl_Channel chan)
void Tcl_RegisterChannel (Tcl_Interp *interp, Tcl_Channel chan)
int Tcl_UnregisterChannel (Tcl_Interp *interp, Tcl_Channel chan)
int Tcl_DetachChannel (Tcl_Interp *interp, Tcl_Channel chan)
static int DetachChannel (Tcl_Interp *interp, Tcl_Channel chan)
Tcl_Channel Tcl_GetChannel (Tcl_Interp *interp, CONST char *chanName, int *modePtr)
Tcl_Channel Tcl_CreateChannel (Tcl_ChannelType *typePtr, CONST char *chanName, ClientData instanceData, int mask)
Tcl_Channel Tcl_StackChannel (Tcl_Interp *interp, Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan)
int Tcl_UnstackChannel (Tcl_Interp *interp, Tcl_Channel chan)
Tcl_Channel Tcl_GetStackedChannel (Tcl_Channel chan)
Tcl_Channel Tcl_GetTopChannel (Tcl_Channel chan)
ClientData Tcl_GetChannelInstanceData (Tcl_Channel chan)
Tcl_ThreadId Tcl_GetChannelThread (Tcl_Channel chan)
Tcl_ChannelType * Tcl_GetChannelType (Tcl_Channel chan)
int Tcl_GetChannelMode (Tcl_Channel chan)
CONST char * Tcl_GetChannelName (Tcl_Channel chan)
int Tcl_GetChannelHandle (Tcl_Channel chan, int direction, ClientData *handlePtr)
static ChannelBuffer * AllocChannelBuffer (int length)
static void RecycleBuffer (ChannelState *statePtr, ChannelBuffer *bufPtr, int mustDiscard)
static void DiscardOutputQueued (ChannelState *statePtr)
static int CheckForDeadChannel (Tcl_Interp *interp, ChannelState *statePtr)
static int FlushChannel (Tcl_Interp *interp, Channel *chanPtr, int calledFromAsyncFlush)
static int CloseChannel (Tcl_Interp *interp, Channel *chanPtr, int errorCode)
void Tcl_CutChannel (Tcl_Channel chan)
void Tcl_SpliceChannel (Tcl_Channel chan)
int Tcl_Close (Tcl_Interp *interp, Tcl_Channel chan)
void Tcl_ClearChannelHandlers (Tcl_Channel channel)
int Tcl_Write (Tcl_Channel chan, CONST char *src, int srcLen)
int Tcl_WriteRaw (Tcl_Channel chan, CONST char *src, int srcLen)
int Tcl_WriteChars (Tcl_Channel chan, CONST char *src, int len)
static int DoWriteChars (Channel *chanPtr, CONST char *src, int len)
int Tcl_WriteObj (Tcl_Channel chan, Tcl_Obj *objPtr)
static int WriteBytes (Channel *chanPtr, CONST char *src, int srcLen)
static int WriteChars (Channel *chanPtr, CONST char *src, int srcLen)
static int TranslateOutputEOL (ChannelState *statePtr, char *dst, CONST char *src, int *dstLenPtr, int *srcLenPtr)
static int CheckFlush (Channel *chanPtr, ChannelBuffer *bufPtr, int newlineFlag)
int Tcl_Gets (Tcl_Channel chan, Tcl_DString *lineRead)
int Tcl_GetsObj (Tcl_Channel chan, Tcl_Obj *objPtr)
static int FilterInputBytes (Channel *chanPtr, GetsState *gsPtr)
static void PeekAhead (Channel *chanPtr, char **dstEndPtr, GetsState *gsPtr)
static void CommonGetsCleanup (Channel *chanPtr, Tcl_Encoding encoding)
int Tcl_Read (Tcl_Channel chan, char *dst, int bytesToRead)
int Tcl_ReadRaw (Tcl_Channel chan, char *bufPtr, int bytesToRead)
int Tcl_ReadChars (Tcl_Channel chan, Tcl_Obj *objPtr, int toRead, int appendFlag)
static int DoReadChars (Channel *chanPtr, Tcl_Obj *objPtr, int toRead, int appendFlag)
static int ReadBytes (ChannelState *statePtr, Tcl_Obj *objPtr, int bytesToRead, int *offsetPtr)
static int ReadChars (ChannelState *statePtr, Tcl_Obj *objPtr, int charsToRead, int *offsetPtr, int *factorPtr)
static int TranslateInputEOL (ChannelState *statePtr, char *dstStart, CONST char *srcStart, int *dstLenPtr, int *srcLenPtr)
int Tcl_Ungets (Tcl_Channel chan, CONST char *str, int len, int atEnd)
int Tcl_Flush (Tcl_Channel chan)
static void DiscardInputQueued (ChannelState *statePtr, int discardSavedBuffers)
static int GetInput (Channel *chanPtr)
Tcl_WideInt Tcl_Seek (Tcl_Channel chan, Tcl_WideInt offset, int mode)
Tcl_WideInt Tcl_Tell (Tcl_Channel chan)
int Tcl_SeekOld (Tcl_Channel chan, int offset, int mode)
int Tcl_TellOld (Tcl_Channel chan)
static int CheckChannelErrors (ChannelState *statePtr, int flags)
int Tcl_Eof (Tcl_Channel chan)
int Tcl_InputBlocked (Tcl_Channel chan)
int Tcl_InputBuffered (Tcl_Channel chan)
int Tcl_OutputBuffered (Tcl_Channel chan)
int Tcl_ChannelBuffered (Tcl_Channel chan)
void Tcl_SetChannelBufferSize (Tcl_Channel chan, int sz)
int Tcl_GetChannelBufferSize (Tcl_Channel chan)
int Tcl_BadChannelOption (Tcl_Interp *interp, CONST char *optionName, CONST char *optionList)
int Tcl_GetChannelOption (Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, Tcl_DString *dsPtr)
int Tcl_SetChannelOption (Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, CONST char *newValue)
static void CleanupChannelHandlers (Tcl_Interp *interp, Channel *chanPtr)
void Tcl_NotifyChannel (Tcl_Channel channel, int mask)
static void UpdateInterest (Channel *chanPtr)
static void ChannelTimerProc (ClientData clientData)
void Tcl_CreateChannelHandler (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData)
void Tcl_DeleteChannelHandler (Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData)
static void DeleteScriptRecord (Tcl_Interp *interp, Channel *chanPtr, int mask)
static void CreateScriptRecord (Tcl_Interp *interp, Channel *chanPtr, int mask, Tcl_Obj *scriptPtr)
void TclChannelEventScriptInvoker (ClientData clientData, int mask)
int Tcl_FileEventObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
int TclCopyChannel (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
static int CopyData (CopyState *csPtr, int mask)
static int DoRead (Channel *chanPtr, char *bufPtr, int toRead)
static int CopyAndTranslateBuffer (ChannelState *statePtr, char *result, int space)
static int CopyBuffer (Channel *chanPtr, char *result, int space)
static int DoWrite (Channel *chanPtr, CONST char *src, int srcLen)
static void CopyEventProc (ClientData clientData, int mask)
static void StopCopy (CopyState *csPtr)
static int StackSetBlockMode (Channel *chanPtr, int mode)
static int SetBlockMode (Tcl_Interp *interp, Channel *chanPtr, int mode)
int Tcl_GetChannelNames (Tcl_Interp *interp)
int Tcl_GetChannelNamesEx (Tcl_Interp *interp, CONST char *pattern)
int Tcl_IsChannelRegistered (Tcl_Interp *interp, Tcl_Channel chan)
int Tcl_IsChannelShared (Tcl_Channel chan)
int Tcl_IsChannelExisting (CONST char *chanName)
CONST char * Tcl_ChannelName (Tcl_ChannelType *chanTypePtr)
Tcl_ChannelTypeVersion Tcl_ChannelVersion (Tcl_ChannelType *chanTypePtr)
static int HaveVersion (Tcl_ChannelType *chanTypePtr, Tcl_ChannelTypeVersion minimumVersion)
Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc (Tcl_ChannelType *chanTypePtr)
Tcl_DriverCloseProc * Tcl_ChannelCloseProc (Tcl_ChannelType *chanTypePtr)
Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc (Tcl_ChannelType *chanTypePtr)
Tcl_DriverInputProc * Tcl_ChannelInputProc (Tcl_ChannelType *chanTypePtr)
Tcl_DriverOutputProc * Tcl_ChannelOutputProc (Tcl_ChannelType *chanTypePtr)
Tcl_DriverSeekProc * Tcl_ChannelSeekProc (Tcl_ChannelType *chanTypePtr)
Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc (Tcl_ChannelType *chanTypePtr)
Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc (Tcl_ChannelType *chanTypePtr)
Tcl_DriverWatchProc * Tcl_ChannelWatchProc (Tcl_ChannelType *chanTypePtr)
Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc (Tcl_ChannelType *chanTypePtr)
Tcl_DriverFlushProc * Tcl_ChannelFlushProc (Tcl_ChannelType *chanTypePtr)
Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc (Tcl_ChannelType *chanTypePtr)
Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc (Tcl_ChannelType *chanTypePtr)
Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc (Tcl_ChannelType *chanTypePtr)
Variables
static Tcl_ThreadDataKey dataKey

Define Documentation
#define ENCODING_LINESIZE  20

Referenced by FilterInputBytes().#define TCL_INHERIT_STD_CHANNELS  1

Definition at line 22 of file tclIO.c.#define UTF_EXPANSION_FACTOR  1024

Referenced by DoReadChars(), and ReadChars().
Function Documentation
static int TranslateInputEOL _ANSI_ARGS_ ((ChannelState *statePtr, char *dst, CONST char *src, int *dstLenPtr, int *srcLenPtr)) [static]
static void StopCopy _ANSI_ARGS_ ((CopyState *csPtr)) [static]
static int StackSetBlockMode _ANSI_ARGS_ ((Channel *chanPtr, int mode)) [static]
static void RecycleBuffer _ANSI_ARGS_ ((ChannelState *statePtr, ChannelBuffer *bufPtr, int mustDiscard)) [static]
static int ReadChars _ANSI_ARGS_ ((ChannelState *statePtr, Tcl_Obj *objPtr, int charsLeft, int *offsetPtr, int *factorPtr)) [static]
static int ReadBytes _ANSI_ARGS_ ((ChannelState *statePtr, Tcl_Obj *objPtr, int charsLeft, int *offsetPtr)) [static]
static void PeekAhead _ANSI_ARGS_ ((Channel *chanPtr, char **dstEndPtr, GetsState *gsPtr)) [static]
static int HaveVersion _ANSI_ARGS_ ((Tcl_ChannelType *typePtr, Tcl_ChannelTypeVersion minimumVersion)) [static]
static int GetInput _ANSI_ARGS_ ((Channel *chanPtr)) [static]
static Tcl_HashTable* GetChannelTable _ANSI_ARGS_ ((Tcl_Interp *interp)) [static]
static int FlushChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Channel *chanPtr, int calledFromAsyncFlush)) [static]
static int FilterInputBytes _ANSI_ARGS_ ((Channel *chanPtr, GetsState *statePtr)) [static]
static int DoWriteChars _ANSI_ARGS_ ((Channel *chan, CONST char *src, int len)) [static]
static int DoReadChars _ANSI_ARGS_ ((Channel *chan, Tcl_Obj *objPtr, int toRead, int appendFlag)) [static]
static int DoWrite _ANSI_ARGS_ ((Channel *chanPtr, CONST char *src, int srcLen)) [static]
static int DoRead _ANSI_ARGS_ ((Channel *chanPtr, char *srcPtr, int slen)) [static]
static void DiscardOutputQueued _ANSI_ARGS_ ((ChannelState *chanPtr)) [static]
static void DiscardInputQueued _ANSI_ARGS_ ((ChannelState *statePtr, int discardSavedBuffers)) [static]
static int DetachChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Channel chan)) [static]
static void DeleteScriptRecord _ANSI_ARGS_ ((Tcl_Interp *interp, Channel *chanPtr, int mask)) [static]
static void DeleteChannelTable _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp)) [static]
static void CreateScriptRecord _ANSI_ARGS_ ((Tcl_Interp *interp, Channel *chanPtr, int mask, Tcl_Obj *scriptPtr)) [static]
static void CopyEventProc _ANSI_ARGS_ ((ClientData clientData, int mask)) [static]
static int CopyData _ANSI_ARGS_ ((CopyState *csPtr, int mask)) [static]
static int CopyBuffer _ANSI_ARGS_ ((Channel *chanPtr, char *result, int space)) [static]
static int CopyAndTranslateBuffer _ANSI_ARGS_ ((ChannelState *statePtr, char *result, int space)) [static]
static void CommonGetsCleanup _ANSI_ARGS_ ((Channel *chanPtr, Tcl_Encoding encoding)) [static]
static int CloseChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Channel *chanPtr, int errorCode)) [static]
static void CleanupChannelHandlers _ANSI_ARGS_ ((Tcl_Interp *interp, Channel *chanPtr)) [static]
static void CheckForStdChannelsBeingClosed _ANSI_ARGS_ ((Tcl_Channel chan)) [static]
static int CheckForDeadChannel _ANSI_ARGS_ ((Tcl_Interp *interp, ChannelState *statePtr)) [static]
static int CheckFlush _ANSI_ARGS_ ((Channel *chanPtr, ChannelBuffer *bufPtr, int newlineFlag)) [static]
static int CheckChannelErrors _ANSI_ARGS_ ((ChannelState *statePtr, int direction)) [static]
static void ChannelTimerProc _ANSI_ARGS_ ((ClientData clientData)) [static]
static ChannelBuffer* AllocChannelBuffer _ANSI_ARGS_ ((int length)) [static]
static ChannelBuffer* AllocChannelBuffer (int length) [static]

Definition at line 1841 of file tclIO.c.
References BUFFER_PADDING, ChannelBuffer::bufLength, CHANNELBUFFER_HEADER_SIZE, ckalloc, ChannelBuffer::nextAdded, ChannelBuffer::nextPtr, ChannelBuffer::nextRemoved, and NULL.
Referenced by DoWrite(), FilterInputBytes(), GetInput(), Tcl_Ungets(), WriteBytes(), and WriteChars().1843 {
1844     ChannelBuffer *bufPtr;
1845     int n;
1846 
1847     n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
1848     bufPtr = (ChannelBuffer *) ckalloc((unsigned) n);
1849     bufPtr->nextAdded = BUFFER_PADDING;
1850     bufPtr->nextRemoved = BUFFER_PADDING;
1851     bufPtr->bufLength = length + BUFFER_PADDING;
1852     bufPtr->nextPtr = (ChannelBuffer *) NULL;
1853     return bufPtr;
1854 }
static void ChannelTimerProc (ClientData clientData) [static]

Definition at line 7146 of file tclIO.c.
References CHANNEL_NEED_MORE_DATA, CHANNEL_NONBLOCKING, NULL, Channel::state, Tcl_ChannelBlockModeProc(), Tcl_CreateTimerHandler(), Tcl_NotifyChannel(), Tcl_Preserve(), TCL_READABLE, Tcl_Release(), and UpdateInterest().
Referenced by UpdateInterest().7148 {
7149     Channel *chanPtr = (Channel *) clientData;
7150     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
7151 
7152     if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
7153       && (statePtr->interestMask & TCL_READABLE)
7154       && (statePtr->inQueueHead != (ChannelBuffer *) NULL)
7155       && (statePtr->inQueueHead->nextRemoved <
7156         statePtr->inQueueHead->nextAdded)) {
7157   /*
7158    * Restart the timer in case a channel handler reenters the
7159    * event loop before UpdateInterest gets called by Tcl_NotifyChannel.
7160    */
7161 
7162   statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
7163     (ClientData) chanPtr);
7164 
7165 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
7166   /* Set the TIMER flag to notify the higher levels that the
7167    * driver might have no data for us. We do this only if we are
7168    * in non-blocking mode and the driver has no BlockModeProc
7169    * because only then we really don't know if the driver will
7170    * block or not. A similar test is done in "PeekAhead".
7171    */
7172 
7173   if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
7174       (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {
7175       statePtr->flags |= CHANNEL_TIMER_FEV;
7176   }
7177 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
7178 
7179   Tcl_Preserve((ClientData) statePtr);
7180   Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
7181 
7182 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
7183   statePtr->flags &= ~CHANNEL_TIMER_FEV; 
7184 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
7185 
7186   Tcl_Release((ClientData) statePtr);
7187     } else {
7188   statePtr->timer = NULL;
7189   UpdateInterest(chanPtr);
7190     }
7191 }
static int CheckChannelErrors (ChannelState * statePtr, int flags) [static]

Definition at line 5865 of file tclIO.c.
References CHANNEL_BLOCKED, CHANNEL_CLOSED, CHANNEL_EOF, CHANNEL_NEED_MORE_DATA, CHANNEL_RAW_MODE, CHANNEL_STICKY_EOF, EACCES, EBUSY, NULL, TCL_READABLE, Tcl_SetErrno(), and TCL_WRITABLE.
Referenced by Tcl_Close(), Tcl_Flush(), Tcl_GetsObj(), Tcl_Read(), Tcl_ReadChars(), Tcl_ReadRaw(), Tcl_Seek(), Tcl_SetChannelOption(), Tcl_Tell(), Tcl_Ungets(), Tcl_Write(), Tcl_WriteChars(), Tcl_WriteObj(), and Tcl_WriteRaw().5867                                                                  :
5868          * TCL_READABLE, TCL_WRITABLE.  Also indicates
5869          * Raw read or write for special close
5870          * processing*/
5871 {
5872     int direction = flags & (TCL_READABLE|TCL_WRITABLE);
5873 
5874     /*
5875      * Check for unreported error.
5876      */
5877 
5878     if (statePtr->unreportedError != 0) {
5879         Tcl_SetErrno(statePtr->unreportedError);
5880         statePtr->unreportedError = 0;
5881         return -1;
5882     }
5883 
5884     /*
5885      * Only the raw read and write operations are allowed during close
5886      * in order to drain data from stacked channels.
5887      */
5888 
5889     if ((statePtr->flags & CHANNEL_CLOSED) &&
5890       ((flags & CHANNEL_RAW_MODE) == 0)) {
5891         Tcl_SetErrno(EACCES);
5892         return -1;
5893     }
5894 
5895     /*
5896      * Fail if the channel is not opened for desired operation.
5897      */
5898 
5899     if ((statePtr->flags & direction) == 0) {
5900         Tcl_SetErrno(EACCES);
5901         return -1;
5902     }
5903 
5904     /*
5905      * Fail if the channel is in the middle of a background copy.
5906      *
5907      * Don't do this tests for raw channels here or else the chaining in the
5908      * transformation drivers will fail with 'file busy' error instead of
5909      * retrieving and transforming the data to copy.
5910      */
5911 
5912     if ((statePtr->csPtr != NULL) && ((flags & CHANNEL_RAW_MODE) == 0)) {
5913   Tcl_SetErrno(EBUSY);
5914   return -1;
5915     }
5916 
5917     if (direction == TCL_READABLE) {
5918   /*
5919    * If we have not encountered a sticky EOF, clear the EOF bit
5920    * (sticky EOF is set if we have seen the input eofChar, to prevent
5921    * reading beyond the eofChar). Also, always clear the BLOCKED bit.
5922    * We want to discover these conditions anew in each operation.
5923    */
5924 
5925   if ((statePtr->flags & CHANNEL_STICKY_EOF) == 0) {
5926       statePtr->flags &= ~CHANNEL_EOF;
5927   }
5928   statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
5929     }
5930 
5931     return 0;
5932 }

static int CheckFlush (Channel * chanPtr, ChannelBuffer * bufPtr, int newlineFlag) [static]

Definition at line 3458 of file tclIO.c.
References BUFFER_READY, ChannelBuffer::bufLength, CHANNEL_LINEBUFFERED, CHANNEL_UNBUFFERED, FlushChannel(), ChannelBuffer::nextAdded, and NULL.
Referenced by WriteBytes(), and WriteChars().3463 {
3464     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
3465     /*
3466      * The current buffer is ready for output:
3467      * 1. if it is full.
3468      * 2. if it contains a newline and this channel is line-buffered.
3469      * 3. if it contains any output and this channel is unbuffered.
3470      */
3471 
3472     if ((statePtr->flags & BUFFER_READY) == 0) {
3473   if (bufPtr->nextAdded == bufPtr->bufLength) {
3474       statePtr->flags |= BUFFER_READY;
3475   } else if (statePtr->flags & CHANNEL_LINEBUFFERED) {
3476       if (newlineFlag != 0) {
3477     statePtr->flags |= BUFFER_READY;
3478       }
3479   } else if (statePtr->flags & CHANNEL_UNBUFFERED) {
3480       statePtr->flags |= BUFFER_READY;
3481   }
3482     }
3483     if (statePtr->flags & BUFFER_READY) {
3484   if (FlushChannel(NULL, chanPtr, 0) != 0) {
3485       return -1;
3486   }
3487     }
3488     return 0;
3489 }
static int CheckForDeadChannel (Tcl_Interp * interp, ChannelState * statePtr) [static]

Definition at line 1992 of file tclIO.c.
References CHANNEL_DEAD, EINVAL, NULL, and Tcl_SetErrno().
Referenced by FlushChannel(), GetInput(), Tcl_GetChannelOption(), Tcl_Seek(), Tcl_SetChannelOption(), and Tcl_Tell().1995 {
1996     if (statePtr->flags & CHANNEL_DEAD) {
1997         Tcl_SetErrno(EINVAL);
1998   if (interp) {
1999       Tcl_AppendResult(interp,
2000         "unable to access channel: invalid channel",
2001         (char *) NULL);   
2002   }
2003   return 1;
2004     }
2005     return 0;
2006 }
static void CheckForStdChannelsBeingClosed (Tcl_Channel chan) [static]

Definition at line 686 of file tclIO.c.
References dataKey, NULL, ThreadSpecificData::stderrChannel, ThreadSpecificData::stderrInitialized, ThreadSpecificData::stdinChannel, ThreadSpecificData::stdinInitialized, ThreadSpecificData::stdoutChannel, ThreadSpecificData::stdoutInitialized, and TCL_TSD_INIT.
Referenced by Tcl_Close(), and Tcl_UnregisterChannel().688 {
689     ChannelState *statePtr = ((Channel *) chan)->state;
690     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
691 
692     if ((chan == tsdPtr->stdinChannel) && (tsdPtr->stdinInitialized)) {
693         if (statePtr->refCount < 2) {
694             statePtr->refCount = 0;
695             tsdPtr->stdinChannel = NULL;
696             return;
697         }
698     } else if ((chan == tsdPtr->stdoutChannel)
699       && (tsdPtr->stdoutInitialized)) {
700         if (statePtr->refCount < 2) {
701             statePtr->refCount = 0;
702             tsdPtr->stdoutChannel = NULL;
703             return;
704         }
705     } else if ((chan == tsdPtr->stderrChannel)
706       && (tsdPtr->stderrInitialized)) {
707         if (statePtr->refCount < 2) {
708             statePtr->refCount = 0;
709             tsdPtr->stderrChannel = NULL;
710             return;
711         }
712     }
713 }
static void CleanupChannelHandlers (Tcl_Interp * interp, Channel * chanPtr) [static]

Definition at line 6841 of file tclIO.c.
References ckfree, EventScriptRecord::interp, EventScriptRecord::nextPtr, NULL, Channel::state, Tcl_DecrRefCount, Tcl_DeleteChannelHandler(), and TclChannelEventScriptInvoker().
Referenced by DetachChannel().6844 {
6845     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
6846     EventScriptRecord *sPtr, *prevPtr, *nextPtr;
6847 
6848     /*
6849      * Remove fileevent records on this channel that refer to the
6850      * given interpreter.
6851      */
6852     
6853     for (sPtr = statePtr->scriptRecordPtr,
6854              prevPtr = (EventScriptRecord *) NULL;
6855    sPtr != (EventScriptRecord *) NULL;
6856    sPtr = nextPtr) {
6857         nextPtr = sPtr->nextPtr;
6858         if (sPtr->interp == interp) {
6859             if (prevPtr == (EventScriptRecord *) NULL) {
6860                 statePtr->scriptRecordPtr = nextPtr;
6861             } else {
6862                 prevPtr->nextPtr = nextPtr;
6863             }
6864 
6865             Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
6866                     TclChannelEventScriptInvoker, (ClientData) sPtr);
6867 
6868       Tcl_DecrRefCount(sPtr->scriptPtr);
6869             ckfree((char *) sPtr);
6870         } else {
6871             prevPtr = sPtr;
6872         }
6873     }
6874 }
static int CloseChannel (Tcl_Interp * interp, Channel * chanPtr, int errorCode) [static]

Definition at line 2259 of file tclIO.c.
References ckfree, dataKey, DiscardInputQueued(), ThreadSpecificData::firstCSPtr, Channel::instanceData, NULL, Tcl_ChannelType::outputProc, panic, Channel::state, Tcl_Close(), TCL_CLOSE2PROC, Tcl_CutChannel(), Tcl_DeleteTimerHandler(), TCL_DYNAMIC, Tcl_EventuallyFree(), Tcl_FreeEncoding(), Tcl_SetErrno(), TCL_TSD_INIT, TCL_WRITABLE, Channel::typePtr, and Channel::upChanPtr.
Referenced by FlushChannel().2263 {
2264     int result = 0;     /* Of calling driver close
2265                                          * operation. */
2266     ChannelState *statePtr;   /* state of the channel stack. */
2267     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2268 
2269     if (chanPtr == NULL) {
2270         return result;
2271     }
2272     statePtr = chanPtr->state;
2273 
2274     /*
2275      * No more input can be consumed so discard any leftover input.
2276      */
2277 
2278     DiscardInputQueued(statePtr, 1);
2279 
2280     /*
2281      * Discard a leftover buffer in the current output buffer field.
2282      */
2283 
2284     if (statePtr->curOutPtr != (ChannelBuffer *) NULL) {
2285         ckfree((char *) statePtr->curOutPtr);
2286         statePtr->curOutPtr = (ChannelBuffer *) NULL;
2287     }
2288     
2289     /*
2290      * The caller guarantees that there are no more buffers
2291      * queued for output.
2292      */
2293 
2294     if (statePtr->outQueueHead != (ChannelBuffer *) NULL) {
2295         panic("TclFlush, closed channel: queued output left");
2296     }
2297 
2298     /*
2299      * If the EOF character is set in the channel, append that to the
2300      * output device.
2301      */
2302 
2303     if ((statePtr->outEofChar != 0) && (statePtr->flags & TCL_WRITABLE)) {
2304         int dummy;
2305         char c;
2306 
2307         c = (char) statePtr->outEofChar;
2308         (chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
2309     }
2310 
2311     /*
2312      * Remove this channel from of the list of all channels.
2313      */
2314     Tcl_CutChannel((Tcl_Channel) chanPtr);
2315 
2316     /*
2317      * Close and free the channel driver state.
2318      */
2319 
2320     if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
2321   result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
2322     } else {
2323   result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
2324     0);
2325     }
2326 
2327     /*
2328      * Some resources can be cleared only if the bottom channel
2329      * in a stack is closed. All the other channels in the stack
2330      * are not allowed to remove.
2331      */
2332 
2333     if (chanPtr == statePtr->bottomChanPtr) {
2334   if (statePtr->channelName != (char *) NULL) {
2335       ckfree((char *) statePtr->channelName);
2336       statePtr->channelName = NULL;
2337   }
2338 
2339   Tcl_FreeEncoding(statePtr->encoding);
2340   if (statePtr->outputStage != NULL) {
2341       ckfree((char *) statePtr->outputStage);
2342       statePtr->outputStage = (char *) NULL;
2343   }
2344     }
2345 
2346     /*
2347      * If we are being called synchronously, report either
2348      * any latent error on the channel or the current error.
2349      */
2350 
2351     if (statePtr->unreportedError != 0) {
2352         errorCode = statePtr->unreportedError;
2353     }
2354     if (errorCode == 0) {
2355         errorCode = result;
2356         if (errorCode != 0) {
2357             Tcl_SetErrno(errorCode);
2358         }
2359     }
2360 
2361     /*
2362      * Cancel any outstanding timer.
2363      */
2364 
2365     Tcl_DeleteTimerHandler(statePtr->timer);
2366 
2367     /*
2368      * Mark the channel as deleted by clearing the type structure.
2369      */
2370 
2371     if (chanPtr->downChanPtr != (Channel *) NULL) {
2372   Channel *downChanPtr = chanPtr->downChanPtr;
2373 
2374   statePtr->nextCSPtr = tsdPtr->firstCSPtr;
2375   tsdPtr->firstCSPtr  = statePtr;
2376 
2377   statePtr->topChanPtr  = downChanPtr;
2378   downChanPtr->upChanPtr  = (Channel *) NULL;
2379   chanPtr->typePtr  = NULL;
2380 
2381   Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
2382   return Tcl_Close(interp, (Tcl_Channel) downChanPtr);
2383     }
2384 
2385     /*
2386      * There is only the TOP Channel, so we free the remaining
2387      * pointers we have and then ourselves.  Since this is the
2388      * last of the channels in the stack, make sure to free the
2389      * ChannelState structure associated with it.  We use
2390      * Tcl_EventuallyFree to allow for any last
2391      */
2392     chanPtr->typePtr = NULL;
2393 
2394     Tcl_EventuallyFree((ClientData) statePtr, TCL_DYNAMIC);
2395     Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
2396 
2397     return errorCode;
2398 }
static void CommonGetsCleanup (Channel * chanPtr, Tcl_Encoding encoding) [static]

Definition at line 4144 of file tclIO.c.
References ChannelBuffer::nextAdded, ChannelBuffer::nextPtr, ChannelBuffer::nextRemoved, NULL, and RecycleBuffer().4147 {
4148     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
4149     ChannelBuffer *bufPtr, *nextPtr;
4150     
4151     bufPtr = statePtr->inQueueHead;
4152     for ( ; bufPtr != NULL; bufPtr = nextPtr) {
4153   nextPtr = bufPtr->nextPtr;
4154   if (bufPtr->nextRemoved < bufPtr->nextAdded) {
4155       break;
4156   }
4157   RecycleBuffer(statePtr, bufPtr, 0);
4158     }
4159     statePtr->inQueueHead = bufPtr;
4160     if (bufPtr == NULL) {
4161   statePtr->inQueueTail = NULL;
4162     } else {
4163   /*
4164    * If any multi-byte characters were split across channel buffer
4165    * boundaries, the split-up bytes were moved to the next channel
4166    * buffer by FilterInputBytes().  Move the bytes back to their
4167    * original buffer because the caller could change the channel's
4168    * encoding which could change the interpretation of whether those
4169    * bytes really made up multi-byte characters after all.
4170    */
4171    
4172   nextPtr = bufPtr->nextPtr;
4173   for ( ; nextPtr != NULL; nextPtr = bufPtr->nextPtr) {
4174       int extra;
4175 
4176       extra = bufPtr->bufLength - bufPtr->nextAdded;
4177       if (extra > 0) {
4178     memcpy((VOID *) (bufPtr->buf + bufPtr->nextAdded),
4179       (VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
4180       (size_t) extra);
4181     bufPtr->nextAdded += extra;
4182     nextPtr->nextRemoved = BUFFER_PADDING;
4183       }
4184       bufPtr = nextPtr;
4185   }
4186     }
4187     if (statePtr->encoding == NULL) {
4188   Tcl_FreeEncoding(encoding);
4189     }
4190 }
static int CopyAndTranslateBuffer (ChannelState * statePtr, char * result, int space) [static]

Definition at line 8127 of file tclIO.c.
References ChannelBuffer::buf, CHANNEL_EOF, INPUT_SAW_CR, ChannelBuffer::nextAdded, ChannelBuffer::nextRemoved, NULL, size_t(), TCL_TRANSLATE_CR, TCL_TRANSLATE_CRLF, and TCL_TRANSLATE_LF.
Referenced by DoRead().8132 {
8133     ChannelBuffer *bufPtr;  /* The buffer from which to copy bytes. */
8134     int bytesInBuffer;    /* How many bytes are available to be
8135                                  * copied in the current input buffer? */
8136     int copied;     /* How many characters were already copied
8137                                  * into the destination space? */
8138     int i;      /* Iterates over the copied input looking
8139                                  * for the input eofChar. */
8140     
8141     /*
8142      * If there is no input at all, return zero. The invariant is that either
8143      * there is no buffer in the queue, or if the first buffer is empty, it
8144      * is also the last buffer (and thus there is no input in the queue).
8145      * Note also that if the buffer is empty, we leave it in the queue.
8146      */
8147     
8148     if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
8149         return 0;
8150     }
8151     bufPtr = statePtr->inQueueHead;
8152     bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
8153 
8154     copied = 0;
8155     switch (statePtr->inputTranslation) {
8156         case TCL_TRANSLATE_LF: {
8157             if (bytesInBuffer == 0) {
8158                 return 0;
8159             }
8160 
8161       /*
8162              * Copy the current chunk into the result buffer.
8163              */
8164 
8165       if (bytesInBuffer < space) {
8166     space = bytesInBuffer;
8167       }
8168       memcpy((VOID *) result,
8169         (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
8170         (size_t) space);
8171       bufPtr->nextRemoved += space;
8172       copied = space;
8173             break;
8174   }
8175         case TCL_TRANSLATE_CR: {
8176       char *end;
8177       
8178             if (bytesInBuffer == 0) {
8179                 return 0;
8180             }
8181 
8182       /*
8183              * Copy the current chunk into the result buffer, then
8184              * replace all \r with \n.
8185              */
8186 
8187       if (bytesInBuffer < space) {
8188     space = bytesInBuffer;
8189       }
8190       memcpy((VOID *) result,
8191         (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
8192         (size_t) space);
8193       bufPtr->nextRemoved += space;
8194       copied = space;
8195 
8196       for (end = result + copied; result < end; result++) {
8197     if (*result == '\r') {
8198         *result = '\n';
8199     }
8200             }
8201             break;
8202   }
8203         case TCL_TRANSLATE_CRLF: {
8204       char *src, *end, *dst;
8205       int curByte;
8206       
8207             /*
8208              * If there is a held-back "\r" at EOF, produce it now.
8209              */
8210             
8211       if (bytesInBuffer == 0) {
8212                 if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
8213                         (INPUT_SAW_CR | CHANNEL_EOF)) {
8214                     result[0] = '\r';
8215                     statePtr->flags &= ~INPUT_SAW_CR;
8216                     return 1;
8217                 }
8218                 return 0;
8219             }
8220 
8221             /*
8222              * Copy the current chunk and replace "\r\n" with "\n"
8223              * (but not standalone "\r"!).
8224              */
8225 
8226       if (bytesInBuffer < space) {
8227     space = bytesInBuffer;
8228       }
8229       memcpy((VOID *) result,
8230         (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
8231         (size_t) space);
8232       bufPtr->nextRemoved += space;
8233       copied = space;
8234 
8235       end = result + copied;
8236       dst = result;
8237       for (src = result; src < end; src++) {
8238     curByte = *src;
8239     if (curByte == '\n') {
8240                     statePtr->flags &= ~INPUT_SAW_CR;
8241     } else if (statePtr->flags & INPUT_SAW_CR) {
8242         statePtr->flags &= ~INPUT_SAW_CR;
8243         *dst = '\r';
8244         dst++;
8245     }
8246     if (curByte == '\r') {
8247         statePtr->flags |= INPUT_SAW_CR;
8248     } else {
8249         *dst = (char) curByte;
8250         dst++;
8251     }
8252       }
8253       copied = dst - result;
8254       break;
8255   }
8256         case TCL_TRANSLATE_AUTO: {
8257       char *src, *end, *dst;
8258       int curByte;
8259   
8260             if (bytesInBuffer == 0) {
8261                 return 0;
8262             }
8263 
8264             /*
8265              * Loop over the current buffer, converting "\r" and "\r\n"
8266              * to "\n".
8267              */
8268 
8269       if (bytesInBuffer < space) {
8270     space = bytesInBuffer;
8271       }
8272       memcpy((VOID *) result,
8273         (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
8274         (size_t) space);
8275       bufPtr->nextRemoved += space;
8276       copied = space;
8277 
8278       end = result + copied;
8279       dst = result;
8280       for (src = result; src < end; src++) {
8281     curByte = *src;
8282     if (curByte == '\r') {
8283         statePtr->flags |= INPUT_SAW_CR;
8284         *dst = '\n';
8285         dst++;
8286     } else {
8287         if ((curByte != '\n') || 
8288           !(statePtr->flags & INPUT_SAW_CR)) {
8289       *dst = (char) curByte;
8290       dst++;
8291         }
8292         statePtr->flags &= ~INPUT_SAW_CR;
8293     }
8294       }
8295       copied = dst - result;
8296             break;
8297   }
8298         default: {
8299             panic("unknown eol translation mode");
8300   }
8301     }
8302 
8303     /*
8304      * If an in-stream EOF character is set for this channel, check that
8305      * the input we copied so far does not contain the EOF char.  If it does,
8306      * copy only up to and excluding that character.
8307      */
8308     
8309     if (statePtr->inEofChar != 0) {
8310         for (i = 0; i < copied; i++) {
8311             if (result[i] == (char) statePtr->inEofChar) {
8312     /*
8313      * Set sticky EOF so that no further input is presented
8314      * to the caller.
8315      */
8316     
8317     statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
8318     statePtr->inputEncodingFlags |= TCL_ENCODING_END;
8319     copied = i;
8320                 break;
8321             }
8322         }
8323     }
8324 
8325     /*
8326      * If the current buffer is empty recycle it.
8327      */
8328 
8329     if (bufPtr->nextRemoved == bufPtr->nextAdded) {
8330         statePtr->inQueueHead = bufPtr->nextPtr;
8331         if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
8332             statePtr->inQueueTail = (ChannelBuffer *) NULL;
8333         }
8334         RecycleBuffer(statePtr, bufPtr, 0);
8335     }
8336 
8337     /*
8338      * Return the number of characters copied into the result buffer.
8339      * This may be different from the number of bytes consumed, because
8340      * of EOL translations.
8341      */
8342 
8343     return copied;
8344 }
static int CopyBuffer (Channel * chanPtr, char * result, int space) [static]

Definition at line 8364 of file tclIO.c.
References ChannelBuffer::buf, ChannelBuffer::nextAdded, ChannelBuffer::nextPtr, ChannelBuffer::nextRemoved, NULL, RecycleBuffer(), and size_t().
Referenced by Tcl_ReadRaw().8369 {
8370     ChannelBuffer *bufPtr;  /* The buffer from which to copy bytes. */
8371     int bytesInBuffer;    /* How many bytes are available to be
8372                                  * copied in the current input buffer? */
8373     int copied;     /* How many characters were already copied
8374                                  * into the destination space? */
8375     
8376     /*
8377      * If there is no input at all, return zero. The invariant is that
8378      * either there is no buffer in the queue, or if the first buffer
8379      * is empty, it is also the last buffer (and thus there is no
8380      * input in the queue).  Note also that if the buffer is empty, we
8381      * don't leave it in the queue, but recycle it.
8382      */
8383     
8384     if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
8385         return 0;
8386     }
8387     bufPtr = chanPtr->inQueueHead;
8388     bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
8389 
8390     copied = 0;
8391 
8392     if (bytesInBuffer == 0) {
8393         RecycleBuffer(chanPtr->state, bufPtr, 0);
8394   chanPtr->inQueueHead = (ChannelBuffer*) NULL;
8395   chanPtr->inQueueTail = (ChannelBuffer*) NULL;
8396         return 0;
8397     }
8398 
8399     /*
8400      * Copy the current chunk into the result buffer.
8401      */
8402 
8403     if (bytesInBuffer < space) {
8404         space = bytesInBuffer;
8405     }
8406 
8407     memcpy((VOID *) result,
8408      (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
8409      (size_t) space);
8410     bufPtr->nextRemoved += space;
8411     copied = space;
8412 
8413     /*
8414      * We don't care about in-stream EOF characters here as the data
8415      * read here may still flow through one or more transformations,
8416      * i.e. is not in its final state yet.
8417      */
8418 
8419     /*
8420      * If the current buffer is empty recycle it.
8421      */
8422 
8423     if (bufPtr->nextRemoved == bufPtr->nextAdded) {
8424         chanPtr->inQueueHead = bufPtr->nextPtr;
8425         if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
8426             chanPtr->inQueueTail = (ChannelBuffer *) NULL;
8427         }
8428         RecycleBuffer(chanPtr->state, bufPtr, 0);
8429     }
8430 
8431     /*
8432      * Return the number of characters copied into the result buffer.
8433      */
8434 
8435     return copied;
8436 }
static int CopyData (CopyState * csPtr, int mask) [static]

Definition at line 7779 of file tclIO.c.
References BG_FLUSH_SCHEDULED, CopyEventProc(), DoRead(), DoReadChars(), DoWrite(), DoWriteChars(), ChannelState::encoding, ChannelState::flags, NULL, StopCopy(), Tcl_BackgroundError(), Tcl_CreateChannelHandler(), Tcl_DecrRefCount, Tcl_DeleteChannelHandler(), Tcl_DuplicateObj(), Tcl_Eof(), TCL_ERROR, TCL_EVAL_GLOBAL, Tcl_EvalObjEx(), Tcl_GetChannelName(), Tcl_GetObjResult(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_ListObjAppendElement(), Tcl_NewIntObj(), Tcl_NewObj(), TCL_OK, Tcl_PosixError(), Tcl_Preserve(), TCL_READABLE, Tcl_Release(), Tcl_ResetResult(), Tcl_SetErrno(), Tcl_SetIntObj(), Tcl_SetObjResult(), TCL_WRITABLE, ChannelState::topChanPtr, and ChannelState::unreportedError.
Referenced by CopyEventProc(), and TclCopyChannel().7782 {
7783     Tcl_Interp *interp;
7784     Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL;
7785     Tcl_Channel inChan, outChan;
7786     ChannelState *inStatePtr, *outStatePtr;
7787     int result = TCL_OK, size, total, sizeb;
7788     char* buffer;
7789 
7790     int inBinary, outBinary, sameEncoding; /* Encoding control */
7791     int underflow;  /* input underflow */
7792 
7793     inChan  = (Tcl_Channel) csPtr->readPtr;
7794     outChan = (Tcl_Channel) csPtr->writePtr;
7795     inStatePtr  = csPtr->readPtr->state;
7796     outStatePtr = csPtr->writePtr->state;
7797     interp  = csPtr->interp;
7798     cmdPtr  = csPtr->cmdPtr;
7799 
7800     /*
7801      * Copy the data the slow way, using the translation mechanism.
7802      *
7803      * Note: We have make sure that we use the topmost channel in a stack
7804      * for the copying. The caller uses Tcl_GetChannel to access it, and
7805      * thus gets the bottom of the stack.
7806      */
7807 
7808     inBinary     = (inStatePtr->encoding  == NULL);
7809     outBinary    = (outStatePtr->encoding == NULL);
7810     sameEncoding = (inStatePtr->encoding  == outStatePtr->encoding);
7811 
7812     if (!(inBinary || sameEncoding)) {
7813         bufObj = Tcl_NewObj ();
7814   Tcl_IncrRefCount (bufObj);
7815     }
7816 
7817     while (csPtr->toRead != 0) {
7818   /*
7819    * Check for unreported background errors.
7820    */
7821 
7822   if (inStatePtr->unreportedError != 0) {
7823       Tcl_SetErrno(inStatePtr->unreportedError);
7824       inStatePtr->unreportedError = 0;
7825       goto readError;
7826   }
7827   if (outStatePtr->unreportedError != 0) {
7828       Tcl_SetErrno(outStatePtr->unreportedError);
7829       outStatePtr->unreportedError = 0;
7830       goto writeError;
7831   }
7832   
7833   /*
7834    * Read up to bufSize bytes.
7835    */
7836 
7837   if ((csPtr->toRead == -1) || (csPtr->toRead > csPtr->bufSize)) {
7838       sizeb = csPtr->bufSize;
7839   } else {
7840       sizeb = csPtr->toRead;
7841   }
7842 
7843   if (inBinary || sameEncoding) {
7844       size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb);
7845   } else {
7846       size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, 0 /* No append */);
7847   }
7848   underflow = (size >= 0) && (size < sizeb);  /* input underflow */
7849 
7850   if (size < 0) {
7851       readError:
7852       errObj = Tcl_NewObj();
7853       Tcl_AppendStringsToObj(errObj, "error reading \"",
7854         Tcl_GetChannelName(inChan), "\": ",
7855         Tcl_PosixError(interp), (char *) NULL);
7856       break;
7857   } else if (underflow) {
7858       /*
7859        * We had an underflow on the read side.  If we are at EOF,
7860        * then the copying is done, otherwise set up a channel
7861        * handler to detect when the channel becomes readable again.
7862        */
7863       
7864       if ((size == 0) && Tcl_Eof(inChan)) {
7865     break;
7866       }
7867       if (! Tcl_Eof(inChan) && !(mask & TCL_READABLE)) {
7868     if (mask & TCL_WRITABLE) {
7869         Tcl_DeleteChannelHandler(outChan, CopyEventProc,
7870           (ClientData) csPtr);
7871     }
7872     Tcl_CreateChannelHandler(inChan, TCL_READABLE,
7873       CopyEventProc, (ClientData) csPtr);
7874       }
7875       if (size == 0) {
7876           if (bufObj != (Tcl_Obj*) NULL) {
7877         Tcl_DecrRefCount (bufObj);
7878         bufObj = (Tcl_Obj*) NULL;
7879     }
7880     return TCL_OK;
7881       }
7882   }
7883 
7884   /*
7885    * Now write the buffer out.
7886    */
7887 
7888   if (inBinary || sameEncoding) {
7889       buffer = csPtr->buffer;
7890       sizeb = size;
7891   } else {
7892       buffer = Tcl_GetStringFromObj (bufObj, &sizeb);
7893   }
7894 
7895   if (outBinary || sameEncoding) {
7896       sizeb = DoWrite(outStatePtr->topChanPtr, buffer, sizeb);
7897   } else {
7898       sizeb = DoWriteChars(outStatePtr->topChanPtr, buffer, sizeb);
7899   }
7900 
7901   if (inBinary || sameEncoding) {
7902       /* Both read and write counted bytes */
7903       size = sizeb;
7904   } /* else : Read counted characters, write counted bytes, i.e. size != sizeb */
7905 
7906   if (sizeb < 0) {
7907       writeError:
7908       errObj = Tcl_NewObj();
7909       Tcl_AppendStringsToObj(errObj, "error writing \"",
7910         Tcl_GetChannelName(outChan), "\": ",
7911         Tcl_PosixError(interp), (char *) NULL);
7912       break;
7913   }
7914 
7915   /*
7916    * Update the current byte count.  Do it now so the count is
7917    * valid before a return or break takes us out of the loop.
7918    * The invariant at the top of the loop should be that 
7919    * csPtr->toRead holds the number of bytes left to copy.
7920    */
7921 
7922   if (csPtr->toRead != -1) {
7923       csPtr->toRead -= size;
7924   }
7925   csPtr->total += size;
7926 
7927   /*
7928    * Break loop if EOF && (size>0)
7929    */
7930 
7931         if (Tcl_Eof(inChan)) {
7932             break;
7933         }
7934 
7935   /*
7936    * Check to see if the write is happening in the background.  If so,
7937    * stop copying and wait for the channel to become writable again.
7938    * After input underflow we already installed a readable handler
7939    * therefore we don't need a writable handler.
7940    */
7941 
7942   if ( ! underflow && (outStatePtr->flags & BG_FLUSH_SCHEDULED) ) {
7943       if (!(mask & TCL_WRITABLE)) {
7944     if (mask & TCL_READABLE) {
7945         Tcl_DeleteChannelHandler(inChan, CopyEventProc,
7946           (ClientData) csPtr);
7947     }
7948     Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
7949       CopyEventProc, (ClientData) csPtr);
7950       }
7951       if (bufObj != (Tcl_Obj*) NULL) {
7952           Tcl_DecrRefCount (bufObj);
7953     bufObj = (Tcl_Obj*) NULL;
7954       }
7955       return TCL_OK;
7956   }
7957 
7958   /*
7959    * For background copies, we only do one buffer per invocation so
7960    * we don't starve the rest of the system.
7961    */
7962 
7963   if (cmdPtr) {
7964       /*
7965        * The first time we enter this code, there won't be a
7966        * channel handler established yet, so do it here.
7967        */
7968 
7969       if (mask == 0) {
7970     Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
7971       CopyEventProc, (ClientData) csPtr);
7972       }
7973       if (bufObj != (Tcl_Obj*) NULL) {
7974           Tcl_DecrRefCount (bufObj);
7975     bufObj = (Tcl_Obj*) NULL;
7976       }
7977       return TCL_OK;
7978   }
7979     } /* while */
7980 
7981     if (bufObj != (Tcl_Obj*) NULL) {
7982         Tcl_DecrRefCount (bufObj);
7983   bufObj = (Tcl_Obj*) NULL;
7984     }
7985 
7986     /*
7987      * Make the callback or return the number of bytes transferred.
7988      * The local total is used because StopCopy frees csPtr.
7989      */
7990 
7991     total = csPtr->total;
7992     if (cmdPtr && interp) {
7993   /*
7994    * Get a private copy of the command so we can mutate it
7995    * by adding arguments.  Note that StopCopy frees our saved
7996    * reference to the original command obj.
7997    */
7998 
7999   cmdPtr = Tcl_DuplicateObj(cmdPtr);
8000   Tcl_IncrRefCount(cmdPtr);
8001   StopCopy(csPtr);
8002   Tcl_Preserve((ClientData) interp);
8003 
8004   Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total));
8005   if (errObj) {
8006       Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
8007   }
8008   if (Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
8009       Tcl_BackgroundError(interp);
8010       result = TCL_ERROR;
8011   }
8012   Tcl_DecrRefCount(cmdPtr);
8013   Tcl_Release((ClientData) interp);
8014     } else {
8015   StopCopy(csPtr);
8016   if (interp) {
8017       if (errObj) {
8018     Tcl_SetObjResult(interp, errObj);
8019     result = TCL_ERROR;
8020       } else {
8021     Tcl_ResetResult(interp);
8022     Tcl_SetIntObj(Tcl_GetObjResult(interp), total);
8023       }
8024   }
8025     }
8026     return result;
8027 }
static void CopyEventProc (ClientData clientData, int mask) [static]

Definition at line 8615 of file tclIO.c.
References CopyData(), and void().
Referenced by CopyData(), and StopCopy().8618 {
8619     (void) CopyData((CopyState *)clientData, mask);
8620 }
static void CreateScriptRecord (Tcl_Interp * interp, Channel * chanPtr, int mask, Tcl_Obj * scriptPtr) [static]

Definition at line 7443 of file tclIO.c.
References EventScriptRecord::chanPtr, ckalloc, EventScriptRecord::interp, EventScriptRecord::mask, EventScriptRecord::nextPtr, NULL, EventScriptRecord::scriptPtr, Channel::state, Tcl_CreateChannelHandler(), Tcl_DecrRefCount, Tcl_IncrRefCount, and TclChannelEventScriptInvoker().
Referenced by Tcl_FileEventObjCmd().7451 {
7452     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
7453     EventScriptRecord *esPtr;
7454 
7455     for (esPtr = statePtr->scriptRecordPtr;
7456    esPtr != (EventScriptRecord *) NULL;
7457    esPtr = esPtr->nextPtr) {
7458         if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
7459       Tcl_DecrRefCount(esPtr->scriptPtr);
7460       esPtr->scriptPtr = (Tcl_Obj *) NULL;
7461             break;
7462         }
7463     }
7464     if (esPtr == (EventScriptRecord *) NULL) {
7465         esPtr = (EventScriptRecord *) ckalloc((unsigned)
7466                 sizeof(EventScriptRecord));
7467         Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
7468                 TclChannelEventScriptInvoker, (ClientData) esPtr);
7469         esPtr->nextPtr = statePtr->scriptRecordPtr;
7470         statePtr->scriptRecordPtr = esPtr;
7471     }
7472     esPtr->chanPtr = chanPtr;
7473     esPtr->interp = interp;
7474     esPtr->mask = mask;
7475     Tcl_IncrRefCount(scriptPtr);
7476     esPtr->scriptPtr = scriptPtr;
7477 }
static void DeleteChannelTable (ClientData clientData, Tcl_Interp * interp) [static]

Definition at line 591 of file tclIO.c.
References BG_FLUSH_SCHEDULED, ckfree, EventScriptRecord::interp, EventScriptRecord::nextPtr, NULL, Channel::state, Tcl_Close(), Tcl_DecrRefCount, Tcl_DeleteChannelHandler(), Tcl_DeleteHashEntry(), Tcl_DeleteHashTable(), Tcl_FirstHashEntry(), Tcl_GetHashValue, TclChannelEventScriptInvoker(), and void().
Referenced by GetChannelTable().594 {
595     Tcl_HashTable *hTblPtr; /* The hash table. */
596     Tcl_HashSearch hSearch; /* Search variable. */
597     Tcl_HashEntry *hPtr;  /* Search variable. */
598     Channel *chanPtr;   /* Channel being deleted. */
599     ChannelState *statePtr; /* State of Channel being deleted. */
600     EventScriptRecord *sPtr, *prevPtr, *nextPtr;
601             /* Variables to loop over all channel events
602                                  * registered, to delete the ones that refer
603                                  * to the interpreter being deleted. */
604 
605     /*
606      * Delete all the registered channels - this will close channels whose
607      * refcount reaches zero.
608      */
609     
610     hTblPtr = (Tcl_HashTable *) clientData;
611     for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
612    hPtr != (Tcl_HashEntry *) NULL;
613    hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
614 
615         chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
616   statePtr = chanPtr->state;
617 
618         /*
619          * Remove any fileevents registered in this interpreter.
620          */
621         
622         for (sPtr = statePtr->scriptRecordPtr,
623                  prevPtr = (EventScriptRecord *) NULL;
624        sPtr != (EventScriptRecord *) NULL;
625        sPtr = nextPtr) {
626             nextPtr = sPtr->nextPtr;
627             if (sPtr->interp == interp) {
628                 if (prevPtr == (EventScriptRecord *) NULL) {
629                     statePtr->scriptRecordPtr = nextPtr;
630                 } else {
631                     prevPtr->nextPtr = nextPtr;
632                 }
633 
634                 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
635                         TclChannelEventScriptInvoker, (ClientData) sPtr);
636 
637     Tcl_DecrRefCount(sPtr->scriptPtr);
638                 ckfree((char *) sPtr);
639             } else {
640                 prevPtr = sPtr;
641             }
642         }
643 
644         /*
645          * Cannot call Tcl_UnregisterChannel because that procedure calls
646          * Tcl_GetAssocData to get the channel table, which might already
647          * be inaccessible from the interpreter structure. Instead, we
648          * emulate the behavior of Tcl_UnregisterChannel directly here.
649          */
650 
651         Tcl_DeleteHashEntry(hPtr);
652         statePtr->refCount--;
653         if (statePtr->refCount <= 0) {
654             if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
655                 (void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
656             }
657         }
658     }
659     Tcl_DeleteHashTable(hTblPtr);
660     ckfree((char *) hTblPtr);
661 }
static void DeleteScriptRecord (Tcl_Interp * interp, Channel * chanPtr, int mask) [static]

Definition at line 7392 of file tclIO.c.
References ckfree, EventScriptRecord::interp, EventScriptRecord::mask, EventScriptRecord::nextPtr, NULL, Channel::state, Tcl_DecrRefCount, Tcl_DeleteChannelHandler(), and TclChannelEventScriptInvoker().
Referenced by Tcl_FileEventObjCmd(), and TclChannelEventScriptInvoker().7399 {
7400     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
7401     EventScriptRecord *esPtr, *prevEsPtr;
7402 
7403     for (esPtr = statePtr->scriptRecordPtr,
7404              prevEsPtr = (EventScriptRecord *) NULL;
7405    esPtr != (EventScriptRecord *) NULL;
7406    prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {
7407         if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
7408             if (esPtr == statePtr->scriptRecordPtr) {
7409                 statePtr->scriptRecordPtr = esPtr->nextPtr;
7410             } else {
7411                 prevEsPtr->nextPtr = esPtr->nextPtr;
7412             }
7413 
7414             Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
7415                     TclChannelEventScriptInvoker, (ClientData) esPtr);
7416             
7417       Tcl_DecrRefCount(esPtr->scriptPtr);
7418             ckfree((char *) esPtr);
7419 
7420             break;
7421         }
7422     }
7423 }
static int DetachChannel (Tcl_Interp * interp, Tcl_Channel chan) [static]

Definition at line 972 of file tclIO.c.
References ChannelState::bottomChanPtr, CleanupChannelHandlers(), NULL, Channel::state, Tcl_DeleteHashEntry(), TCL_ERROR, Tcl_FindHashEntry, Tcl_GetAssocData(), Tcl_GetHashValue, and TCL_OK.
Referenced by Tcl_DetachChannel(), and Tcl_UnregisterChannel().975 {
976     Tcl_HashTable *hTblPtr; /* Hash table of channels. */
977     Tcl_HashEntry *hPtr;  /* Search variable. */
978     Channel *chanPtr;   /* The real IO channel. */
979     ChannelState *statePtr; /* State of the real channel. */
980 
981     /*
982      * Always (un)register bottom-most channel in the stack.  This makes
983      * management of the channel list easier because no manipulation is
984      * necessary during (un)stack operation.
985      */
986     chanPtr = ((Channel *) chan)->state->bottomChanPtr;
987     statePtr = chanPtr->state;
988 
989     if (interp != (Tcl_Interp *) NULL) {
990   hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
991   if (hTblPtr == (Tcl_HashTable *) NULL) {
992       return TCL_ERROR;
993   }
994   hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
995   if (hPtr == (Tcl_HashEntry *) NULL) {
996       return TCL_ERROR;
997   }
998   if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
999       return TCL_ERROR;
1000   }
1001   Tcl_DeleteHashEntry(hPtr);
1002 
1003   /*
1004    * Remove channel handlers that refer to this interpreter, so that they
1005    * will not be present if the actual close is delayed and more events
1006    * happen on the channel. This may occur if the channel is shared
1007    * between several interpreters, or if the channel has async
1008    * flushing active.
1009    */
1010     
1011   CleanupChannelHandlers(interp, chanPtr);
1012     }
1013 
1014     statePtr->refCount--;
1015     
1016     return TCL_OK;
1017 }
static void DiscardInputQueued (ChannelState * statePtr, int discardSavedBuffers) [static]

Definition at line 5314 of file tclIO.c.
References ckfree, ChannelBuffer::nextPtr, NULL, and RecycleBuffer().
Referenced by CloseChannel(), Tcl_Seek(), and Tcl_UnstackChannel().5319 {
5320     ChannelBuffer *bufPtr, *nxtPtr; /* Loop variables. */
5321 
5322     bufPtr = statePtr->inQueueHead;
5323     statePtr->inQueueHead = (ChannelBuffer *) NULL;
5324     statePtr->inQueueTail = (ChannelBuffer *) NULL;
5325     for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) {
5326         nxtPtr = bufPtr->nextPtr;
5327         RecycleBuffer(statePtr, bufPtr, discardSavedBuffers);
5328     }
5329 
5330     /*
5331      * If discardSavedBuffers is nonzero, must also discard any previously
5332      * saved buffer in the saveInBufPtr field.
5333      */
5334     
5335     if (discardSavedBuffers) {
5336         if (statePtr->saveInBufPtr != (ChannelBuffer *) NULL) {
5337             ckfree((char *) statePtr->saveInBufPtr);
5338             statePtr->saveInBufPtr = (ChannelBuffer *) NULL;
5339         }
5340     }
5341 }
static void DiscardOutputQueued (ChannelState * statePtr) [static]

Definition at line 1960 of file tclIO.c.
References ChannelBuffer::nextPtr, NULL, and RecycleBuffer().
Referenced by FlushChannel().1962 {
1963     ChannelBuffer *bufPtr;
1964     
1965     while (statePtr->outQueueHead != (ChannelBuffer *) NULL) {
1966         bufPtr = statePtr->outQueueHead;
1967         statePtr->outQueueHead = bufPtr->nextPtr;
1968         RecycleBuffer(statePtr, bufPtr, 0);
1969     }
1970     statePtr->outQueueHead = (ChannelBuffer *) NULL;
1971     statePtr->outQueueTail = (ChannelBuffer *) NULL;
1972 }
static int DoRead (Channel * chanPtr, char * bufPtr, int toRead) [static]

Definition at line 8049 of file tclIO.c.
References CHANNEL_BLOCKED, CHANNEL_EOF, CHANNEL_NEED_MORE_DATA, CHANNEL_NONBLOCKING, CHANNEL_STICKY_EOF, and CopyAndTranslateBuffer().
Referenced by CopyData(), and Tcl_Read().8053 {
8054     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
8055     int copied;     /* How many characters were copied into
8056                                  * the result string? */
8057     int copiedNow;    /* How many characters were copied from
8058                                  * the current input buffer? */
8059     int result;     /* Of calling GetInput. */
8060 
8061     /*
8062      * If we have not encountered a sticky EOF, clear the EOF bit. Either
8063      * way clear the BLOCKED bit. We want to discover these anew during
8064      * each operation.
8065      */
8066 
8067     if (!(statePtr->flags & CHANNEL_STICKY_EOF)) {
8068         statePtr->flags &= ~CHANNEL_EOF;
8069     }
8070     statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
8071     
8072     for (copied = 0; copied < toRead; copied += copiedNow) {
8073         copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied,
8074                 toRead - copied);
8075         if (copiedNow == 0) {
8076             if (statePtr->flags & CHANNEL_EOF) {
8077     goto done;
8078             }
8079             if (statePtr->flags & CHANNEL_BLOCKED) {
8080                 if (statePtr->flags & CHANNEL_NONBLOCKING) {
8081         goto done;
8082                 }
8083                 statePtr->flags &= (~(CHANNEL_BLOCKED));
8084             }
8085             result = GetInput(chanPtr);
8086             if (result != 0) {
8087                 if (result != EAGAIN) {
8088                     copied = -1;
8089                 }
8090     goto done;
8091             }
8092         }
8093     }
8094 
8095     statePtr->flags &= (~(CHANNEL_BLOCKED));
8096 
8097     done:
8098     /*
8099      * Update the notifier state so we don't block while there is still
8100      * data in the buffers.
8101      */
8102 
8103     UpdateInterest(chanPtr);
8104     return copied;
8105 }
static int DoReadChars (Channel* chanPtr, Tcl_Obj * objPtr, int toRead, int appendFlag) [static]

Definition at line 4463 of file tclIO.c.
References CHANNEL_BLOCKED, CHANNEL_EOF, CHANNEL_NONBLOCKING, EAGAIN, GetInput(), ChannelBuffer::nextAdded, ChannelBuffer::nextPtr, ChannelBuffer::nextRemoved, NULL, ReadBytes(), ReadChars(), RecycleBuffer(), Tcl_GetByteArrayFromObj(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_SetByteArrayLength(), Tcl_SetObjLength(), and UTF_EXPANSION_FACTOR.
Referenced by CopyData(), and Tcl_ReadChars().4474 {
4475     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
4476     ChannelBuffer *bufPtr;
4477     int offset, factor, copied, copiedNow, result;
4478     Tcl_Encoding encoding;
4479 #define UTF_EXPANSION_FACTOR  1024
4480 
4481     /*
4482      * This operation should occur at the top of a channel stack.
4483      */
4484 
4485     chanPtr  = statePtr->topChanPtr;
4486     encoding = statePtr->encoding;
4487     factor   = UTF_EXPANSION_FACTOR;
4488 
4489     if (appendFlag == 0) {
4490   if (encoding == NULL) {
4491       Tcl_SetByteArrayLength(objPtr, 0);
4492   } else {
4493       Tcl_SetObjLength(objPtr, 0);
4494       /* 
4495        * We're going to access objPtr->bytes directly, so
4496        * we must ensure that this is actually a string
4497        * object (otherwise it might have been pure Unicode).
4498        */
4499       Tcl_GetString(objPtr);
4500   }
4501   offset = 0;
4502     } else {
4503   if (encoding == NULL) {
4504       Tcl_GetByteArrayFromObj(objPtr, &offset);
4505   } else {
4506       Tcl_GetStringFromObj(objPtr, &offset);
4507   }
4508     }
4509 
4510     for (copied = 0; (unsigned) toRead > 0; ) {
4511   copiedNow = -1;
4512   if (statePtr->inQueueHead != NULL) {
4513       if (encoding == NULL) {
4514     copiedNow = ReadBytes(statePtr, objPtr, toRead, &offset);
4515       } else {
4516     copiedNow = ReadChars(statePtr, objPtr, toRead, &offset,
4517       &factor);
4518       }
4519 
4520       /*
4521        * If the current buffer is empty recycle it.
4522        */
4523 
4524       bufPtr = statePtr->inQueueHead;
4525       if (bufPtr->nextRemoved == bufPtr->nextAdded) {
4526     ChannelBuffer *nextPtr;
4527 
4528     nextPtr = bufPtr->nextPtr;
4529     RecycleBuffer(statePtr, bufPtr, 0);
4530     statePtr->inQueueHead = nextPtr;
4531     if (nextPtr == NULL) {
4532         statePtr->inQueueTail = NULL;
4533     }
4534       }
4535   }
4536   if (copiedNow < 0) {
4537       if (statePtr->flags & CHANNEL_EOF) {
4538     break;
4539       }
4540       if (statePtr->flags & CHANNEL_BLOCKED) {
4541     if (statePtr->flags & CHANNEL_NONBLOCKING) {
4542         break;
4543     }
4544     statePtr->flags &= ~CHANNEL_BLOCKED;
4545       }
4546       result = GetInput(chanPtr);
4547       if (result != 0) {
4548     if (result == EAGAIN) {
4549         break;
4550     }
4551     copied = -1;
4552     goto done;
4553       }
4554   } else {
4555       copied += copiedNow;
4556       toRead -= copiedNow;
4557   }
4558     }
4559     statePtr->flags &= ~CHANNEL_BLOCKED;
4560     if (encoding == NULL) {
4561   Tcl_SetByteArrayLength(objPtr, offset);
4562     } else {
4563   Tcl_SetObjLength(objPtr, offset);
4564     }
4565 
4566     done:
4567     /*
4568      * Update the notifier state so we don't block while there is still
4569      * data in the buffers.
4570      */
4571 
4572     UpdateInterest(chanPtr);
4573     return copied;
4574 }
static int DoWrite (Channel * chanPtr, CONST char * src, int srcLen) [static]

Definition at line 8460 of file tclIO.c.
References AllocChannelBuffer(), ChannelBuffer::buf, BUFFER_READY, ChannelBuffer::bufLength, CHANNEL_LINEBUFFERED, CHANNEL_UNBUFFERED, CONST, FlushChannel(), ChannelBuffer::nextAdded, NULL, panic, size_t(), TCL_TRANSLATE_AUTO, TCL_TRANSLATE_CR, TCL_TRANSLATE_CRLF, and TCL_TRANSLATE_LF.
Referenced by CopyData(), and Tcl_Write().8464 {
8465     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
8466     ChannelBuffer *outBufPtr;   /* Current output buffer. */
8467     int foundNewline;     /* Did we find a newline in output? */
8468     char *dPtr;
8469     CONST char *sPtr;     /* Search variables for newline. */
8470     int crsent;       /* In CRLF eol translation mode,
8471                                          * remember the fact that a CR was
8472                                          * output to the channel without
8473                                          * its following NL. */
8474     int i;        /* Loop index for newline search. */
8475     int destCopied;     /* How many bytes were used in this
8476                                          * destination buffer to hold the
8477                                          * output? */
8478     int totalDestCopied;    /* How many bytes total were
8479                                          * copied to the channel buffer? */
8480     int srcCopied;      /* How many bytes were copied from
8481                                          * the source string? */
8482     char *destPtr;      /* Where in line to copy to? */
8483 
8484     /*
8485      * If we are in network (or windows) translation mode, record the fact
8486      * that we have not yet sent a CR to the channel.
8487      */
8488 
8489     crsent = 0;
8490     
8491     /*
8492      * Loop filling buffers and flushing them until all output has been
8493      * consumed.
8494      */
8495 
8496     srcCopied = 0;
8497     totalDestCopied = 0;
8498 
8499     while (srcLen > 0) {
8500         
8501         /*
8502          * Make sure there is a current output buffer to accept output.
8503          */
8504 
8505         if (statePtr->curOutPtr == (ChannelBuffer *) NULL) {
8506             statePtr->curOutPtr = AllocChannelBuffer(statePtr->bufSize);
8507         }
8508 
8509         outBufPtr = statePtr->curOutPtr;
8510 
8511         destCopied = outBufPtr->bufLength - outBufPtr->nextAdded;
8512         if (destCopied > srcLen) {
8513             destCopied = srcLen;
8514         }
8515         
8516         destPtr = outBufPtr->buf + outBufPtr->nextAdded;
8517         switch (statePtr->outputTranslation) {
8518             case TCL_TRANSLATE_LF:
8519                 srcCopied = destCopied;
8520                 memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
8521                 break;
8522             case TCL_TRANSLATE_CR:
8523                 srcCopied = destCopied;
8524                 memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
8525                 for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {
8526                     if (*dPtr == '\n') {
8527                         *dPtr = '\r';
8528                     }
8529                 }
8530                 break;
8531             case TCL_TRANSLATE_CRLF:
8532                 for (srcCopied = 0, dPtr = destPtr, sPtr = src;
8533                      dPtr < destPtr + destCopied;
8534                      dPtr++, sPtr++, srcCopied++) {
8535                     if (*sPtr == '\n') {
8536                         if (crsent) {
8537                             *dPtr = '\n';
8538                             crsent = 0;
8539                         } else {
8540                             *dPtr = '\r';
8541                             crsent = 1;
8542                             sPtr--, srcCopied--;
8543                         }
8544                     } else {
8545                         *dPtr = *sPtr;
8546                     }
8547                 }
8548                 break;
8549             case TCL_TRANSLATE_AUTO:
8550                 panic("Tcl_Write: AUTO output translation mode not supported");
8551             default:
8552                 panic("Tcl_Write: unknown output translation mode");
8553         }
8554 
8555         /*
8556          * The current buffer is ready for output if it is full, or if it
8557          * contains a newline and this channel is line-buffered, or if it
8558          * contains any output and this channel is unbuffered.
8559          */
8560 
8561         outBufPtr->nextAdded += destCopied;
8562         if (!(statePtr->flags & BUFFER_READY)) {
8563             if (outBufPtr->nextAdded == outBufPtr->bufLength) {
8564                 statePtr->flags |= BUFFER_READY;
8565             } else if (statePtr->flags & CHANNEL_LINEBUFFERED) {
8566                 for (sPtr = src, i = 0, foundNewline = 0;
8567          (i < srcCopied) && (!foundNewline);
8568          i++, sPtr++) {
8569                     if (*sPtr == '\n') {
8570                         foundNewline = 1;
8571                         break;
8572                     }
8573                 }
8574                 if (foundNewline) {
8575                     statePtr->flags |= BUFFER_READY;
8576                 }
8577             } else if (statePtr->flags & CHANNEL_UNBUFFERED) {
8578                 statePtr->flags |= BUFFER_READY;
8579             }
8580         }
8581         
8582         totalDestCopied += srcCopied;
8583         src += srcCopied;
8584         srcLen -= srcCopied;
8585 
8586         if (statePtr->flags & BUFFER_READY) {
8587             if (FlushChannel(NULL, chanPtr, 0) != 0) {
8588                 return -1;
8589             }
8590         }
8591     } /* Closes "while" */
8592 
8593     return totalDestCopied;
8594 }
static int DoWriteChars (Channel* chanPtr, CONST char * src, int len) [static]

Definition at line 2931 of file tclIO.c.
References NULL, Tcl_DecrRefCount, Tcl_GetByteArrayFromObj(), Tcl_NewStringObj(), WriteBytes(), and WriteChars().
Referenced by CopyData(), and Tcl_WriteChars().2936 {
2937     /*
2938      * Always use the topmost channel of the stack
2939      */
2940     ChannelState *statePtr; /* state info for channel */
2941 
2942     statePtr = chanPtr->state;
2943     chanPtr  = statePtr->topChanPtr;
2944 
2945     if (len < 0) {
2946         len = strlen(src);
2947     }
2948     if (statePtr->encoding == NULL) {
2949   /*
2950    * Inefficient way to convert UTF-8 to byte-array, but the  
2951    * code parallels the way it is done for objects.
2952    */
2953 
2954   Tcl_Obj *objPtr;
2955   int result;
2956 
2957   objPtr = Tcl_NewStringObj(src, len);
2958   src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
2959   result = WriteBytes(chanPtr, src, len);
2960   Tcl_DecrRefCount(objPtr);
2961   return result;
2962     }
2963     return WriteChars(chanPtr, src, len);
2964 }
static int FilterInputBytes (Channel * chanPtr, GetsState * gsPtr) [static]

Definition at line 3891 of file tclIO.c.
References AllocChannelBuffer(), ChannelBuffer::buf, BUFFER_PADDING, ChannelBuffer::bufLength, GetsState::bufPtr, Tcl_Obj::bytes, GetsState::bytesWrote, CHANNEL_BLOCKED, CHANNEL_EOF, CHANNEL_NONBLOCKING, GetsState::charsWrote, GetsState::dstPtr, GetsState::encoding, ENCODING_LINESIZE, GetInput(), Tcl_Obj::length, ChannelBuffer::nextAdded, ChannelBuffer::nextPtr, ChannelBuffer::nextRemoved, NULL, GetsState::objPtr, GetsState::rawRead, size_t(), GetsState::state, TCL_CONVERT_MULTIBYTE, TCL_ENCODING_START, Tcl_ExternalToUtf(), Tcl_SetObjLength(), TCL_UTF_MAX, GetsState::totalChars, and VOID.
Referenced by PeekAhead(), and Tcl_GetsObj().3894 {
3895     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
3896     ChannelBuffer *bufPtr;
3897     char *raw, *rawStart, *rawEnd;
3898     char *dst;
3899     int offset, toRead, dstNeeded, spaceLeft, result, rawLen, length;
3900     Tcl_Obj *objPtr;
3901 #define ENCODING_LINESIZE   20  /* Lower bound on how many bytes to convert
3902          * at a time.  Since we don't know a priori
3903          * how many bytes of storage this many source
3904          * bytes will use, we actually need at least
3905          * ENCODING_LINESIZE * TCL_MAX_UTF bytes of
3906          * room. */
3907 
3908     objPtr = gsPtr->objPtr;
3909 
3910     /*
3911      * Subtract the number of bytes that were removed from channel buffer
3912      * during last call.
3913      */
3914 
3915     bufPtr = gsPtr->bufPtr;
3916     if (bufPtr != NULL) {
3917   bufPtr->nextRemoved += gsPtr->rawRead;
3918   if (bufPtr->nextRemoved >= bufPtr->nextAdded) {
3919       bufPtr = bufPtr->nextPtr;
3920   }
3921     }
3922     gsPtr->totalChars += gsPtr->charsWrote;
3923 
3924     if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) {
3925   /*
3926    * All channel buffers were exhausted and the caller still hasn't
3927    * seen EOL.  Need to read more bytes from the channel device.
3928    * Side effect is to allocate another channel buffer.
3929    */
3930 
3931   read:
3932         if (statePtr->flags & CHANNEL_BLOCKED) {
3933             if (statePtr->flags & CHANNEL_NONBLOCKING) {
3934     gsPtr->charsWrote = 0;
3935     gsPtr->rawRead = 0;
3936     return -1;
3937       }
3938             statePtr->flags &= ~CHANNEL_BLOCKED;
3939         }
3940   if (GetInput(chanPtr) != 0) {
3941       gsPtr->charsWrote = 0;
3942       gsPtr->rawRead = 0;
3943       return -1;
3944   }
3945   bufPtr = statePtr->inQueueTail;
3946   gsPtr->bufPtr = bufPtr;
3947     }
3948 
3949     /*
3950      * Convert some of the bytes from the channel buffer to UTF-8.  Space in
3951      * objPtr's string rep is used to hold the UTF-8 characters.  Grow the
3952      * string rep if we need more space.
3953      */
3954 
3955     rawStart = bufPtr->buf + bufPtr->nextRemoved;
3956     raw = rawStart;
3957     rawEnd = bufPtr->buf + bufPtr->nextAdded;
3958     rawLen = rawEnd - rawStart;
3959 
3960     dst = *gsPtr->dstPtr;
3961     offset = dst - objPtr->bytes;
3962     toRead = ENCODING_LINESIZE;
3963     if (toRead > rawLen) {
3964   toRead = rawLen;
3965     }
3966     dstNeeded = toRead * TCL_UTF_MAX + 1;
3967     spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
3968     if (dstNeeded > spaceLeft) {
3969   length = offset * 2;
3970   if (offset < dstNeeded) {
3971       length = offset + dstNeeded;
3972   }
3973   length += TCL_UTF_MAX + 1;
3974   Tcl_SetObjLength(objPtr, length);
3975   spaceLeft = length - offset;
3976   dst = objPtr->bytes + offset;
3977   *gsPtr->dstPtr = dst;
3978     }
3979     gsPtr->state = statePtr->inputEncodingState;
3980     result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
3981       statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
3982       dst, spaceLeft, &gsPtr->rawRead, &gsPtr->bytesWrote,
3983       &gsPtr->charsWrote);
3984 
3985     /*
3986      * Make sure that if we go through 'gets', that we reset the
3987      * TCL_ENCODING_START flag still.  [Bug #523988]
3988      */
3989     statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
3990 
3991     if (result == TCL_CONVERT_MULTIBYTE) {
3992   /*
3993    * The last few bytes in this channel buffer were the start of a
3994    * multibyte sequence.  If this buffer was full, then move them to
3995    * the next buffer so the bytes will be contiguous.  
3996    */
3997 
3998   ChannelBuffer *nextPtr;
3999   int extra;
4000   
4001   nextPtr = bufPtr->nextPtr;
4002   if (bufPtr->nextAdded < bufPtr->bufLength) {
4003       if (gsPtr->rawRead > 0) {
4004     /*
4005      * Some raw bytes were converted to UTF-8.  Fall through,
4006      * returning those UTF-8 characters because a EOL might be
4007      * present in them.
4008      */
4009       } else if (statePtr->flags & CHANNEL_EOF) {
4010     /*
4011      * There was a partial character followed by EOF on the
4012      * device.  Fall through, returning that nothing was found.
4013      */
4014 
4015     bufPtr->nextRemoved = bufPtr->nextAdded;
4016       } else {
4017     /*
4018      * There are no more cached raw bytes left.  See if we can
4019      * get some more.
4020      */
4021 
4022     goto read;
4023       }
4024   } else {
4025       if (nextPtr == NULL) {
4026     nextPtr = AllocChannelBuffer(statePtr->bufSize);
4027     bufPtr->nextPtr = nextPtr;
4028     statePtr->inQueueTail = nextPtr;
4029       }
4030       extra = rawLen - gsPtr->rawRead;
4031       memcpy((VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
4032         (VOID *) (raw + gsPtr->rawRead), (size_t) extra);
4033       nextPtr->nextRemoved -= extra;
4034       bufPtr->nextAdded -= extra;
4035   }
4036     }
4037 
4038     gsPtr->bufPtr = bufPtr;
4039     return 0;
4040 }
static int FlushChannel (Tcl_Interp * interp, Channel * chanPtr, int calledFromAsyncFlush) [static]

Definition at line 2030 of file tclIO.c.
References BG_FLUSH_SCHEDULED, ChannelBuffer::buf, BUFFER_READY, CHANNEL_CLOSED, CheckForDeadChannel(), CloseChannel(), DiscardOutputQueued(), EAGAIN, EINTR, EWOULDBLOCK, Channel::instanceData, ChannelBuffer::nextAdded, ChannelBuffer::nextPtr, ChannelBuffer::nextRemoved, NULL, Tcl_ChannelType::outputProc, RecycleBuffer(), Channel::state, Tcl_PosixError(), Tcl_SetErrno(), Tcl_SetResult(), TCL_VOLATILE, Channel::typePtr, UpdateInterest(), and Tcl_ChannelType::watchProc.
Referenced by CheckFlush(), DoWrite(), Tcl_Close(), Tcl_Flush(), Tcl_NotifyChannel(), and Tcl_Seek().2036 {
2037     ChannelState *statePtr = chanPtr->state;
2038           /* State of the channel stack. */
2039     ChannelBuffer *bufPtr;    /* Iterates over buffered output
2040                                          * queue. */
2041     int toWrite;      /* Amount of output data in current
2042                                          * buffer available to be written. */
2043     int written;      /* Amount of output data actually
2044                                          * written in current round. */
2045     int errorCode = 0;      /* Stores POSIX error codes from
2046                                          * channel driver operations. */
2047     int wroteSome = 0;      /* Set to one if any data was
2048            * written to the driver. */
2049 
2050     /*
2051      * Prevent writing on a dead channel -- a channel that has been closed
2052      * but not yet deallocated. This can occur if the exit handler for the
2053      * channel deallocation runs before all channels are deregistered in
2054      * all interpreters.
2055      */
2056     
2057     if (CheckForDeadChannel(interp, statePtr)) return -1;
2058     
2059     /*
2060      * Loop over the queued buffers and attempt to flush as
2061      * much as possible of the queued output to the channel.
2062      */
2063 
2064     while (1) {
2065 
2066         /*
2067          * If the queue is empty and there is a ready current buffer, OR if
2068          * the current buffer is full, then move the current buffer to the
2069          * queue.
2070          */
2071 
2072         if (((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
2073                 (statePtr->curOutPtr->nextAdded == statePtr->curOutPtr->bufLength))
2074                 || ((statePtr->flags & BUFFER_READY) &&
2075                         (statePtr->outQueueHead == (ChannelBuffer *) NULL))) {
2076             statePtr->flags &= (~(BUFFER_READY));
2077             statePtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
2078             if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
2079                 statePtr->outQueueHead = statePtr->curOutPtr;
2080             } else {
2081                 statePtr->outQueueTail->nextPtr = statePtr->curOutPtr;
2082             }
2083             statePtr->outQueueTail = statePtr->curOutPtr;
2084             statePtr->curOutPtr = (ChannelBuffer *) NULL;
2085         }
2086         bufPtr = statePtr->outQueueHead;
2087 
2088         /*
2089          * If we are not being called from an async flush and an async
2090          * flush is active, we just return without producing any output.
2091          */
2092 
2093         if ((!calledFromAsyncFlush) &&
2094                 (statePtr->flags & BG_FLUSH_SCHEDULED)) {
2095             return 0;
2096         }
2097 
2098         /*
2099          * If the output queue is still empty, break out of the while loop.
2100          */
2101 
2102         if (bufPtr == (ChannelBuffer *) NULL) {
2103             break;  /* Out of the "while (1)". */
2104         }
2105 
2106         /*
2107          * Produce the output on the channel.
2108          */
2109 
2110         toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
2111         written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
2112                 bufPtr->buf + bufPtr->nextRemoved, toWrite,
2113     &errorCode);
2114 
2115   /*
2116          * If the write failed completely attempt to start the asynchronous
2117          * flush mechanism and break out of this loop - do not attempt to
2118          * write any more output at this time.
2119          */
2120 
2121         if (written < 0) {
2122             
2123             /*
2124              * If the last attempt to write was interrupted, simply retry.
2125              */
2126             
2127             if (errorCode == EINTR) {
2128                 errorCode = 0;
2129                 continue;
2130             }
2131 
2132             /*
2133              * If the channel is non-blocking and we would have blocked,
2134              * start a background flushing handler and break out of the loop.
2135              */
2136 
2137             if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) {
2138     /*
2139      * This used to check for CHANNEL_NONBLOCKING, and panic
2140      * if the channel was blocking.  However, it appears
2141      * that setting stdin to -blocking 0 has some effect on
2142      * the stdout when it's a tty channel (dup'ed underneath)
2143      */
2144     if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
2145         statePtr->flags |= BG_FLUSH_SCHEDULED;
2146         UpdateInterest(chanPtr);
2147     }
2148     errorCode = 0;
2149     break;
2150             }
2151 
2152             /*
2153              * Decide whether to report the error upwards or defer it.
2154              */
2155 
2156             if (calledFromAsyncFlush) {
2157                 if (statePtr->unreportedError == 0) {
2158                     statePtr->unreportedError = errorCode;
2159                 }
2160             } else {
2161                 Tcl_SetErrno(errorCode);
2162     if (interp != NULL) {
2163 
2164         /*
2165          * Casting away CONST here is safe because the
2166          * TCL_VOLATILE flag guarantees CONST treatment
2167          * of the Posix error string.
2168          */
2169 
2170         Tcl_SetResult(interp,
2171           (char *) Tcl_PosixError(interp), TCL_VOLATILE);
2172     }
2173             }
2174 
2175             /*
2176              * When we get an error we throw away all the output
2177              * currently queued.
2178              */
2179 
2180             DiscardOutputQueued(statePtr);
2181             continue;
2182         } else {
2183       wroteSome = 1;
2184   }
2185 
2186         bufPtr->nextRemoved += written;
2187 
2188         /*
2189          * If this buffer is now empty, recycle it.
2190          */
2191 
2192         if (bufPtr->nextRemoved == bufPtr->nextAdded) {
2193             statePtr->outQueueHead = bufPtr->nextPtr;
2194             if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
2195                 statePtr->outQueueTail = (ChannelBuffer *) NULL;
2196             }
2197             RecycleBuffer(statePtr, bufPtr, 0);
2198         }
2199     } /* Closes "while (1)". */
2200 
2201     /*
2202      * If we wrote some data while flushing in the background, we are done.
2203      * We can't finish the background flush until we run out of data and
2204      * the channel becomes writable again.  This ensures that all of the
2205      * pending data has been flushed at the system level.
2206      */
2207 
2208     if (statePtr->flags & BG_FLUSH_SCHEDULED) {
2209   if (wroteSome) {
2210       return errorCode;
2211   } else if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
2212       statePtr->flags &= (~(BG_FLUSH_SCHEDULED));
2213       (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
2214         statePtr->interestMask);
2215   }
2216     }
2217 
2218     /*
2219      * If the channel is flagged as closed, delete it when the refCount
2220      * drops to zero, the output queue is empty and there is no output
2221      * in the current output buffer.
2222      */
2223 
2224     if ((statePtr->flags & CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
2225             (statePtr->outQueueHead == (ChannelBuffer *) NULL) &&
2226             ((statePtr->curOutPtr == (ChannelBuffer *) NULL) ||
2227                     (statePtr->curOutPtr->nextAdded ==
2228                             statePtr->curOutPtr->nextRemoved))) {
2229   return CloseChannel(interp, chanPtr, errorCode);
2230     }
2231     return errorCode;
2232 }
static Tcl_HashTable* GetChannelTable (Tcl_Interp * interp) [static]

Definition at line 529 of file tclIO.c.
References ckalloc, DeleteChannelTable(), NULL, Tcl_GetAssocData(), Tcl_GetStdChannel(), Tcl_InitHashTable(), Tcl_IsSafe(), Tcl_RegisterChannel(), Tcl_SetAssocData(), TCL_STDERR, TCL_STDIN, TCL_STDOUT, TCL_STRING_KEYS, and void().
Referenced by Tcl_GetChannel(), Tcl_GetChannelNamesEx(), and Tcl_RegisterChannel().531 {
532     Tcl_HashTable *hTblPtr; /* Hash table of channels. */
533     Tcl_Channel stdinChan, stdoutChan, stderrChan;
534 
535     hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
536     if (hTblPtr == (Tcl_HashTable *) NULL) {
537         hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
538         Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
539 
540         (void) Tcl_SetAssocData(interp, "tclIO",
541                 (Tcl_InterpDeleteProc *) DeleteChannelTable,
542                 (ClientData) hTblPtr);
543 
544         /*
545          * If the interpreter is trusted (not "safe"), insert channels
546          * for stdin, stdout and stderr (possibly creating them in the
547          * process).
548          */
549 
550         if (Tcl_IsSafe(interp) == 0) {
551             stdinChan = Tcl_GetStdChannel(TCL_STDIN);
552             if (stdinChan != NULL) {
553                 Tcl_RegisterChannel(interp, stdinChan);
554             }
555             stdoutChan = Tcl_GetStdChannel(TCL_STDOUT);
556             if (stdoutChan != NULL) {
557                 Tcl_RegisterChannel(interp, stdoutChan);
558             }
559             stderrChan = Tcl_GetStdChannel(TCL_STDERR);
560             if (stderrChan != NULL) {
561                 Tcl_RegisterChannel(interp, stderrChan);
562             }
563         }
564 
565     }
566     return hTblPtr;
567 }
static int GetInput (Channel * chanPtr) [static]

Definition at line 5361 of file tclIO.c.
References AllocChannelBuffer(), ChannelBuffer::buf, BUFFER_PADDING, ChannelBuffer::bufLength, CHANNEL_BLOCKED, CHANNEL_EOF, CHANNEL_NONBLOCKING, CheckForDeadChannel(), ckfree, EAGAIN, EINVAL, EWOULDBLOCK, ChannelBuffer::nextAdded, ChannelBuffer::nextPtr, NULL, RecycleBuffer(), Tcl_ChannelBlockModeProc(), TCL_ENCODING_END, and Tcl_SetErrno().
Referenced by DoReadChars(), and FilterInputBytes().5363 {
5364     int toRead;     /* How much to read? */
5365     int result;     /* Of calling driver. */
5366     int nread;      /* How much was read from channel? */
5367     ChannelBuffer *bufPtr;  /* New buffer to add to input queue. */
5368     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
5369 
5370     /*
5371      * Prevent reading from a dead channel -- a channel that has been closed
5372      * but not yet deallocated, which can happen if the exit handler for
5373      * channel cleanup has run but the channel is still registered in some
5374      * interpreter.
5375      */
5376     
5377     if (CheckForDeadChannel(NULL, statePtr)) {
5378   return EINVAL;
5379     }
5380 
5381     /*
5382      * First check for more buffers in the pushback area of the
5383      * topmost channel in the stack and use them. They can be the
5384      * result of a transformation which went away without reading all
5385      * the information placed in the area when it was stacked.
5386      *
5387      * Two possibilities for the state: No buffers in it, or a single
5388      * empty buffer. In the latter case we can recycle it now.
5389      */
5390 
5391     if (chanPtr->inQueueHead != (ChannelBuffer*) NULL) {
5392         if (statePtr->inQueueHead != (ChannelBuffer*) NULL) {
5393       RecycleBuffer(statePtr, statePtr->inQueueHead, 0);
5394       statePtr->inQueueHead = (ChannelBuffer*) NULL;
5395   }
5396 
5397   statePtr->inQueueHead = chanPtr->inQueueHead;
5398   statePtr->inQueueTail = chanPtr->inQueueTail;
5399   chanPtr->inQueueHead  = (ChannelBuffer*) NULL;
5400   chanPtr->inQueueTail  = (ChannelBuffer*) NULL;
5401   return 0;
5402     }
5403 
5404     /*
5405      * Nothing in the pushback area, fall back to the usual handling
5406      * (driver, etc.)
5407      */
5408 
5409     /*
5410      * See if we can fill an existing buffer. If we can, read only
5411      * as much as will fit in it. Otherwise allocate a new buffer,
5412      * add it to the input queue and attempt to fill it to the max.
5413      */
5414 
5415     bufPtr = statePtr->inQueueTail;
5416     if ((bufPtr != NULL) && (bufPtr->nextAdded < bufPtr->bufLength)) {
5417         toRead = bufPtr->bufLength - bufPtr->nextAdded;
5418     } else {
5419   bufPtr = statePtr->saveInBufPtr;
5420   statePtr->saveInBufPtr = NULL;
5421 
5422   /*
5423    * Check the actual buffersize against the requested
5424    * buffersize. Buffers which are smaller than requested are
5425    * squashed. This is done to honor dynamic changes of the
5426    * buffersize made by the user.
5427    */
5428 
5429   if ((bufPtr != NULL) && ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize)) {
5430     ckfree((char *) bufPtr);
5431     bufPtr = NULL;
5432   }
5433 
5434   if (bufPtr == NULL) {
5435       bufPtr = AllocChannelBuffer(statePtr->bufSize);
5436   }
5437         bufPtr->nextPtr = (ChannelBuffer *) NULL;
5438 
5439   /* SF #427196: Use the actual size of the buffer to determine
5440    * the number of bytes to read from the channel and not the
5441    * size for new buffers. They can be different if the
5442    * buffersize was changed between reads.
5443    *
5444    * Note: This affects performance negatively if the buffersize
5445    * was extended but this small buffer is reused for all
5446    * subsequent reads. The system never uses buffers with the
5447    * requested bigger size in that case. An adjunct patch could
5448    * try and delete all unused buffers it encounters and which
5449    * are smaller than the formally requested buffersize.
5450    */
5451 
5452   toRead = bufPtr->bufLength - bufPtr->nextAdded;
5453 
5454         if (statePtr->inQueueTail == NULL) {
5455             statePtr->inQueueHead = bufPtr;
5456         } else {
5457             statePtr->inQueueTail->nextPtr = bufPtr;
5458         }
5459         statePtr->inQueueTail = bufPtr;
5460     }
5461 
5462     /*
5463      * If EOF is set, we should avoid calling the driver because on some
5464      * platforms it is impossible to read from a device after EOF.
5465      */
5466 
5467     if (statePtr->flags & CHANNEL_EOF) {
5468   return 0;
5469     }
5470 
5471 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
5472     /* [SF Tcl Bug 943274]. Better emulation of non-blocking channels
5473      * for channels without BlockModeProc, by keeping track of true
5474      * fileevents generated by the OS == Data waiting and reading if
5475      * and only if we are sure to have data.
5476      */
5477 
5478     if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
5479   (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
5480   !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
5481 
5482         /* Bypass the driver, it would block, as no data is available */
5483         nread = -1;
5484         result = EWOULDBLOCK;
5485     } else {
5486 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
5487 
5488         nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
5489         bufPtr->buf + bufPtr->nextAdded, toRead, &result);
5490 
5491 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
5492     }
5493 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
5494 
5495     if (nread > 0) {
5496   bufPtr->nextAdded += nread;
5497 
5498   /*
5499    * If we get a short read, signal up that we may be BLOCKED. We
5500    * should avoid calling the driver because on some platforms we
5501    * will block in the low level reading code even though the
5502    * channel is set into nonblocking mode.
5503    */
5504             
5505   if (nread < toRead) {
5506       statePtr->flags |= CHANNEL_BLOCKED;
5507   }
5508 
5509 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
5510   if (nread <= toRead) {
5511     /* [SF Tcl Bug 943274] We have read the available data,
5512      * clear flag */
5513     statePtr->flags &= ~CHANNEL_HAS_MORE_DATA;
5514   }
5515 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
5516 
5517     } else if (nread == 0) {
5518   statePtr->flags |= CHANNEL_EOF;
5519   statePtr->inputEncodingFlags |= TCL_ENCODING_END;
5520     } else if (nread < 0) {
5521   if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
5522       statePtr->flags |= CHANNEL_BLOCKED;
5523       result = EAGAIN;
5524   }
5525   Tcl_SetErrno(result);
5526   return result;
5527     }
5528     return 0;
5529 }
static int HaveVersion (Tcl_ChannelType * chanTypePtr, Tcl_ChannelTypeVersion minimumVersion) [static]

Definition at line 9071 of file tclIO.c.
References Tcl_ChannelVersion().
Referenced by Tcl_ChannelBlockModeProc(), Tcl_ChannelFlushProc(), Tcl_ChannelHandlerProc(), Tcl_ChannelThreadActionProc(), Tcl_ChannelWideSeekProc(), Tcl_Seek(), and Tcl_Tell().9074 {
9075     Tcl_ChannelTypeVersion actualVersion = Tcl_ChannelVersion(chanTypePtr);
9076 
9077     return ((int)actualVersion) >= ((int)minimumVersion);
9078 }
static void PeekAhead (Channel * chanPtr, char ** dstEndPtr, GetsState * gsPtr) [static]

Definition at line 4065 of file tclIO.c.
References ChannelBuffer::bufLength, GetsState::bufPtr, GetsState::bytesWrote, CHANNEL_NONBLOCKING, GetsState::charsWrote, cleanup(), GetsState::dstPtr, FilterInputBytes(), ChannelBuffer::nextAdded, ChannelBuffer::nextPtr, ChannelBuffer::nextRemoved, NULL, GetsState::rawRead, StackSetBlockMode(), Tcl_ChannelBlockModeProc(), TCL_MODE_BLOCKING, TCL_MODE_NONBLOCKING, and GetsState::totalChars.
Referenced by Tcl_GetsObj().4070 {
4071     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
4072     ChannelBuffer *bufPtr;
4073     Tcl_DriverBlockModeProc *blockModeProc;
4074     int bytesLeft;
4075 
4076     bufPtr = gsPtr->bufPtr;
4077 
4078     /*
4079      * If there's any more raw input that's still buffered, we'll peek into
4080      * that.  Otherwise, only get more data from the channel driver if it
4081      * looks like there might actually be more data.  The assumption is that
4082      * if the channel buffer is filled right up to the end, then there
4083      * might be more data to read.
4084      */
4085 
4086     blockModeProc = NULL;
4087     if (bufPtr->nextPtr == NULL) {
4088   bytesLeft = bufPtr->nextAdded - (bufPtr->nextRemoved + gsPtr->rawRead);
4089   if (bytesLeft == 0) {
4090       if (bufPtr->nextAdded < bufPtr->bufLength) {
4091     /*
4092      * Don't peek ahead if last read was short read.
4093      */
4094      
4095     goto cleanup;
4096       }
4097       if ((statePtr->flags & CHANNEL_NONBLOCKING) == 0) {
4098     blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
4099     if (blockModeProc == NULL) {
4100         /*
4101          * Don't peek ahead if cannot set non-blocking mode.
4102          */
4103 
4104         goto cleanup;
4105     }
4106     StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
4107       }
4108   }
4109     }
4110     if (FilterInputBytes(chanPtr, gsPtr) == 0) {
4111   *dstEndPtr = *gsPtr->dstPtr + gsPtr->bytesWrote;
4112     }
4113     if (blockModeProc != NULL) {
4114   StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
4115     }
4116     return;
4117 
4118     cleanup:
4119     bufPtr->nextRemoved += gsPtr->rawRead;
4120     gsPtr->rawRead = 0;
4121     gsPtr->totalChars += gsPtr->charsWrote;
4122     gsPtr->bytesWrote = 0;
4123     gsPtr->charsWrote = 0;
4124 }
static int ReadBytes (ChannelState * statePtr, Tcl_Obj * objPtr, int bytesToRead, int * offsetPtr) [static]

Definition at line 4602 of file tclIO.c.
References ChannelBuffer::buf, INPUT_NEED_NL, ChannelBuffer::nextAdded, ChannelBuffer::nextRemoved, Tcl_GetByteArrayFromObj(), Tcl_SetByteArrayLength(), and TranslateInputEOL().
Referenced by DoReadChars().4621 {
4622     int toRead, srcLen, offset, length, srcRead, dstWrote;
4623     ChannelBuffer *bufPtr;
4624     char *src, *dst;
4625 
4626     offset = *offsetPtr;
4627 
4628     bufPtr = statePtr->inQueueHead; 
4629     src = bufPtr->buf + bufPtr->nextRemoved;
4630     srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
4631 
4632     toRead = bytesToRead;
4633     if ((unsigned) toRead > (unsigned) srcLen) {
4634   toRead = srcLen;
4635     }
4636 
4637     dst = (char *) Tcl_GetByteArrayFromObj(objPtr, &length);
4638     if (toRead > length - offset - 1) {
4639   /*
4640    * Double the existing size of the object or make enough room to
4641    * hold all the characters we may get from the source buffer,
4642    * whichever is larger.
4643    */
4644 
4645   length = offset * 2;
4646   if (offset < toRead) {
4647       length = offset + toRead + 1;
4648   }
4649   dst = (char *) Tcl_SetByteArrayLength(objPtr, length);
4650     }
4651     dst += offset;
4652 
4653     if (statePtr->flags & INPUT_NEED_NL) {
4654   statePtr->flags &= ~INPUT_NEED_NL;
4655   if ((srcLen == 0) || (*src != '\n')) {
4656       *dst = '\r';
4657       *offsetPtr += 1;
4658       return 1;
4659   }
4660   *dst++ = '\n';
4661   src++;
4662   srcLen--;
4663   toRead--;
4664     }
4665 
4666     srcRead = srcLen;
4667     dstWrote = toRead;
4668     if (TranslateInputEOL(statePtr, dst, src, &dstWrote, &srcRead) != 0) {
4669   if (dstWrote == 0) {
4670       return -1;
4671   }
4672     }
4673     bufPtr->nextRemoved += srcRead;
4674     *offsetPtr += dstWrote;
4675     return dstWrote;
4676 }
static int ReadChars (ChannelState * statePtr, Tcl_Obj * objPtr, int charsToRead, int * offsetPtr, int * factorPtr) [static]

Definition at line 4706 of file tclIO.c.
References ChannelBuffer::buf, Tcl_Obj::bytes, CHANNEL_NEED_MORE_DATA, CONST, INPUT_NEED_NL, Tcl_Obj::length, ChannelBuffer::nextAdded, ChannelBuffer::nextPtr, ChannelBuffer::nextRemoved, NULL, RecycleBuffer(), size_t(), TCL_ENCODING_END, TCL_ENCODING_START, Tcl_ExternalToUtf(), Tcl_SetObjLength(), TCL_UTF_MAX, Tcl_UtfAtIndex(), TranslateInputEOL(), UTF_EXPANSION_FACTOR, and VOID.
Referenced by DoReadChars().4729 {
4730     int toRead, factor, offset, spaceLeft, length, srcLen, dstNeeded;
4731     int srcRead, dstWrote, numChars, dstRead;
4732     ChannelBuffer *bufPtr;
4733     char *src, *dst;
4734     Tcl_EncodingState oldState;
4735     int encEndFlagSuppressed = 0;
4736 
4737     factor = *factorPtr;
4738     offset = *offsetPtr;
4739 
4740     bufPtr = statePtr->inQueueHead; 
4741     src    = bufPtr->buf + bufPtr->nextRemoved;
4742     srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
4743 
4744     toRead = charsToRead;
4745     if ((unsigned)toRead > (unsigned)srcLen) {
4746   toRead = srcLen;
4747     }
4748 
4749     /*
4750      * 'factor' is how much we guess that the bytes in the source buffer
4751      * will expand when converted to UTF-8 chars.  This guess comes from
4752      * analyzing how many characters were produced by the previous
4753      * pass.
4754      */
4755 
4756     dstNeeded = toRead * factor / UTF_EXPANSION_FACTOR;
4757     spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
4758 
4759     if (dstNeeded > spaceLeft) {
4760   /*
4761    * Double the existing size of the object or make enough room to
4762    * hold all the characters we want from the source buffer,
4763    * whichever is larger.
4764    */
4765 
4766   length = offset * 2;
4767   if (offset < dstNeeded) {
4768       length = offset + dstNeeded;
4769   }
4770   spaceLeft = length - offset;
4771   length += TCL_UTF_MAX + 1;
4772   Tcl_SetObjLength(objPtr, length);
4773     }
4774     if (toRead == srcLen) {
4775   /*
4776    * Want to convert the whole buffer in one pass.  If we have
4777    * enough space, convert it using all available space in object
4778    * rather than using the factor.
4779    */
4780 
4781   dstNeeded = spaceLeft;
4782     }
4783     dst = objPtr->bytes + offset;
4784 
4785     /*
4786      * SF Tcl Bug 1462248
4787      * The cause of the crash reported in the referenced bug is this:
4788      *
4789      * - ReadChars, called with a single buffer, with a incomplete
4790      *   multi-byte character at the end (only the first byte of it).
4791      * - Encoding translation fails, asks for more data
4792      * - Data is read, and eof is reached, TCL_ENCODING_END (TEE) is set.
4793      * - ReadChar is called again, converts the first buffer, but due
4794      *   to TEE it does not check for incomplete multi-byte data, and the
4795      *   character just after the end of the first buffer is a valid
4796      *   completion of the multi-byte header in the actual buffer. The
4797      *   conversion reads more characters from the buffer then present.
4798      *   This causes nextRemoved to overshoot nextAdded and the next
4799      *   reads compute a negative srcLen, cause further translations to
4800      *   fail, causing copying of data into the next buffer using bad
4801      *   arguments, causing the mecpy for to eventually fail.
4802      *
4803      * In the end it is a memory access bug spiraling out of control
4804      * if the conditions are _just so_. And ultimate cause is that TEE
4805      * is given to a conversion where it should not. TEE signals that
4806      * this is the last buffer. Except in our case it is not.
4807      *
4808      * My solution is to suppress TEE if the first buffer is not the
4809      * last. We will eventually need it given that EOF has been
4810      * reached, but not right now. This is what the new flag
4811      * "endEncSuppressFlag" is for.
4812      *
4813      * The bug in 'Tcl_Utf2UtfProc' where it read from memory behind
4814      * the actual buffer has been fixed as well, and fixes the problem
4815      * with the crash too, but this would still allow the generic
4816      * layer to accidentially break a multi-byte sequence if the
4817      * conditions are just right, because again the ExternalToUtf
4818      * would be successful where it should not.
4819      */
4820 
4821     if ((statePtr->inputEncodingFlags & TCL_ENCODING_END) &&
4822   (bufPtr->nextPtr != NULL)) {
4823 
4824         /* TEE is set for a buffer which is not the last. Squash it
4825    * for now, and restore it later, before yielding control to
4826    * our caller.
4827    */
4828 
4829         statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
4830         encEndFlagSuppressed = 1;
4831     }
4832 
4833     oldState = statePtr->inputEncodingState;
4834     if (statePtr->flags & INPUT_NEED_NL) {
4835   /*
4836    * We want a '\n' because the last character we saw was '\r'.
4837    */
4838 
4839   statePtr->flags &= ~INPUT_NEED_NL;
4840   Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
4841     statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
4842     dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars);
4843   if ((dstWrote > 0) && (*dst == '\n')) {
4844       /*
4845        * The next char was a '\n'.  Consume it and produce a '\n'.
4846        */
4847 
4848       bufPtr->nextRemoved += srcRead;
4849   } else {
4850       /*
4851        * The next char was not a '\n'.  Produce a '\r'.
4852        */
4853 
4854       *dst = '\r';
4855   }
4856   statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
4857   *offsetPtr += 1;
4858 
4859   if (encEndFlagSuppressed) {
4860       statePtr->inputEncodingFlags |= TCL_ENCODING_END;
4861   }
4862         return 1;
4863     }
4864 
4865     Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
4866       statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
4867       dstNeeded + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
4868 
4869     if (encEndFlagSuppressed) {
4870         statePtr->inputEncodingFlags |= TCL_ENCODING_END;
4871     }
4872 
4873     if (srcRead == 0) {
4874   /*
4875    * Not enough bytes in src buffer to make a complete char.  Copy
4876    * the bytes to the next buffer to make a new contiguous string,
4877    * then tell the caller to fill the buffer with more bytes.
4878    */
4879 
4880   ChannelBuffer *nextPtr;
4881   
4882   nextPtr = bufPtr->nextPtr;
4883   if (nextPtr == NULL) {
4884       if (srcLen > 0) {
4885           /*
4886      * There isn't enough data in the buffers to complete the next
4887      * character, so we need to wait for more data before the next
4888      * file event can be delivered.
4889      *
4890      * SF #478856.
4891      *
4892      * The exception to this is if the input buffer was
4893      * completely empty before we tried to convert its
4894      * contents. Nothing in, nothing out, and no incomplete
4895      * character data. The conversion before the current one
4896      * was complete.
4897      */
4898 
4899           statePtr->flags |= CHANNEL_NEED_MORE_DATA;
4900       }
4901       return -1;
4902   }
4903 
4904   /* Space is made at the beginning of the buffer to copy the
4905    * previous unused bytes there. Check first if the buffer we
4906    * are using actually has enough space at its beginning for
4907    * the data we are copying. Because if not we will write over the
4908    * buffer management information, especially the 'nextPtr'.
4909    *
4910    * Note that the BUFFER_PADDING (See AllocChannelBuffer) is
4911    * used to prevent exactly this situation. I.e. it should
4912    * never happen. Therefore it is ok to panic should it happen
4913    * despite the precautions.
4914    */
4915 
4916   if (nextPtr->nextRemoved - srcLen < 0) {
4917       Tcl_Panic ("Buffer Underflow, BUFFER_PADDING not enough");
4918   }
4919 
4920   nextPtr->nextRemoved -= srcLen;
4921   memcpy((VOID *) (nextPtr->buf + nextPtr->nextRemoved), (VOID *) src,
4922     (size_t) srcLen);
4923   RecycleBuffer(statePtr, bufPtr, 0);
4924   statePtr->inQueueHead = nextPtr;
4925   return ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr);
4926     }
4927 
4928     dstRead = dstWrote;
4929     if (TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead) != 0) {
4930   /*
4931    * Hit EOF char.  How many bytes of src correspond to where the
4932    * EOF was located in dst? Run the conversion again with an
4933    * output buffer just big enough to hold the data so we can
4934    * get the correct value for srcRead.
4935    */
4936    
4937   if (dstWrote == 0) {
4938       return -1;
4939   }
4940   statePtr->inputEncodingState = oldState;
4941   Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
4942     statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
4943     dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
4944   TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
4945     } 
4946 
4947     /*
4948      * The number of characters that we got may be less than the number
4949      * that we started with because "\r\n" sequences may have been
4950      * turned into just '\n' in dst.
4951      */
4952 
4953     numChars -= (dstRead - dstWrote);
4954 
4955     if ((unsigned) numChars > (unsigned) toRead) {
4956   /*
4957    * Got too many chars.
4958    */
4959 
4960   CONST char *eof;
4961 
4962   eof = Tcl_UtfAtIndex(dst, toRead);
4963   statePtr->inputEncodingState = oldState;
4964   Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
4965     statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
4966     dst, eof - dst + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
4967   dstRead = dstWrote;
4968   TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
4969   numChars -= (dstRead - dstWrote);
4970     }
4971     statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
4972 
4973     bufPtr->nextRemoved += srcRead;
4974     if (dstWrote > srcRead + 1) {
4975   *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
4976     }
4977     *offsetPtr += dstWrote;
4978     return numChars;
4979 }
static void RecycleBuffer (ChannelState * statePtr, ChannelBuffer * bufPtr, int mustDiscard) [static]

Definition at line 1877 of file tclIO.c.
References BUFFER_PADDING, ChannelBuffer::bufLength, ckfree, NULL, TCL_READABLE, and TCL_WRITABLE.
Referenced by CommonGetsCleanup(), CopyBuffer(), DiscardInputQueued(), DiscardOutputQueued(), DoReadChars(), FlushChannel(), GetInput(), ReadChars(), and Tcl_SetChannelOption().1882 {
1883     /*
1884      * Do we have to free the buffer to the OS?
1885      */
1886 
1887     if (mustDiscard) {
1888         ckfree((char *) bufPtr);
1889         return;
1890     }
1891 
1892     /*
1893      * Only save buffers which are at least as big as the requested
1894      * buffersize for the channel. This is to honor dynamic changes
1895      * of the buffersize made by the user.
1896      */
1897 
1898     if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {
1899         ckfree((char *) bufPtr);
1900         return;
1901     }
1902 
1903     /*
1904      * Only save buffers for the input queue if the channel is readable.
1905      */
1906     
1907     if (statePtr->flags & TCL_READABLE) {
1908         if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
1909             statePtr->inQueueHead = bufPtr;
1910             statePtr->inQueueTail = bufPtr;
1911             goto keepit;
1912         }
1913         if (statePtr->saveInBufPtr == (ChannelBuffer *) NULL) {
1914             statePtr->saveInBufPtr = bufPtr;
1915             goto keepit;
1916         }
1917     }
1918 
1919     /*
1920      * Only save buffers for the output queue if the channel is writable.
1921      */
1922 
1923     if (statePtr->flags & TCL_WRITABLE) {
1924         if (statePtr->curOutPtr == (ChannelBuffer *) NULL) {
1925             statePtr->curOutPtr = bufPtr;
1926             goto keepit;
1927         }
1928     }
1929 
1930     /*
1931      * If we reached this code we return the buffer to the OS.
1932      */
1933 
1934     ckfree((char *) bufPtr);
1935     return;
1936 
1937     keepit:
1938     bufPtr->nextRemoved = BUFFER_PADDING;
1939     bufPtr->nextAdded = BUFFER_PADDING;
1940     bufPtr->nextPtr = (ChannelBuffer *) NULL;
1941 }
static int SetBlockMode (Tcl_Interp * interp, Channel * chanPtr, int mode) [static]

Definition at line 8752 of file tclIO.c.
References BG_FLUSH_SCHEDULED, CHANNEL_NONBLOCKING, NULL, StackSetBlockMode(), Channel::state, TCL_ERROR, TCL_MODE_BLOCKING, TCL_OK, and Tcl_PosixError().
Referenced by StopCopy(), Tcl_SetChannelOption(), and TclCopyChannel().8757 {
8758     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
8759     int result = 0;
8760 
8761     result = StackSetBlockMode(chanPtr, mode);
8762     if (result != 0) {
8763   if (interp != (Tcl_Interp *) NULL) {
8764       Tcl_AppendResult(interp, "error setting blocking mode: ",
8765         Tcl_PosixError(interp), (char *) NULL);
8766   }
8767   return TCL_ERROR;
8768     }
8769     if (mode == TCL_MODE_BLOCKING) {
8770   statePtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED));
8771     } else {
8772   statePtr->flags |= CHANNEL_NONBLOCKING;
8773     }
8774     return TCL_OK;
8775 }
static int StackSetBlockMode (Channel * chanPtr, int mode) [static]

Definition at line 8706 of file tclIO.c.
References NULL, Tcl_ChannelBlockModeProc(), and Tcl_SetErrno().
Referenced by PeekAhead(), SetBlockMode(), and Tcl_Seek().8710 {
8711     int result = 0;
8712     Tcl_DriverBlockModeProc *blockModeProc;
8713 
8714     /*
8715      * Start at the top of the channel stack
8716      */
8717 
8718     chanPtr = chanPtr->state->topChanPtr;
8719     while (chanPtr != (Channel *) NULL) {
8720   blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
8721   if (blockModeProc != NULL) {
8722       result = (*blockModeProc) (chanPtr->instanceData, mode);
8723       if (result != 0) {
8724     Tcl_SetErrno(result);
8725     return result;
8726       }
8727   }
8728   chanPtr = chanPtr->downChanPtr;
8729     }
8730     return 0;
8731 }
static void StopCopy (CopyState * csPtr) [static]

Definition at line 8640 of file tclIO.c.
References CHANNEL_LINEBUFFERED, CHANNEL_NONBLOCKING, CHANNEL_UNBUFFERED, ckfree, CopyEventProc(), ChannelState::csPtr, ChannelState::flags, NULL, SetBlockMode(), Tcl_DecrRefCount, Tcl_DeleteChannelHandler(), TCL_MODE_BLOCKING, and TCL_MODE_NONBLOCKING.
Referenced by CopyData(), and Tcl_ClearChannelHandlers().8642 {
8643     ChannelState *inStatePtr, *outStatePtr;
8644     int nonBlocking;
8645 
8646     if (!csPtr) {
8647   return;
8648     }
8649 
8650     inStatePtr  = csPtr->readPtr->state;
8651     outStatePtr = csPtr->writePtr->state;
8652 
8653     /*
8654      * Restore the old blocking mode and output buffering mode.
8655      */
8656 
8657     nonBlocking = (csPtr->readFlags & CHANNEL_NONBLOCKING);
8658     if (nonBlocking != (inStatePtr->flags & CHANNEL_NONBLOCKING)) {
8659   SetBlockMode(NULL, csPtr->readPtr,
8660     nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
8661     }
8662     if (csPtr->readPtr != csPtr->writePtr) {
8663   nonBlocking = (csPtr->writeFlags & CHANNEL_NONBLOCKING);
8664   if (nonBlocking != (outStatePtr->flags & CHANNEL_NONBLOCKING)) {
8665       SetBlockMode(NULL, csPtr->writePtr,
8666         nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
8667   }
8668     }
8669     outStatePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
8670     outStatePtr->flags |=
8671   csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
8672 
8673     if (csPtr->cmdPtr) {
8674   Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->readPtr, CopyEventProc,
8675     (ClientData)csPtr);
8676   if (csPtr->readPtr != csPtr->writePtr) {
8677       Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->writePtr,
8678         CopyEventProc, (ClientData)csPtr);
8679   }
8680         Tcl_DecrRefCount(csPtr->cmdPtr);
8681     }
8682     inStatePtr->csPtr  = NULL;
8683     outStatePtr->csPtr = NULL;
8684     ckfree((char*) csPtr);
8685 }
int Tcl_BadChannelOption (Tcl_Interp * interp, CONST char * optionName, CONST char * optionList)

Definition at line 6218 of file tclIO.c.
References ckfree, CONST, EINVAL, NULL, panic, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, TCL_ERROR, TCL_OK, Tcl_ResetResult(), Tcl_SetErrno(), and Tcl_SplitList().
Referenced by SerialGetOptionProc(), Tcl_GetChannelOption(), Tcl_SetChannelOption(), TcpGetOptionProc(), and TcpSetOptionProc().6226 {
6227     if (interp) {
6228   CONST char *genericopt = 
6229       "blocking buffering buffersize encoding eofchar translation";
6230   CONST char **argv;
6231   int  argc, i;
6232   Tcl_DString ds;
6233 
6234   Tcl_DStringInit(&ds);
6235   Tcl_DStringAppend(&ds, genericopt, -1);
6236   if (optionList && (*optionList)) {
6237       Tcl_DStringAppend(&ds, " ", 1);
6238       Tcl_DStringAppend(&ds, optionList, -1);
6239   }
6240   if (Tcl_SplitList(interp, Tcl_DStringValue(&ds), 
6241     &argc, &argv) != TCL_OK) {
6242       panic("malformed option list in channel driver");
6243   }
6244   Tcl_ResetResult(interp);
6245   Tcl_AppendResult(interp, "bad option \"", optionName, 
6246     "\": should be one of ", (char *) NULL);
6247   argc--;
6248   for (i = 0; i < argc; i++) {
6249       Tcl_AppendResult(interp, "-", argv[i], ", ", (char *) NULL);
6250   }
6251   Tcl_AppendResult(interp, "or -", argv[i], (char *) NULL);
6252   Tcl_DStringFree(&ds);
6253   ckfree((char *) argv);
6254     }
6255     Tcl_SetErrno(EINVAL);
6256     return TCL_ERROR;
6257 }
Tcl_DriverBlockModeProc* Tcl_ChannelBlockModeProc (Tcl_ChannelType * chanTypePtr)

Definition at line 9096 of file tclIO.c.
References HaveVersion(), and TCL_CHANNEL_VERSION_2.
Referenced by ChannelTimerProc(), GetInput(), PeekAhead(), StackSetBlockMode(), and Tcl_NotifyChannel().9098 {
9099     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
9100   return chanTypePtr->blockModeProc;
9101     } else {
9102   /*
9103    * The v1 structure had the blockModeProc in a different place.
9104    */
9105   return (Tcl_DriverBlockModeProc *) (chanTypePtr->version);
9106     }
9107 }
int Tcl_ChannelBuffered (Tcl_Channel chan)

Definition at line 6095 of file tclIO.c.
References Channel::inQueueHead, ChannelBuffer::nextAdded, ChannelBuffer::nextPtr, ChannelBuffer::nextRemoved, and NULL.6097 {
6098     Channel *chanPtr = (Channel *) chan;
6099           /* real channel structure. */
6100     ChannelBuffer *bufPtr;
6101     int bytesBuffered;
6102 
6103     for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead;
6104    bufPtr != (ChannelBuffer *) NULL;
6105    bufPtr = bufPtr->nextPtr) {
6106         bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
6107     }
6108 
6109     return bytesBuffered;
6110 }
Tcl_DriverClose2Proc* Tcl_ChannelClose2Proc (Tcl_ChannelType * chanTypePtr)

Definition at line 9149 of file tclIO.c.9151 {
9152     return chanTypePtr->close2Proc;
9153 }
Tcl_DriverCloseProc* Tcl_ChannelCloseProc (Tcl_ChannelType * chanTypePtr)

Definition at line 9126 of file tclIO.c.9128 {
9129     return chanTypePtr->closeProc;
9130 }
Tcl_DriverFlushProc* Tcl_ChannelFlushProc (Tcl_ChannelType * chanTypePtr)

Definition at line 9333 of file tclIO.c.
References HaveVersion(), NULL, and TCL_CHANNEL_VERSION_2.9335 {
9336     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
9337   return chanTypePtr->flushProc;
9338     } else {
9339   return NULL;
9340     }
9341 }
Tcl_DriverGetHandleProc* Tcl_ChannelGetHandleProc (Tcl_ChannelType * chanTypePtr)

Definition at line 9310 of file tclIO.c.9312 {
9313     return chanTypePtr->getHandleProc;
9314 }
Tcl_DriverGetOptionProc* Tcl_ChannelGetOptionProc (Tcl_ChannelType * chanTypePtr)

Definition at line 9264 of file tclIO.c.
Referenced by TransformGetOptionProc().9266 {
9267     return chanTypePtr->getOptionProc;
9268 }
Tcl_DriverHandlerProc* Tcl_ChannelHandlerProc (Tcl_ChannelType * chanTypePtr)

Definition at line 9360 of file tclIO.c.
References HaveVersion(), NULL, and TCL_CHANNEL_VERSION_2.
Referenced by Tcl_NotifyChannel().9362 {
9363     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
9364   return chanTypePtr->handlerProc;
9365     } else {
9366   return NULL;
9367     }
9368 }
Tcl_DriverInputProc* Tcl_ChannelInputProc (Tcl_ChannelType * chanTypePtr)

Definition at line 9172 of file tclIO.c.9174 {
9175     return chanTypePtr->inputProc;
9176 }
CONST char* Tcl_ChannelName (Tcl_ChannelType * chanTypePtr)

Definition at line 9012 of file tclIO.c.
Referenced by Tcl_SetChannelOption(), and TestChannelCmd().9014 {
9015     return chanTypePtr->typeName;
9016 }
Tcl_DriverOutputProc* Tcl_ChannelOutputProc (Tcl_ChannelType * chanTypePtr)

Definition at line 9195 of file tclIO.c.9197 {
9198     return chanTypePtr->outputProc;
9199 }
Tcl_DriverSeekProc* Tcl_ChannelSeekProc (Tcl_ChannelType * chanTypePtr)

Definition at line 9218 of file tclIO.c.
Referenced by TransformSeekProc(), and TransformWideSeekProc().9220 {
9221     return chanTypePtr->seekProc;
9222 }
Tcl_DriverSetOptionProc* Tcl_ChannelSetOptionProc (Tcl_ChannelType * chanTypePtr)

Definition at line 9241 of file tclIO.c.
Referenced by TransformSetOptionProc().9243 {
9244     return chanTypePtr->setOptionProc;
9245 }
Tcl_DriverThreadActionProc* Tcl_ChannelThreadActionProc (Tcl_ChannelType * chanTypePtr)

Definition at line 9414 of file tclIO.c.
References HaveVersion(), NULL, and TCL_CHANNEL_VERSION_4.
Referenced by Tcl_CutChannel(), and Tcl_SpliceChannel().9416 {
9417     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {
9418   return chanTypePtr->threadActionProc;
9419     } else {
9420   return NULL;
9421     }
9422 }
Tcl_ChannelTypeVersion Tcl_ChannelVersion (Tcl_ChannelType * chanTypePtr)

Definition at line 9035 of file tclIO.c.
References TCL_CHANNEL_VERSION_1, TCL_CHANNEL_VERSION_2, TCL_CHANNEL_VERSION_3, and TCL_CHANNEL_VERSION_4.
Referenced by HaveVersion().9037 {
9038     if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) {
9039   return TCL_CHANNEL_VERSION_2;
9040     } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_3) {
9041   return TCL_CHANNEL_VERSION_3;
9042     } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_4) {
9043   return TCL_CHANNEL_VERSION_4;
9044     } else {
9045   /*
9046    * In <v2 channel versions, the version field is occupied
9047    * by the Tcl_DriverBlockModeProc
9048    */
9049   return TCL_CHANNEL_VERSION_1;
9050     }
9051 }
Tcl_DriverWatchProc* Tcl_ChannelWatchProc (Tcl_ChannelType * chanTypePtr)

Definition at line 9287 of file tclIO.c.9289 {
9290     return chanTypePtr->watchProc;
9291 }
Tcl_DriverWideSeekProc* Tcl_ChannelWideSeekProc (Tcl_ChannelType * chanTypePtr)

Definition at line 9387 of file tclIO.c.
References HaveVersion(), NULL, and TCL_CHANNEL_VERSION_3.
Referenced by TransformWideSeekProc().9389 {
9390     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) {
9391   return chanTypePtr->wideSeekProc;
9392     } else {
9393   return NULL;
9394     }
9395 }
void Tcl_ClearChannelHandlers (Tcl_Channel channel)

Definition at line 2678 of file tclIO.c.
References ChannelHandler::chanPtr, ckfree, dataKey, NextChannelHandler::nestedHandlerPtr, ThreadSpecificData::nestedHandlerPtr, NextChannelHandler::nextHandlerPtr, EventScriptRecord::nextPtr, ChannelHandler::nextPtr, NULL, EventScriptRecord::scriptPtr, Channel::state, StopCopy(), Tcl_DecrRefCount, Tcl_DeleteTimerHandler(), and TCL_TSD_INIT.
Referenced by Tcl_Close(), and TestChannelCmd().2680 {
2681     ChannelHandler *chPtr, *chNext; /* Iterate over channel handlers. */
2682     EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */
2683     Channel *chanPtr;     /* The real IO channel. */
2684     ChannelState *statePtr;   /* State of real IO channel. */
2685     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2686     NextChannelHandler *nhPtr;
2687 
2688     /*
2689      * This operation should occur at the top of a channel stack.
2690      */
2691 
2692     chanPtr = (Channel *) channel;
2693     statePtr  = chanPtr->state;
2694     chanPtr = statePtr->topChanPtr;
2695 
2696     /*
2697      * Cancel any outstanding timer.
2698      */
2699 
2700     Tcl_DeleteTimerHandler(statePtr->timer);
2701 
2702     /*
2703      * Remove any references to channel handlers for this channel that
2704      * may be about to be invoked.
2705      */
2706 
2707     for (nhPtr = tsdPtr->nestedHandlerPtr;
2708    nhPtr != (NextChannelHandler *) NULL;
2709    nhPtr = nhPtr->nestedHandlerPtr) {
2710         if (nhPtr->nextHandlerPtr &&
2711     (nhPtr->nextHandlerPtr->chanPtr == chanPtr)) {
2712       nhPtr->nextHandlerPtr = NULL;
2713         }
2714     }
2715 
2716     /*
2717      * Remove all the channel handler records attached to the channel
2718      * itself.
2719      */
2720 
2721     for (chPtr = statePtr->chPtr;
2722    chPtr != (ChannelHandler *) NULL;
2723    chPtr = chNext) {
2724         chNext = chPtr->nextPtr;
2725         ckfree((char *) chPtr);
2726     }
2727     statePtr->chPtr = (ChannelHandler *) NULL;
2728 
2729     /*
2730      * Cancel any pending copy operation.
2731      */
2732 
2733     StopCopy(statePtr->csPtr);
2734 
2735     /*
2736      * Must set the interest mask now to 0, otherwise infinite loops
2737      * will occur if Tcl_DoOneEvent is called before the channel is
2738      * finally deleted in FlushChannel. This can happen if the channel
2739      * has a background flush active.
2740      */
2741 
2742     statePtr->interestMask = 0;
2743 
2744     /*
2745      * Remove any EventScript records for this channel.
2746      */
2747 
2748     for (ePtr = statePtr->scriptRecordPtr;
2749    ePtr != (EventScriptRecord *) NULL;
2750    ePtr = eNextPtr) {
2751         eNextPtr = ePtr->nextPtr;
2752   Tcl_DecrRefCount(ePtr->scriptPtr);
2753         ckfree((char *) ePtr);
2754     }
2755     statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
2756 }
int Tcl_Close (Tcl_Interp * interp, Tcl_Channel chan)

Definition at line 2552 of file tclIO.c.
References BUFFER_READY, CHANNEL_CLOSED, CHANNEL_INCLOSE, CheckChannelErrors(), CheckForStdChannelsBeingClosed(), ckfree, CloseCallback::clientData, Tcl_ChannelType::close2Proc, Tcl_ChannelType::closeProc, FlushChannel(), Channel::instanceData, CloseCallback::nextPtr, NULL, panic, CloseCallback::proc, Channel::state, Tcl_ClearChannelHandlers(), TCL_CLOSE2PROC, TCL_CLOSE_READ, TCL_ENCODING_END, TCL_ERROR, TCL_OK, TCL_WRITABLE, Channel::typePtr, and WriteChars().
Referenced by AcceptCallbackProc(), CloseChannel(), DeleteChannelTable(), FileRCVariables(), LoadEncodingFile(), MakeTcpClientChannelMode(), OpenFileChannel(), PretendTclpOpenFileChannel(), Tcl_ExecObjCmd(), Tcl_FSEvalFile(), Tcl_FSLoadFile(), Tcl_FSOpenFileChannel(), Tcl_OpenTcpClient(), Tcl_OpenTcpServer(), Tcl_SourceRCFile(), Tcl_UnregisterChannel(), Tcl_UnstackChannel(), TclCleanupChildren(), TclCrossFilesystemCopy(), TclFinalizeIOSubsystem(), TclpGetDefaultStdChannel(), TclpOpenFileChannel(), and TcpAccept().2557 {
2558     CloseCallback *cbPtr;   /* Iterate over close callbacks
2559                                          * for this channel. */
2560     Channel *chanPtr;     /* The real IO channel. */
2561     ChannelState *statePtr;   /* State of real IO channel. */
2562     int result;       /* Of calling FlushChannel. */
2563 
2564     if (chan == (Tcl_Channel) NULL) {
2565         return TCL_OK;
2566     }
2567 
2568     /*
2569      * Perform special handling for standard channels being closed. If the
2570      * refCount is now 1 it means that the last reference to the standard
2571      * channel is being explicitly closed, so bump the refCount down
2572      * artificially to 0. This will ensure that the channel is actually
2573      * closed, below. Also set the static pointer to NULL for the channel.
2574      */
2575 
2576     CheckForStdChannelsBeingClosed(chan);
2577 
2578     /*
2579      * This operation should occur at the top of a channel stack.
2580      */
2581 
2582     chanPtr = (Channel *) chan;
2583     statePtr  = chanPtr->state;
2584     chanPtr = statePtr->topChanPtr;
2585 
2586     if (statePtr->refCount > 0) {
2587         panic("called Tcl_Close on channel with refCount > 0");
2588     }
2589  
2590     if (statePtr->flags & CHANNEL_INCLOSE) {
2591   if (interp) {
2592             Tcl_AppendResult(interp,
2593       "Illegal recursive call to close through close-handler of channel",
2594       (char *) NULL);
2595   }
2596         return TCL_ERROR;
2597     }
2598     statePtr->flags |= CHANNEL_INCLOSE;
2599 
2600     /*
2601      * When the channel has an escape sequence driven encoding such as
2602      * iso2022, the terminated escape sequence must write to the buffer.
2603      */
2604     if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
2605       && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
2606         statePtr->outputEncodingFlags |= TCL_ENCODING_END;
2607         WriteChars(chanPtr, "", 0);
2608     }
2609 
2610     Tcl_ClearChannelHandlers(chan);
2611 
2612     /*
2613      * Invoke the registered close callbacks and delete their records.
2614      */
2615 
2616     while (statePtr->closeCbPtr != (CloseCallback *) NULL) {
2617         cbPtr = statePtr->closeCbPtr;
2618         statePtr->closeCbPtr = cbPtr->nextPtr;
2619         (cbPtr->proc) (cbPtr->clientData);
2620         ckfree((char *) cbPtr);
2621     }
2622 
2623     statePtr->flags &= ~CHANNEL_INCLOSE;
2624 
2625     /*
2626      * Ensure that the last output buffer will be flushed.
2627      */
2628     
2629     if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
2630       (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
2631         statePtr->flags |= BUFFER_READY;
2632     }
2633 
2634     /*
2635      * If this channel supports it, close the read side, since we don't need it
2636      * anymore and this will help avoid deadlocks on some channel types.
2637      */
2638 
2639     if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
2640   result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
2641     TCL_CLOSE_READ);
2642     } else {
2643   result = 0;
2644     }
2645 
2646     /*
2647      * The call to FlushChannel will flush any queued output and invoke
2648      * the close function of the channel driver, or it will set up the
2649      * channel to be flushed and closed asynchronously.
2650      */
2651 
2652     statePtr->flags |= CHANNEL_CLOSED;
2653     if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {
2654         return TCL_ERROR;
2655     }
2656     return TCL_OK;
2657 }
Tcl_Channel Tcl_CreateChannel (Tcl_ChannelType * typePtr, CONST char * chanName, ClientData instanceData, int mask)

Definition at line 1120 of file tclIO.c.
References CHANNELBUFFER_DEFAULT_SIZE, ckalloc, CONST, dataKey, Channel::downChanPtr, Channel::inQueueHead, Channel::inQueueTail, Channel::instanceData, NULL, panic, Channel::state, ThreadSpecificData::stderrChannel, ThreadSpecificData::stderrInitialized, ThreadSpecificData::stdinChannel, ThreadSpecificData::stdinInitialized, ThreadSpecificData::stdoutChannel, ThreadSpecificData::stdoutInitialized, TCL_ENCODING_START, Tcl_GetEncoding(), Tcl_GetEncodingName(), TCL_PLATFORM_TRANSLATION, Tcl_RegisterChannel(), Tcl_SetStdChannel(), Tcl_SpliceChannel(), TCL_STDERR, TCL_STDIN, TCL_STDOUT, TCL_TRANSLATE_AUTO, TCL_TSD_INIT, TCL_WRITABLE, Channel::typePtr, and Channel::upChanPtr.
Referenced by MakeTcpClientChannelMode(), OpenFileChannel(), Tcl_MakeFileChannel(), Tcl_MakeTcpClientChannel(), Tcl_OpenTcpClient(), Tcl_OpenTcpServer(), TclpCreateCommandChannel(), TclpGetDefaultStdChannel(), TclpOpenFileChannel(), TclWinOpenConsoleChannel(), TclWinOpenFileChannel(), TclWinOpenSerialChannel(), and TcpAccept().1126 {
1127     Channel *chanPtr;   /* The channel structure newly created. */
1128     ChannelState *statePtr; /* The stack-level independent state info
1129          * for the channel. */
1130     CONST char *name;
1131     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1132 
1133     /*
1134      * With the change of the Tcl_ChannelType structure to use a version in
1135      * 8.3.2+, we have to make sure that our assumption that the structure
1136      * remains a binary compatible size is true.
1137      *
1138      * If this assertion fails on some system, then it can be removed
1139      * only if the user recompiles code with older channel drivers in
1140      * the new system as well.
1141      */
1142 
1143     assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc*));
1144 
1145     /*
1146      * JH: We could subsequently memset these to 0 to avoid the
1147      * numerous assignments to 0/NULL below.
1148      */
1149     chanPtr  = (Channel *) ckalloc((unsigned) sizeof(Channel));
1150     statePtr = (ChannelState *) ckalloc((unsigned) sizeof(ChannelState));
1151     chanPtr->state = statePtr;
1152 
1153     chanPtr->instanceData = instanceData;
1154     chanPtr->typePtr    = typePtr;
1155 
1156     /*
1157      * Set all the bits that are part of the stack-independent state
1158      * information for the channel.
1159      */
1160 
1161     if (chanName != (char *) NULL) {
1162   char *tmp = ckalloc((unsigned) (strlen(chanName) + 1));
1163         statePtr->channelName = tmp;
1164         strcpy(tmp, chanName);
1165     } else {
1166         panic("Tcl_CreateChannel: NULL channel name");
1167     }
1168 
1169     statePtr->flags   = mask;
1170 
1171     /*
1172      * Set the channel to system default encoding.
1173      */
1174 
1175     statePtr->encoding = NULL;
1176     name = Tcl_GetEncodingName(NULL);
1177     if (strcmp(name, "binary") != 0) {
1178       statePtr->encoding = Tcl_GetEncoding(NULL, name);
1179     }
1180     statePtr->inputEncodingState  = NULL;
1181     statePtr->inputEncodingFlags  = TCL_ENCODING_START;
1182     statePtr->outputEncodingState = NULL;
1183     statePtr->outputEncodingFlags = TCL_ENCODING_START;
1184 
1185     /*
1186      * Set the channel up initially in AUTO input translation mode to
1187      * accept "\n", "\r" and "\r\n". Output translation mode is set to
1188      * a platform specific default value. The eofChar is set to 0 for both
1189      * input and output, so that Tcl does not look for an in-file EOF
1190      * indicator (e.g. ^Z) and does not append an EOF indicator to files.
1191      */
1192 
1193     statePtr->inputTranslation  = TCL_TRANSLATE_AUTO;
1194     statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
1195     statePtr->inEofChar   = 0;
1196     statePtr->outEofChar  = 0;
1197 
1198     statePtr->unreportedError = 0;
1199     statePtr->refCount    = 0;
1200     statePtr->closeCbPtr  = (CloseCallback *) NULL;
1201     statePtr->curOutPtr   = (ChannelBuffer *) NULL;
1202     statePtr->outQueueHead  = (ChannelBuffer *) NULL;
1203     statePtr->outQueueTail  = (ChannelBuffer *) NULL;
1204     statePtr->saveInBufPtr  = (ChannelBuffer *) NULL;
1205     statePtr->inQueueHead = (ChannelBuffer *) NULL;
1206     statePtr->inQueueTail = (ChannelBuffer *) NULL;
1207     statePtr->chPtr   = (ChannelHandler *) NULL;
1208     statePtr->interestMask  = 0;
1209     statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
1210     statePtr->bufSize   = CHANNELBUFFER_DEFAULT_SIZE;
1211     statePtr->timer   = NULL;
1212     statePtr->csPtr   = NULL;
1213 
1214     statePtr->outputStage = NULL;
1215     if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
1216   statePtr->outputStage = (char *)
1217       ckalloc((unsigned) (statePtr->bufSize + 2));
1218     }
1219 
1220     /*
1221      * As we are creating the channel, it is obviously the top for now
1222      */
1223     statePtr->topChanPtr  = chanPtr;
1224     statePtr->bottomChanPtr = chanPtr;
1225     chanPtr->downChanPtr  = (Channel *) NULL;
1226     chanPtr->upChanPtr    = (Channel *) NULL;
1227     chanPtr->inQueueHead        = (ChannelBuffer*) NULL;
1228     chanPtr->inQueueTail        = (ChannelBuffer*) NULL;
1229 
1230     /*
1231      * Link the channel into the list of all channels; create an on-exit
1232      * handler if there is not one already, to close off all the channels
1233      * in the list on exit.
1234      *
1235      * JH: Could call Tcl_SpliceChannel, but need to avoid NULL check.
1236      *
1237      * TIP #218.
1238      * AK: Just initialize the field to NULL before invoking Tcl_SpliceChannel
1239      *     We need Tcl_SpliceChannel, for the threadAction calls.
1240      *     There is no real reason to duplicate all of this.
1241      * NOTE: All drivers using thread actions now have to perform their TSD
1242      *       manipulation only in their thread action proc. Doing it when
1243      *       creating their instance structures will collide with the thread
1244      *       action activity and lead to damaged lists.
1245      */
1246 
1247     statePtr->nextCSPtr = (ChannelState *) NULL;
1248     Tcl_SpliceChannel ((Tcl_Channel) chanPtr);
1249 
1250     /*
1251      * Install this channel in the first empty standard channel slot, if
1252      * the channel was previously closed explicitly.
1253      */
1254 #if TCL_INHERIT_STD_CHANNELS
1255     if ((tsdPtr->stdinChannel == NULL) &&
1256       (tsdPtr->stdinInitialized == 1)) {
1257   Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDIN);
1258         Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
1259     } else if ((tsdPtr->stdoutChannel == NULL) &&
1260       (tsdPtr->stdoutInitialized == 1)) {
1261   Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDOUT);
1262         Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
1263     } else if ((tsdPtr->stderrChannel == NULL) &&
1264       (tsdPtr->stderrInitialized == 1)) {
1265   Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDERR);
1266         Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
1267     }
1268 #endif
1269     return (Tcl_Channel) chanPtr;
1270 }
void Tcl_CreateChannelHandler (Tcl_Channel chan, int mask, Tcl_ChannelProc * proc, ClientData clientData)

Definition at line 7216 of file tclIO.c.
References ChannelHandler::chanPtr, ckalloc, ChannelHandler::clientData, ChannelHandler::mask, ChannelHandler::nextPtr, NULL, ChannelHandler::proc, Channel::state, and UpdateInterest().
Referenced by CopyData(), CreateScriptRecord(), StdinProc(), Tcl_Main(), and TestChannelEventCmd().7219                                           :
7220          * indicates conditions under which
7221          * proc should be called. Use 0 to
7222                                  * disable a registered handler. */
7223     Tcl_ChannelProc *proc;  /* Procedure to call for each
7224          * selected event. */
7225     ClientData clientData;  /* Arbitrary data to pass to proc. */
7226 {
7227     ChannelHandler *chPtr;
7228     Channel *chanPtr = (Channel *) chan;
7229     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
7230 
7231     /*
7232      * Check whether this channel handler is not already registered. If
7233      * it is not, create a new record, else reuse existing record (smash
7234      * current values).
7235      */
7236 
7237     for (chPtr = statePtr->chPtr;
7238    chPtr != (ChannelHandler *) NULL;
7239    chPtr = chPtr->nextPtr) {
7240         if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
7241                 (chPtr->clientData == clientData)) {
7242             break;
7243         }
7244     }
7245     if (chPtr == (ChannelHandler *) NULL) {
7246         chPtr = (ChannelHandler *) ckalloc((unsigned) sizeof(ChannelHandler));
7247         chPtr->mask = 0;
7248         chPtr->proc = proc;
7249         chPtr->clientData = clientData;
7250         chPtr->chanPtr = chanPtr;
7251         chPtr->nextPtr = statePtr->chPtr;
7252         statePtr->chPtr = chPtr;
7253     }
7254 
7255     /*
7256      * The remainder of the initialization below is done regardless of
7257      * whether or not this is a new record or a modification of an old
7258      * one.
7259      */
7260 
7261     chPtr->mask = mask;
7262 
7263     /*
7264      * Recompute the interest mask for the channel - this call may actually
7265      * be disabling an existing handler.
7266      */
7267     
7268     statePtr->interestMask = 0;
7269     for (chPtr = statePtr->chPtr;
7270    chPtr != (ChannelHandler *) NULL;
7271    chPtr = chPtr->nextPtr) {
7272   statePtr->interestMask |= chPtr->mask;
7273     }
7274 
7275     UpdateInterest(statePtr->topChanPtr);
7276 }

void Tcl_CreateCloseHandler (Tcl_Channel chan, Tcl_CloseProc * proc, ClientData clientData)

Definition at line 440 of file tclIO.c.
References ckalloc, CloseCallback::clientData, CloseCallback::nextPtr, and CloseCallback::proc.
Referenced by Tcl_SocketObjCmd().447 {
448     ChannelState *statePtr;
449     CloseCallback *cbPtr;
450 
451     statePtr = ((Channel *) chan)->state;
452 
453     cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));
454     cbPtr->proc = proc;
455     cbPtr->clientData = clientData;
456 
457     cbPtr->nextPtr = statePtr->closeCbPtr;
458     statePtr->closeCbPtr = cbPtr;
459 }
void Tcl_CutChannel (Tcl_Channel chan)

Definition at line 2427 of file tclIO.c.
References dataKey, ThreadSpecificData::firstCSPtr, ChannelState::nextCSPtr, NULL, panic, TCL_CHANNEL_THREAD_REMOVE, Tcl_ChannelThreadActionProc(), Tcl_GetChannelInstanceData(), Tcl_GetChannelType(), and TCL_TSD_INIT.
Referenced by CloseChannel(), and TestChannelCmd().2431 {
2432     ThreadSpecificData* tsdPtr  = TCL_TSD_INIT(&dataKey);
2433     ChannelState *prevCSPtr;    /* Preceding channel state in list of
2434                                          * all states - used to splice a
2435                                          * channel out of the list on close. */
2436     ChannelState *statePtr = ((Channel *) chan)->state;
2437           /* state of the channel stack. */
2438     Tcl_DriverThreadActionProc *threadActionProc;
2439 
2440     /*
2441      * Remove this channel from of the list of all channels
2442      * (in the current thread).
2443      */
2444 
2445     if (tsdPtr->firstCSPtr && (statePtr == tsdPtr->firstCSPtr)) {
2446         tsdPtr->firstCSPtr = statePtr->nextCSPtr;
2447     } else {
2448         for (prevCSPtr = tsdPtr->firstCSPtr;
2449        prevCSPtr && (prevCSPtr->nextCSPtr != statePtr);
2450        prevCSPtr = prevCSPtr->nextCSPtr) {
2451             /* Empty loop body. */
2452         }
2453         if (prevCSPtr == (ChannelState *) NULL) {
2454             panic("FlushChannel: damaged channel list");
2455         }
2456         prevCSPtr->nextCSPtr = statePtr->nextCSPtr;
2457     }
2458 
2459     statePtr->nextCSPtr = (ChannelState *) NULL;
2460 
2461     /* TIP #218, Channel Thread Actions */
2462     threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
2463     if (threadActionProc != NULL) {
2464         (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
2465            TCL_CHANNEL_THREAD_REMOVE);
2466     }
2467 }
void Tcl_DeleteChannelHandler (Tcl_Channel chan, Tcl_ChannelProc * proc, ClientData clientData)

Definition at line 7298 of file tclIO.c.
References ChannelHandler::chanPtr, ckfree, ChannelHandler::clientData, dataKey, NextChannelHandler::nestedHandlerPtr, ThreadSpecificData::nestedHandlerPtr, NextChannelHandler::nextHandlerPtr, ChannelHandler::nextPtr, NULL, ChannelHandler::proc, Channel::state, TCL_TSD_INIT, and UpdateInterest().
Referenced by CleanupChannelHandlers(), CopyData(), DeleteChannelTable(), DeleteScriptRecord(), StdinProc(), StopCopy(), Tcl_Main(), and TestChannelEventCmd().7305 {
7306     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
7307     ChannelHandler *chPtr, *prevChPtr;
7308     Channel *chanPtr = (Channel *) chan;
7309     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
7310     NextChannelHandler *nhPtr;
7311 
7312     /*
7313      * Find the entry and the previous one in the list.
7314      */
7315 
7316     for (prevChPtr = (ChannelHandler *) NULL, chPtr = statePtr->chPtr;
7317    chPtr != (ChannelHandler *) NULL;
7318    chPtr = chPtr->nextPtr) {
7319         if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)
7320                 && (chPtr->proc == proc)) {
7321             break;
7322         }
7323         prevChPtr = chPtr;
7324     }
7325 
7326     /*
7327      * If not found, return without doing anything.
7328      */
7329 
7330     if (chPtr == (ChannelHandler *) NULL) {
7331         return;
7332     }
7333 
7334     /*
7335      * If ChannelHandlerEventProc is about to process this handler, tell it to
7336      * process the next one instead - we are going to delete *this* one.
7337      */
7338 
7339     for (nhPtr = tsdPtr->nestedHandlerPtr;
7340    nhPtr != (NextChannelHandler *) NULL;
7341    nhPtr = nhPtr->nestedHandlerPtr) {
7342         if (nhPtr->nextHandlerPtr == chPtr) {
7343             nhPtr->nextHandlerPtr = chPtr->nextPtr;
7344         }
7345     }
7346 
7347     /*
7348      * Splice it out of the list of channel handlers.
7349      */
7350     
7351     if (prevChPtr == (ChannelHandler *) NULL) {
7352         statePtr->chPtr = chPtr->nextPtr;
7353     } else {
7354         prevChPtr->nextPtr = chPtr->nextPtr;
7355     }
7356     ckfree((char *) chPtr);
7357 
7358     /*
7359      * Recompute the interest list for the channel, so that infinite loops
7360      * will not result if Tcl_DeleteChannelHandler is called inside an
7361      * event.
7362      */
7363 
7364     statePtr->interestMask = 0;
7365     for (chPtr = statePtr->chPtr;
7366    chPtr != (ChannelHandler *) NULL;
7367    chPtr = chPtr->nextPtr) {
7368         statePtr->interestMask |= chPtr->mask;
7369     }
7370 
7371     UpdateInterest(statePtr->topChanPtr);
7372 }
void Tcl_DeleteCloseHandler (Tcl_Channel chan, Tcl_CloseProc * proc, ClientData clientData)

Definition at line 481 of file tclIO.c.
References ckfree, CloseCallback::clientData, CloseCallback::nextPtr, NULL, and CloseCallback::proc.488 {
489     ChannelState *statePtr;
490     CloseCallback *cbPtr, *cbPrevPtr;
491 
492     statePtr = ((Channel *) chan)->state;
493     for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
494    cbPtr != (CloseCallback *) NULL;
495    cbPtr = cbPtr->nextPtr) {
496         if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
497             if (cbPrevPtr == (CloseCallback *) NULL) {
498                 statePtr->closeCbPtr = cbPtr->nextPtr;
499             }
500             ckfree((char *) cbPtr);
501             break;
502         } else {
503             cbPrevPtr = cbPtr;
504         }
505     }
506 }
int Tcl_DetachChannel (Tcl_Interp * interp, Tcl_Channel chan)

Definition at line 935 of file tclIO.c.
References DetachChannel(), TCL_ERROR, and Tcl_IsStandardChannel().938 {
939     if (Tcl_IsStandardChannel(chan)) {
940         return TCL_ERROR;
941     }
942     
943     return DetachChannel(interp, chan);
944 }
int Tcl_Eof (Tcl_Channel chan)

Definition at line 5951 of file tclIO.c.
References CHANNEL_EOF, CHANNEL_STICKY_EOF, and Tcl_InputBuffered().
Referenced by CopyData(), Tcl_EofObjCmd(), Tcl_GetsObjCmd(), and TransformInputProc().5953 {
5954     ChannelState *statePtr = ((Channel *) chan)->state;
5955           /* State of real channel structure. */
5956 
5957     return ((statePtr->flags & CHANNEL_STICKY_EOF) ||
5958             ((statePtr->flags & CHANNEL_EOF) &&
5959         (Tcl_InputBuffered(chan) == 0))) ? 1 : 0;
5960 }
int Tcl_FileEventObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv)

Definition at line 7561 of file tclIO.c.
References CONST, CreateScriptRecord(), DeleteScriptRecord(), EventScriptRecord::interp, EventScriptRecord::mask, EventScriptRecord::nextPtr, NULL, EventScriptRecord::scriptPtr, Channel::state, TCL_ERROR, Tcl_GetChannel(), Tcl_GetIndexFromObj(), Tcl_GetString(), TCL_OK, TCL_READABLE, Tcl_SetObjResult(), TCL_WRITABLE, and Tcl_WrongNumArgs().7568 {
7569     Channel *chanPtr;     /* The channel to create
7570                                          * the handler for. */
7571     ChannelState *statePtr;   /* state info for channel */
7572     Tcl_Channel chan;     /* The opaque type for the channel. */
7573     char *chanName;
7574     int modeIndex;      /* Index of mode argument. */
7575     int mask;
7576     static CONST char *modeOptions[] = {"readable", "writable", NULL};
7577     static int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
7578 
7579     if ((objc != 3) && (objc != 4)) {
7580   Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
7581   return TCL_ERROR;
7582     }
7583     if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0,
7584       &modeIndex) != TCL_OK) {
7585   return TCL_ERROR;
7586     }
7587     mask = maskArray[modeIndex];
7588 
7589     chanName = Tcl_GetString(objv[1]);
7590     chan = Tcl_GetChannel(interp, chanName, NULL);
7591     if (chan == (Tcl_Channel) NULL) {
7592   return TCL_ERROR;
7593     }
7594     chanPtr  = (Channel *) chan;
7595     statePtr = chanPtr->state;
7596     if ((statePtr->flags & mask) == 0) {
7597         Tcl_AppendResult(interp, "channel is not ",
7598                 (mask == TCL_READABLE) ? "readable" : "writable",
7599                 (char *) NULL);
7600         return TCL_ERROR;
7601     }
7602     
7603     /*
7604      * If we are supposed to return the script, do so.
7605      */
7606 
7607     if (objc == 3) {
7608   EventScriptRecord *esPtr;
7609   for (esPtr = statePtr->scriptRecordPtr;
7610              esPtr != (EventScriptRecord *) NULL;
7611              esPtr = esPtr->nextPtr) {
7612       if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
7613     Tcl_SetObjResult(interp, esPtr->scriptPtr);
7614     break;
7615       }
7616   }
7617         return TCL_OK;
7618     }
7619 
7620     /*
7621      * If we are supposed to delete a stored script, do so.
7622      */
7623 
7624     if (*(Tcl_GetString(objv[3])) == '\0') {
7625         DeleteScriptRecord(interp, chanPtr, mask);
7626         return TCL_OK;
7627     }
7628 
7629     /*
7630      * Make the script record that will link between the event and the
7631      * script to invoke. This also creates a channel event handler which
7632      * will evaluate the script in the supplied interpreter.
7633      */
7634 
7635     CreateScriptRecord(interp, chanPtr, mask, objv[3]);
7636     
7637     return TCL_OK;
7638 }
int Tcl_Flush (Tcl_Channel chan)

Definition at line 5261 of file tclIO.c.
References BUFFER_READY, CheckChannelErrors(), FlushChannel(), NULL, Channel::state, TCL_ERROR, TCL_OK, and TCL_WRITABLE.
Referenced by HandleBgErrors(), Prompt(), TCL_DECLARE_MUTEX(), Tcl_FlushObjCmd(), Tcl_StackChannel(), Tcl_UnstackChannel(), and TclFinalizeIOSubsystem().5263 {
5264     int result;       /* Of calling FlushChannel. */
5265     Channel *chanPtr  = (Channel *) chan; /* The actual channel. */
5266     ChannelState *statePtr = chanPtr->state;  /* State of actual channel. */
5267 
5268     /*
5269      * This operation should occur at the top of a channel stack.
5270      */
5271 
5272     chanPtr = statePtr->topChanPtr;
5273 
5274     if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
5275   return -1;
5276     }
5277 
5278     /*
5279      * Force current output buffer to be output also.
5280      */
5281 
5282     if ((statePtr->curOutPtr != NULL)
5283       && (statePtr->curOutPtr->nextAdded > 0)) {
5284         statePtr->flags |= BUFFER_READY;
5285     }
5286     
5287     result = FlushChannel(NULL, chanPtr, 0);
5288     if (result != 0) {
5289         return TCL_ERROR;
5290     }
5291 
5292     return TCL_OK;
5293 }
Tcl_Channel Tcl_GetChannel (Tcl_Interp * interp, CONST char * chanName, int * modePtr)

Definition at line 1041 of file tclIO.c.
References ChannelState::bottomChanPtr, ChannelState::channelName, CONST, ChannelState::flags, GetChannelTable(), NULL, Channel::state, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_GetStdChannel(), TCL_READABLE, TCL_STDERR, TCL_STDIN, TCL_STDOUT, and TCL_WRITABLE.
Referenced by Tcl_CloseObjCmd(), TCL_DECLARE_MUTEX(), Tcl_EchoCmd(), Tcl_EofObjCmd(), Tcl_FblockedObjCmd(), Tcl_FconfigureObjCmd(), Tcl_FcopyObjCmd(), Tcl_FileEventObjCmd(), Tcl_FlushObjCmd(), Tcl_GetOpenFile(), Tcl_GetsObjCmd(), Tcl_InterpObjCmd(), Tcl_PidObjCmd(), Tcl_PutsObjCmd(), Tcl_ReadObjCmd(), Tcl_SeekObjCmd(), Tcl_TellObjCmd(), Tcltest_Init(), TestChannelCmd(), TestChannelEventCmd(), TestfeventCmd(), and TestfilewaitCmd().1049 {
1050     Channel *chanPtr;   /* The actual channel. */
1051     Tcl_HashTable *hTblPtr; /* Hash table of channels. */
1052     Tcl_HashEntry *hPtr;  /* Search variable. */
1053     CONST char *name;   /* Translated name. */
1054 
1055     /*
1056      * Substitute "stdin", etc.  Note that even though we immediately
1057      * find the channel using Tcl_GetStdChannel, we still need to look
1058      * it up in the specified interpreter to ensure that it is present
1059      * in the channel table.  Otherwise, safe interpreters would always
1060      * have access to the standard channels.
1061      */
1062 
1063     name = chanName;
1064     if ((chanName[0] == 's') && (chanName[1] == 't')) {
1065   chanPtr = NULL;
1066   if (strcmp(chanName, "stdin") == 0) {
1067       chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDIN);
1068   } else if (strcmp(chanName, "stdout") == 0) {
1069       chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDOUT);
1070   } else if (strcmp(chanName, "stderr") == 0) {
1071       chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDERR);
1072   }
1073   if (chanPtr != NULL) {
1074       name = chanPtr->state->channelName;
1075   }
1076     }
1077 
1078     hTblPtr = GetChannelTable(interp);
1079     hPtr = Tcl_FindHashEntry(hTblPtr, name);
1080     if (hPtr == (Tcl_HashEntry *) NULL) {
1081         Tcl_AppendResult(interp, "can not find channel named \"",
1082                 chanName, "\"", (char *) NULL);
1083         return NULL;
1084     }
1085 
1086     /*
1087      * Always return bottom-most channel in the stack.  This one lives
1088      * the longest - other channels may go away unnoticed.
1089      * The other APIs compensate where necessary to retrieve the
1090      * topmost channel again.
1091      */
1092     chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
1093     chanPtr = chanPtr->state->bottomChanPtr;
1094     if (modePtr != NULL) {
1095         *modePtr = (chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE));
1096     }
1097     
1098     return (Tcl_Channel) chanPtr;
1099 }
int Tcl_GetChannelBufferSize (Tcl_Channel chan)

Definition at line 6179 of file tclIO.c.6182 {
6183     ChannelState *statePtr = ((Channel *) chan)->state;
6184           /* State of real channel structure. */
6185 
6186     return statePtr->bufSize;
6187 }
int Tcl_GetChannelHandle (Tcl_Channel chan, int direction, ClientData * handlePtr)

Definition at line 1797 of file tclIO.c.
References ChannelState::bottomChanPtr, Tcl_ChannelType::getHandleProc, Channel::instanceData, Channel::state, and Channel::typePtr.
Referenced by Tcl_ExecObjCmd(), Tcl_GetOpenFile(), TclpMakeFile(), TestfilewaitCmd(), and TransformGetFileHandleProc().1801 {
1802     Channel *chanPtr;   /* The actual channel. */
1803     ClientData handle;
1804     int result;
1805 
1806     chanPtr = ((Channel *) chan)->state->bottomChanPtr;
1807     result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
1808       direction, &handle);
1809     if (handlePtr) {
1810   *handlePtr = handle;
1811     }
1812     return result;
1813 }
ClientData Tcl_GetChannelInstanceData (Tcl_Channel chan)

Definition at line 1664 of file tclIO.c.
References Channel::instanceData.
Referenced by Tcl_CutChannel(), Tcl_PidObjCmd(), Tcl_SpliceChannel(), TclGetAndDetachPids(), TransformGetOptionProc(), TransformSeekProc(), TransformSetOptionProc(), TransformWatchProc(), and TransformWideSeekProc().1666 {
1667     Channel *chanPtr = (Channel *) chan;  /* The actual channel. */
1668 
1669     return chanPtr->instanceData;
1670 }
int Tcl_GetChannelMode (Tcl_Channel chan)

Definition at line 1741 of file tclIO.c.
References TCL_READABLE, and TCL_WRITABLE.1744 {
1745     ChannelState *statePtr = ((Channel *) chan)->state;
1746           /* State of actual channel. */
1747 
1748     return (statePtr->flags & (TCL_READABLE | TCL_WRITABLE));
1749 }
CONST char* Tcl_GetChannelName (Tcl_Channel chan)

Definition at line 1770 of file tclIO.c.
Referenced by AcceptCallbackProc(), CopyData(), TCL_DECLARE_MUTEX(), Tcl_EchoCmd(), Tcl_OpenObjCmd(), Tcl_SocketObjCmd(), Tcl_StackChannel(), Tcl_UnstackChannel(), TclChannelTransform(), and TclCopyChannel().1772 {
1773     ChannelState *statePtr; /* State of actual channel. */
1774 
1775     statePtr = ((Channel *) chan)->state;
1776     return statePtr->channelName;
1777 }
int Tcl_GetChannelNames (Tcl_Interp * interp)

Definition at line 8794 of file tclIO.c.
References NULL, and Tcl_GetChannelNamesEx().8796 {
8797     return Tcl_GetChannelNamesEx(interp, (char *) NULL);
8798 }
int Tcl_GetChannelNamesEx (Tcl_Interp * interp, CONST char * pattern)

Definition at line 8819 of file tclIO.c.
References CONST, dataKey, GetChannelTable(), NULL, ThreadSpecificData::stderrChannel, ThreadSpecificData::stdinChannel, ThreadSpecificData::stdoutChannel, TCL_ERROR, Tcl_FirstHashEntry(), Tcl_GetHashValue, Tcl_GetObjResult(), Tcl_ListObjAppendElement(), Tcl_NewStringObj(), Tcl_NextHashEntry(), TCL_OK, Tcl_StringMatch(), and TCL_TSD_INIT.
Referenced by Tcl_FileObjCmd(), and Tcl_GetChannelNames().8822 {
8823     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
8824     ChannelState *statePtr;
8825     CONST char *name;   /* name for channel */
8826     Tcl_Obj *resultPtr;   /* pointer to result object */
8827     Tcl_HashTable *hTblPtr; /* Hash table of channels. */
8828     Tcl_HashEntry *hPtr;  /* Search variable. */
8829     Tcl_HashSearch hSearch; /* Search variable. */
8830 
8831     if (interp == (Tcl_Interp *) NULL) {
8832   return TCL_OK;
8833     }
8834 
8835     /*
8836      * Get the channel table that stores the channels registered
8837      * for this interpreter.
8838      */
8839     hTblPtr = GetChannelTable(interp);
8840     resultPtr = Tcl_GetObjResult(interp);
8841 
8842     for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
8843    hPtr != (Tcl_HashEntry *) NULL;
8844    hPtr = Tcl_NextHashEntry(&hSearch)) {
8845 
8846   statePtr = ((Channel *) Tcl_GetHashValue(hPtr))->state;
8847         if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {
8848       name = "stdin";
8849   } else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) {
8850       name = "stdout";
8851   } else if (statePtr->topChanPtr == (Channel *) tsdPtr->stderrChannel) {
8852       name = "stderr";
8853   } else {
8854       /*
8855        * This is also stored in Tcl_GetHashKey(hTblPtr, hPtr),
8856        * but it's simpler to just grab the name from the statePtr.
8857        */
8858       name = statePtr->channelName;
8859   }
8860 
8861   if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) &&
8862     (Tcl_ListObjAppendElement(interp, resultPtr,
8863       Tcl_NewStringObj(name, -1)) != TCL_OK)) {
8864       return TCL_ERROR;
8865   }
8866     }
8867     return TCL_OK;
8868 }
int Tcl_GetChannelOption (Tcl_Interp * interp, Tcl_Channel chan, CONST char * optionName, Tcl_DString * dsPtr)

Definition at line 6280 of file tclIO.c.
References CHANNEL_LINEBUFFERED, CHANNEL_NONBLOCKING, CHANNEL_UNBUFFERED, CheckForDeadChannel(), Tcl_ChannelType::getOptionProc, Channel::instanceData, NULL, size_t(), Channel::state, Tcl_BadChannelOption(), Tcl_DStringAppendElement(), Tcl_DStringEndSublist(), Tcl_DStringStartSublist(), TCL_ERROR, Tcl_GetEncodingName(), TCL_OK, TCL_READABLE, TCL_TRANSLATE_AUTO, TCL_TRANSLATE_CR, TCL_TRANSLATE_CRLF, TCL_WRITABLE, TclFormatInt(), and Channel::typePtr.
Referenced by Tcl_FconfigureObjCmd(), and TclChannelTransform().6285 {
6286     size_t len;     /* Length of optionName string. */
6287     char optionVal[128];  /* Buffer for sprintf. */
6288     Channel *chanPtr = (Channel *) chan;
6289     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
6290     int flags;
6291 
6292     /*
6293      * Disallow options on dead channels -- channels that have been closed but
6294      * not yet been deallocated. Such channels can be found if the exit
6295      * handler for channel cleanup has run but the channel is still
6296      * registered in an interpreter.
6297      */
6298 
6299     if (CheckForDeadChannel(interp, statePtr)) {
6300   return TCL_ERROR;
6301     }
6302 
6303     /*
6304      * This operation should occur at the top of a channel stack.
6305      */
6306 
6307     chanPtr = statePtr->topChanPtr;
6308 
6309     /*
6310      * If we are in the middle of a background copy, use the saved flags.
6311      */
6312 
6313     if (statePtr->csPtr) {
6314   if (chanPtr == statePtr->csPtr->readPtr) {
6315       flags = statePtr->csPtr->readFlags;
6316   } else {
6317       flags = statePtr->csPtr->writeFlags;
6318   }
6319     } else {
6320   flags = statePtr->flags;
6321     }
6322 
6323     /*
6324      * If the optionName is NULL it means that we want a list of all
6325      * options and values.
6326      */
6327     
6328     if (optionName == (char *) NULL) {
6329         len = 0;
6330     } else {
6331         len = strlen(optionName);
6332     }
6333     
6334     if ((len == 0) || ((len > 2) && (optionName[1] == 'b') &&
6335             (strncmp(optionName, "-blocking", len) == 0))) {
6336         if (len == 0) {
6337             Tcl_DStringAppendElement(dsPtr, "-blocking");
6338         }
6339         Tcl_DStringAppendElement(dsPtr,
6340     (flags & CHANNEL_NONBLOCKING) ? "0" : "1");
6341         if (len > 0) {
6342             return TCL_OK;
6343         }
6344     }
6345     if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
6346             (strncmp(optionName, "-buffering", len) == 0))) {
6347         if (len == 0) {
6348             Tcl_DStringAppendElement(dsPtr, "-buffering");
6349         }
6350         if (flags & CHANNEL_LINEBUFFERED) {
6351             Tcl_DStringAppendElement(dsPtr, "line");
6352         } else if (flags & CHANNEL_UNBUFFERED) {
6353             Tcl_DStringAppendElement(dsPtr, "none");
6354         } else {
6355             Tcl_DStringAppendElement(dsPtr, "full");
6356         }
6357         if (len > 0) {
6358             return TCL_OK;
6359         }
6360     }
6361     if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
6362             (strncmp(optionName, "-buffersize", len) == 0))) {
6363         if (len == 0) {
6364             Tcl_DStringAppendElement(dsPtr, "-buffersize");
6365         }
6366         TclFormatInt(optionVal, statePtr->bufSize);
6367         Tcl_DStringAppendElement(dsPtr, optionVal);
6368         if (len > 0) {
6369             return TCL_OK;
6370         }
6371     }
6372     if ((len == 0) ||
6373       ((len > 2) && (optionName[1] == 'e') &&
6374         (strncmp(optionName, "-encoding", len) == 0))) {
6375   if (len == 0) {
6376       Tcl_DStringAppendElement(dsPtr, "-encoding");
6377   }
6378   if (statePtr->encoding == NULL) {
6379       Tcl_DStringAppendElement(dsPtr, "binary");
6380   } else {
6381       Tcl_DStringAppendElement(dsPtr,
6382         Tcl_GetEncodingName(statePtr->encoding));
6383   }
6384   if (len > 0) {
6385       return TCL_OK;
6386   }
6387     }
6388     if ((len == 0) ||
6389             ((len > 2) && (optionName[1] == 'e') &&
6390                     (strncmp(optionName, "-eofchar", len) == 0))) {
6391         if (len == 0) {
6392             Tcl_DStringAppendElement(dsPtr, "-eofchar");
6393         }
6394         if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
6395                 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
6396             Tcl_DStringStartSublist(dsPtr);
6397         }
6398         if (flags & TCL_READABLE) {
6399             if (statePtr->inEofChar == 0) {
6400                 Tcl_DStringAppendElement(dsPtr, "");
6401             } else {
6402                 char buf[4];
6403 
6404                 sprintf(buf, "%c", statePtr->inEofChar);
6405                 Tcl_DStringAppendElement(dsPtr, buf);
6406             }
6407         }
6408         if (flags & TCL_WRITABLE) {
6409             if (statePtr->outEofChar == 0) {
6410                 Tcl_DStringAppendElement(dsPtr, "");
6411             } else {
6412                 char buf[4];
6413 
6414                 sprintf(buf, "%c", statePtr->outEofChar);
6415                 Tcl_DStringAppendElement(dsPtr, buf);
6416             }
6417         }
6418         if ( !(flags & (TCL_READABLE|TCL_WRITABLE))) {
6419             /* Not readable or writable (server socket) */
6420             Tcl_DStringAppendElement(dsPtr, "");
6421         }
6422         if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
6423                 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
6424             Tcl_DStringEndSublist(dsPtr);
6425         }
6426         if (len > 0) {
6427             return TCL_OK;
6428         }
6429     }
6430     if ((len == 0) ||
6431             ((len > 1) && (optionName[1] == 't') &&
6432                     (strncmp(optionName, "-translation", len) == 0))) {
6433         if (len == 0) {
6434             Tcl_DStringAppendElement(dsPtr, "-translation");
6435         }
6436         if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
6437                 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
6438             Tcl_DStringStartSublist(dsPtr);
6439         }
6440         if (flags & TCL_READABLE) {
6441             if (statePtr->inputTranslation == TCL_TRANSLATE_AUTO) {
6442                 Tcl_DStringAppendElement(dsPtr, "auto");
6443             } else if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
6444                 Tcl_DStringAppendElement(dsPtr, "cr");
6445             } else if (statePtr->inputTranslation == TCL_TRANSLATE_CRLF) {
6446                 Tcl_DStringAppendElement(dsPtr, "crlf");
6447             } else {
6448                 Tcl_DStringAppendElement(dsPtr, "lf");
6449             }
6450         }
6451         if (flags & TCL_WRITABLE) {
6452             if (statePtr->outputTranslation == TCL_TRANSLATE_AUTO) {
6453                 Tcl_DStringAppendElement(dsPtr, "auto");
6454             } else if (statePtr->outputTranslation == TCL_TRANSLATE_CR) {
6455                 Tcl_DStringAppendElement(dsPtr, "cr");
6456             } else if (statePtr->outputTranslation == TCL_TRANSLATE_CRLF) {
6457                 Tcl_DStringAppendElement(dsPtr, "crlf");
6458             } else {
6459                 Tcl_DStringAppendElement(dsPtr, "lf");
6460             }
6461         }
6462         if ( !(flags & (TCL_READABLE|TCL_WRITABLE))) {
6463             /* Not readable or writable (server socket) */
6464             Tcl_DStringAppendElement(dsPtr, "auto");
6465         }
6466         if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
6467                 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
6468             Tcl_DStringEndSublist(dsPtr);
6469         }
6470         if (len > 0) {
6471             return TCL_OK;
6472         }
6473     }
6474     if (chanPtr->typePtr->getOptionProc != (Tcl_DriverGetOptionProc *) NULL) {
6475   /*
6476    * let the driver specific handle additional options
6477    * and result code and message.
6478    */
6479 
6480         return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,
6481     interp, optionName, dsPtr);
6482     } else {
6483   /*
6484    * no driver specific options case.
6485    */
6486 
6487         if (len == 0) {
6488             return TCL_OK;
6489         }
6490   return Tcl_BadChannelOption(interp, optionName, NULL);
6491     }
6492 }
Tcl_ThreadId Tcl_GetChannelThread (Tcl_Channel chan)

Definition at line 1690 of file tclIO.c.
References ChannelState::managingThread, and Channel::state.
Referenced by ConsoleThreadActionProc(), PipeThreadActionProc(), SerialThreadActionProc(), and TestChannelCmd().1692 {
1693     Channel *chanPtr = (Channel *) chan;  /* The actual channel. */
1694 
1695     return chanPtr->state->managingThread;
1696 }
Tcl_ChannelType* Tcl_GetChannelType (Tcl_Channel chan)

Definition at line 1715 of file tclIO.c.
References Channel::typePtr.
Referenced by Tcl_CutChannel(), Tcl_GetOpenFile(), Tcl_PidObjCmd(), Tcl_SpliceChannel(), TclGetAndDetachPids(), TclpGetDefaultStdChannel(), TransformGetOptionProc(), TransformSeekProc(), TransformSetOptionProc(), TransformWatchProc(), and TransformWideSeekProc().1717 {
1718     Channel *chanPtr = (Channel *) chan;  /* The actual channel. */
1719 
1720     return chanPtr->typePtr;
1721 }
int Tcl_Gets (Tcl_Channel chan, Tcl_DString * lineRead)

Definition at line 3511 of file tclIO.c.
References Tcl_DecrRefCount, Tcl_DStringAppend(), Tcl_GetsObj(), Tcl_GetStringFromObj(), and Tcl_NewObj().
Referenced by FileRCVariables(), LoadEncodingFile(), LoadEscapeEncoding(), and LoadTableEncoding().3517 {
3518     Tcl_Obj *objPtr;
3519     int charsStored, length;
3520     char *string;
3521 
3522     objPtr = Tcl_NewObj();
3523     charsStored = Tcl_GetsObj(chan, objPtr);
3524     if (charsStored > 0) {
3525   string = Tcl_GetStringFromObj(objPtr, &length);
3526   Tcl_DStringAppend(lineRead, string, length);
3527     }
3528     Tcl_DecrRefCount(objPtr);
3529     return charsStored;
3530 }
int Tcl_GetsObj (Tcl_Channel chan, Tcl_Obj * objPtr)

Definition at line 3558 of file tclIO.c.
References ChannelBuffer::buf, BUFFER_PADDING, GetsState::bufPtr, Tcl_Obj::bytes, GetsState::bytesWrote, GetsState::charsWrote, CheckChannelErrors(), GetsState::dstPtr, GetsState::encoding, FilterInputBytes(), INPUT_SAW_CR, ChannelBuffer::nextRemoved, NULL, GetsState::objPtr, PeekAhead(), GetsState::rawRead, size_t(), skip(), GetsState::state, Channel::state, Tcl_ExternalToUtf(), Tcl_GetEncoding(), Tcl_GetStringFromObj(), TCL_READABLE, TCL_TRANSLATE_AUTO, TCL_TRANSLATE_CR, TCL_TRANSLATE_CRLF, TCL_TRANSLATE_LF, TCL_UTF_MAX, and GetsState::totalChars.
Referenced by StdinProc(), Tcl_Gets(), Tcl_GetsObjCmd(), and Tcl_Main().3562 {
3563     GetsState gs;
3564     Channel *chanPtr = (Channel *) chan;
3565     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
3566     ChannelBuffer *bufPtr;
3567     int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved;
3568     Tcl_Encoding encoding;
3569     char *dst, *dstEnd, *eol, *eof;
3570     Tcl_EncodingState oldState;
3571 
3572     /*
3573      * This operation should occur at the top of a channel stack.
3574      */
3575 
3576     chanPtr = statePtr->topChanPtr;
3577 
3578     if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
3579   copiedTotal = -1;
3580   goto done;
3581     }
3582 
3583     bufPtr = statePtr->inQueueHead;
3584     encoding = statePtr->encoding;
3585 
3586     /*
3587      * Preserved so we can restore the channel's state in case we don't
3588      * find a newline in the available input.
3589      */
3590 
3591     Tcl_GetStringFromObj(objPtr, &oldLength);
3592     oldFlags = statePtr->inputEncodingFlags;
3593     oldState = statePtr->inputEncodingState;
3594     oldRemoved = BUFFER_PADDING;
3595     if (bufPtr != NULL) {
3596   oldRemoved = bufPtr->nextRemoved;
3597     }
3598 
3599     /*
3600      * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't
3601      * produce ByteArray objects.  To avoid circularity problems,
3602      * "iso8859-1" is builtin to Tcl.
3603      */
3604 
3605     if (encoding == NULL) {
3606   encoding = Tcl_GetEncoding(NULL, "iso8859-1");
3607     }
3608 
3609     /*
3610      * Object used by FilterInputBytes to keep track of how much data has
3611      * been consumed from the channel buffers.
3612      */
3613 
3614     gs.objPtr   = objPtr;
3615     gs.dstPtr   = &dst;
3616     gs.encoding   = encoding;
3617     gs.bufPtr   = bufPtr;
3618     gs.state    = oldState;
3619     gs.rawRead    = 0;
3620     gs.bytesWrote = 0;
3621     gs.charsWrote = 0;
3622     gs.totalChars = 0;
3623 
3624     dst = objPtr->bytes + oldLength;
3625     dstEnd = dst;
3626 
3627     skip = 0;
3628     eof = NULL;
3629     inEofChar = statePtr->inEofChar;
3630 
3631     while (1) {
3632   if (dst >= dstEnd) {
3633       if (FilterInputBytes(chanPtr, &gs) != 0) {
3634     goto restore;
3635       }
3636       dstEnd = dst + gs.bytesWrote;
3637   }
3638   
3639   /*
3640    * Remember if EOF char is seen, then look for EOL anyhow, because
3641    * the EOL might be before the EOF char.
3642    */
3643 
3644   if (inEofChar != '\0') {
3645       for (eol = dst; eol < dstEnd; eol++) {
3646     if (*eol == inEofChar) {
3647         dstEnd = eol;
3648         eof = eol;
3649         break;
3650     }
3651       }
3652   }
3653 
3654   /*
3655    * On EOL, leave current file position pointing after the EOL, but
3656    * don't store the EOL in the output string.
3657    */
3658 
3659   switch (statePtr->inputTranslation) {
3660       case TCL_TRANSLATE_LF: {
3661     for (eol = dst; eol < dstEnd; eol++) {
3662         if (*eol == '\n') {
3663       skip = 1;
3664       goto goteol;
3665         }
3666     }
3667     break;
3668       }
3669       case TCL_TRANSLATE_CR: {
3670     for (eol = dst; eol < dstEnd; eol++) {
3671         if (*eol == '\r') {
3672       skip = 1;
3673       goto goteol;
3674         }
3675     }
3676     break;
3677       }
3678       case TCL_TRANSLATE_CRLF: {
3679     for (eol = dst; eol < dstEnd; eol++) {
3680         if (*eol == '\r') {
3681       eol++;
3682       if (eol >= dstEnd) {
3683           int offset;
3684           
3685           offset = eol - objPtr->bytes;
3686           dst = dstEnd;
3687           if (FilterInputBytes(chanPtr, &gs) != 0) {
3688         goto restore;
3689           }
3690           dstEnd = dst + gs.bytesWrote;
3691           eol = objPtr->bytes + offset;
3692           if (eol >= dstEnd) {
3693         skip = 0;
3694         goto goteol;
3695           }
3696       }
3697       if (*eol == '\n') {
3698           eol--;
3699           skip = 2;
3700           goto goteol;
3701       }
3702         }
3703     }
3704     break;
3705       }
3706       case TCL_TRANSLATE_AUTO: {
3707     eol = dst;
3708     skip = 1;
3709     if (statePtr->flags & INPUT_SAW_CR) {
3710         statePtr->flags &= ~INPUT_SAW_CR;
3711         if (*eol == '\n') {
3712       /*
3713        * Skip the raw bytes that make up the '\n'.
3714        */
3715 
3716       char tmp[1 + TCL_UTF_MAX];
3717       int rawRead;
3718 
3719       bufPtr = gs.bufPtr;
3720       Tcl_ExternalToUtf(NULL, gs.encoding,
3721         bufPtr->buf + bufPtr->nextRemoved,
3722         gs.rawRead, statePtr->inputEncodingFlags,
3723         &gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead,
3724         NULL, NULL);
3725       bufPtr->nextRemoved += rawRead;
3726       gs.rawRead -= rawRead;
3727       gs.bytesWrote--;
3728       gs.charsWrote--;
3729       memmove(dst, dst + 1, (size_t) (dstEnd - dst));
3730       dstEnd--;
3731         }
3732     }
3733     for (eol = dst; eol < dstEnd; eol++) {
3734         if (*eol == '\r') {
3735       eol++;
3736       if (eol == dstEnd) {
3737           /*
3738            * If buffer ended on \r, peek ahead to see if a
3739            * \n is available.
3740            */
3741 
3742           int offset;
3743           
3744           offset = eol - objPtr->bytes;
3745           dst = dstEnd;
3746           PeekAhead(chanPtr, &dstEnd, &gs);
3747           eol = objPtr->bytes + offset;
3748           if (eol >= dstEnd) {
3749         eol--;
3750         statePtr->flags |= INPUT_SAW_CR;
3751         goto goteol;
3752           }
3753       }
3754       if (*eol == '\n') {
3755           skip++;
3756       }
3757       eol--;
3758       goto goteol;
3759         } else if (*eol == '\n') {
3760       goto goteol;
3761         }
3762     }
3763       }
3764   }
3765   if (eof != NULL) {
3766       /*
3767        * EOF character was seen.  On EOF, leave current file position
3768        * pointing at the EOF character, but don't store the EOF
3769        * character in the output string.
3770        */
3771 
3772       dstEnd = eof;
3773       statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
3774       statePtr->inputEncodingFlags |= TCL_ENCODING_END;
3775   }
3776   if (statePtr->flags & CHANNEL_EOF) {
3777       skip = 0;
3778       eol = dstEnd;
3779       if (eol == objPtr->bytes + oldLength) {
3780     /*
3781      * If we didn't append any bytes before encountering EOF,
3782      * caller needs to see -1.
3783      */
3784 
3785     Tcl_SetObjLength(objPtr, oldLength);
3786     CommonGetsCleanup(chanPtr, encoding);
3787     copiedTotal = -1;
3788     goto done;
3789       }
3790       goto goteol;
3791   }
3792   dst = dstEnd;
3793     }
3794 
3795     /*
3796      * Found EOL or EOF, but the output buffer may now contain too many
3797      * UTF-8 characters.  We need to know how many raw bytes correspond to
3798      * the number of UTF-8 characters we want, plus how many raw bytes
3799      * correspond to the character(s) making up EOL (if any), so we can
3800      * remove the correct number of bytes from the channel buffer.
3801      */
3802      
3803     goteol:
3804     bufPtr = gs.bufPtr;
3805     statePtr->inputEncodingState = gs.state;
3806     Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved,
3807       gs.rawRead, statePtr->inputEncodingFlags,
3808       &statePtr->inputEncodingState, dst,
3809       eol - dst + skip + TCL_UTF_MAX, &gs.rawRead, NULL,
3810       &gs.charsWrote);
3811     bufPtr->nextRemoved += gs.rawRead;
3812 
3813     /*
3814      * Recycle all the emptied buffers.
3815      */
3816 
3817     Tcl_SetObjLength(objPtr, eol - objPtr->bytes);
3818     CommonGetsCleanup(chanPtr, encoding);
3819     statePtr->flags &= ~CHANNEL_BLOCKED;
3820     copiedTotal = gs.totalChars + gs.charsWrote - skip;
3821     goto done;
3822 
3823     /*
3824      * Couldn't get a complete line.  This only happens if we get a error
3825      * reading from the channel or we are non-blocking and there wasn't
3826      * an EOL or EOF in the data available.
3827      */
3828 
3829     restore:
3830     bufPtr = statePtr->inQueueHead;
3831     bufPtr->nextRemoved = oldRemoved;
3832 
3833     for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
3834   bufPtr->nextRemoved = BUFFER_PADDING;
3835     }
3836     CommonGetsCleanup(chanPtr, encoding);
3837 
3838     statePtr->inputEncodingState = oldState;
3839     statePtr->inputEncodingFlags = oldFlags;
3840     Tcl_SetObjLength(objPtr, oldLength);
3841 
3842     /*
3843      * We didn't get a complete line so we need to indicate to UpdateInterest
3844      * that the gets blocked.  It will wait for more data instead of firing
3845      * a timer, avoiding a busy wait.  This is where we are assuming that the
3846      * next operation is a gets.  No more file events will be delivered on 
3847      * this channel until new data arrives or some operation is performed
3848      * on the channel (e.g. gets, read, fconfigure) that changes the blocking
3849      * state.  Note that this means a file event will not be delivered even
3850      * though a read would be able to consume the buffered data.
3851      */
3852 
3853     statePtr->flags |= CHANNEL_NEED_MORE_DATA;
3854     copiedTotal = -1;
3855 
3856     done:
3857     /*
3858      * Update the notifier state so we don't block while there is still
3859      * data in the buffers.
3860      */
3861 
3862     UpdateInterest(chanPtr);
3863     return copiedTotal;
3864 }
Tcl_Channel Tcl_GetStackedChannel (Tcl_Channel chan)

Definition at line 1612 of file tclIO.c.
References Channel::downChanPtr.
Referenced by ExecuteCallback(), TransformGetFileHandleProc(), TransformGetOptionProc(), TransformInputProc(), TransformSeekProc(), TransformSetOptionProc(), TransformWatchProc(), and TransformWideSeekProc().1614 {
1615     Channel *chanPtr = (Channel *) chan;  /* The actual channel. */
1616 
1617     return (Tcl_Channel) chanPtr->downChanPtr;
1618 }
Tcl_Channel Tcl_GetStdChannel (int type)

Definition at line 361 of file tclIO.c.
References dataKey, NULL, ThreadSpecificData::stderrChannel, ThreadSpecificData::stderrInitialized, ThreadSpecificData::stdinChannel, ThreadSpecificData::stdinInitialized, ThreadSpecificData::stdoutChannel, ThreadSpecificData::stdoutInitialized, Tcl_RegisterChannel(), TCL_STDERR, TCL_STDIN, TCL_STDOUT, TCL_TSD_INIT, TclpGetDefaultStdChannel(), and void().
Referenced by GetChannelTable(), HandleBgErrors(), Prompt(), SetupStdFile(), StdinProc(), Tcl_GetChannel(), Tcl_Main(), Tcl_MakeSafe(), Tcl_SourceRCFile(), TclCreatePipeline(), and TclpCreateProcess().363 {
364     Tcl_Channel channel = NULL;
365     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
366 
367     /*
368      * If the channels were not created yet, create them now and
369      * store them in the static variables. 
370      */
371 
372     switch (type) {
373   case TCL_STDIN:
374       if (!tsdPtr->stdinInitialized) {
375     tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);
376     tsdPtr->stdinInitialized = 1;
377 
378     /*
379                  * Artificially bump the refcount to ensure that the channel
380                  * is only closed on exit.
381                  *
382                  * NOTE: Must only do this if stdinChannel is not NULL. It
383                  * can be NULL in situations where Tcl is unable to connect
384                  * to the standard input.
385                  */
386 
387                 if (tsdPtr->stdinChannel != (Tcl_Channel) NULL) {
388                     (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
389                             tsdPtr->stdinChannel);
390                 }
391       }
392       channel = tsdPtr->stdinChannel;
393       break;
394   case TCL_STDOUT:
395       if (!tsdPtr->stdoutInitialized) {
396     tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);
397     tsdPtr->stdoutInitialized = 1;
398                 if (tsdPtr->stdoutChannel != (Tcl_Channel) NULL) {
399                     (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
400                             tsdPtr->stdoutChannel);
401                 }
402       }
403       channel = tsdPtr->stdoutChannel;
404       break;
405   case TCL_STDERR:
406       if (!tsdPtr->stderrInitialized) {
407     tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
408     tsdPtr->stderrInitialized = 1;
409                 if (tsdPtr->stderrChannel != (Tcl_Channel) NULL) {
410                     (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
411                             tsdPtr->stderrChannel);
412                 }
413       }
414       channel = tsdPtr->stderrChannel;
415       break;
416     }
417     return channel;
418 }
Tcl_Channel Tcl_GetTopChannel (Tcl_Channel chan)

Definition at line 1639 of file tclIO.c.
References Channel::state, and ChannelState::topChanPtr.1641 {
1642     Channel *chanPtr = (Channel *) chan;  /* The actual channel. */
1643 
1644     return (Tcl_Channel) chanPtr->state->topChanPtr;
1645 }
int Tcl_InputBlocked (Tcl_Channel chan)

Definition at line 5979 of file tclIO.c.
References CHANNEL_BLOCKED.
Referenced by StdinProc(), Tcl_FblockedObjCmd(), Tcl_GetsObjCmd(), and Tcl_Main().5981 {
5982     ChannelState *statePtr = ((Channel *) chan)->state;
5983           /* State of real channel structure. */
5984 
5985     return (statePtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
5986 }
int Tcl_InputBuffered (Tcl_Channel chan)

Definition at line 6007 of file tclIO.c.
References ChannelBuffer::nextAdded, ChannelBuffer::nextPtr, ChannelBuffer::nextRemoved, and NULL.
Referenced by SerialGetOptionProc(), Tcl_Eof(), Tcl_Seek(), and Tcl_Tell().6009 {
6010     ChannelState *statePtr = ((Channel *) chan)->state;
6011           /* State of real channel structure. */
6012     ChannelBuffer *bufPtr;
6013     int bytesBuffered;
6014 
6015     for (bytesBuffered = 0, bufPtr = statePtr->inQueueHead;
6016    bufPtr != (ChannelBuffer *) NULL;
6017    bufPtr = bufPtr->nextPtr) {
6018         bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
6019     }
6020 
6021     /*
6022      * Don't forget the bytes in the topmost pushback area.
6023      */
6024 
6025     for (bufPtr = statePtr->topChanPtr->inQueueHead;
6026    bufPtr != (ChannelBuffer *) NULL;
6027    bufPtr = bufPtr->nextPtr) {
6028         bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
6029     }
6030 
6031     return bytesBuffered;
6032 }
int Tcl_IsChannelExisting (CONST char* chanName)

Definition at line 8964 of file tclIO.c.
References CONST, dataKey, ThreadSpecificData::firstCSPtr, memcmp(), NULL, size_t(), ThreadSpecificData::stderrChannel, ThreadSpecificData::stdinChannel, ThreadSpecificData::stdoutChannel, and TCL_TSD_INIT.8966 {
8967     ChannelState *statePtr;
8968     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
8969     CONST char *name;
8970     int chanNameLen;
8971 
8972     chanNameLen = strlen(chanName);
8973     for (statePtr = tsdPtr->firstCSPtr;
8974    statePtr != NULL;
8975    statePtr = statePtr->nextCSPtr) {
8976         if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {
8977       name = "stdin";
8978   } else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) {
8979       name = "stdout";
8980   } else if (statePtr->topChanPtr == (Channel *) tsdPtr->stderrChannel) {
8981       name = "stderr";
8982   } else {
8983       name = statePtr->channelName;
8984   }
8985 
8986   if ((*chanName == *name) &&
8987     (memcmp(name, chanName, (size_t) chanNameLen) == 0)) {
8988       return 1;
8989   }
8990     }
8991 
8992     return 0;
8993 }
int Tcl_IsChannelRegistered (Tcl_Interp* interp, Tcl_Channel chan)

Definition at line 8888 of file tclIO.c.
References ChannelState::bottomChanPtr, NULL, Channel::state, Tcl_FindHashEntry, Tcl_GetAssocData(), and Tcl_GetHashValue.8891 {
8892     Tcl_HashTable *hTblPtr; /* Hash table of channels. */
8893     Tcl_HashEntry *hPtr;    /* Search variable. */
8894     Channel   *chanPtr; /* The real IO channel. */
8895     ChannelState  *statePtr;  /* State of the real channel. */
8896 
8897     /*
8898      * Always check bottom-most channel in the stack.  This is the one
8899      * that gets registered.
8900      */
8901     chanPtr = ((Channel *) chan)->state->bottomChanPtr;
8902     statePtr = chanPtr->state;
8903 
8904     hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
8905     if (hTblPtr == (Tcl_HashTable *) NULL) {
8906         return 0;
8907     }
8908     hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
8909     if (hPtr == (Tcl_HashEntry *) NULL) {
8910         return 0;
8911     }
8912     if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
8913         return 0;
8914     }
8915 
8916     return 1;
8917 }
int Tcl_IsChannelShared (Tcl_Channel chan)

Definition at line 8936 of file tclIO.c.
Referenced by TestChannelCmd().8938 {
8939     ChannelState *statePtr = ((Channel *) chan)->state;
8940           /* State of real channel structure. */
8941 
8942     return ((statePtr->refCount > 1) ? 1 : 0);
8943 }
int Tcl_IsStandardChannel (Tcl_Channel chan)

Definition at line 733 of file tclIO.c.
References dataKey, ThreadSpecificData::stderrChannel, ThreadSpecificData::stdinChannel, ThreadSpecificData::stdoutChannel, and TCL_TSD_INIT.
Referenced by Tcl_DetachChannel(), and TestChannelCmd().735 {
736     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
737 
738     if ((chan == tsdPtr->stdinChannel) 
739   || (chan == tsdPtr->stdoutChannel)
740   || (chan == tsdPtr->stderrChannel)) {
741   return 1;
742     } else {
743   return 0;
744     }
745 }
void Tcl_NotifyChannel (Tcl_Channel channel, int mask)

Definition at line 6896 of file tclIO.c.
References BG_FLUSH_SCHEDULED, CHANNEL_NONBLOCKING, ChannelHandler::clientData, dataKey, FlushChannel(), Channel::instanceData, ChannelHandler::mask, ThreadSpecificData::nestedHandlerPtr, NextChannelHandler::nestedHandlerPtr, NextChannelHandler::nextHandlerPtr, ChannelHandler::nextPtr, NULL, ChannelHandler::proc, Channel::state, Tcl_ChannelBlockModeProc(), Tcl_ChannelHandlerProc(), Tcl_Preserve(), TCL_READABLE, Tcl_Release(), TCL_TSD_INIT, TCL_WRITABLE, Channel::typePtr, Channel::upChanPtr, and UpdateInterest().
Referenced by ChannelTimerProc(), ConsoleEventProc(), FileEventProc(), FileWatchProc(), PipeEventProc(), PipeWatchProc(), SerialEventProc(), SocketEventProc(), TcpWatchProc(), and TransformChannelHandlerTimer().6899                                          : indicates
6900          * which events were detected. */
6901 {
6902     Channel *chanPtr = (Channel *) channel;
6903     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
6904     ChannelHandler *chPtr;
6905     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
6906     NextChannelHandler nh;
6907     Channel* upChanPtr;
6908     Tcl_ChannelType* upTypePtr;
6909 
6910 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
6911     /* [SF Tcl Bug 943274]
6912      * For a non-blocking channel without blockmodeproc we keep track
6913      * of actual input coming from the OS so that we can do a credible
6914      * imitation of non-blocking behaviour.
6915      */
6916 
6917     if ((mask & TCL_READABLE) &&
6918   (statePtr->flags & CHANNEL_NONBLOCKING) &&
6919   (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
6920   !(statePtr->flags & CHANNEL_TIMER_FEV)) {
6921 
6922         statePtr->flags |= CHANNEL_HAS_MORE_DATA;
6923     }
6924 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
6925 
6926     /*
6927      * In contrast to the other API functions this procedure walks towards
6928      * the top of a stack and not down from it.
6929      *
6930      * The channel calling this procedure is the one who generated the event,
6931      * and thus does not take part in handling it. IOW, its HandlerProc is
6932      * not called, instead we begin with the channel above it.
6933      *
6934      * This behaviour also allows the transformation channels to
6935      * generate their own events and pass them upward.
6936      */
6937 
6938     while (mask && (chanPtr->upChanPtr != ((Channel*) NULL))) {
6939   Tcl_DriverHandlerProc* upHandlerProc;
6940 
6941         upChanPtr = chanPtr->upChanPtr;
6942   upTypePtr = upChanPtr->typePtr;
6943   upHandlerProc = Tcl_ChannelHandlerProc(upTypePtr);
6944   if (upHandlerProc != NULL) {
6945       mask = (*upHandlerProc) (upChanPtr->instanceData, mask);
6946   }
6947 
6948   /* ELSE:
6949    * Ignore transformations which are unable to handle the event
6950    * coming from below. Assume that they don't change the mask and
6951    * pass it on.
6952    */
6953 
6954   chanPtr = upChanPtr;
6955     }
6956 
6957     channel = (Tcl_Channel) chanPtr;
6958 
6959     /*
6960      * Here we have either reached the top of the stack or the mask is
6961      * empty.  We break out of the procedure if it is the latter.
6962      */
6963 
6964     if (!mask) {
6965         return;
6966     }
6967 
6968     /*
6969      * We are now above the topmost channel in a stack and have events
6970      * left. Now call the channel handlers as usual.
6971      *
6972      * Preserve the channel struct in case the script closes it.
6973      */
6974      
6975     Tcl_Preserve((ClientData) channel);
6976     Tcl_Preserve((ClientData) statePtr);
6977 
6978     /*
6979      * If we are flushing in the background, be sure to call FlushChannel
6980      * for writable events.  Note that we have to discard the writable
6981      * event so we don't call any write handlers before the flush is
6982      * complete.
6983      */
6984 
6985     if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
6986   FlushChannel(NULL, chanPtr, 1);
6987   mask &= ~TCL_WRITABLE;
6988     }
6989 
6990     /*
6991      * Add this invocation to the list of recursive invocations of
6992      * ChannelHandlerEventProc.
6993      */
6994     
6995     nh.nextHandlerPtr = (ChannelHandler *) NULL;
6996     nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;
6997     tsdPtr->nestedHandlerPtr = &nh;
6998 
6999     for (chPtr = statePtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
7000   /*
7001    * If this channel handler is interested in any of the events that
7002    * have occurred on the channel, invoke its procedure.
7003    */
7004 
7005   if ((chPtr->mask & mask) != 0) {
7006       nh.nextHandlerPtr = chPtr->nextPtr;
7007       (*(chPtr->proc))(chPtr->clientData, mask);
7008       chPtr = nh.nextHandlerPtr;
7009   } else {
7010       chPtr = chPtr->nextPtr;
7011   }
7012     }
7013 
7014     /*
7015      * Update the notifier interest, since it may have changed after
7016      * invoking event handlers. Skip that if the channel was deleted
7017      * in the call to the channel handler.
7018      */
7019 
7020     if (chanPtr->typePtr != NULL) {
7021         UpdateInterest(chanPtr);
7022     }
7023 
7024     Tcl_Release((ClientData) statePtr);
7025     Tcl_Release((ClientData) channel);
7026 
7027     tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
7028 }
int Tcl_OutputBuffered (Tcl_Channel chan)

Definition at line 6053 of file tclIO.c.
References BUFFER_READY, ChannelBuffer::nextAdded, ChannelBuffer::nextPtr, ChannelBuffer::nextRemoved, and NULL.
Referenced by SerialGetOptionProc(), Tcl_Seek(), and Tcl_Tell().6055 {
6056     ChannelState *statePtr = ((Channel *) chan)->state;
6057                                       /* State of real channel structure. */
6058     ChannelBuffer *bufPtr;
6059     int bytesBuffered;
6060 
6061     for (bytesBuffered = 0, bufPtr = statePtr->outQueueHead;
6062   bufPtr != (ChannelBuffer *) NULL;
6063   bufPtr = bufPtr->nextPtr) {
6064   bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
6065     }
6066     if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
6067   (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
6068   statePtr->flags |= BUFFER_READY;
6069   bytesBuffered +=
6070       (statePtr->curOutPtr->nextAdded - statePtr->curOutPtr->nextRemoved);
6071     }
6072 
6073     return bytesBuffered;
6074 }
int Tcl_Read (Tcl_Channel chan, char * dst, int bytesToRead)

Definition at line 4215 of file tclIO.c.
References CheckChannelErrors(), DoRead(), Channel::state, and TCL_READABLE.
Referenced by Tcl_FSLoadFile().4219 {
4220     Channel *chanPtr = (Channel *) chan;    
4221     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
4222 
4223     /*
4224      * This operation should occur at the top of a channel stack.
4225      */
4226 
4227     chanPtr = statePtr->topChanPtr;
4228 
4229     if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
4230   return -1;
4231     }
4232 
4233     return DoRead(chanPtr, dst, bytesToRead);
4234 }
int Tcl_ReadChars (Tcl_Channel chan, Tcl_Obj * objPtr, int toRead, int appendFlag)

Definition at line 4408 of file tclIO.c.
References CheckChannelErrors(), DoReadChars(), Channel::state, TCL_READABLE, and UpdateInterest().
Referenced by LoadTableEncoding(), Tcl_ExecObjCmd(), Tcl_FSEvalFile(), Tcl_ReadObjCmd(), and TclCleanupChildren().4419 {
4420     Channel*      chanPtr  = (Channel *) chan;
4421     ChannelState* statePtr = chanPtr->state;  /* state info for channel */
4422     
4423     /*
4424      * This operation should occur at the top of a channel stack.
4425      */
4426 
4427     chanPtr = statePtr->topChanPtr;
4428 
4429     if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
4430         /*
4431    * Update the notifier state so we don't block while there is still
4432    * data in the buffers.
4433    */
4434         UpdateInterest(chanPtr);
4435   return -1;
4436     }
4437 
4438     return DoReadChars (chanPtr, objPtr, toRead, appendFlag);
4439 }
int Tcl_ReadRaw (Tcl_Channel chan, char * bufPtr, int bytesToRead)

Definition at line 4259 of file tclIO.c.
References CHANNEL_BLOCKED, CHANNEL_EOF, CHANNEL_NONBLOCKING, CHANNEL_RAW_MODE, CheckChannelErrors(), CopyBuffer(), Channel::state, and TCL_READABLE.
Referenced by TransformInputProc().4263 {
4264     Channel *chanPtr = (Channel *) chan;    
4265     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
4266     int nread, result;
4267     int copied, copiedNow;
4268 
4269     /*
4270      * The check below does too much because it will reject a call to this
4271      * function with a channel which is part of an 'fcopy'. But we have to
4272      * allow this here or else the chaining in the transformation drivers
4273      * will fail with 'file busy' error instead of retrieving and
4274      * transforming the data to copy.
4275      *
4276      * We let the check procedure now believe that there is no fcopy in
4277      * progress. A better solution than this might be an additional flag
4278      * argument to switch off specific checks.
4279      */
4280 
4281     if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) {
4282   return -1;
4283     }
4284 
4285     /*
4286      * Check for information in the push-back buffers. If there is
4287      * some, use it. Go to the driver only if there is none (anymore)
4288      * and the caller requests more bytes.
4289      */
4290 
4291     for (copied = 0; copied < bytesToRead; copied += copiedNow) {
4292         copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
4293                 bytesToRead - copied);
4294         if (copiedNow == 0) {
4295             if (statePtr->flags & CHANNEL_EOF) {
4296     goto done;
4297             }
4298             if (statePtr->flags & CHANNEL_BLOCKED) {
4299                 if (statePtr->flags & CHANNEL_NONBLOCKING) {
4300         goto done;
4301                 }
4302                 statePtr->flags &= (~(CHANNEL_BLOCKED));
4303             }
4304 
4305 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
4306       /* [SF Tcl Bug 943274]. Better emulation of non-blocking
4307        * channels for channels without BlockModeProc, by keeping
4308        * track of true fileevents generated by the OS == Data
4309        * waiting and reading if and only if we are sure to have
4310        * data.
4311        */
4312 
4313       if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
4314     (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
4315     !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
4316 
4317           /* We bypass the driver, it would block, as no data is available */
4318           nread  = -1;
4319           result = EWOULDBLOCK;
4320       } else {
4321 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
4322         /*
4323          * Now go to the driver to get as much as is possible to
4324          * fill the remaining request. Do all the error handling
4325          * by ourselves.  The code was stolen from 'GetInput' and
4326          * slightly adapted (different return value here).
4327          *
4328          * The case of 'bytesToRead == 0' at this point cannot happen.
4329          */
4330 
4331         nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
4332         bufPtr + copied, bytesToRead - copied, &result);
4333 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
4334       }
4335 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
4336       if (nread > 0) {
4337           /*
4338      * If we get a short read, signal up that we may be
4339      * BLOCKED. We should avoid calling the driver because
4340      * on some platforms we will block in the low level
4341      * reading code even though the channel is set into
4342      * nonblocking mode.
4343      */
4344             
4345           if (nread < (bytesToRead - copied)) {
4346         statePtr->flags |= CHANNEL_BLOCKED;
4347     }
4348 
4349 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
4350           if (nread <= (bytesToRead - copied)) {
4351         /* [SF Tcl Bug 943274] We have read the available
4352          * data, clear flag */
4353         statePtr->flags &= ~CHANNEL_HAS_MORE_DATA;
4354     }
4355 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
4356       } else if (nread == 0) {
4357           statePtr->flags |= CHANNEL_EOF;
4358     statePtr->inputEncodingFlags |= TCL_ENCODING_END;
4359       } else if (nread < 0) {
4360           if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
4361         if (copied > 0) {
4362           /*
4363            * Information that was copied earlier has precedence
4364            * over EAGAIN/WOULDBLOCK handling.
4365            */
4366           return copied;
4367         }
4368 
4369         statePtr->flags |= CHANNEL_BLOCKED;
4370         result = EAGAIN;
4371     }
4372 
4373     Tcl_SetErrno(result);
4374     return -1;
4375       } 
4376 
4377       return copied + nread;
4378         }
4379     }
4380 
4381 done:
4382     return copied;
4383 }
void Tcl_RegisterChannel (Tcl_Interp * interp, Tcl_Channel chan)

Definition at line 766 of file tclIO.c.
References ChannelState::bottomChanPtr, CONST, GetChannelTable(), NULL, panic, Channel::state, Tcl_CreateHashEntry, Tcl_GetHashValue, and Tcl_SetHashValue.
Referenced by AcceptCallbackProc(), GetChannelTable(), Tcl_AppInit(), Tcl_CreateChannel(), Tcl_GetStdChannel(), Tcl_InterpObjCmd(), Tcl_OpenObjCmd(), Tcl_SocketObjCmd(), and TestfeventCmd().770 {
771     Tcl_HashTable *hTblPtr; /* Hash table of channels. */
772     Tcl_HashEntry *hPtr;  /* Search variable. */
773     int new;      /* Is the hash entry new or does it exist? */
774     Channel *chanPtr;   /* The actual channel. */
775     ChannelState *statePtr; /* State of the actual channel. */
776 
777     /*
778      * Always (un)register bottom-most channel in the stack.  This makes
779      * management of the channel list easier because no manipulation is
780      * necessary during (un)stack operation.
781      */
782     chanPtr = ((Channel *) chan)->state->bottomChanPtr;
783     statePtr = chanPtr->state;
784 
785     if (statePtr->channelName == (CONST char *) NULL) {
786         panic("Tcl_RegisterChannel: channel without name");
787     }
788     if (interp != (Tcl_Interp *) NULL) {
789         hTblPtr = GetChannelTable(interp);
790         hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &new);
791         if (new == 0) {
792             if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
793                 return;
794             }
795 
796       panic("Tcl_RegisterChannel: duplicate channel names");
797         }
798         Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
799     }
800 
801     statePtr->refCount++;
802 }
Tcl_WideInt Tcl_Seek (Tcl_Channel chan, Tcl_WideInt offset, int mode)

Definition at line 5550 of file tclIO.c.
References BG_FLUSH_SCHEDULED, CHANNEL_BLOCKED, CHANNEL_EOF, CHANNEL_NONBLOCKING, CHANNEL_STICKY_EOF, CheckChannelErrors(), CheckForDeadChannel(), DiscardInputQueued(), EFAULT, EINVAL, EOVERFLOW, FlushChannel(), HaveVersion(), INPUT_SAW_CR, Channel::instanceData, LONG_MAX, LONG_MIN, NULL, SEEK_CUR, Tcl_ChannelType::seekProc, StackSetBlockMode(), Channel::state, TCL_CHANNEL_VERSION_3, Tcl_InputBuffered(), Tcl_LongAsWide, TCL_MODE_BLOCKING, TCL_MODE_NONBLOCKING, Tcl_OutputBuffered(), TCL_READABLE, Tcl_SetErrno(), Tcl_WideAsLong, TCL_WRITABLE, Channel::typePtr, and Tcl_ChannelType::wideSeekProc.
Referenced by OpenFileChannel(), PretendTclpOpenFileChannel(), Tcl_FSOpenFileChannel(), Tcl_SeekObjCmd(), Tcl_SeekOld(), and TclCleanupChildren().5554 {
5555     Channel *chanPtr = (Channel *) chan;  /* The real IO channel. */
5556     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
5557     int inputBuffered, outputBuffered;
5558         /* # bytes held in buffers. */
5559     int result;     /* Of device driver operations. */
5560     Tcl_WideInt curPos;   /* Position on the device. */
5561     int wasAsync;   /* Was the channel nonblocking before the
5562                                  * seek operation? If so, must restore to
5563                                  * nonblocking mode after the seek. */
5564 
5565     if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
5566   return Tcl_LongAsWide(-1);
5567     }
5568 
5569     /*
5570      * Disallow seek on dead channels -- channels that have been closed but
5571      * not yet been deallocated. Such channels can be found if the exit
5572      * handler for channel cleanup has run but the channel is still
5573      * registered in an interpreter.
5574      */
5575 
5576     if (CheckForDeadChannel(NULL, statePtr)) {
5577   return Tcl_LongAsWide(-1);
5578     }
5579 
5580     /*
5581      * This operation should occur at the top of a channel stack.
5582      */
5583 
5584     chanPtr = statePtr->topChanPtr;
5585 
5586     /*
5587      * Disallow seek on channels whose type does not have a seek procedure
5588      * defined. This means that the channel does not support seeking.
5589      */
5590 
5591     if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
5592         Tcl_SetErrno(EINVAL);
5593         return Tcl_LongAsWide(-1);
5594     }
5595 
5596     /*
5597      * Compute how much input and output is buffered. If both input and
5598      * output is buffered, cannot compute the current position.
5599      */
5600 
5601     inputBuffered = Tcl_InputBuffered(chan);
5602     outputBuffered = Tcl_OutputBuffered(chan);
5603 
5604     if ((inputBuffered != 0) && (outputBuffered != 0)) {
5605         Tcl_SetErrno(EFAULT);
5606         return Tcl_LongAsWide(-1);
5607     }
5608 
5609     /*
5610      * If we are seeking relative to the current position, compute the
5611      * corrected offset taking into account the amount of unread input.
5612      */
5613 
5614     if (mode == SEEK_CUR) {
5615         offset -= inputBuffered;
5616     }
5617 
5618     /*
5619      * Discard any queued input - this input should not be read after
5620      * the seek.
5621      */
5622 
5623     DiscardInputQueued(statePtr, 0);
5624 
5625     /*
5626      * Reset EOF and BLOCKED flags. We invalidate them by moving the
5627      * access point. Also clear CR related flags.
5628      */
5629 
5630     statePtr->flags &=
5631         (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR));
5632     
5633     /*
5634      * If the channel is in asynchronous output mode, switch it back
5635      * to synchronous mode and cancel any async flush that may be
5636      * scheduled. After the flush, the channel will be put back into
5637      * asynchronous output mode.
5638      */
5639 
5640     wasAsync = 0;
5641     if (statePtr->flags & CHANNEL_NONBLOCKING) {
5642         wasAsync = 1;
5643         result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
5644   if (result != 0) {
5645       return Tcl_LongAsWide(-1);
5646   }
5647         statePtr->flags &= (~(CHANNEL_NONBLOCKING));
5648         if (statePtr->flags & BG_FLUSH_SCHEDULED) {
5649             statePtr->flags &= (~(BG_FLUSH_SCHEDULED));
5650         }
5651     }
5652     
5653     /*
5654      * If the flush fails we cannot recover the original position. In
5655      * that case the seek is not attempted because we do not know where
5656      * the access position is - instead we return the error. FlushChannel
5657      * has already called Tcl_SetErrno() to report the error upwards.
5658      * If the flush succeeds we do the seek also.
5659      */
5660     
5661     if (FlushChannel(NULL, chanPtr, 0) != 0) {
5662         curPos = -1;
5663     } else {
5664 
5665         /*
5666          * Now seek to the new position in the channel as requested by the
5667          * caller.  Note that we prefer the wideSeekProc if that is
5668    * available and non-NULL...
5669          */
5670 
5671   if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
5672     chanPtr->typePtr->wideSeekProc != NULL) {
5673       curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData,
5674         offset, mode, &result);
5675   } else if (offset < Tcl_LongAsWide(LONG_MIN) ||
5676     offset > Tcl_LongAsWide(LONG_MAX)) {
5677       result = EOVERFLOW;
5678       curPos = Tcl_LongAsWide(-1);
5679   } else {
5680       curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) (
5681         chanPtr->instanceData, Tcl_WideAsLong(offset), mode,
5682         &result));
5683   }
5684   if (curPos == Tcl_LongAsWide(-1)) {
5685       Tcl_SetErrno(result);
5686   }
5687     }
5688     
5689     /*
5690      * Restore to nonblocking mode if that was the previous behavior.
5691      *
5692      * NOTE: Even if there was an async flush active we do not restore
5693      * it now because we already flushed all the queued output, above.
5694      */
5695     
5696     if (wasAsync) {
5697         statePtr->flags |= CHANNEL_NONBLOCKING;
5698         result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
5699   if (result != 0) {
5700       return Tcl_LongAsWide(-1);
5701   }
5702     }
5703 
5704     return curPos;
5705 }
int Tcl_SeekOld (Tcl_Channel chan, int offset, int mode)

Definition at line 5824 of file tclIO.c.
References Tcl_LongAsWide, Tcl_Seek(), and Tcl_WideAsLong.5828 {
5829     Tcl_WideInt wOffset, wResult;
5830 
5831     wOffset = Tcl_LongAsWide((long)offset);
5832     wResult = Tcl_Seek(chan, wOffset, mode);
5833     return (int)Tcl_WideAsLong(wResult);
5834 }
void Tcl_SetChannelBufferSize (Tcl_Channel chan, int sz)

Definition at line 6130 of file tclIO.c.
References ckalloc, ckfree, NULL, and TCL_WRITABLE.
Referenced by Tcl_MakeTcpClientChannel(), Tcl_OpenTcpClient(), Tcl_OpenTcpServer(), Tcl_SetChannelOption(), and TcpAccept().6134 {
6135     ChannelState *statePtr;   /* State of real channel structure. */
6136     
6137     /*
6138      * If the buffer size is smaller than 1 byte or larger than one MByte,
6139      * do not accept the requested size and leave the current buffer size.
6140      */
6141     
6142     if (sz < 1) {
6143         return;
6144     }
6145     if (sz > (1024 * 1024)) {
6146         return;
6147     }
6148 
6149     statePtr = ((Channel *) chan)->state;
6150     statePtr->bufSize = sz;
6151 
6152     if (statePtr->outputStage != NULL) {
6153   ckfree((char *) statePtr->outputStage);
6154   statePtr->outputStage = NULL;
6155     }
6156     if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
6157   statePtr->outputStage = (char *)
6158       ckalloc((unsigned) (statePtr->bufSize + 2));
6159     }
6160 }
int Tcl_SetChannelOption (Tcl_Interp * interp, Tcl_Channel chan, CONST char * optionName, CONST char * newValue)

Definition at line 6512 of file tclIO.c.
References CHANNEL_BLOCKED, CHANNEL_EOF, CHANNEL_LINEBUFFERED, CHANNEL_NEED_MORE_DATA, CHANNEL_STICKY_EOF, CHANNEL_UNBUFFERED, CheckChannelErrors(), CheckForDeadChannel(), ckalloc, ckfree, CONST, INPUT_SAW_CR, Channel::instanceData, NULL, RecycleBuffer(), SetBlockMode(), Tcl_ChannelType::setOptionProc, size_t(), Channel::state, Tcl_BadChannelOption(), Tcl_ChannelName(), TCL_ENCODING_END, TCL_ENCODING_START, TCL_ERROR, Tcl_FreeEncoding(), Tcl_GetBoolean(), Tcl_GetEncoding(), Tcl_GetInt(), TCL_MODE_BLOCKING, TCL_MODE_NONBLOCKING, TCL_OK, TCL_PLATFORM_TRANSLATION, TCL_READABLE, Tcl_SetChannelBufferSize(), Tcl_SplitList(), TCL_TRANSLATE_AUTO, TCL_TRANSLATE_CR, TCL_TRANSLATE_CRLF, TCL_TRANSLATE_LF, TCL_WRITABLE, Channel::typePtr, UpdateInterest(), and WriteChars().
Referenced by LoadEncodingFile(), MakeTcpClientChannelMode(), Tcl_AppInit(), Tcl_FconfigureObjCmd(), Tcl_FSEvalFile(), Tcl_FSLoadFile(), Tcl_MakeTcpClientChannel(), Tcl_OpenTcpClient(), Tcl_OpenTcpServer(), TclCrossFilesystemCopy(), TclFinalizeIOSubsystem(), TclpCreateCommandChannel(), TclpGetDefaultStdChannel(), TclpOpenFileChannel(), TclWinOpenConsoleChannel(), TclWinOpenFileChannel(), TclWinOpenSerialChannel(), and TcpAccept().6517 {
6518     Channel *chanPtr = (Channel *) chan;  /* The real IO channel. */
6519     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
6520     size_t len;     /* Length of optionName string. */
6521     int argc;
6522     CONST char **argv;
6523 
6524     /*
6525      * If the channel is in the middle of a background copy, fail.
6526      */
6527 
6528     if (statePtr->csPtr) {
6529   if (interp) {
6530       Tcl_AppendResult(interp,
6531         "unable to set channel options: background copy in progress",
6532         (char *) NULL);
6533   }
6534         return TCL_ERROR;
6535     }
6536 
6537     /*
6538      * Disallow options on dead channels -- channels that have been closed but
6539      * not yet been deallocated. Such channels can be found if the exit
6540      * handler for channel cleanup has run but the channel is still
6541      * registered in an interpreter.
6542      */
6543 
6544     if (CheckForDeadChannel(NULL, statePtr)) {
6545   return TCL_ERROR;
6546     }
6547 
6548     /*
6549      * This operation should occur at the top of a channel stack.
6550      */
6551 
6552     chanPtr = statePtr->topChanPtr;
6553 
6554     len = strlen(optionName);
6555 
6556     if ((len > 2) && (optionName[1] == 'b') &&
6557             (strncmp(optionName, "-blocking", len) == 0)) {
6558   int newMode;
6559         if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {
6560             return TCL_ERROR;
6561         }
6562         if (newMode) {
6563             newMode = TCL_MODE_BLOCKING;
6564         } else {
6565             newMode = TCL_MODE_NONBLOCKING;
6566         }
6567   return SetBlockMode(interp, chanPtr, newMode);
6568     } else if ((len > 7) && (optionName[1] == 'b') &&
6569             (strncmp(optionName, "-buffering", len) == 0)) {
6570         len = strlen(newValue);
6571         if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
6572             statePtr->flags &=
6573                 (~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED));
6574         } else if ((newValue[0] == 'l') &&
6575                 (strncmp(newValue, "line", len) == 0)) {
6576             statePtr->flags &= (~(CHANNEL_UNBUFFERED));
6577             statePtr->flags |= CHANNEL_LINEBUFFERED;
6578         } else if ((newValue[0] == 'n') &&
6579                 (strncmp(newValue, "none", len) == 0)) {
6580             statePtr->flags &= (~(CHANNEL_LINEBUFFERED));
6581             statePtr->flags |= CHANNEL_UNBUFFERED;
6582         } else {
6583             if (interp) {
6584                 Tcl_AppendResult(interp, "bad value for -buffering: ",
6585                         "must be one of full, line, or none",
6586                         (char *) NULL);
6587                 return TCL_ERROR;
6588             }
6589         }
6590   return TCL_OK;
6591     } else if ((len > 7) && (optionName[1] == 'b') &&
6592             (strncmp(optionName, "-buffersize", len) == 0)) {
6593   int newBufferSize;
6594   if (Tcl_GetInt(interp, newValue, &newBufferSize) == TCL_ERROR) {
6595       return TCL_ERROR;
6596   }
6597   Tcl_SetChannelBufferSize(chan, newBufferSize);
6598     } else if ((len > 2) && (optionName[1] == 'e') &&
6599       (strncmp(optionName, "-encoding", len) == 0)) {
6600   Tcl_Encoding encoding;
6601 
6602   if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) {
6603       encoding = NULL;
6604   } else {
6605       encoding = Tcl_GetEncoding(interp, newValue);
6606       if (encoding == NULL) {
6607     return TCL_ERROR;
6608       }
6609   }
6610   /*
6611    * When the channel has an escape sequence driven encoding such as
6612    * iso2022, the terminated escape sequence must write to the buffer.
6613    */
6614   if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
6615     && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
6616       statePtr->outputEncodingFlags |= TCL_ENCODING_END;
6617       WriteChars(chanPtr, "", 0);
6618   }
6619   Tcl_FreeEncoding(statePtr->encoding);
6620   statePtr->encoding = encoding;
6621   statePtr->inputEncodingState = NULL;
6622   statePtr->inputEncodingFlags = TCL_ENCODING_START;
6623   statePtr->outputEncodingState = NULL;
6624   statePtr->outputEncodingFlags = TCL_ENCODING_START;
6625   statePtr->flags &= ~CHANNEL_NEED_MORE_DATA;
6626   UpdateInterest(chanPtr);
6627     } else if ((len > 2) && (optionName[1] == 'e') &&
6628             (strncmp(optionName, "-eofchar", len) == 0)) {
6629         if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
6630             return TCL_ERROR;
6631         }
6632         if (argc == 0) {
6633             statePtr->inEofChar = 0;
6634             statePtr->outEofChar = 0;
6635         } else if (argc == 1) {
6636             if (statePtr->flags & TCL_WRITABLE) {
6637                 statePtr->outEofChar = (int) argv[0][0];
6638             }
6639             if (statePtr->flags & TCL_READABLE) {
6640                 statePtr->inEofChar = (int) argv[0][0];
6641             }
6642         } else if (argc != 2) {
6643             if (interp) {
6644                 Tcl_AppendResult(interp,
6645                         "bad value for -eofchar: should be a list of zero,",
6646                         " one, or two elements", (char *) NULL);
6647             }
6648             ckfree((char *) argv);
6649             return TCL_ERROR;
6650         } else {
6651             if (statePtr->flags & TCL_READABLE) {
6652                 statePtr->inEofChar = (int) argv[0][0];
6653             }
6654             if (statePtr->flags & TCL_WRITABLE) {
6655                 statePtr->outEofChar = (int) argv[1][0];
6656             }
6657         }
6658         if (argv != NULL) {
6659             ckfree((char *) argv);
6660         }
6661 
6662   /*
6663    * [SF Tcl Bug 930851] Reset EOF and BLOCKED flags. Changing
6664    * the character which signals eof can transform a current eof
6665    * condition into a 'go ahead'. Ditto for blocked.
6666    */
6667 
6668   statePtr->flags &= (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED));
6669 
6670   return TCL_OK;
6671     } else if ((len > 1) && (optionName[1] == 't') &&
6672             (strncmp(optionName, "-translation", len) == 0)) {
6673   CONST char *readMode, *writeMode;
6674 
6675         if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
6676             return TCL_ERROR;
6677         }
6678 
6679         if (argc == 1) {
6680       readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
6681       writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
6682   } else if (argc == 2) {
6683       readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
6684       writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
6685   } else {
6686             if (interp) {
6687                 Tcl_AppendResult(interp,
6688                         "bad value for -translation: must be a one or two",
6689                         " element list", (char *) NULL);
6690             }
6691             ckfree((char *) argv);
6692             return TCL_ERROR;
6693   }
6694 
6695   if (readMode) {
6696       TclEolTranslation translation;
6697       if (*readMode == '\0') {
6698     translation = statePtr->inputTranslation;
6699       } else if (strcmp(readMode, "auto") == 0) {
6700     translation = TCL_TRANSLATE_AUTO;
6701       } else if (strcmp(readMode, "binary") == 0) {
6702     translation = TCL_TRANSLATE_LF;
6703     statePtr->inEofChar = 0;
6704     Tcl_FreeEncoding(statePtr->encoding);       
6705     statePtr->encoding = NULL;
6706       } else if (strcmp(readMode, "lf") == 0) {
6707     translation = TCL_TRANSLATE_LF;
6708       } else if (strcmp(readMode, "cr") == 0) {
6709     translation = TCL_TRANSLATE_CR;
6710       } else if (strcmp(readMode, "crlf") == 0) {
6711     translation = TCL_TRANSLATE_CRLF;
6712       } else if (strcmp(readMode, "platform") == 0) {
6713     translation = TCL_PLATFORM_TRANSLATION;
6714       } else {
6715     if (interp) {
6716         Tcl_AppendResult(interp,
6717           "bad value for -translation: ",
6718           "must be one of auto, binary, cr, lf, crlf,",
6719           " or platform", (char *) NULL);
6720     }
6721     ckfree((char *) argv);
6722     return TCL_ERROR;
6723       }
6724 
6725       /*
6726        * Reset the EOL flags since we need to look at any buffered
6727        * data to see if the new translation mode allows us to
6728        * complete the line.
6729        */
6730 
6731       if (translation != statePtr->inputTranslation) {
6732     statePtr->inputTranslation = translation;
6733     statePtr->flags &= ~(INPUT_SAW_CR);
6734     statePtr->flags &= ~(CHANNEL_NEED_MORE_DATA);
6735     UpdateInterest(chanPtr);
6736       }
6737   }
6738   if (writeMode) {
6739       if (*writeMode == '\0') {
6740     /* Do nothing. */
6741       } else if (strcmp(writeMode, "auto") == 0) {
6742     /*
6743      * This is a hack to get TCP sockets to produce output
6744      * in CRLF mode if they are being set into AUTO mode.
6745      * A better solution for achieving this effect will be
6746      * coded later.
6747      */
6748 
6749     if (strcmp(Tcl_ChannelName(chanPtr->typePtr), "tcp") == 0) {
6750         statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
6751     } else {
6752         statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
6753     }
6754       } else if (strcmp(writeMode, "binary") == 0) {
6755     statePtr->outEofChar = 0;
6756     statePtr->outputTranslation = TCL_TRANSLATE_LF;
6757     Tcl_FreeEncoding(statePtr->encoding);       
6758     statePtr->encoding = NULL;
6759       } else if (strcmp(writeMode, "lf") == 0) {
6760     statePtr->outputTranslation = TCL_TRANSLATE_LF;
6761       } else if (strcmp(writeMode, "cr") == 0) {
6762     statePtr->outputTranslation = TCL_TRANSLATE_CR;
6763       } else if (strcmp(writeMode, "crlf") == 0) {
6764     statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
6765       } else if (strcmp(writeMode, "platform") == 0) {
6766     statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
6767       } else {
6768     if (interp) {
6769         Tcl_AppendResult(interp,
6770           "bad value for -translation: ",
6771           "must be one of auto, binary, cr, lf, crlf,",
6772           " or platform", (char *) NULL);
6773     }
6774     ckfree((char *) argv);
6775     return TCL_ERROR;
6776       }
6777   }
6778         ckfree((char *) argv);            
6779         return TCL_OK;
6780     } else if (chanPtr->typePtr->setOptionProc != NULL) {
6781         return (*chanPtr->typePtr->setOptionProc)(chanPtr->instanceData,
6782                 interp, optionName, newValue);
6783     } else {
6784   return Tcl_BadChannelOption(interp, optionName, (char *) NULL);
6785     }
6786 
6787     /*
6788      * If bufsize changes, need to get rid of old utility buffer.
6789      */
6790 
6791     if (statePtr->saveInBufPtr != NULL) {
6792   RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1);
6793   statePtr->saveInBufPtr = NULL;
6794     }
6795     if (statePtr->inQueueHead != NULL) {
6796   if ((statePtr->inQueueHead->nextPtr == NULL)
6797     && (statePtr->inQueueHead->nextAdded ==
6798       statePtr->inQueueHead->nextRemoved)) {
6799       RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
6800       statePtr->inQueueHead = NULL;
6801       statePtr->inQueueTail = NULL;
6802   }
6803     }
6804 
6805     /*
6806      * If encoding or bufsize changes, need to update output staging buffer.
6807      */
6808 
6809     if (statePtr->outputStage != NULL) {
6810   ckfree((char *) statePtr->outputStage);
6811   statePtr->outputStage = NULL;
6812     }
6813     if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
6814   statePtr->outputStage = (char *) 
6815       ckalloc((unsigned) (statePtr->bufSize + 2));
6816     }
6817     return TCL_OK;
6818 }
void Tcl_SetStdChannel (Tcl_Channel channel, int type)

Definition at line 323 of file tclIO.c.
References dataKey, ThreadSpecificData::stderrChannel, ThreadSpecificData::stderrInitialized, ThreadSpecificData::stdinChannel, ThreadSpecificData::stdinInitialized, ThreadSpecificData::stdoutChannel, ThreadSpecificData::stdoutInitialized, TCL_STDERR, TCL_STDIN, TCL_STDOUT, and TCL_TSD_INIT.
Referenced by Tcl_AppInit(), and Tcl_CreateChannel().326 {
327     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
328     switch (type) {
329   case TCL_STDIN:
330       tsdPtr->stdinInitialized = 1;
331       tsdPtr->stdinChannel = channel;
332       break;
333   case TCL_STDOUT:
334       tsdPtr->stdoutInitialized = 1;
335       tsdPtr->stdoutChannel = channel;
336       break;
337   case TCL_STDERR:
338       tsdPtr->stderrInitialized = 1;
339       tsdPtr->stderrChannel = channel;
340       break;
341     }
342 }
void Tcl_SpliceChannel (Tcl_Channel chan)

Definition at line 2496 of file tclIO.c.
References dataKey, ThreadSpecificData::firstCSPtr, NULL, panic, TCL_CHANNEL_THREAD_INSERT, Tcl_ChannelThreadActionProc(), Tcl_GetChannelInstanceData(), Tcl_GetChannelType(), Tcl_GetCurrentThread(), and TCL_TSD_INIT.
Referenced by Tcl_CreateChannel(), and TestChannelCmd().2500 {
2501     ThreadSpecificData  *tsdPtr = TCL_TSD_INIT(&dataKey);
2502     ChannelState  *statePtr = ((Channel *) chan)->state;
2503     Tcl_DriverThreadActionProc *threadActionProc;
2504 
2505     if (statePtr->nextCSPtr != (ChannelState *) NULL) {
2506         panic("Tcl_SpliceChannel: trying to add channel used in different list");
2507     }
2508 
2509     statePtr->nextCSPtr = tsdPtr->firstCSPtr;
2510     tsdPtr->firstCSPtr  = statePtr;
2511 
2512     /*
2513      * TIP #10. Mark the current thread as the new one managing this
2514      *          channel. Note: 'Tcl_GetCurrentThread' returns sensible
2515      *          values even for a non-threaded core.
2516      */
2517 
2518     statePtr->managingThread = Tcl_GetCurrentThread ();
2519 
2520     /* TIP #218, Channel Thread Actions */
2521     threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
2522     if (threadActionProc != NULL) {
2523         (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
2524            TCL_CHANNEL_THREAD_INSERT);
2525     }
2526 }
Tcl_Channel Tcl_StackChannel (Tcl_Interp	    * interp, Tcl_ChannelType * typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan)

Definition at line 1302 of file tclIO.c.
References ckalloc, dataKey, Channel::downChanPtr, ThreadSpecificData::firstCSPtr, Channel::inQueueHead, Channel::inQueueTail, Channel::instanceData, NULL, Channel::state, Tcl_Flush(), Tcl_GetChannelName(), TCL_OK, TCL_READABLE, TCL_TSD_INIT, TCL_WRITABLE, ChannelState::topChanPtr, Channel::typePtr, and Channel::upChanPtr.
Referenced by TclChannelTransform().1311 {
1312     ThreadSpecificData  *tsdPtr = TCL_TSD_INIT(&dataKey);
1313     Channel   *chanPtr, *prevChanPtr;
1314     ChannelState  *statePtr;
1315 
1316     /*
1317      * Find the given channel in the list of all channels.
1318      * If we don't find it, then it was never registered correctly.
1319      *
1320      * This operation should occur at the top of a channel stack.
1321      */
1322 
1323     statePtr    = (ChannelState *) tsdPtr->firstCSPtr;
1324     prevChanPtr = ((Channel *) prevChan)->state->topChanPtr;
1325 
1326     while ((statePtr != NULL) && (statePtr->topChanPtr != prevChanPtr)) {
1327   statePtr = statePtr->nextCSPtr;
1328     }
1329 
1330     if (statePtr == NULL) {
1331   if (interp) {
1332       Tcl_AppendResult(interp, "couldn't find state for channel \"",
1333         Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
1334   }
1335         return (Tcl_Channel) NULL;
1336     }
1337 
1338     /*
1339      * Here we check if the given "mask" matches the "flags"
1340      * of the already existing channel.
1341      *
1342      *    | - | R | W | RW |
1343      *  --+---+---+---+----+  <=>  0 != (chan->mask & prevChan->mask)
1344      *  - |   |   |   |    |
1345      *  R |   | + |   | +  |  The superceding channel is allowed to
1346      *  W |   |   | + | +  |  restrict the capabilities of the
1347      *  RW|   | + | + | +  |  superceded one !
1348      *  --+---+---+---+----+
1349      */
1350 
1351     if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) {
1352   if (interp) {
1353       Tcl_AppendResult(interp,
1354         "reading and writing both disallowed for channel \"",
1355         Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
1356   }
1357         return (Tcl_Channel) NULL;
1358     }
1359 
1360     /*
1361      * Flush the buffers. This ensures that any data still in them
1362      * at this time is not handled by the new transformation. Restrict
1363      * this to writable channels. Take care to hide a possible bg-copy
1364      * in progress from Tcl_Flush and the CheckForChannelErrors inside.
1365      */
1366 
1367     if ((mask & TCL_WRITABLE) != 0) {
1368         CopyState *csPtr;
1369 
1370         csPtr           = statePtr->csPtr;
1371   statePtr->csPtr = (CopyState*) NULL;
1372 
1373   if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
1374       statePtr->csPtr = csPtr;
1375       if (interp) {
1376     Tcl_AppendResult(interp, "could not flush channel \"",
1377       Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
1378       }
1379       return (Tcl_Channel) NULL;
1380   }
1381 
1382   statePtr->csPtr = csPtr;
1383     }
1384     /*
1385      * Discard any input in the buffers. They are not yet read by the
1386      * user of the channel, so they have to go through the new
1387      * transformation before reading. As the buffers contain the
1388      * untransformed form their contents are not only useless but actually
1389      * distorts our view of the system.
1390      *
1391      * To preserve the information without having to read them again and
1392      * to avoid problems with the location in the channel (seeking might
1393      * be impossible) we move the buffers from the common state structure
1394      * into the channel itself. We use the buffers in the channel below
1395      * the new transformation to hold the data. In the future this allows
1396      * us to write transformations which pre-read data and push the unused
1397      * part back when they are going away.
1398      */
1399 
1400     if (((mask & TCL_READABLE) != 0) &&
1401   (statePtr->inQueueHead != (ChannelBuffer*) NULL)) {
1402       /*
1403        * Remark: It is possible that the channel buffers contain data from
1404        * some earlier push-backs.
1405        */
1406 
1407       statePtr->inQueueTail->nextPtr = prevChanPtr->inQueueHead;
1408       prevChanPtr->inQueueHead       = statePtr->inQueueHead;
1409 
1410       if (prevChanPtr->inQueueTail == (ChannelBuffer*) NULL) {
1411   prevChanPtr->inQueueTail = statePtr->inQueueTail;
1412       }
1413 
1414       statePtr->inQueueHead          = (ChannelBuffer*) NULL;
1415       statePtr->inQueueTail          = (ChannelBuffer*) NULL;
1416     }
1417 
1418     chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
1419 
1420     /*
1421      * Save some of the current state into the new structure,
1422      * reinitialize the parts which will stay with the transformation.
1423      *
1424      * Remarks:
1425      */
1426 
1427     chanPtr->state    = statePtr;
1428     chanPtr->instanceData = instanceData;
1429     chanPtr->typePtr    = typePtr;
1430     chanPtr->downChanPtr  = prevChanPtr;
1431     chanPtr->upChanPtr    = (Channel *) NULL;
1432     chanPtr->inQueueHead        = (ChannelBuffer*) NULL;
1433     chanPtr->inQueueTail        = (ChannelBuffer*) NULL;
1434 
1435     /*
1436      * Place new block at the head of a possibly existing list of previously
1437      * stacked channels.
1438      */
1439 
1440     prevChanPtr->upChanPtr  = chanPtr;
1441     statePtr->topChanPtr  = chanPtr;
1442 
1443     return (Tcl_Channel) chanPtr;
1444 }
Tcl_WideInt Tcl_Tell (Tcl_Channel chan)

Definition at line 5727 of file tclIO.c.
References CheckChannelErrors(), CheckForDeadChannel(), EFAULT, EINVAL, HaveVersion(), Channel::instanceData, NULL, SEEK_CUR, Tcl_ChannelType::seekProc, Channel::state, TCL_CHANNEL_VERSION_3, Tcl_InputBuffered(), Tcl_LongAsWide, Tcl_OutputBuffered(), TCL_READABLE, Tcl_SetErrno(), TCL_WRITABLE, Channel::typePtr, and Tcl_ChannelType::wideSeekProc.
Referenced by Tcl_TellObjCmd(), Tcl_TellOld(), and TestChannelCmd().5729 {
5730     Channel *chanPtr = (Channel *) chan;  /* The real IO channel. */
5731     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
5732     int inputBuffered, outputBuffered;  /* # bytes held in buffers. */
5733     int result;       /* Of calling device driver. */
5734     Tcl_WideInt curPos;     /* Position on device. */
5735 
5736     if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
5737   return Tcl_LongAsWide(-1);
5738     }
5739 
5740     /*
5741      * Disallow tell on dead channels -- channels that have been closed but
5742      * not yet been deallocated. Such channels can be found if the exit
5743      * handler for channel cleanup has run but the channel is still
5744      * registered in an interpreter.
5745      */
5746 
5747     if (CheckForDeadChannel(NULL, statePtr)) {
5748   return Tcl_LongAsWide(-1);
5749     }
5750 
5751     /*
5752      * This operation should occur at the top of a channel stack.
5753      */
5754 
5755     chanPtr = statePtr->topChanPtr;
5756 
5757     /*
5758      * Disallow tell on channels whose type does not have a seek procedure
5759      * defined. This means that the channel does not support seeking.
5760      */
5761 
5762     if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
5763         Tcl_SetErrno(EINVAL);
5764         return Tcl_LongAsWide(-1);
5765     }
5766 
5767     /*
5768      * Compute how much input and output is buffered. If both input and
5769      * output is buffered, cannot compute the current position.
5770      */
5771 
5772     inputBuffered = Tcl_InputBuffered(chan);
5773     outputBuffered = Tcl_OutputBuffered(chan);
5774 
5775     if ((inputBuffered != 0) && (outputBuffered != 0)) {
5776         Tcl_SetErrno(EFAULT);
5777         return Tcl_LongAsWide(-1);
5778     }
5779 
5780     /*
5781      * Get the current position in the device and compute the position
5782      * where the next character will be read or written.  Note that we
5783      * prefer the wideSeekProc if that is available and non-NULL...
5784      */
5785 
5786     if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
5787       chanPtr->typePtr->wideSeekProc != NULL) {
5788   curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData,
5789     Tcl_LongAsWide(0), SEEK_CUR, &result);
5790     } else {
5791   curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) (
5792     chanPtr->instanceData, 0, SEEK_CUR, &result));
5793     }
5794     if (curPos == Tcl_LongAsWide(-1)) {
5795         Tcl_SetErrno(result);
5796         return Tcl_LongAsWide(-1);
5797     }
5798     if (inputBuffered != 0) {
5799         return curPos - inputBuffered;
5800     }
5801     return curPos + outputBuffered;
5802 }
int Tcl_TellOld (Tcl_Channel chan)

Definition at line 5837 of file tclIO.c.
References Tcl_Tell(), and Tcl_WideAsLong.5839 {
5840     Tcl_WideInt wResult;
5841 
5842     wResult = Tcl_Tell(chan);
5843     return (int)Tcl_WideAsLong(wResult);
5844 }
int Tcl_Ungets (Tcl_Channel chan, CONST char * str, int len, int atEnd)

Definition at line 5171 of file tclIO.c.
References AllocChannelBuffer(), ChannelBuffer::buf, CHANNEL_BLOCKED, CHANNEL_EOF, CHANNEL_STICKY_EOF, CheckChannelErrors(), ChannelBuffer::nextAdded, ChannelBuffer::nextPtr, NULL, Channel::state, and TCL_READABLE.5177 {
5178     Channel *chanPtr;   /* The real IO channel. */
5179     ChannelState *statePtr; /* State of actual channel. */
5180     ChannelBuffer *bufPtr;  /* Buffer to contain the data. */
5181     int i, flags;
5182 
5183     chanPtr = (Channel *) chan;
5184     statePtr = chanPtr->state;
5185 
5186     /*
5187      * This operation should occur at the top of a channel stack.
5188      */
5189 
5190     chanPtr = statePtr->topChanPtr;
5191 
5192     /*
5193      * CheckChannelErrors clears too many flag bits in this one case.
5194      */
5195      
5196     flags = statePtr->flags;
5197     if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
5198   len = -1;
5199   goto done;
5200     }
5201     statePtr->flags = flags;
5202 
5203     /*
5204      * If we have encountered a sticky EOF, just punt without storing.
5205      * (sticky EOF is set if we have seen the input eofChar, to prevent
5206      * reading beyond the eofChar). Otherwise, clear the EOF flags, and
5207      * clear the BLOCKED bit. We want to discover these conditions anew
5208      * in each operation.
5209      */
5210 
5211     if (statePtr->flags & CHANNEL_STICKY_EOF) {
5212   goto done;
5213     }
5214     statePtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF));
5215 
5216     bufPtr = AllocChannelBuffer(len);
5217     for (i = 0; i < len; i++) {
5218         bufPtr->buf[bufPtr->nextAdded++] = str[i];
5219     }
5220 
5221     if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
5222         bufPtr->nextPtr = (ChannelBuffer *) NULL;
5223         statePtr->inQueueHead = bufPtr;
5224         statePtr->inQueueTail = bufPtr;
5225     } else if (atEnd) {
5226         bufPtr->nextPtr = (ChannelBuffer *) NULL;
5227         statePtr->inQueueTail->nextPtr = bufPtr;
5228         statePtr->inQueueTail = bufPtr;
5229     } else {
5230         bufPtr->nextPtr = statePtr->inQueueHead;
5231         statePtr->inQueueHead = bufPtr;
5232     }
5233 
5234     done:
5235     /*
5236      * Update the notifier state so we don't block while there is still
5237      * data in the buffers.
5238      */
5239 
5240     UpdateInterest(chanPtr);
5241     return len;
5242 }
int Tcl_UnregisterChannel (Tcl_Interp * interp, Tcl_Channel chan)

Definition at line 831 of file tclIO.c.
References BG_FLUSH_SCHEDULED, BUFFER_READY, CHANNEL_CLOSED, CHANNEL_INCLOSE, CheckForStdChannelsBeingClosed(), DetachChannel(), NULL, Tcl_Close(), TCL_ERROR, TCL_OK, Tcl_Preserve(), and Tcl_Release().
Referenced by AcceptCallbackProc(), Tcl_CloseObjCmd(), Tcl_InterpObjCmd(), Tcl_MakeSafe(), and Tcltest_Init().834 {
835     ChannelState *statePtr; /* State of the real channel. */
836 
837     statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
838  
839     if (statePtr->flags & CHANNEL_INCLOSE) {
840         if (interp != (Tcl_Interp*) NULL) {
841       Tcl_AppendResult(interp, 
842        "Illegal recursive call to close through close-handler of channel",
843        (char *) NULL);
844   }
845         return TCL_ERROR;
846     }
847  
848     if (DetachChannel(interp, chan) != TCL_OK) {
849         return TCL_OK;
850     }
851     
852     statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
853 
854     /*
855      * Perform special handling for standard channels being closed. If the
856      * refCount is now 1 it means that the last reference to the standard
857      * channel is being explicitly closed, so bump the refCount down
858      * artificially to 0. This will ensure that the channel is actually
859      * closed, below. Also set the static pointer to NULL for the channel.
860      */
861 
862     CheckForStdChannelsBeingClosed(chan);
863 
864     /*
865      * If the refCount reached zero, close the actual channel.
866      */
867 
868     if (statePtr->refCount <= 0) {
869 
870         /*
871          * Ensure that if there is another buffer, it gets flushed
872          * whether or not we are doing a background flush.
873          */
874 
875         if ((statePtr->curOutPtr != NULL) &&
876                 (statePtr->curOutPtr->nextAdded >
877                         statePtr->curOutPtr->nextRemoved)) {
878             statePtr->flags |= BUFFER_READY;
879         }
880   Tcl_Preserve((ClientData)statePtr);
881         if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
882       /* We don't want to re-enter Tcl_Close */
883       if (!(statePtr->flags & CHANNEL_CLOSED)) {
884     if (Tcl_Close(interp, chan) != TCL_OK) {
885         statePtr->flags |= CHANNEL_CLOSED;
886         Tcl_Release((ClientData)statePtr);
887         return TCL_ERROR;
888     }
889       }
890         }
891         statePtr->flags |= CHANNEL_CLOSED;
892   Tcl_Release((ClientData)statePtr);
893     }
894     return TCL_OK;
895 }
int Tcl_UnstackChannel (Tcl_Interp * interp, Tcl_Channel chan)

Definition at line 1465 of file tclIO.c.
References Tcl_ChannelType::close2Proc, Tcl_ChannelType::closeProc, DiscardInputQueued(), Channel::downChanPtr, Channel::inQueueHead, Channel::inQueueTail, Channel::instanceData, NULL, Channel::state, Tcl_Close(), TCL_CLOSE2PROC, TCL_DYNAMIC, TCL_ERROR, Tcl_EventuallyFree(), Tcl_Flush(), Tcl_GetChannelName(), TCL_OK, TCL_READABLE, Tcl_SetErrno(), TCL_WRITABLE, Channel::typePtr, Channel::upChanPtr, and UpdateInterest().
Referenced by TclChannelTransform(), and TestChannelCmd().1468 {
1469     Channel      *chanPtr  = (Channel *) chan;
1470     ChannelState *statePtr = chanPtr->state;
1471     int result = 0;
1472 
1473     /*
1474      * This operation should occur at the top of a channel stack.
1475      */
1476 
1477     chanPtr = statePtr->topChanPtr;
1478 
1479     if (chanPtr->downChanPtr != (Channel *) NULL) {
1480         /*
1481    * Instead of manipulating the per-thread / per-interp list/hashtable
1482    * of registered channels we wind down the state of the transformation,
1483    * and then restore the state of underlying channel into the old
1484    * structure.
1485    */
1486   Channel *downChanPtr = chanPtr->downChanPtr;
1487 
1488   /*
1489    * Flush the buffers. This ensures that any data still in them
1490    * at this time _is_ handled by the transformation we are unstacking
1491    * right now. Restrict this to writable channels. Take care to hide
1492    * a possible bg-copy in progress from Tcl_Flush and the
1493    * CheckForChannelErrors inside.
1494    */
1495 
1496   if (statePtr->flags & TCL_WRITABLE) {
1497       CopyState*    csPtr;
1498 
1499       csPtr           = statePtr->csPtr;
1500       statePtr->csPtr = (CopyState*) NULL;
1501 
1502       if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) {
1503           statePtr->csPtr = csPtr;
1504     if (interp) {
1505         Tcl_AppendResult(interp, "could not flush channel \"",
1506           Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"",
1507           (char *) NULL);
1508     }
1509     return TCL_ERROR;
1510       }
1511 
1512       statePtr->csPtr = csPtr;
1513   }
1514 
1515   /*
1516    * Anything in the input queue and the push-back buffers of
1517    * the transformation going away is transformed data, but not
1518    * yet read. As unstacking means that the caller does not want
1519    * to see transformed data any more we have to discard these
1520    * bytes. To avoid writing an analogue to 'DiscardInputQueued'
1521    * we move the information in the push back buffers to the
1522    * input queue and then call 'DiscardInputQueued' on that.
1523    */
1524 
1525   if (((statePtr->flags & TCL_READABLE)  != 0) &&
1526       ((statePtr->inQueueHead != (ChannelBuffer*) NULL) ||
1527        (chanPtr->inQueueHead  != (ChannelBuffer*) NULL))) {
1528 
1529       if ((statePtr->inQueueHead != (ChannelBuffer*) NULL) &&
1530     (chanPtr->inQueueHead  != (ChannelBuffer*) NULL)) {
1531           statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead;
1532     statePtr->inQueueTail = chanPtr->inQueueTail;
1533           statePtr->inQueueHead = statePtr->inQueueTail;
1534 
1535       } else if (chanPtr->inQueueHead != (ChannelBuffer*) NULL) {
1536           statePtr->inQueueHead = chanPtr->inQueueHead;
1537     statePtr->inQueueTail = chanPtr->inQueueTail;
1538       }
1539 
1540       chanPtr->inQueueHead          = (ChannelBuffer*) NULL;
1541       chanPtr->inQueueTail          = (ChannelBuffer*) NULL;
1542 
1543       DiscardInputQueued (statePtr, 0);
1544   }
1545 
1546   statePtr->topChanPtr  = downChanPtr;
1547   downChanPtr->upChanPtr  = (Channel *) NULL;
1548 
1549   /*
1550    * Leave this link intact for closeproc
1551    *  chanPtr->downChanPtr  = (Channel *) NULL;
1552    */
1553 
1554   /*
1555    * Close and free the channel driver state.
1556    */
1557 
1558   if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
1559       result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
1560         interp);
1561   } else {
1562       result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
1563         interp, 0);
1564   }
1565 
1566   chanPtr->typePtr  = NULL;
1567   /*
1568    * AK: Tcl_NotifyChannel may hold a reference to this block of memory
1569    */
1570   Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
1571   UpdateInterest(downChanPtr);
1572 
1573   if (result != 0) {
1574       Tcl_SetErrno(result);
1575       return TCL_ERROR;
1576   }
1577     } else {
1578         /*
1579    * This channel does not cover another one.
1580    * Simply do a close, if necessary.
1581    */
1582 
1583         if (statePtr->refCount <= 0) {
1584             if (Tcl_Close(interp, chan) != TCL_OK) {
1585                 return TCL_ERROR;
1586             }
1587   }
1588     }
1589 
1590     return TCL_OK;
1591 }
int Tcl_Write (Tcl_Channel chan, CONST char * src, int srcLen)

Definition at line 2783 of file tclIO.c.
References CheckChannelErrors(), DoWrite(), and TCL_WRITABLE.2788 {
2789     /*
2790      * Always use the topmost channel of the stack
2791      */
2792     Channel *chanPtr;
2793     ChannelState *statePtr; /* state info for channel */
2794 
2795     statePtr = ((Channel *) chan)->state;
2796     chanPtr  = statePtr->topChanPtr;
2797 
2798     if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
2799   return -1;
2800     }
2801 
2802     if (srcLen < 0) {
2803         srcLen = strlen(src);
2804     }
2805     return DoWrite(chanPtr, src, srcLen);
2806 }
int Tcl_WriteChars (Tcl_Channel chan, CONST char * src, int len)

Definition at line 2890 of file tclIO.c.
References CheckChannelErrors(), DoWriteChars(), and TCL_WRITABLE.
Referenced by HandleBgErrors(), Prompt(), StdinProc(), Tcl_EchoCmd(), Tcl_Main(), Tcl_PutsObjCmd(), and Tcl_SourceRCFile().2895 {
2896     ChannelState *statePtr; /* state info for channel */
2897 
2898     statePtr = ((Channel *) chan)->state;
2899 
2900     if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
2901   return -1;
2902     }
2903 
2904     return DoWriteChars ((Channel*) chan, src, len);
2905 }
int Tcl_WriteObj (Tcl_Channel chan, Tcl_Obj * objPtr)

Definition at line 2992 of file tclIO.c.
References CheckChannelErrors(), NULL, Tcl_GetByteArrayFromObj(), Tcl_GetStringFromObj(), TCL_WRITABLE, WriteBytes(), and WriteChars().
Referenced by Prompt(), StdinProc(), Tcl_Main(), Tcl_PutsObjCmd(), and Tcl_SourceRCFile().2995 {
2996     /*
2997      * Always use the topmost channel of the stack
2998      */
2999     Channel *chanPtr;
3000     ChannelState *statePtr; /* state info for channel */
3001     char *src;
3002     int srcLen;
3003 
3004     statePtr = ((Channel *) chan)->state;
3005     chanPtr  = statePtr->topChanPtr;
3006 
3007     if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
3008   return -1;
3009     }
3010     if (statePtr->encoding == NULL) {
3011   src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
3012   return WriteBytes(chanPtr, src, srcLen);
3013     } else {
3014   src = Tcl_GetStringFromObj(objPtr, &srcLen);
3015   return WriteChars(chanPtr, src, srcLen);
3016     }
3017 }
int Tcl_WriteRaw (Tcl_Channel chan, CONST char * src, int srcLen)

Definition at line 2833 of file tclIO.c.
References CHANNEL_RAW_MODE, CheckChannelErrors(), Channel::instanceData, Tcl_ChannelType::outputProc, Channel::state, Tcl_SetErrno(), TCL_WRITABLE, and Channel::typePtr.
Referenced by ExecuteCallback().2838 {
2839     Channel *chanPtr = ((Channel *) chan);
2840     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
2841     int errorCode, written;
2842 
2843     if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) {
2844   return -1;
2845     }
2846 
2847     if (srcLen < 0) {
2848         srcLen = strlen(src);
2849     }
2850 
2851     /*
2852      * Go immediately to the driver, do all the error handling by ourselves.
2853      * The code was stolen from 'FlushChannel'.
2854      */
2855 
2856     written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
2857       src, srcLen, &errorCode);
2858 
2859     if (written < 0) {
2860   Tcl_SetErrno(errorCode);
2861     }
2862 
2863     return written;
2864 }
void TclChannelEventScriptInvoker (ClientData clientData, int mask)

Definition at line 7498 of file tclIO.c.
References EventScriptRecord::chanPtr, DeleteScriptRecord(), EventScriptRecord::interp, EventScriptRecord::mask, NULL, EventScriptRecord::scriptPtr, Tcl_BackgroundError(), TCL_EVAL_GLOBAL, Tcl_EvalObjEx(), TCL_OK, Tcl_Preserve(), Tcl_Release(), and Channel::typePtr.
Referenced by CleanupChannelHandlers(), CreateScriptRecord(), DeleteChannelTable(), DeleteScriptRecord(), and TestChannelEventCmd().7501 {
7502     Tcl_Interp *interp;   /* Interpreter in which to eval the script. */
7503     Channel *chanPtr;   /* The channel for which this handler is
7504                                  * registered. */
7505     EventScriptRecord *esPtr; /* The event script + interpreter to eval it
7506                                  * in. */
7507     int result;     /* Result of call to eval script. */
7508 
7509     esPtr = (EventScriptRecord *) clientData;
7510     chanPtr = esPtr->chanPtr;
7511     mask  = esPtr->mask;
7512     interp  = esPtr->interp;
7513 
7514     /*
7515      * We must preserve the interpreter so we can report errors on it
7516      * later.  Note that we do not need to preserve the channel because
7517      * that is done by Tcl_NotifyChannel before calling channel handlers.
7518      */
7519     
7520     Tcl_Preserve((ClientData) interp);
7521     result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);
7522 
7523     /*
7524      * On error, cause a background error and remove the channel handler
7525      * and the script record.
7526      *
7527      * NOTE: Must delete channel handler before causing the background error
7528      * because the background error may want to reinstall the handler.
7529      */
7530     
7531     if (result != TCL_OK) {
7532   if (chanPtr->typePtr != NULL) {
7533       DeleteScriptRecord(interp, chanPtr, mask);
7534   }
7535         Tcl_BackgroundError(interp);
7536     }
7537     Tcl_Release((ClientData) interp);
7538 }
int TclCopyChannel (Tcl_Interp * interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj * cmdPtr)

Definition at line 7662 of file tclIO.c.
References CopyState::bufSize, ChannelState::bufSize, CHANNEL_LINEBUFFERED, CHANNEL_NONBLOCKING, CHANNEL_UNBUFFERED, ckalloc, CopyState::cmdPtr, CopyData(), ChannelState::csPtr, ChannelState::flags, CopyState::interp, NULL, CopyState::readFlags, CopyState::readPtr, SetBlockMode(), Channel::state, TCL_ERROR, Tcl_GetChannelName(), Tcl_GetObjResult(), Tcl_IncrRefCount, TCL_MODE_BLOCKING, TCL_MODE_NONBLOCKING, TCL_OK, CopyState::toRead, CopyState::total, CopyState::writeFlags, and CopyState::writePtr.
Referenced by Tcl_FcopyObjCmd(), and TclCrossFilesystemCopy().7668 {
7669     Channel *inPtr = (Channel *) inChan;
7670     Channel *outPtr = (Channel *) outChan;
7671     ChannelState *inStatePtr, *outStatePtr;
7672     int readFlags, writeFlags;
7673     CopyState *csPtr;
7674     int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;
7675 
7676     inStatePtr  = inPtr->state;
7677     outStatePtr = outPtr->state;
7678 
7679     if (inStatePtr->csPtr) {
7680   if (interp) {
7681       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
7682         Tcl_GetChannelName(inChan), "\" is busy", NULL);
7683   }
7684   return TCL_ERROR;
7685     }
7686     if (outStatePtr->csPtr) {
7687   if (interp) {
7688       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
7689         Tcl_GetChannelName(outChan), "\" is busy", NULL);
7690   }
7691   return TCL_ERROR;
7692     }
7693 
7694     readFlags = inStatePtr->flags;
7695     writeFlags  = outStatePtr->flags;
7696 
7697     /*
7698      * Set up the blocking mode appropriately.  Background copies need
7699      * non-blocking channels.  Foreground copies need blocking channels.
7700      * If there is an error, restore the old blocking mode.
7701      */
7702 
7703     if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
7704   if (SetBlockMode(interp, inPtr,
7705     nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)
7706     != TCL_OK) {
7707       return TCL_ERROR;
7708   }
7709     }     
7710     if (inPtr != outPtr) {
7711   if (nonBlocking != (writeFlags & CHANNEL_NONBLOCKING)) {
7712       if (SetBlockMode(NULL, outPtr,
7713         nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)
7714         != TCL_OK) {
7715     if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
7716         SetBlockMode(NULL, inPtr,
7717           (readFlags & CHANNEL_NONBLOCKING)
7718           ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
7719         return TCL_ERROR;
7720     }
7721       }
7722   }
7723     }
7724 
7725     /*
7726      * Make sure the output side is unbuffered.
7727      */
7728 
7729     outStatePtr->flags = (outStatePtr->flags & ~(CHANNEL_LINEBUFFERED))
7730   | CHANNEL_UNBUFFERED;
7731 
7732     /*
7733      * Allocate a new CopyState to maintain info about the current copy in
7734      * progress.  This structure will be deallocated when the copy is
7735      * completed.
7736      */
7737 
7738     csPtr = (CopyState*) ckalloc(sizeof(CopyState) + inStatePtr->bufSize);
7739     csPtr->bufSize    = inStatePtr->bufSize;
7740     csPtr->readPtr    = inPtr;
7741     csPtr->writePtr   = outPtr;
7742     csPtr->readFlags  = readFlags;
7743     csPtr->writeFlags = writeFlags;
7744     csPtr->toRead     = toRead;
7745     csPtr->total      = 0;
7746     csPtr->interp     = interp;
7747     if (cmdPtr) {
7748   Tcl_IncrRefCount(cmdPtr);
7749     }
7750     csPtr->cmdPtr = cmdPtr;
7751     inStatePtr->csPtr = csPtr;
7752     outStatePtr->csPtr = csPtr;
7753 
7754     /*
7755      * Start copying data between the channels.
7756      */
7757 
7758     return CopyData(csPtr, 0);
7759 }
void TclFinalizeIOSubsystem ()

Definition at line 207 of file tclIO.c.
References CHANNEL_DEAD, dataKey, ThreadSpecificData::firstCSPtr, NULL, ThreadSpecificData::stderrChannel, ThreadSpecificData::stdinChannel, ThreadSpecificData::stdoutChannel, Tcl_Close(), TCL_CLOSE2PROC, Tcl_Flush(), Tcl_Preserve(), Tcl_Release(), Tcl_SetChannelOption(), TCL_TSD_INIT, TclpFinalizePipes(), TclpFinalizeSockets(), and void().
Referenced by Tcl_FinalizeThread().208 {
209     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
210     Channel *chanPtr;     /* Iterates over open channels. */
211     ChannelState *nextCSPtr;    /* Iterates over open channels. */
212     ChannelState *statePtr;   /* state of channel stack */
213 
214     /*
215      * Walk all channel state structures known to this thread and
216      * close corresponding channels.
217      */
218 
219     for (statePtr = tsdPtr->firstCSPtr; statePtr != (ChannelState *) NULL;
220    statePtr = nextCSPtr) {
221   chanPtr = statePtr->topChanPtr;
222 
223         /*
224          * Set the channel back into blocking mode to ensure that we wait
225          * for all data to flush out.
226          */
227 
228         (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
229                 "-blocking", "on");
230 
231         if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
232                 (chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
233                 (chanPtr == (Channel *) tsdPtr->stderrChannel)) {
234             /*
235              * Decrement the refcount which was earlier artificially bumped
236              * up to keep the channel from being closed.
237              */
238 
239             statePtr->refCount--;
240         }
241 
242   /*
243    * Preserve statePtr from disappearing until we can get the
244    * nextCSPtr below.
245    */
246 
247   Tcl_Preserve(statePtr);
248 
249         if (statePtr->refCount <= 0) {
250 
251       /*
252              * Close it only if the refcount indicates that the channel is not
253              * referenced from any interpreter. If it is, that interpreter will
254              * close the channel when it gets destroyed.
255              */
256 
257             (void) Tcl_Close((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
258 
259         } else {
260 
261             /*
262              * The refcount is greater than zero, so flush the channel.
263              */
264 
265             Tcl_Flush((Tcl_Channel) chanPtr);
266 
267             /*
268              * Call the device driver to actually close the underlying
269              * device for this channel.
270              */
271 
272       if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
273     (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
274       (Tcl_Interp *) NULL);
275       } else {
276     (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
277       (Tcl_Interp *) NULL, 0);
278       }
279 
280             /*
281              * Finally, we clean up the fields in the channel data structure
282              * since all of them have been deleted already. We mark the
283              * channel with CHANNEL_DEAD to prevent any further IO operations
284              * on it.
285              */
286 
287             chanPtr->instanceData = (ClientData) NULL;
288             statePtr->flags |= CHANNEL_DEAD;
289         }
290 
291   /*
292    * We look for the next pointer now in case we had one closed on up
293    * during the current channel's closeproc (eg: rechan extension)
294    */
295 
296   nextCSPtr = statePtr->nextCSPtr;
297   Tcl_Release(statePtr);
298     }
299 
300     TclpFinalizeSockets();
301     TclpFinalizePipes();
302 }
void TclInitIOSubsystem ()

Definition at line 178 of file tclIO.c.
References dataKey, TCL_TSD_INIT, and void().
Referenced by TclInitSubsystems().179 {
180     /*
181      * By fetching thread local storage we take care of
182      * allocating it for each thread.
183      */
184     (void) TCL_TSD_INIT(&dataKey);
185 }   
static int TranslateInputEOL (ChannelState * statePtr, char * dstStart, CONST char * srcStart, int * dstLenPtr, int * srcLenPtr) [static]

Definition at line 5000 of file tclIO.c.
References CONST, NULL, size_t(), TCL_TRANSLATE_LF, and VOID.
Referenced by ReadBytes(), and ReadChars().5014 {
5015     int dstLen, srcLen, inEofChar;
5016     CONST char *eof;
5017 
5018     dstLen = *dstLenPtr;
5019 
5020     eof = NULL;
5021     inEofChar = statePtr->inEofChar;
5022     if (inEofChar != '\0') {
5023   /*
5024    * Find EOF in translated buffer then compress out the EOL.  The
5025    * source buffer may be much longer than the destination buffer --
5026    * we only want to return EOF if the EOF has been copied to the
5027    * destination buffer.
5028    */
5029 
5030   CONST char *src, *srcMax;
5031 
5032   srcMax = srcStart + *srcLenPtr;
5033   for (src = srcStart; src < srcMax; src++) {
5034       if (*src == inEofChar) {
5035     eof = src;
5036     srcLen = src - srcStart;
5037     if (srcLen < dstLen) {
5038         dstLen = srcLen;
5039     }
5040     *srcLenPtr = srcLen;
5041     break;
5042       }
5043   }
5044     }
5045     switch (statePtr->inputTranslation) {
5046   case TCL_TRANSLATE_LF: {
5047       if (dstStart != srcStart) {
5048     memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);
5049       }
5050       srcLen = dstLen;
5051       break;
5052   }
5053   case TCL_TRANSLATE_CR: {
5054       char *dst, *dstEnd;
5055       
5056       if (dstStart != srcStart) {
5057     memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);
5058       }
5059       dstEnd = dstStart + dstLen;
5060       for (dst = dstStart; dst < dstEnd; dst++) {
5061     if (*dst == '\r') {
5062         *dst = '\n';
5063     }
5064       }
5065       srcLen = dstLen;
5066       break;
5067   }
5068   case TCL_TRANSLATE_CRLF: {
5069       char *dst;
5070       CONST char *src, *srcEnd, *srcMax;
5071       
5072       dst = dstStart;
5073       src = srcStart;
5074       srcEnd = srcStart + dstLen;
5075       srcMax = srcStart + *srcLenPtr;
5076 
5077       for ( ; src < srcEnd; ) {
5078     if (*src == '\r') {
5079         src++;
5080         if (src >= srcMax) {
5081       statePtr->flags |= INPUT_NEED_NL;
5082         } else if (*src == '\n') {
5083       *dst++ = *src++;
5084         } else {
5085       *dst++ = '\r';
5086         }
5087     } else {
5088         *dst++ = *src++;
5089     }
5090       }
5091       srcLen = src - srcStart;
5092       dstLen = dst - dstStart;
5093       break;
5094   }
5095   case TCL_TRANSLATE_AUTO: {
5096       char *dst;
5097       CONST char *src, *srcEnd, *srcMax;
5098 
5099       dst = dstStart;
5100       src = srcStart;
5101       srcEnd = srcStart + dstLen;
5102       srcMax = srcStart + *srcLenPtr;
5103 
5104       if ((statePtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
5105     if (*src == '\n') {
5106         src++;
5107     }
5108     statePtr->flags &= ~INPUT_SAW_CR;
5109       }
5110       for ( ; src < srcEnd; ) {
5111     if (*src == '\r') {
5112         src++;
5113         if (src >= srcMax) {
5114       statePtr->flags |= INPUT_SAW_CR;
5115         } else if (*src == '\n') {
5116       if (srcEnd < srcMax) {
5117           srcEnd++;
5118       }
5119       src++;
5120         }
5121         *dst++ = '\n';
5122     } else {
5123         *dst++ = *src++;
5124     }
5125       }
5126       srcLen = src - srcStart;
5127       dstLen = dst - dstStart;
5128       break;
5129   }
5130   default: {    /* lint. */
5131       return 0;
5132   }
5133     }
5134     *dstLenPtr = dstLen;
5135 
5136     if ((eof != NULL) && (srcStart + srcLen >= eof)) {
5137   /*
5138    * EOF character was seen in EOL translated range.  Leave current
5139    * file position pointing at the EOF character, but don't store the
5140    * EOF character in the output string.
5141    */
5142 
5143   statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
5144   statePtr->inputEncodingFlags |= TCL_ENCODING_END;
5145   statePtr->flags &= ~(INPUT_SAW_CR | INPUT_NEED_NL);
5146   return 1;
5147     }
5148 
5149     *srcLenPtr = srcLen;
5150     return 0;
5151 }
static int TranslateOutputEOL (ChannelState * statePtr, char * dst, CONST char * src, int * dstLenPtr, int * srcLenPtr) [static]

Definition at line 3352 of file tclIO.c.
References CONST, TCL_TRANSLATE_CR, TCL_TRANSLATE_CRLF, and TCL_TRANSLATE_LF.
Referenced by WriteBytes(), and WriteChars().3365 {
3366     char *dstEnd;
3367     int srcLen, newlineFound;
3368     
3369     newlineFound = 0;
3370     srcLen = *srcLenPtr;
3371 
3372     switch (statePtr->outputTranslation) {
3373   case TCL_TRANSLATE_LF: {
3374       for (dstEnd = dst + srcLen; dst < dstEnd; ) {
3375     if (*src == '\n') {
3376         newlineFound = 1;
3377     }
3378     *dst++ = *src++;
3379       }
3380       *dstLenPtr = srcLen;
3381       break;
3382   }
3383   case TCL_TRANSLATE_CR: {
3384       for (dstEnd = dst + srcLen; dst < dstEnd;) {
3385     if (*src == '\n') {
3386         *dst++ = '\r';
3387         newlineFound = 1;
3388         src++;
3389     } else {
3390         *dst++ = *src++;
3391     }
3392       }
3393       *dstLenPtr = srcLen;
3394       break;
3395   }
3396   case TCL_TRANSLATE_CRLF: {
3397       /*
3398        * Since this causes the number of bytes to grow, we
3399        * start off trying to put 'srcLen' bytes into the
3400        * output buffer, but allow it to store more bytes, as
3401        * long as there's still source bytes and room in the
3402        * output buffer.
3403        */
3404 
3405       char *dstStart, *dstMax;
3406       CONST char *srcStart;
3407       
3408       dstStart = dst;
3409       dstMax = dst + *dstLenPtr;
3410 
3411       srcStart = src;
3412       
3413       if (srcLen < *dstLenPtr) {
3414     dstEnd = dst + srcLen;
3415       } else {
3416     dstEnd = dst + *dstLenPtr;
3417       }
3418       while (dst < dstEnd) {
3419     if (*src == '\n') {
3420         if (dstEnd < dstMax) {
3421       dstEnd++;
3422         }
3423         *dst++ = '\r';
3424         newlineFound = 1;
3425     }
3426     *dst++ = *src++;
3427       }
3428       *srcLenPtr = src - srcStart;
3429       *dstLenPtr = dst - dstStart;
3430       break;
3431   }
3432   default: {
3433       break;
3434   }
3435     }
3436     return newlineFound;
3437 }
static void UpdateInterest (Channel * chanPtr) [static]

Definition at line 7048 of file tclIO.c.
References BG_FLUSH_SCHEDULED, CHANNEL_NEED_MORE_DATA, ChannelTimerProc(), NULL, Tcl_CreateTimerHandler(), TCL_EXCEPTION, TCL_READABLE, and TCL_WRITABLE.
Referenced by ChannelTimerProc(), FlushChannel(), Tcl_CreateChannelHandler(), Tcl_DeleteChannelHandler(), Tcl_NotifyChannel(), Tcl_ReadChars(), Tcl_SetChannelOption(), and Tcl_UnstackChannel().7050 {
7051     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
7052     int mask = statePtr->interestMask;
7053 
7054     /*
7055      * If there are flushed buffers waiting to be written, then
7056      * we need to watch for the channel to become writable.
7057      */
7058 
7059     if (statePtr->flags & BG_FLUSH_SCHEDULED) {
7060   mask |= TCL_WRITABLE;
7061     }
7062 
7063     /*
7064      * If there is data in the input queue, and we aren't waiting for more
7065      * data, then we need to schedule a timer so we don't block in the
7066      * notifier.  Also, cancel the read interest so we don't get duplicate
7067      * events.
7068      */
7069 
7070     if (mask & TCL_READABLE) {
7071   if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
7072     && (statePtr->inQueueHead != (ChannelBuffer *) NULL)
7073     && (statePtr->inQueueHead->nextRemoved <
7074       statePtr->inQueueHead->nextAdded)) {
7075       mask &= ~TCL_READABLE;
7076 
7077       /*
7078        * Andreas Kupries, April 11, 2003
7079        *
7080        * Some operating systems (Solaris 2.6 and higher (but not
7081        * Solaris 2.5, go figure)) generate READABLE and
7082        * EXCEPTION events when select()'ing [*] on a plain file,
7083        * even if EOF was not yet reached. This is a problem in
7084        * the following situation:
7085        *
7086        * - An extension asks to get both READABLE and EXCEPTION
7087        *   events.
7088        * - It reads data into a buffer smaller than the buffer
7089        *   used by Tcl itself.
7090        * - It does not process all events in the event queue, but
7091        *   only only one, at least in some situations.
7092        *
7093        * In that case we can get into a situation where
7094        *
7095        * - Tcl drops READABLE here, because it has data in its own
7096        *   buffers waiting to be read by the extension.
7097        * - A READABLE event is syntesized via timer.
7098        * - The OS still reports the EXCEPTION condition on the file.
7099        * - And the extension gets the EXCPTION event first, and
7100        *   handles this as EOF.
7101        *
7102        * End result ==> Premature end of reading from a file.
7103        *
7104        * The concrete example is 'Expect', and its [expect]
7105        * command (and at the C-level, deep in the bowels of
7106        * Expect, 'exp_get_next_event'. See marker 'SunOS' for
7107        * commentary in that function too).
7108        *
7109        * [*] As the Tcl notifier does. See also for marker
7110        * 'SunOS' in file 'exp_event.c' of Expect.
7111        *
7112        * Our solution here is to drop the interest in the
7113        * EXCEPTION events too. This compiles on all platforms,
7114        * and also passes the testsuite on all of them.
7115        */
7116 
7117       mask &= ~TCL_EXCEPTION;
7118 
7119       if (!statePtr->timer) {
7120     statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
7121       (ClientData) chanPtr);
7122       }
7123   }
7124     }
7125     (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask);
7126 }
static int WriteBytes (Channel * chanPtr, CONST char * src, int srcLen) [static]

Definition at line 3041 of file tclIO.c.
References AllocChannelBuffer(), ChannelBuffer::buf, ChannelBuffer::bufLength, CheckFlush(), ChannelBuffer::nextAdded, NULL, and TranslateOutputEOL().
Referenced by DoWriteChars(), and Tcl_WriteObj().3045 {
3046     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
3047     ChannelBuffer *bufPtr;
3048     char *dst;
3049     int dstMax, sawLF, savedLF, total, dstLen, toWrite;
3050     
3051     total = 0;
3052     sawLF = 0;
3053     savedLF = 0;
3054 
3055     /*
3056      * Loop over all bytes in src, storing them in output buffer with
3057      * proper EOL translation.
3058      */
3059 
3060     while (srcLen + savedLF > 0) {
3061   bufPtr = statePtr->curOutPtr;
3062   if (bufPtr == NULL) {
3063       bufPtr = AllocChannelBuffer(statePtr->bufSize);
3064       statePtr->curOutPtr = bufPtr;
3065   }
3066   dst = bufPtr->buf + bufPtr->nextAdded;
3067   dstMax = bufPtr->bufLength - bufPtr->nextAdded;
3068   dstLen = dstMax;
3069 
3070   toWrite = dstLen;
3071   if (toWrite > srcLen) {
3072       toWrite = srcLen;
3073   }
3074 
3075   if (savedLF) {
3076       /*
3077        * A '\n' was left over from last call to TranslateOutputEOL()
3078        * and we need to store it in this buffer.  If the channel is
3079        * line-based, we will need to flush it.
3080        */
3081 
3082       *dst++ = '\n';
3083       dstLen--;
3084       sawLF++;
3085   }
3086   sawLF += TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite);
3087   dstLen += savedLF;
3088   savedLF = 0;
3089 
3090   if (dstLen > dstMax) {
3091       savedLF = 1;
3092       dstLen = dstMax;
3093   }
3094   bufPtr->nextAdded += dstLen;
3095   if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
3096       return -1;
3097   }
3098   total += dstLen;
3099   src += toWrite;
3100   srcLen -= toWrite;
3101   sawLF = 0;
3102     }
3103     return total;
3104 }
static int WriteChars (Channel * chanPtr, CONST char * src, int srcLen) [static]

Definition at line 3129 of file tclIO.c.
References AllocChannelBuffer(), ChannelBuffer::buf, BUFFER_PADDING, ChannelBuffer::bufLength, CheckFlush(), EINVAL, ChannelBuffer::nextAdded, NULL, size_t(), TCL_ENCODING_END, TCL_ENCODING_START, Tcl_SetErrno(), Tcl_UtfToExternal(), TranslateOutputEOL(), and VOID.
Referenced by DoWriteChars(), Tcl_Close(), Tcl_SetChannelOption(), and Tcl_WriteObj().3133 {
3134     ChannelState *statePtr = chanPtr->state;  /* state info for channel */
3135     ChannelBuffer *bufPtr;
3136     char *dst, *stage;
3137     int saved, savedLF, sawLF, total, dstLen, stageMax, dstWrote;
3138     int stageLen, toWrite, stageRead, endEncoding, result;
3139     int consumedSomething;
3140     Tcl_Encoding encoding;
3141     char safe[BUFFER_PADDING];
3142     
3143     total = 0;
3144     sawLF = 0;
3145     savedLF = 0;
3146     saved = 0;
3147     encoding = statePtr->encoding;
3148 
3149     /*
3150      * Write the terminated escape sequence even if srcLen is 0.
3151      */
3152 
3153     endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);
3154 
3155     /*
3156      * Loop over all UTF-8 characters in src, storing them in staging buffer
3157      * with proper EOL translation.
3158      */
3159 
3160     consumedSomething = 1;
3161     while (consumedSomething && (srcLen + savedLF + endEncoding > 0)) {
3162         consumedSomething = 0;
3163   stage = statePtr->outputStage;
3164   stageMax = statePtr->bufSize;
3165   stageLen = stageMax;
3166 
3167   toWrite = stageLen;
3168   if (toWrite > srcLen) {
3169       toWrite = srcLen;
3170   }
3171 
3172   if (savedLF) {
3173       /*
3174        * A '\n' was left over from last call to TranslateOutputEOL()
3175        * and we need to store it in the staging buffer.  If the
3176        * channel is line-based, we will need to flush the output
3177        * buffer (after translating the staging buffer).
3178        */
3179       
3180       *stage++ = '\n';
3181       stageLen--;
3182       sawLF++;
3183   }
3184   sawLF += TranslateOutputEOL(statePtr, stage, src, &stageLen, &toWrite);
3185 
3186   stage -= savedLF;
3187   stageLen += savedLF;
3188   savedLF = 0;
3189 
3190   if (stageLen > stageMax) {
3191       savedLF = 1;
3192       stageLen = stageMax;
3193   }
3194   src += toWrite;
3195   srcLen -= toWrite;
3196 
3197   /*
3198    * Loop over all UTF-8 characters in staging buffer, converting them
3199    * to external encoding, storing them in output buffer.
3200    */
3201 
3202   while (stageLen + saved + endEncoding > 0) {
3203       bufPtr = statePtr->curOutPtr;
3204       if (bufPtr == NULL) {
3205     bufPtr = AllocChannelBuffer(statePtr->bufSize);
3206     statePtr->curOutPtr = bufPtr;
3207       }
3208       dst = bufPtr->buf + bufPtr->nextAdded;
3209       dstLen = bufPtr->bufLength - bufPtr->nextAdded;
3210 
3211       if (saved != 0) {
3212     /*
3213      * Here's some translated bytes left over from the last
3214      * buffer that we need to stick at the beginning of this
3215      * buffer.
3216      */
3217      
3218     memcpy((VOID *) dst, (VOID *) safe, (size_t) saved);
3219     bufPtr->nextAdded += saved;
3220     dst += saved;
3221     dstLen -= saved;
3222     saved = 0;
3223       }
3224 
3225       result = Tcl_UtfToExternal(NULL, encoding, stage, stageLen,
3226         statePtr->outputEncodingFlags,
3227         &statePtr->outputEncodingState, dst,
3228         dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL);
3229 
3230       /* Fix for SF #506297, reported by Martin Forssen
3231        * <ruric@users.sourceforge.net>.
3232        *
3233        * The encoding chosen in the script exposing the bug writes out
3234        * three intro characters when TCL_ENCODING_START is set, but does
3235        * not consume any input as TCL_ENCODING_END is cleared. As some
3236        * output was generated the enclosing loop calls UtfToExternal
3237        * again, again with START set. Three more characters in the out
3238        * and still no use of input ... To break this infinite loop we
3239        * remove TCL_ENCODING_START from the set of flags after the first
3240        * call (no condition is required, the later calls remove an unset
3241        * flag, which is a no-op). This causes the subsequent calls to
3242        * UtfToExternal to consume and convert the actual input.
3243        */
3244 
3245       statePtr->outputEncodingFlags &= ~TCL_ENCODING_START;
3246       /*
3247        * The following code must be executed only when result is not 0.
3248        */
3249       if (result && ((stageRead + dstWrote) == 0)) {
3250     /*
3251      * We have an incomplete UTF-8 character at the end of the
3252      * staging buffer.  It will get moved to the beginning of the
3253      * staging buffer followed by more bytes from src.
3254      */
3255 
3256     src -= stageLen;
3257     srcLen += stageLen;
3258     stageLen = 0;
3259     savedLF = 0;
3260     break;
3261       }
3262       bufPtr->nextAdded += dstWrote;
3263       if (bufPtr->nextAdded > bufPtr->bufLength) {
3264     /*
3265      * When translating from UTF-8 to external encoding, we
3266      * allowed the translation to produce a character that
3267      * crossed the end of the output buffer, so that we would
3268      * get a completely full buffer before flushing it.  The
3269      * extra bytes will be moved to the beginning of the next
3270      * buffer.
3271      */
3272 
3273     saved = bufPtr->nextAdded - bufPtr->bufLength;
3274     memcpy((VOID *) safe, (VOID *) (dst + dstLen), (size_t) saved);
3275     bufPtr->nextAdded = bufPtr->bufLength;
3276       }
3277       if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
3278     return -1;
3279       }
3280 
3281       total += dstWrote;
3282       stage += stageRead;
3283       stageLen -= stageRead;
3284       sawLF = 0;
3285 
3286       consumedSomething = 1;
3287 
3288       /*
3289        * If all translated characters are written to the buffer,
3290        * endEncoding is set to 0 because the escape sequence may be
3291        * output.
3292        */
3293 
3294       if ((stageLen + saved == 0) && (result == 0)) {
3295     endEncoding = 0;
3296       }
3297   }
3298     }
3299 
3300     /* If nothing was written and it happened because there was no progress
3301      * in the UTF conversion, we throw an error.
3302      */
3303 
3304     if (!consumedSomething && (total == 0)) {
3305         Tcl_SetErrno (EINVAL);
3306         return -1;
3307     }
3308     return total;
3309 }

Variable Documentation
Tcl_ThreadDataKey dataKey [static]

Definition at line 72 of file tclIO.c.

generic/tclIO.h File Reference
Classes
struct CopyState
struct ChannelBuffer
struct CloseCallback
struct EventScriptRecord
struct Channel
struct ChannelState
struct ChannelHandler
struct NextChannelHandler
struct ChannelHandlerEvent
struct GetsState
Defines
#define CHANNELBUFFER_HEADER_SIZE  (sizeof(ChannelBuffer) - 4)
#define BUFFER_PADDING  16
#define CHANNELBUFFER_DEFAULT_SIZE  (1024 * 4)
#define CHANNEL_NONBLOCKING  (1<<3)
#define CHANNEL_LINEBUFFERED  (1<<4)
#define CHANNEL_UNBUFFERED  (1<<5)
#define BUFFER_READY  (1<<6)
#define BG_FLUSH_SCHEDULED  (1<<7)
#define CHANNEL_CLOSED  (1<<8)
#define CHANNEL_EOF  (1<<9)
#define CHANNEL_STICKY_EOF  (1<<10)
#define CHANNEL_BLOCKED  (1<<11)
#define INPUT_SAW_CR  (1<<12)
#define INPUT_NEED_NL  (1<<15)
#define CHANNEL_DEAD  (1<<13)
#define CHANNEL_NEED_MORE_DATA  (1<<14)
#define CHANNEL_RAW_MODE  (1<<16)
#define CHANNEL_INCLOSE  (1<<19)

Define Documentation
#define BG_FLUSH_SCHEDULED  (1<<7)

Definition at line 258 of file tclIO.h.
Referenced by CopyData(), DeleteChannelTable(), FlushChannel(), SetBlockMode(), Tcl_NotifyChannel(), Tcl_Seek(), Tcl_UnregisterChannel(), TestChannelCmd(), and UpdateInterest().#define BUFFER_PADDING  16

Definition at line 82 of file tclIO.h.
Referenced by AllocChannelBuffer(), FilterInputBytes(), GetInput(), RecycleBuffer(), Tcl_GetsObj(), and WriteChars().#define BUFFER_READY  (1<<6)

Definition at line 253 of file tclIO.h.
Referenced by CheckFlush(), DoWrite(), FlushChannel(), Tcl_Close(), Tcl_Flush(), Tcl_OutputBuffered(), and Tcl_UnregisterChannel().#define CHANNEL_BLOCKED  (1<<11)

Definition at line 271 of file tclIO.h.
Referenced by CheckChannelErrors(), DoRead(), DoReadChars(), FilterInputBytes(), GetInput(), Tcl_InputBlocked(), Tcl_ReadRaw(), Tcl_Seek(), Tcl_SetChannelOption(), Tcl_Ungets(), and TestChannelCmd().#define CHANNEL_CLOSED  (1<<8)

Definition at line 261 of file tclIO.h.
Referenced by CheckChannelErrors(), FlushChannel(), Tcl_Close(), and Tcl_UnregisterChannel().#define CHANNEL_DEAD  (1<<13)

Definition at line 281 of file tclIO.h.
Referenced by CheckForDeadChannel(), and TclFinalizeIOSubsystem().#define CHANNEL_EOF  (1<<9)

Definition at line 264 of file tclIO.h.
Referenced by CheckChannelErrors(), CopyAndTranslateBuffer(), DoRead(), DoReadChars(), FilterInputBytes(), GetInput(), Tcl_Eof(), Tcl_ReadRaw(), Tcl_Seek(), Tcl_SetChannelOption(), Tcl_Ungets(), and TestChannelCmd().#define CHANNEL_INCLOSE  (1<<19)

Definition at line 329 of file tclIO.h.
Referenced by Tcl_Close(), and Tcl_UnregisterChannel().#define CHANNEL_LINEBUFFERED  (1<<4)

Definition at line 249 of file tclIO.h.
Referenced by CheckFlush(), DoWrite(), StopCopy(), Tcl_GetChannelOption(), Tcl_SetChannelOption(), TclCopyChannel(), and TestChannelCmd().#define CHANNEL_NEED_MORE_DATA  (1<<14)

Definition at line 288 of file tclIO.h.
Referenced by ChannelTimerProc(), CheckChannelErrors(), DoRead(), ReadChars(), Tcl_SetChannelOption(), and UpdateInterest().#define CHANNEL_NONBLOCKING  (1<<3)

Definition at line 247 of file tclIO.h.
Referenced by ChannelTimerProc(), DoRead(), DoReadChars(), FilterInputBytes(), GetInput(), PeekAhead(), SetBlockMode(), StopCopy(), Tcl_GetChannelOption(), Tcl_NotifyChannel(), Tcl_ReadRaw(), Tcl_Seek(), TclCopyChannel(), and TestChannelCmd().#define CHANNEL_RAW_MODE  (1<<16)

Definition at line 297 of file tclIO.h.
Referenced by CheckChannelErrors(), Tcl_ReadRaw(), and Tcl_WriteRaw().#define CHANNEL_STICKY_EOF  (1<<10)

Definition at line 267 of file tclIO.h.
Referenced by CheckChannelErrors(), DoRead(), Tcl_Eof(), Tcl_Seek(), Tcl_SetChannelOption(), and Tcl_Ungets().#define CHANNEL_UNBUFFERED  (1<<5)

Definition at line 251 of file tclIO.h.
Referenced by CheckFlush(), DoWrite(), StopCopy(), Tcl_GetChannelOption(), Tcl_SetChannelOption(), TclCopyChannel(), and TestChannelCmd().#define CHANNELBUFFER_DEFAULT_SIZE  (1024 * 4)

Definition at line 88 of file tclIO.h.
Referenced by Tcl_CreateChannel().#define CHANNELBUFFER_HEADER_SIZE  (sizeof(ChannelBuffer) - 4)

Definition at line 74 of file tclIO.h.
Referenced by AllocChannelBuffer().#define INPUT_NEED_NL  (1<<15)

Definition at line 278 of file tclIO.h.
Referenced by ReadBytes(), and ReadChars().#define INPUT_SAW_CR  (1<<12)

Definition at line 275 of file tclIO.h.
Referenced by CopyAndTranslateBuffer(), Tcl_GetsObj(), Tcl_Seek(), Tcl_SetChannelOption(), and TestChannelCmd().

generic/tclIOCmd.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Classes
struct AcceptCallback
Defines
#define NUM_ARGS  20
Functions
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))
int Tcl_PutsObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_FlushObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_GetsObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_ReadObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_SeekObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
int Tcl_TellObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
int Tcl_CloseObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
int Tcl_FconfigureObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
int Tcl_EofObjCmd (ClientData unused, Tcl_Interp *interp, int objc, objv)
int Tcl_ExecObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_FblockedObjCmd (ClientData unused, Tcl_Interp *interp, int objc, objv)
int Tcl_OpenObjCmd (ClientData notUsed, Tcl_Interp *interp, int objc, objv)
static void TcpAcceptCallbacksDeleteProc (ClientData clientData, Tcl_Interp *interp)
static void RegisterTcpServerInterpCleanup (Tcl_Interp *interp, AcceptCallback *acceptCallbackPtr)
static void UnregisterTcpServerInterpCleanupProc (Tcl_Interp *interp, AcceptCallback *acceptCallbackPtr)
static void AcceptCallbackProc (ClientData callbackData, Tcl_Channel chan, char *address, int port)
static void TcpServerCloseProc (ClientData callbackData)
int Tcl_SocketObjCmd (ClientData notUsed, Tcl_Interp *interp, int objc, objv)
int Tcl_FcopyObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)

Define Documentation
#define NUM_ARGS  20

Function Documentation
static void TcpServerCloseProc _ANSI_ARGS_ ((ClientData callbackData)) [static]
static void TcpAcceptCallbacksDeleteProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp)) [static]
static void RegisterTcpServerInterpCleanup _ANSI_ARGS_ ((Tcl_Interp *interp, AcceptCallback *acceptCallbackPtr)) [static]
static void AcceptCallbackProc _ANSI_ARGS_ ((ClientData callbackData, Tcl_Channel chan, char *address, int port)) [static]
static void AcceptCallbackProc (ClientData callbackData, Tcl_Channel chan, char * address, int port) [static]

Definition at line 1171 of file tclIOCmd.c.
References AcceptCallback::interp, NULL, AcceptCallback::script, Tcl_BackgroundError(), Tcl_Close(), Tcl_GetChannelName(), TCL_INTEGER_SPACE, TCL_OK, Tcl_Preserve(), Tcl_RegisterChannel(), Tcl_Release(), Tcl_UnregisterChannel(), and TclFormatInt().
Referenced by Tcl_SocketObjCmd().1180 {
1181     AcceptCallback *acceptCallbackPtr;
1182     Tcl_Interp *interp;
1183     char *script;
1184     char portBuf[TCL_INTEGER_SPACE];
1185     int result;
1186 
1187     acceptCallbackPtr = (AcceptCallback *) callbackData;
1188 
1189     /*
1190      * Check if the callback is still valid; the interpreter may have gone
1191      * away, this is signalled by setting the interp field of the callback
1192      * data to NULL.
1193      */
1194     
1195     if (acceptCallbackPtr->interp != (Tcl_Interp *) NULL) {
1196 
1197         script = acceptCallbackPtr->script;
1198         interp = acceptCallbackPtr->interp;
1199         
1200         Tcl_Preserve((ClientData) script);
1201         Tcl_Preserve((ClientData) interp);
1202 
1203   TclFormatInt(portBuf, port);
1204         Tcl_RegisterChannel(interp, chan);
1205 
1206         /*
1207          * Artificially bump the refcount to protect the channel from
1208          * being deleted while the script is being evaluated.
1209          */
1210 
1211         Tcl_RegisterChannel((Tcl_Interp *) NULL,  chan);
1212         
1213         result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
1214                 " ", address, " ", portBuf, (char *) NULL);
1215         if (result != TCL_OK) {
1216             Tcl_BackgroundError(interp);
1217       Tcl_UnregisterChannel(interp, chan);
1218         }
1219 
1220         /*
1221          * Decrement the artificially bumped refcount. After this it is
1222          * not safe anymore to use "chan", because it may now be deleted.
1223          */
1224 
1225         Tcl_UnregisterChannel((Tcl_Interp *) NULL, chan);
1226         
1227         Tcl_Release((ClientData) interp);
1228         Tcl_Release((ClientData) script);
1229     } else {
1230 
1231         /*
1232          * The interpreter has been deleted, so there is no useful
1233          * way to utilize the client socket - just close it.
1234          */
1235 
1236         Tcl_Close((Tcl_Interp *) NULL, chan);
1237     }
1238 }
static void RegisterTcpServerInterpCleanup (Tcl_Interp * interp, AcceptCallback * acceptCallbackPtr) [static]

Definition at line 1081 of file tclIOCmd.c.
References ckalloc, NULL, panic, Tcl_CreateHashEntry, Tcl_GetAssocData(), Tcl_InitHashTable(), TCL_ONE_WORD_KEYS, Tcl_SetAssocData(), Tcl_SetHashValue, TcpAcceptCallbacksDeleteProc(), and void().
Referenced by Tcl_SocketObjCmd().1088 {
1089     Tcl_HashTable *hTblPtr; /* Hash table for accept callback
1090                                  * records to smash when the interpreter
1091                                  * will be deleted. */
1092     Tcl_HashEntry *hPtr;  /* Entry for this record. */
1093     int new;      /* Is the entry new? */
1094 
1095     hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
1096             "tclTCPAcceptCallbacks",
1097             NULL);
1098     if (hTblPtr == (Tcl_HashTable *) NULL) {
1099         hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
1100         Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
1101         (void) Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
1102                 TcpAcceptCallbacksDeleteProc, (ClientData) hTblPtr);
1103     }
1104     hPtr = Tcl_CreateHashEntry(hTblPtr, (char *) acceptCallbackPtr, &new);
1105     if (!new) {
1106         panic("RegisterTcpServerCleanup: damaged accept record table");
1107     }
1108     Tcl_SetHashValue(hPtr, (ClientData) acceptCallbackPtr);
1109 }
int Tcl_CloseObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv)

Definition at line 524 of file tclIOCmd.c.
References NULL, TCL_ERROR, Tcl_GetChannel(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), TCL_OK, Tcl_SetObjLength(), Tcl_UnregisterChannel(), and Tcl_WrongNumArgs().529 {
530     Tcl_Channel chan;     /* The channel to close. */
531     char *arg;
532 
533     if (objc != 2) {
534   Tcl_WrongNumArgs(interp, 1, objv, "channelId");
535   return TCL_ERROR;
536     }
537 
538     arg = Tcl_GetString(objv[1]);
539     chan = Tcl_GetChannel(interp, arg, NULL);
540     if (chan == (Tcl_Channel) NULL) {
541   return TCL_ERROR;
542     }
543 
544     if (Tcl_UnregisterChannel(interp, chan) != TCL_OK) {
545         /*
546          * If there is an error message and it ends with a newline, remove
547          * the newline. This is done for command pipeline channels where the
548          * error output from the subprocesses is stored in interp's result.
549          *
550          * NOTE: This is likely to not have any effect on regular error
551          * messages produced by drivers during the closing of a channel,
552          * because the Tcl convention is that such error messages do not
553          * have a terminating newline.
554          */
555 
556   Tcl_Obj *resultPtr;
557   char *string;
558   int len;
559   
560   resultPtr = Tcl_GetObjResult(interp);
561   string = Tcl_GetStringFromObj(resultPtr, &len);
562         if ((len > 0) && (string[len - 1] == '\n')) {
563       Tcl_SetObjLength(resultPtr, len - 1);
564         }
565         return TCL_ERROR;
566     }
567 
568     return TCL_OK;
569 }
int Tcl_EofObjCmd (ClientData unused, Tcl_Interp * interp, int objc, objv)

Definition at line 662 of file tclIOCmd.c.
References NULL, Tcl_Eof(), TCL_ERROR, Tcl_GetChannel(), Tcl_GetObjResult(), Tcl_GetString(), TCL_OK, Tcl_SetBooleanObj(), and Tcl_WrongNumArgs().667 {
668     Tcl_Channel chan;
669     int dummy;
670     char *arg;
671 
672     if (objc != 2) {
673   Tcl_WrongNumArgs(interp, 1, objv, "channelId");
674         return TCL_ERROR;
675     }
676 
677     arg = Tcl_GetString(objv[1]);
678     chan = Tcl_GetChannel(interp, arg, &dummy);
679     if (chan == NULL) {
680   return TCL_ERROR;
681     }
682 
683     Tcl_SetBooleanObj(Tcl_GetObjResult(interp), Tcl_Eof(chan));
684     return TCL_OK;
685 }
int Tcl_ExecObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 706 of file tclIOCmd.c.
References ckalloc, ckfree, CONST, NULL, NUM_ARGS, skip(), Tcl_AppendToObj(), Tcl_Close(), Tcl_DecrRefCount, TCL_ERROR, TCL_EXACT, Tcl_GetChannelHandle(), Tcl_GetIndexFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_NewObj(), TCL_OK, Tcl_OpenCommandChannel(), Tcl_PosixError(), TCL_READABLE, Tcl_ReadChars(), Tcl_ResetResult(), Tcl_SetObjLength(), Tcl_SetObjResult(), TCL_STDERR, TCL_STDOUT, Tcl_WrongNumArgs(), and TclGetAndDetachPids().711 {
712 #ifdef MAC_TCL
713 
714     Tcl_AppendResult(interp, "exec not implemented under Mac OS",
715     (char *)NULL);
716     return TCL_ERROR;
717 
718 #else /* !MAC_TCL */
719 
720     /*
721      * This procedure generates an argv array for the string arguments. It
722      * starts out with stack-allocated space but uses dynamically-allocated
723      * storage if needed.
724      */
725 
726 #define NUM_ARGS 20
727     Tcl_Obj *resultPtr;
728     CONST char **argv;
729     char *string;
730     Tcl_Channel chan;
731     CONST char *argStorage[NUM_ARGS];
732     int argc, background, i, index, keepNewline, result, skip, length;
733     static CONST char *options[] = {
734   "-keepnewline", "--",   NULL
735     };
736     enum options {
737   EXEC_KEEPNEWLINE, EXEC_LAST
738     };
739 
740     /*
741      * Check for a leading "-keepnewline" argument.
742      */
743 
744     keepNewline = 0;
745     for (skip = 1; skip < objc; skip++) {
746   string = Tcl_GetString(objv[skip]);
747   if (string[0] != '-') {
748       break;
749   }
750   if (Tcl_GetIndexFromObj(interp, objv[skip], options, "switch",
751     TCL_EXACT, &index) != TCL_OK) {
752       return TCL_ERROR;
753   }
754   if (index == EXEC_KEEPNEWLINE) {
755       keepNewline = 1;
756   } else {
757       skip++;
758       break;
759   }
760     }
761     if (objc <= skip) {
762   Tcl_WrongNumArgs(interp, 1, objv, "?switches? arg ?arg ...?");
763   return TCL_ERROR;
764     }
765 
766     /*
767      * See if the command is to be run in background.
768      */
769 
770     background = 0;
771     string = Tcl_GetString(objv[objc - 1]);
772     if ((string[0] == '&') && (string[1] == '\0')) {
773   objc--;
774         background = 1;
775     }
776 
777     /*
778      * Create the string argument array "argv". Make sure argv is large
779      * enough to hold the argc arguments plus 1 extra for the zero
780      * end-of-argv word.
781      */
782 
783     argv = argStorage;
784     argc = objc - skip;
785     if ((argc + 1) > sizeof(argv) / sizeof(argv[0])) {
786   argv = (CONST char **) ckalloc((unsigned)(argc + 1) * sizeof(char *));
787     }
788 
789     /*
790      * Copy the string conversions of each (post option) object into the
791      * argument vector.
792      */
793 
794     for (i = 0; i < argc; i++) {
795   argv[i] = Tcl_GetString(objv[i + skip]);
796     }
797     argv[argc] = NULL;
798     chan = Tcl_OpenCommandChannel(interp, argc, argv,
799             (background ? 0 : TCL_STDOUT | TCL_STDERR));
800 
801     /*
802      * Free the argv array if malloc'ed storage was used.
803      */
804 
805     if (argv != argStorage) {
806   ckfree((char *)argv);
807     }
808 
809     if (chan == (Tcl_Channel) NULL) {
810   return TCL_ERROR;
811     }
812 
813     if (background) {
814         /*
815    * Store the list of PIDs from the pipeline in interp's result and
816    * detach the PIDs (instead of waiting for them).
817    */
818 
819         TclGetAndDetachPids(interp, chan);
820         if (Tcl_Close(interp, chan) != TCL_OK) {
821       return TCL_ERROR;
822         }
823   return TCL_OK;
824     }
825 
826     resultPtr = Tcl_NewObj();
827     if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
828   if (Tcl_ReadChars(chan, resultPtr, -1, 0) < 0) {
829       Tcl_ResetResult(interp);
830       Tcl_AppendResult(interp, "error reading output from command: ",
831         Tcl_PosixError(interp), (char *) NULL);
832       Tcl_DecrRefCount(resultPtr);
833       return TCL_ERROR;
834   }
835     }
836     /*
837      * If the process produced anything on stderr, it will have been
838      * returned in the interpreter result.  It needs to be appended to
839      * the result string.
840      */
841 
842     result = Tcl_Close(interp, chan);
843     string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
844     Tcl_AppendToObj(resultPtr, string, length);
845 
846     /*
847      * If the last character of the result is a newline, then remove
848      * the newline character.
849      */
850     
851     if (keepNewline == 0) {
852   string = Tcl_GetStringFromObj(resultPtr, &length);
853   if ((length > 0) && (string[length - 1] == '\n')) {
854       Tcl_SetObjLength(resultPtr, length - 1);
855   }
856     }
857     Tcl_SetObjResult(interp, resultPtr);
858 
859     return result;
860 #endif /* !MAC_TCL */
861 }
int Tcl_FblockedObjCmd (ClientData unused, Tcl_Interp * interp, int objc, objv)

Definition at line 883 of file tclIOCmd.c.
References NULL, TCL_ERROR, Tcl_GetChannel(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_InputBlocked(), TCL_OK, TCL_READABLE, Tcl_SetBooleanObj(), and Tcl_WrongNumArgs().888 {
889     Tcl_Channel chan;
890     int mode;
891     char *arg;
892 
893     if (objc != 2) {
894   Tcl_WrongNumArgs(interp, 1, objv, "channelId");
895         return TCL_ERROR;
896     }
897 
898     arg = Tcl_GetString(objv[1]);
899     chan = Tcl_GetChannel(interp, arg, &mode);
900     if (chan == NULL) {
901         return TCL_ERROR;
902     }
903     if ((mode & TCL_READABLE) == 0) {
904   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
905     arg, "\" wasn't opened for reading", (char *) NULL);
906         return TCL_ERROR;
907     }
908         
909     Tcl_SetBooleanObj(Tcl_GetObjResult(interp), Tcl_InputBlocked(chan));
910     return TCL_OK;
911 }
int Tcl_FconfigureObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv)

Definition at line 590 of file tclIOCmd.c.
References NULL, Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringResult(), TCL_ERROR, Tcl_GetChannel(), Tcl_GetChannelOption(), Tcl_GetString(), TCL_OK, Tcl_SetChannelOption(), and Tcl_WrongNumArgs().595 {
596     char *chanName, *optionName, *valueName;
597     Tcl_Channel chan;     /* The channel to set a mode on. */
598     int i;        /* Iterate over arg-value pairs. */
599     Tcl_DString ds;     /* DString to hold result of
600                                          * calling Tcl_GetChannelOption. */
601 
602     if ((objc < 2) || (((objc % 2) == 1) && (objc != 3))) {
603   Tcl_WrongNumArgs(interp, 1, objv,
604     "channelId ?optionName? ?value? ?optionName value?...");
605         return TCL_ERROR;
606     }
607     chanName = Tcl_GetString(objv[1]);
608     chan = Tcl_GetChannel(interp, chanName, NULL);
609     if (chan == (Tcl_Channel) NULL) {
610         return TCL_ERROR;
611     }
612     if (objc == 2) {
613         Tcl_DStringInit(&ds);
614         if (Tcl_GetChannelOption(interp, chan, (char *) NULL, &ds) != TCL_OK) {
615       Tcl_DStringFree(&ds);
616       return TCL_ERROR;
617         }
618         Tcl_DStringResult(interp, &ds);
619         return TCL_OK;
620     }
621     if (objc == 3) {
622         Tcl_DStringInit(&ds);
623   optionName = Tcl_GetString(objv[2]);
624         if (Tcl_GetChannelOption(interp, chan, optionName, &ds) != TCL_OK) {
625             Tcl_DStringFree(&ds);
626             return TCL_ERROR;
627         }
628         Tcl_DStringResult(interp, &ds);
629         return TCL_OK;
630     }
631     for (i = 3; i < objc; i += 2) {
632   optionName = Tcl_GetString(objv[i-1]);
633   valueName = Tcl_GetString(objv[i]);
634         if (Tcl_SetChannelOption(interp, chan, optionName, valueName)
635     != TCL_OK) {
636             return TCL_ERROR;
637         }
638     }
639     return TCL_OK;
640 }
int Tcl_FcopyObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 1486 of file tclIOCmd.c.
References CONST, NULL, TCL_ERROR, Tcl_GetChannel(), Tcl_GetIndexFromObj(), Tcl_GetIntFromObj(), Tcl_GetObjResult(), Tcl_GetString(), TCL_OK, TCL_READABLE, TCL_WRITABLE, Tcl_WrongNumArgs(), and TclCopyChannel().1491 {
1492     Tcl_Channel inChan, outChan;
1493     char *arg;
1494     int mode, i;
1495     int toRead, index;
1496     Tcl_Obj *cmdPtr;
1497     static CONST char* switches[] = { "-size", "-command", NULL };
1498     enum { FcopySize, FcopyCommand };
1499 
1500     if ((objc < 3) || (objc > 7) || (objc == 4) || (objc == 6)) {
1501   Tcl_WrongNumArgs(interp, 1, objv,
1502     "input output ?-size size? ?-command callback?");
1503   return TCL_ERROR;
1504     }
1505 
1506     /*
1507      * Parse the channel arguments and verify that they are readable
1508      * or writable, as appropriate.
1509      */
1510 
1511     arg = Tcl_GetString(objv[1]);
1512     inChan = Tcl_GetChannel(interp, arg, &mode);
1513     if (inChan == (Tcl_Channel) NULL) {
1514   return TCL_ERROR;
1515     }
1516     if ((mode & TCL_READABLE) == 0) {
1517   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
1518     arg, 
1519                 "\" wasn't opened for reading", (char *) NULL);
1520         return TCL_ERROR;
1521     }
1522     arg = Tcl_GetString(objv[2]);
1523     outChan = Tcl_GetChannel(interp, arg, &mode);
1524     if (outChan == (Tcl_Channel) NULL) {
1525   return TCL_ERROR;
1526     }
1527     if ((mode & TCL_WRITABLE) == 0) {
1528   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
1529     arg, 
1530                 "\" wasn't opened for writing", (char *) NULL);
1531         return TCL_ERROR;
1532     }
1533 
1534     toRead = -1;
1535     cmdPtr = NULL;
1536     for (i = 3; i < objc; i += 2) {
1537   if (Tcl_GetIndexFromObj(interp, objv[i], switches, "switch", 0,
1538     (int *) &index) != TCL_OK) {
1539       return TCL_ERROR;
1540   }
1541   switch (index) {
1542       case FcopySize:
1543     if (Tcl_GetIntFromObj(interp, objv[i+1], &toRead) != TCL_OK) {
1544         return TCL_ERROR;
1545     }
1546     break;
1547       case FcopyCommand:
1548     cmdPtr = objv[i+1];
1549     break;
1550   }
1551     }
1552 
1553     return TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr);
1554 }
int Tcl_FlushObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 169 of file tclIOCmd.c.
References NULL, TCL_ERROR, Tcl_Flush(), Tcl_GetChannel(), Tcl_GetString(), TCL_OK, Tcl_PosixError(), TCL_WRITABLE, and Tcl_WrongNumArgs().174 {
175     Tcl_Channel chan;     /* The channel to flush on. */
176     char *channelId;
177     int mode;
178 
179     if (objc != 2) {
180   Tcl_WrongNumArgs(interp, 1, objv, "channelId");
181   return TCL_ERROR;
182     }
183     channelId = Tcl_GetString(objv[1]);
184     chan = Tcl_GetChannel(interp, channelId, &mode);
185     if (chan == (Tcl_Channel) NULL) {
186   return TCL_ERROR;
187     }
188     if ((mode & TCL_WRITABLE) == 0) {
189   Tcl_AppendResult(interp, "channel \"", channelId,
190     "\" wasn't opened for writing", (char *) NULL);
191         return TCL_ERROR;
192     }
193     
194     if (Tcl_Flush(chan) != TCL_OK) {
195   Tcl_AppendResult(interp, "error flushing \"", channelId, "\": ",
196     Tcl_PosixError(interp), (char *) NULL);
197   return TCL_ERROR;
198     }
199     return TCL_OK;
200 }
int Tcl_GetsObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 221 of file tclIOCmd.c.
References NULL, Tcl_DecrRefCount, Tcl_Eof(), TCL_ERROR, Tcl_GetChannel(), Tcl_GetObjResult(), Tcl_GetsObj(), Tcl_GetString(), Tcl_InputBlocked(), TCL_LEAVE_ERR_MSG, Tcl_NewObj(), Tcl_ObjSetVar2(), TCL_OK, Tcl_PosixError(), TCL_READABLE, Tcl_ResetResult(), Tcl_SetIntObj(), Tcl_SetObjResult(), and Tcl_WrongNumArgs().226 {
227     Tcl_Channel chan;     /* The channel to read from. */
228     int lineLen;      /* Length of line just read. */
229     int mode;       /* Mode in which channel is opened. */
230     char *name;
231     Tcl_Obj *resultPtr, *linePtr;
232 
233     if ((objc != 2) && (objc != 3)) {
234   Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
235   return TCL_ERROR;
236     }
237     name = Tcl_GetString(objv[1]);
238     chan = Tcl_GetChannel(interp, name, &mode);
239     if (chan == (Tcl_Channel) NULL) {
240   return TCL_ERROR;
241     }
242     if ((mode & TCL_READABLE) == 0) {
243   Tcl_AppendResult(interp, "channel \"", name,
244     "\" wasn't opened for reading", (char *) NULL);
245         return TCL_ERROR;
246     }
247 
248     linePtr = Tcl_NewObj();
249 
250     lineLen = Tcl_GetsObj(chan, linePtr);
251     if (lineLen < 0) {
252         if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
253       Tcl_DecrRefCount(linePtr);
254       Tcl_ResetResult(interp);
255       Tcl_AppendResult(interp, "error reading \"", name, "\": ",
256         Tcl_PosixError(interp), (char *) NULL);
257             return TCL_ERROR;
258         }
259         lineLen = -1;
260     }
261     if (objc == 3) {
262   if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
263     TCL_LEAVE_ERR_MSG) == NULL) {
264       Tcl_DecrRefCount(linePtr);
265             return TCL_ERROR;
266         }
267   resultPtr = Tcl_GetObjResult(interp);
268   Tcl_SetIntObj(resultPtr, lineLen);
269         return TCL_OK;
270     } else {
271   Tcl_SetObjResult(interp, linePtr);
272     }
273     return TCL_OK;
274 }
int Tcl_OpenObjCmd (ClientData notUsed, Tcl_Interp * interp, int objc, objv)

Definition at line 932 of file tclIOCmd.c.
References ckfree, CONST, NULL, panic, TCL_ENFORCE_MODE, TCL_ERROR, Tcl_FSOpenFileChannel(), Tcl_GetChannelName(), Tcl_GetIntFromObj(), Tcl_GetString(), TCL_OK, Tcl_OpenCommandChannel(), Tcl_RegisterChannel(), Tcl_SplitList(), TCL_STDERR, TCL_STDIN, TCL_STDOUT, Tcl_WrongNumArgs(), and TclGetOpenMode().937 {
938     int pipeline, prot;
939     char *modeString, *what;
940     Tcl_Channel chan;
941 
942     if ((objc < 2) || (objc > 4)) {
943   Tcl_WrongNumArgs(interp, 1, objv, "fileName ?access? ?permissions?");
944   return TCL_ERROR;
945     }
946     prot = 0666;
947     if (objc == 2) {
948   modeString = "r";
949     } else {
950   modeString = Tcl_GetString(objv[2]);
951   if (objc == 4) {
952       if (Tcl_GetIntFromObj(interp, objv[3], &prot) != TCL_OK) {
953     return TCL_ERROR;
954       }
955   }
956     }
957 
958     pipeline = 0;
959     what = Tcl_GetString(objv[1]);
960     if (what[0] == '|') {
961   pipeline = 1;
962     }
963 
964     /*
965      * Open the file or create a process pipeline.
966      */
967 
968     if (!pipeline) {
969         chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot);
970     } else {
971 #ifdef MAC_TCL
972   Tcl_AppendResult(interp,
973     "command pipelines not supported on Macintosh OS",
974     (char *)NULL);
975   return TCL_ERROR;
976 #else
977   int mode, seekFlag, cmdObjc;
978   CONST char **cmdArgv;
979 
980         if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) {
981             return TCL_ERROR;
982         }
983 
984         mode = TclGetOpenMode(interp, modeString, &seekFlag);
985         if (mode == -1) {
986       chan = NULL;
987         } else {
988       int flags = TCL_STDERR | TCL_ENFORCE_MODE;
989       switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
990     case O_RDONLY:
991         flags |= TCL_STDOUT;
992         break;
993     case O_WRONLY:
994         flags |= TCL_STDIN;
995         break;
996     case O_RDWR:
997         flags |= (TCL_STDIN | TCL_STDOUT);
998         break;
999     default:
1000         panic("Tcl_OpenCmd: invalid mode value");
1001         break;
1002       }
1003       chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags);
1004   }
1005         ckfree((char *) cmdArgv);
1006 #endif
1007     }
1008     if (chan == (Tcl_Channel) NULL) {
1009         return TCL_ERROR;
1010     }
1011     Tcl_RegisterChannel(interp, chan);
1012     Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
1013     return TCL_OK;
1014 }
int Tcl_PutsObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 59 of file tclIOCmd.c.
References newline(), NULL, size_t(), TCL_ERROR, Tcl_GetChannel(), Tcl_GetString(), Tcl_GetStringFromObj(), TCL_OK, Tcl_PosixError(), TCL_WRITABLE, Tcl_WriteChars(), Tcl_WriteObj(), and Tcl_WrongNumArgs().64 {
65     Tcl_Channel chan;     /* The channel to puts on. */
66     Tcl_Obj *string;      /* String to write. */
67     int newline;      /* Add a newline at end? */
68     char *channelId;      /* Name of channel for puts. */
69     int result;       /* Result of puts operation. */
70     int mode;       /* Mode in which channel is opened. */
71 
72     switch (objc) {
73     case 2: /* puts $x */
74   string = objv[1];
75   newline = 1;
76   channelId = "stdout";
77   break;
78 
79     case 3: /* puts -nonewline $x  or  puts $chan $x */ 
80   if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
81       newline = 0;
82       channelId = "stdout";
83   } else {
84       newline = 1;
85       channelId = Tcl_GetString(objv[1]);
86   }
87   string = objv[2];
88   break;
89 
90     case 4: /* puts -nonewline $chan $x  or  puts $chan $x nonewline */
91   if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
92       channelId = Tcl_GetString(objv[2]);
93       string = objv[3];
94   } else {
95       /*
96        * The code below provides backwards compatibility with an
97        * old form of the command that is no longer recommended
98        * or documented.
99        */
100 
101       char *arg;
102       int length;
103 
104       arg = Tcl_GetStringFromObj(objv[3], &length);
105       if ((length != 9) || (strncmp(arg, "nonewline", (size_t) length) != 0)) {
106     Tcl_AppendResult(interp, "bad argument \"", arg,
107          "\": should be \"nonewline\"",
108          (char *) NULL);
109     return TCL_ERROR;
110       }
111       channelId = Tcl_GetString(objv[1]);
112       string = objv[2];
113   }
114   newline = 0;
115   break;
116 
117     default: /* puts  or  puts some bad number of arguments... */
118   Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
119   return TCL_ERROR;
120     }
121 
122     chan = Tcl_GetChannel(interp, channelId, &mode);
123     if (chan == (Tcl_Channel) NULL) {
124         return TCL_ERROR;
125     }
126     if ((mode & TCL_WRITABLE) == 0) {
127   Tcl_AppendResult(interp, "channel \"", channelId,
128                 "\" wasn't opened for writing", (char *) NULL);
129         return TCL_ERROR;
130     }
131 
132     result = Tcl_WriteObj(chan, string);
133     if (result < 0) {
134         goto error;
135     }
136     if (newline != 0) {
137         result = Tcl_WriteChars(chan, "\n", 1);
138         if (result < 0) {
139             goto error;
140         }
141     }
142     return TCL_OK;
143 
144     error:
145     Tcl_AppendResult(interp, "error writing \"", channelId, "\": ",
146       Tcl_PosixError(interp), (char *) NULL);
147     return TCL_ERROR;
148 }
int Tcl_ReadObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 295 of file tclIOCmd.c.
References newline(), NULL, Tcl_DecrRefCount, TCL_ERROR, Tcl_GetChannel(), Tcl_GetIntFromObj(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_NewObj(), TCL_OK, Tcl_PosixError(), TCL_READABLE, Tcl_ReadChars(), Tcl_ResetResult(), Tcl_SetObjLength(), Tcl_SetObjResult(), Tcl_WrongNumArgs(), and UCHAR.300 {
301     Tcl_Channel chan;   /* The channel to read from. */
302     int newline, i;   /* Discard newline at end? */
303     int toRead;     /* How many bytes to read? */
304     int charactersRead;   /* How many characters were read? */
305     int mode;     /* Mode in which channel is opened. */
306     char *name;
307     Tcl_Obj *resultPtr;
308 
309     if ((objc != 2) && (objc != 3)) {
310   argerror:
311   Tcl_WrongNumArgs(interp, 1, objv, "channelId ?numChars?");
312   Tcl_AppendResult(interp, " or \"", Tcl_GetString(objv[0]),
313     " ?-nonewline? channelId\"", (char *) NULL);
314   return TCL_ERROR;
315     }
316 
317     i = 1;
318     newline = 0;
319     if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
320   newline = 1;
321   i++;
322     }
323 
324     if (i == objc) {
325         goto argerror;
326     }
327 
328     name = Tcl_GetString(objv[i]);
329     chan = Tcl_GetChannel(interp, name, &mode);
330     if (chan == (Tcl_Channel) NULL) {
331   return TCL_ERROR;
332     }
333     if ((mode & TCL_READABLE) == 0) {
334   Tcl_AppendResult(interp, "channel \"", name, 
335                 "\" wasn't opened for reading", (char *) NULL);
336         return TCL_ERROR;
337     }
338     i++;  /* Consumed channel name. */
339 
340     /*
341      * Compute how many bytes to read, and see whether the final
342      * newline should be dropped.
343      */
344 
345     toRead = -1;
346     if (i < objc) {
347   char *arg;
348   
349   arg = Tcl_GetString(objv[i]);
350   if (isdigit(UCHAR(arg[0]))) { /* INTL: digit */
351       if (Tcl_GetIntFromObj(interp, objv[i], &toRead) != TCL_OK) {
352                 return TCL_ERROR;
353       }
354   } else if (strcmp(arg, "nonewline") == 0) {
355       newline = 1;
356   } else {
357       Tcl_AppendResult(interp, "bad argument \"", arg,
358         "\": should be \"nonewline\"", (char *) NULL);
359       return TCL_ERROR;
360         }
361     }
362 
363     resultPtr = Tcl_NewObj();
364     Tcl_IncrRefCount(resultPtr);
365     charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
366     if (charactersRead < 0) {
367   Tcl_ResetResult(interp);
368   Tcl_AppendResult(interp, "error reading \"", name, "\": ",
369     Tcl_PosixError(interp), (char *) NULL);
370   Tcl_DecrRefCount(resultPtr);
371   return TCL_ERROR;
372     }
373     
374     /*
375      * If requested, remove the last newline in the channel if at EOF.
376      */
377     
378     if ((charactersRead > 0) && (newline != 0)) {
379   char *result;
380   int length;
381 
382   result = Tcl_GetStringFromObj(resultPtr, &length);
383   if (result[length - 1] == '\n') {
384       Tcl_SetObjLength(resultPtr, length - 1);
385   }
386     }
387     Tcl_SetObjResult(interp, resultPtr);
388     Tcl_DecrRefCount(resultPtr);
389     return TCL_OK;
390 }
int Tcl_SeekObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv)

Definition at line 412 of file tclIOCmd.c.
References CONST, NULL, SEEK_CUR, SEEK_END, SEEK_SET, TCL_ERROR, Tcl_GetChannel(), Tcl_GetIndexFromObj(), Tcl_GetString(), Tcl_GetWideIntFromObj(), Tcl_LongAsWide, TCL_OK, Tcl_PosixError(), Tcl_Seek(), and Tcl_WrongNumArgs().417 {
418     Tcl_Channel chan;     /* The channel to tell on. */
419     Tcl_WideInt offset;     /* Where to seek? */
420     int mode;       /* How to seek? */
421     Tcl_WideInt result;     /* Of calling Tcl_Seek. */
422     char *chanName;
423     int optionIndex;
424     static CONST char *originOptions[] = {
425   "start", "current", "end", (char *) NULL
426     };
427     static int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END};
428 
429     if ((objc != 3) && (objc != 4)) {
430   Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?");
431   return TCL_ERROR;
432     }
433     chanName = Tcl_GetString(objv[1]);
434     chan = Tcl_GetChannel(interp, chanName, NULL);
435     if (chan == (Tcl_Channel) NULL) {
436   return TCL_ERROR;
437     }
438     if (Tcl_GetWideIntFromObj(interp, objv[2], &offset) != TCL_OK) {
439   return TCL_ERROR;
440     }
441     mode = SEEK_SET;
442     if (objc == 4) {
443   if (Tcl_GetIndexFromObj(interp, objv[3], originOptions, "origin", 0,
444     &optionIndex) != TCL_OK) {
445       return TCL_ERROR;
446   }
447   mode = modeArray[optionIndex];
448     }
449 
450     result = Tcl_Seek(chan, offset, mode);
451     if (result == Tcl_LongAsWide(-1)) {
452         Tcl_AppendResult(interp, "error during seek on \"", 
453     chanName, "\": ", Tcl_PosixError(interp), (char *) NULL);
454         return TCL_ERROR;
455     }
456     return TCL_OK;
457 }
int Tcl_SocketObjCmd (ClientData notUsed, Tcl_Interp * interp, int objc, objv)

Definition at line 1296 of file tclIOCmd.c.
References AcceptCallbackProc(), ckalloc, ckfree, CONST, AcceptCallback::interp, NULL, panic, RegisterTcpServerInterpCleanup(), AcceptCallback::script, Tcl_CreateCloseHandler(), TCL_ERROR, TCL_EXACT, Tcl_GetChannelName(), Tcl_GetIndexFromObj(), Tcl_GetString(), TCL_OK, Tcl_OpenTcpClient(), Tcl_OpenTcpServer(), Tcl_RegisterChannel(), TclpHasSockets(), TclSockGetPort(), and TcpServerCloseProc().1301 {
1302     static CONST char *socketOptions[] = {
1303   "-async", "-myaddr", "-myport","-server", (char *) NULL
1304     };
1305     enum socketOptions {
1306   SKT_ASYNC,      SKT_MYADDR,      SKT_MYPORT,      SKT_SERVER  
1307     };
1308     int optionIndex, a, server, port;
1309     char *arg, *copyScript, *host, *script;
1310     char *myaddr = NULL;
1311     int myport = 0;
1312     int async = 0;
1313     Tcl_Channel chan;
1314     AcceptCallback *acceptCallbackPtr;
1315     
1316     server = 0;
1317     script = NULL;
1318 
1319     if (TclpHasSockets(interp) != TCL_OK) {
1320   return TCL_ERROR;
1321     }
1322 
1323     for (a = 1; a < objc; a++) {
1324   arg = Tcl_GetString(objv[a]);
1325   if (arg[0] != '-') {
1326       break;
1327   }
1328   if (Tcl_GetIndexFromObj(interp, objv[a], socketOptions,
1329     "option", TCL_EXACT, &optionIndex) != TCL_OK) {
1330       return TCL_ERROR;
1331   }
1332   switch ((enum socketOptions) optionIndex) {
1333       case SKT_ASYNC: {
1334                 if (server == 1) {
1335                     Tcl_AppendResult(interp,
1336                             "cannot set -async option for server sockets",
1337                             (char *) NULL);
1338                     return TCL_ERROR;
1339                 }
1340                 async = 1;    
1341     break;
1342       }
1343       case SKT_MYADDR: {
1344     a++;
1345                 if (a >= objc) {
1346         Tcl_AppendResult(interp,
1347           "no argument given for -myaddr option",
1348                             (char *) NULL);
1349         return TCL_ERROR;
1350     }
1351                 myaddr = Tcl_GetString(objv[a]);
1352     break;
1353       }
1354       case SKT_MYPORT: {
1355     char *myPortName;
1356     a++;
1357                 if (a >= objc) {
1358         Tcl_AppendResult(interp,
1359           "no argument given for -myport option",
1360                             (char *) NULL);
1361         return TCL_ERROR;
1362     }
1363     myPortName = Tcl_GetString(objv[a]);
1364     if (TclSockGetPort(interp, myPortName, "tcp", &myport)
1365       != TCL_OK) {
1366         return TCL_ERROR;
1367     }
1368     break;
1369       }
1370       case SKT_SERVER: {
1371                 if (async == 1) {
1372                     Tcl_AppendResult(interp,
1373                             "cannot set -async option for server sockets",
1374                             (char *) NULL);
1375                     return TCL_ERROR;
1376                 }
1377     server = 1;
1378     a++;
1379     if (a >= objc) {
1380         Tcl_AppendResult(interp,
1381           "no argument given for -server option",
1382                             (char *) NULL);
1383         return TCL_ERROR;
1384     }
1385                 script = Tcl_GetString(objv[a]);
1386     break;
1387       }
1388       default: {
1389     panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
1390       }
1391   }
1392     }
1393     if (server) {
1394         host = myaddr;    /* NULL implies INADDR_ANY */
1395   if (myport != 0) {
1396       Tcl_AppendResult(interp, "Option -myport is not valid for servers",
1397         NULL);
1398       return TCL_ERROR;
1399   }
1400     } else if (a < objc) {
1401   host = Tcl_GetString(objv[a]);
1402   a++;
1403     } else {
1404 wrongNumArgs:
1405   Tcl_AppendResult(interp, "wrong # args: should be either:\n",
1406     Tcl_GetString(objv[0]),
1407                 " ?-myaddr addr? ?-myport myport? ?-async? host port\n",
1408     Tcl_GetString(objv[0]),
1409                 " -server command ?-myaddr addr? port",
1410                 (char *) NULL);
1411         return TCL_ERROR;
1412     }
1413 
1414     if (a == objc-1) {
1415   if (TclSockGetPort(interp, Tcl_GetString(objv[a]),
1416     "tcp", &port) != TCL_OK) {
1417       return TCL_ERROR;
1418   }
1419     } else {
1420   goto wrongNumArgs;
1421     }
1422 
1423     if (server) {
1424         acceptCallbackPtr = (AcceptCallback *) ckalloc((unsigned)
1425                 sizeof(AcceptCallback));
1426         copyScript = ckalloc((unsigned) strlen(script) + 1);
1427         strcpy(copyScript, script);
1428         acceptCallbackPtr->script = copyScript;
1429         acceptCallbackPtr->interp = interp;
1430         chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,
1431                 (ClientData) acceptCallbackPtr);
1432         if (chan == (Tcl_Channel) NULL) {
1433             ckfree(copyScript);
1434             ckfree((char *) acceptCallbackPtr);
1435             return TCL_ERROR;
1436         }
1437 
1438         /*
1439          * Register with the interpreter to let us know when the
1440          * interpreter is deleted (by having the callback set the
1441          * acceptCallbackPtr->interp field to NULL). This is to
1442          * avoid trying to eval the script in a deleted interpreter.
1443          */
1444 
1445         RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr);
1446         
1447         /*
1448          * Register a close callback. This callback will inform the
1449          * interpreter (if it still exists) that this channel does not
1450          * need to be informed when the interpreter is deleted.
1451          */
1452         
1453         Tcl_CreateCloseHandler(chan, TcpServerCloseProc,
1454                 (ClientData) acceptCallbackPtr);
1455     } else {
1456         chan = Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async);
1457         if (chan == (Tcl_Channel) NULL) {
1458             return TCL_ERROR;
1459         }
1460     }
1461     Tcl_RegisterChannel(interp, chan);            
1462     Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
1463     
1464     return TCL_OK;
1465 }
int Tcl_TellObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv)

Definition at line 478 of file tclIOCmd.c.
References NULL, TCL_ERROR, Tcl_GetChannel(), Tcl_GetObjResult(), Tcl_GetString(), TCL_OK, Tcl_SetWideIntObj(), Tcl_Tell(), and Tcl_WrongNumArgs().483 {
484     Tcl_Channel chan;     /* The channel to tell on. */
485     char *chanName;
486 
487     if (objc != 2) {
488   Tcl_WrongNumArgs(interp, 1, objv, "channelId");
489   return TCL_ERROR;
490     }
491     /*
492      * Try to find a channel with the right name and permissions in
493      * the IO channel table of this interpreter.
494      */
495     
496     chanName = Tcl_GetString(objv[1]);
497     chan = Tcl_GetChannel(interp, chanName, NULL);
498     if (chan == (Tcl_Channel) NULL) {
499   return TCL_ERROR;
500     }
501     Tcl_SetWideIntObj(Tcl_GetObjResult(interp), Tcl_Tell(chan));
502     return TCL_OK;
503 }
static void TcpAcceptCallbacksDeleteProc (ClientData clientData, Tcl_Interp * interp) [static]

Definition at line 1039 of file tclIOCmd.c.
References ckfree, AcceptCallback::interp, NULL, Tcl_DeleteHashTable(), Tcl_FirstHashEntry(), Tcl_GetHashValue, and Tcl_NextHashEntry().
Referenced by RegisterTcpServerInterpCleanup().1043 {
1044     Tcl_HashTable *hTblPtr;
1045     Tcl_HashEntry *hPtr;
1046     Tcl_HashSearch hSearch;
1047     AcceptCallback *acceptCallbackPtr;
1048 
1049     hTblPtr = (Tcl_HashTable *) clientData;
1050     for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
1051              hPtr != (Tcl_HashEntry *) NULL;
1052              hPtr = Tcl_NextHashEntry(&hSearch)) {
1053         acceptCallbackPtr = (AcceptCallback *) Tcl_GetHashValue(hPtr);
1054         acceptCallbackPtr->interp = (Tcl_Interp *) NULL;
1055     }
1056     Tcl_DeleteHashTable(hTblPtr);
1057     ckfree((char *) hTblPtr);
1058 }
static void TcpServerCloseProc (ClientData callbackData) [static]

Definition at line 1262 of file tclIOCmd.c.
References ckfree, AcceptCallback::interp, NULL, AcceptCallback::script, TCL_DYNAMIC, Tcl_EventuallyFree(), and UnregisterTcpServerInterpCleanupProc().
Referenced by Tcl_SocketObjCmd().1265 {
1266     AcceptCallback *acceptCallbackPtr;
1267             /* The actual data. */
1268 
1269     acceptCallbackPtr = (AcceptCallback *) callbackData;
1270     if (acceptCallbackPtr->interp != (Tcl_Interp *) NULL) {
1271         UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
1272                 acceptCallbackPtr);
1273     }
1274     Tcl_EventuallyFree((ClientData) acceptCallbackPtr->script, TCL_DYNAMIC);
1275     ckfree((char *) acceptCallbackPtr);
1276 }
static void UnregisterTcpServerInterpCleanupProc (Tcl_Interp * interp, AcceptCallback * acceptCallbackPtr) [static]

Definition at line 1131 of file tclIOCmd.c.
References NULL, Tcl_DeleteHashEntry(), Tcl_FindHashEntry, and Tcl_GetAssocData().
Referenced by TcpServerCloseProc().1137 {
1138     Tcl_HashTable *hTblPtr;
1139     Tcl_HashEntry *hPtr;
1140 
1141     hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
1142             "tclTCPAcceptCallbacks", NULL);
1143     if (hTblPtr == (Tcl_HashTable *) NULL) {
1144         return;
1145     }
1146     hPtr = Tcl_FindHashEntry(hTblPtr, (char *) acceptCallbackPtr);
1147     if (hPtr == (Tcl_HashEntry *) NULL) {
1148         return;
1149     }
1150     Tcl_DeleteHashEntry(hPtr);
1151 }

generic/tclIOGT.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include "tclIO.h"
Classes
struct ResultBuffer
struct TransformChannelData
Defines
#define TRANSMIT_DONT  (0)
#define TRANSMIT_DOWN  (1)
#define TRANSMIT_SELF  (2)
#define TRANSMIT_IBUF  (3)
#define TRANSMIT_NUM  (4)
#define P_PRESERVE  (1)
#define P_NO_PRESERVE  (0)
#define A_CREATE_WRITE  (UCHARP ("create/write"))
#define A_DELETE_WRITE  (UCHARP ("delete/write"))
#define A_FLUSH_WRITE  (UCHARP ("flush/write"))
#define A_WRITE  (UCHARP ("write"))
#define A_CREATE_READ  (UCHARP ("create/read"))
#define A_DELETE_READ  (UCHARP ("delete/read"))
#define A_FLUSH_READ  (UCHARP ("flush/read"))
#define A_READ  (UCHARP ("read"))
#define A_QUERY_MAXREAD  (UCHARP ("query/maxRead"))
#define A_CLEAR_READ  (UCHARP ("clear/read"))
#define CHANNEL_ASYNC  (1<<0)
#define INCREMENT  (512)
#define FLUSH_DELAY  (5)
#define UCHARP(x)  ((unsigned char*) (x))
#define NO_INTERP  ((Tcl_Interp*) NULL)
Typedefs
typedef TransformChannelData TransformChannelData
typedef ResultBuffer ResultBuffer
Functions
static int TransformBlockModeProc _ANSI_ARGS_ ((ClientData instanceData, int mode))
static int TransformCloseProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp))
static int TransformInputProc _ANSI_ARGS_ ((ClientData instanceData, char *buf, int toRead, int *errorCodePtr))
static int TransformOutputProc _ANSI_ARGS_ ((ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr))
static int TransformSeekProc _ANSI_ARGS_ ((ClientData instanceData, long offset, int mode, int *errorCodePtr))
static int TransformSetOptionProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, CONST char *value))
static int TransformGetOptionProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, Tcl_DString *dsPtr))
static int TransformGetFileHandleProc _ANSI_ARGS_ ((ClientData instanceData, int direction, ClientData *handlePtr))
static Tcl_WideInt TransformWideSeekProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCodePtr))
static void TransformChannelHandlerTimer _ANSI_ARGS_ ((ClientData clientData))
static int ExecuteCallback _ANSI_ARGS_ ((TransformChannelData *ctrl, Tcl_Interp *interp, unsigned char *op, unsigned char *buf, int bufLen, int transmit, int preserve))
static void ResultClear _ANSI_ARGS_ ((ResultBuffer *r))
static int ResultCopy _ANSI_ARGS_ ((ResultBuffer *r, unsigned char *buf, int toRead))
static void ResultAdd _ANSI_ARGS_ ((ResultBuffer *r, unsigned char *buf, int toWrite))
int TclChannelTransform (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr)
static int ExecuteCallback (TransformChannelData *dataPtr, Tcl_Interp *interp, unsigned char *op, unsigned char *buf, int bufLen, int transmit, int preserve)
static int TransformBlockModeProc (ClientData instanceData, int mode)
static int TransformCloseProc (ClientData instanceData, Tcl_Interp *interp)
static int TransformInputProc (ClientData instanceData, char *buf, int toRead, int *errorCodePtr)
static int TransformOutputProc (ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr)
static int TransformSeekProc (ClientData instanceData, long offset, int mode, int *errorCodePtr)
static Tcl_WideInt TransformWideSeekProc (ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCodePtr)
static int TransformSetOptionProc (ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, CONST char *value)
static int TransformGetOptionProc (ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, Tcl_DString *dsPtr)
static void TransformWatchProc (ClientData instanceData, int mask)
static int TransformGetFileHandleProc (ClientData instanceData, int direction, ClientData *handlePtr)
static int TransformNotifyProc (ClientData clientData, int mask)
static void TransformChannelHandlerTimer (ClientData clientData)
static void ResultClear (ResultBuffer *r)
static void ResultInit (ResultBuffer *r)
static int ResultLength (ResultBuffer *r)
static int ResultCopy (ResultBuffer *r, unsigned char *buf, int toRead)
static void ResultAdd (ResultBuffer *r, unsigned char *buf, int toWrite)
Variables
static Tcl_ChannelType transformChannelType

Define Documentation
#define A_CLEAR_READ  (UCHARP ("clear/read"))

Definition at line 111 of file tclIOGT.c.
Referenced by TransformSeekProc(), and TransformWideSeekProc().#define A_CREATE_READ  (UCHARP ("create/read"))

Definition at line 105 of file tclIOGT.c.
Referenced by TclChannelTransform().#define A_CREATE_WRITE  (UCHARP ("create/write"))

Definition at line 100 of file tclIOGT.c.
Referenced by TclChannelTransform().#define A_DELETE_READ  (UCHARP ("delete/read"))

Definition at line 106 of file tclIOGT.c.
Referenced by TransformCloseProc().#define A_DELETE_WRITE  (UCHARP ("delete/write"))

Definition at line 101 of file tclIOGT.c.
Referenced by TclChannelTransform(), and TransformCloseProc().#define A_FLUSH_READ  (UCHARP ("flush/read"))

Definition at line 107 of file tclIOGT.c.
Referenced by TransformCloseProc(), and TransformInputProc().#define A_FLUSH_WRITE  (UCHARP ("flush/write"))

Definition at line 102 of file tclIOGT.c.
Referenced by TransformCloseProc(), TransformSeekProc(), and TransformWideSeekProc().#define A_QUERY_MAXREAD  (UCHARP ("query/maxRead"))

Definition at line 110 of file tclIOGT.c.
Referenced by TransformInputProc().#define A_READ  (UCHARP ("read"))

Definition at line 108 of file tclIOGT.c.
Referenced by TransformInputProc().#define A_WRITE  (UCHARP ("write"))

Definition at line 103 of file tclIOGT.c.
Referenced by TransformOutputProc().#define CHANNEL_ASYNC  (1<<0)

Definition at line 154 of file tclIOGT.c.
Referenced by TclChannelTransform(), TransformBlockModeProc(), and TransformInputProc().#define FLUSH_DELAY  (5)

Definition at line 178 of file tclIOGT.c.
Referenced by TransformWatchProc().#define INCREMENT  (512)

Definition at line 171 of file tclIOGT.c.
Referenced by ResultAdd().#define NO_INTERP  ((Tcl_Interp*) NULL)

Definition at line 185 of file tclIOGT.c.
Referenced by ExecuteCallback(), TclChannelTransform(), TransformInputProc(), TransformOutputProc(), TransformSeekProc(), and TransformWideSeekProc().#define P_NO_PRESERVE  (0)

Definition at line 93 of file tclIOGT.c.
Referenced by TclChannelTransform(), TransformOutputProc(), TransformSeekProc(), and TransformWideSeekProc().#define P_PRESERVE  (1)

Definition at line 92 of file tclIOGT.c.
Referenced by TransformInputProc().#define TRANSMIT_DONT  (0)

Definition at line 82 of file tclIOGT.c.
Referenced by ExecuteCallback(), TclChannelTransform(), TransformCloseProc(), TransformSeekProc(), and TransformWideSeekProc().#define TRANSMIT_DOWN  (1)

Definition at line 83 of file tclIOGT.c.
Referenced by ExecuteCallback(), TransformCloseProc(), TransformOutputProc(), TransformSeekProc(), and TransformWideSeekProc().#define TRANSMIT_IBUF  (3)

Definition at line 85 of file tclIOGT.c.
Referenced by ExecuteCallback(), TransformCloseProc(), and TransformInputProc().#define TRANSMIT_NUM  (4)

Definition at line 86 of file tclIOGT.c.
Referenced by ExecuteCallback(), and TransformInputProc().#define TRANSMIT_SELF  (2)

Definition at line 84 of file tclIOGT.c.
Referenced by ExecuteCallback().#define UCHARP(x)  ((unsigned char*) (x))

Definition at line 184 of file tclIOGT.c.
Referenced by ResultAdd(), ResultClear(), ResultInit(), TransformInputProc(), and TransformOutputProc().
Typedef Documentation
typedef struct ResultBuffer ResultBuffer

Definition at line 117 of file tclIOGT.c.typedef struct TransformChannelData TransformChannelData

Definition at line 69 of file tclIOGT.c.
Function Documentation
static void ResultAdd _ANSI_ARGS_ ((ResultBuffer *r, unsigned char *buf, int toWrite)) [static]
static int ResultCopy _ANSI_ARGS_ ((ResultBuffer *r, unsigned char *buf, int toRead)) [static]
static void ResultClear _ANSI_ARGS_ ((ResultBuffer *r)) [static]
static int ExecuteCallback _ANSI_ARGS_ ((TransformChannelData *ctrl, Tcl_Interp *interp, unsigned char *op, unsigned char *buf, int bufLen, int transmit, int preserve)) [static]
static void TransformChannelHandlerTimer _ANSI_ARGS_ ((ClientData clientData)) [static]
static Tcl_WideInt TransformWideSeekProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCodePtr)) [static]
static int TransformGetFileHandleProc _ANSI_ARGS_ ((ClientData instanceData, int direction, ClientData *handlePtr)) [static]
static int TransformGetOptionProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, Tcl_DString *dsPtr)) [static]
static int TransformSetOptionProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, CONST char *value)) [static]
static int TransformSeekProc _ANSI_ARGS_ ((ClientData instanceData, long offset, int mode, int *errorCodePtr)) [static]
static int TransformOutputProc _ANSI_ARGS_ ((ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr)) [static]
static int TransformInputProc _ANSI_ARGS_ ((ClientData instanceData, char *buf, int toRead, int *errorCodePtr)) [static]
static int TransformCloseProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp)) [static]
static int TransformBlockModeProc _ANSI_ARGS_ ((ClientData instanceData, int mode)) [static]
static int ExecuteCallback (TransformChannelData* dataPtr, Tcl_Interp* interp, unsigned char* op, unsigned char* buf, int bufLen, int transmit, int preserve) [static]

Definition at line 363 of file tclIOGT.c.
References cleanup(), NO_INTERP, NULL, ResultAdd(), Tcl_DecrRefCount, Tcl_DuplicateObj(), TCL_ERROR, TCL_EVAL_GLOBAL, Tcl_EvalObjEx(), Tcl_GetByteArrayFromObj(), Tcl_GetIntFromObj(), Tcl_GetObjResult(), Tcl_GetStackedChannel(), Tcl_IncrRefCount, Tcl_ListObjAppendElement(), Tcl_NewByteArrayObj(), Tcl_NewStringObj(), TCL_OK, Tcl_ResetResult(), Tcl_RestoreResult(), Tcl_SaveResult(), Tcl_SetObjResult(), Tcl_WriteRaw(), TRANSMIT_DONT, TRANSMIT_DOWN, TRANSMIT_IBUF, TRANSMIT_NUM, and TRANSMIT_SELF.
Referenced by TclChannelTransform(), TransformCloseProc(), TransformInputProc(), TransformOutputProc(), TransformSeekProc(), and TransformWideSeekProc().375 {
376     /*
377      * Step 1, create the complete command to execute. Do this by appending
378      * operation and buffer to operate upon to a copy of the callback
379      * definition. We *cannot* create a list containing 3 objects and then use
380      * 'Tcl_EvalObjv', because the command may contain additional prefixed
381      * arguments. Feather's curried commands would come in handy here.
382      */
383 
384     Tcl_Obj* resObj;        /* See below, switch (transmit) */
385     int resLen;
386     unsigned char* resBuf;
387     Tcl_SavedResult ciSave;
388     int res = TCL_OK;
389     Tcl_Obj* command = Tcl_DuplicateObj (dataPtr->command);
390     Tcl_Obj* temp;
391 
392     if (preserve) {
393   Tcl_SaveResult (dataPtr->interp, &ciSave);
394     }
395 
396     if (command == (Tcl_Obj*) NULL) {
397         /* Memory allocation problem */
398         res = TCL_ERROR;
399         goto cleanup;
400     }
401 
402     Tcl_IncrRefCount(command);
403 
404     temp = Tcl_NewStringObj((char*) op, -1);
405 
406     if (temp == (Tcl_Obj*) NULL) {
407         /* Memory allocation problem */
408         res = TCL_ERROR;
409         goto cleanup;
410     }
411 
412     res = Tcl_ListObjAppendElement(dataPtr->interp, command, temp);
413 
414     if (res != TCL_OK)
415   goto cleanup;
416 
417     /*
418      * Use a byte-array to prevent the misinterpretation of binary data
419      * coming through as UTF while at the tcl level.
420      */
421 
422     temp = Tcl_NewByteArrayObj(buf, bufLen);
423 
424     if (temp == (Tcl_Obj*) NULL) {
425         /* Memory allocation problem */
426   res = TCL_ERROR;
427         goto cleanup;
428     }
429 
430     res = Tcl_ListObjAppendElement (dataPtr->interp, command, temp);
431 
432     if (res != TCL_OK)
433         goto cleanup;
434 
435     /*
436      * Step 2, execute the command at the global level of the interpreter
437      * used to create the transformation. Destroy the command afterward.
438      * If an error occured and the current interpreter is defined and not
439      * equal to the interpreter for the callback, then copy the error
440      * message into current interpreter. Don't copy if in preservation mode.
441      */
442 
443     res = Tcl_EvalObjEx(dataPtr->interp, command, TCL_EVAL_GLOBAL);
444     Tcl_DecrRefCount (command);
445     command = (Tcl_Obj*) NULL;
446 
447     if ((res != TCL_OK) && (interp != NO_INTERP) &&
448       (dataPtr->interp != interp) && !preserve) {
449         Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));
450   return res;
451     }
452 
453     /*
454      * Step 3, transmit a possible conversion result to the underlying
455      * channel, or ourselves.
456      */
457 
458     switch (transmit) {
459   case TRANSMIT_DONT:
460       /* nothing to do */
461       break;
462 
463   case TRANSMIT_DOWN:
464       resObj = Tcl_GetObjResult(dataPtr->interp);
465       resBuf = (unsigned char*) Tcl_GetByteArrayFromObj(resObj, &resLen);
466       Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self),
467         (char*) resBuf, resLen);
468       break;
469 
470   case TRANSMIT_SELF:
471       resObj = Tcl_GetObjResult (dataPtr->interp);
472       resBuf = (unsigned char*) Tcl_GetByteArrayFromObj(resObj, &resLen);
473       Tcl_WriteRaw(dataPtr->self, (char*) resBuf, resLen);
474       break;
475 
476   case TRANSMIT_IBUF:
477       resObj = Tcl_GetObjResult (dataPtr->interp);
478       resBuf = (unsigned char*) Tcl_GetByteArrayFromObj(resObj, &resLen);
479       ResultAdd(&dataPtr->result, resBuf, resLen);
480       break;
481 
482   case TRANSMIT_NUM:
483       /* Interpret result as integer number */
484       resObj = Tcl_GetObjResult (dataPtr->interp);
485       Tcl_GetIntFromObj(dataPtr->interp, resObj, &dataPtr->maxRead);
486       break;
487     }
488 
489     Tcl_ResetResult(dataPtr->interp);
490 
491     if (preserve) {
492   Tcl_RestoreResult(dataPtr->interp, &ciSave);
493     }
494 
495     return res;
496 
497     cleanup:
498     if (preserve) {
499   Tcl_RestoreResult(dataPtr->interp, &ciSave);
500     }
501 
502     if (command != (Tcl_Obj*) NULL) {
503         Tcl_DecrRefCount(command);
504     }
505 
506     return res;
507 }
static void ResultAdd (ResultBuffer* r, unsigned char* buf, int toWrite) [static]

Definition at line 1431 of file tclIOGT.c.
References ckalloc, ckrealloc, INCREMENT, size_t(), and UCHARP.
Referenced by ExecuteCallback().1435 {
1436     if ((r->used + toWrite) > r->allocated) {
1437         /* Extension of the internal buffer is required.
1438    */
1439 
1440         if (r->allocated == 0) {
1441       r->allocated = toWrite + INCREMENT;
1442       r->buf       = UCHARP (ckalloc((unsigned) r->allocated));
1443   } else {
1444       r->allocated += toWrite + INCREMENT;
1445       r->buf        = UCHARP (ckrealloc((char*) r->buf,
1446         (unsigned) r->allocated));
1447   }
1448     }
1449 
1450     /* now copy data */
1451     memcpy(r->buf + r->used, buf, (size_t) toWrite);
1452     r->used += toWrite;
1453 }
static void ResultClear (ResultBuffer* r) [static]

Definition at line 1285 of file tclIOGT.c.
References ckfree, NULL, UCHARP, and ResultBuffer::used.
Referenced by TclChannelTransform(), TransformCloseProc(), TransformSeekProc(), and TransformWideSeekProc().1287 {
1288     r->used = 0;
1289 
1290     if (r->allocated) {
1291         ckfree((char*) r->buf);
1292   r->buf       = UCHARP (NULL);
1293   r->allocated = 0;
1294     }
1295 }
static int ResultCopy (ResultBuffer* r, unsigned char* buf, int toRead) [static]

Definition at line 1368 of file tclIOGT.c.
References size_t(), and VOID.
Referenced by TransformInputProc().1372 {
1373     if (r->used == 0) {
1374         /* Nothing to copy in the case of an empty buffer.
1375    */
1376 
1377         return 0;
1378     }
1379 
1380     if (r->used == toRead) {
1381         /* We have just enough. Copy everything to the caller.
1382    */
1383 
1384         memcpy ((VOID*) buf, (VOID*) r->buf, (size_t) toRead);
1385   r->used = 0;
1386   return toRead;
1387     }
1388 
1389     if (r->used > toRead) {
1390         /* The internal buffer contains more than requested.
1391    * Copy the requested subset to the caller, and shift
1392    * the remaining bytes down.
1393    */
1394 
1395         memcpy  ((VOID*) buf,    (VOID*) r->buf,            (size_t) toRead);
1396   memmove ((VOID*) r->buf, (VOID*) (r->buf + toRead),
1397     (size_t) r->used - toRead);
1398 
1399   r->used -= toRead;
1400   return toRead;
1401     }
1402 
1403     /* There is not enough in the buffer to satisfy the caller, so
1404      * take everything.
1405      */
1406 
1407     memcpy((VOID*) buf, (VOID*) r->buf, (size_t) r->used);
1408     toRead  = r->used;
1409     r->used = 0;
1410     return toRead;
1411 }
static void ResultInit (ResultBuffer* r) [static]

Definition at line 1316 of file tclIOGT.c.
References NULL, UCHARP, and ResultBuffer::used.
Referenced by TclChannelTransform().1318 {
1319     r->used      = 0;
1320     r->allocated = 0;
1321     r->buf       = UCHARP (NULL);
1322 }
static int ResultLength (ResultBuffer* r) [static]

Definition at line 1341 of file tclIOGT.c.
References ResultBuffer::used.
Referenced by TransformChannelHandlerTimer(), TransformInputProc(), and TransformWatchProc().1343 {
1344     return r->used;
1345 }
int TclChannelTransform (Tcl_Interp	* interp, Tcl_Channel chan, Tcl_Obj	* cmdObjPtr)

Definition at line 247 of file tclIOGT.c.
References A_CREATE_READ, A_CREATE_WRITE, A_DELETE_WRITE, CHANNEL_ASYNC, ckalloc, ckfree, TransformChannelData::command, ExecuteCallback(), TransformChannelData::flags, TransformChannelData::interp, TransformChannelData::maxRead, TransformChannelData::mode, NO_INTERP, NULL, P_NO_PRESERVE, TransformChannelData::readIsFlushed, TransformChannelData::result, ResultClear(), ResultInit(), TransformChannelData::self, Channel::state, Tcl_DecrRefCount, Tcl_DStringFree(), Tcl_DStringInit(), TCL_ERROR, Tcl_GetChannelName(), Tcl_GetChannelOption(), Tcl_IncrRefCount, TCL_OK, TCL_READABLE, Tcl_StackChannel(), Tcl_UnstackChannel(), TCL_WRITABLE, TransformChannelData::timer, transformChannelType, TRANSMIT_DONT, VOID, and TransformChannelData::watchMask.
Referenced by TestChannelCmd().251 {
252     Channel     *chanPtr; /* The actual channel. */
253     ChannelState    *statePtr;  /* state info for channel */
254     int       mode;   /* rw mode of the channel */
255     TransformChannelData  *dataPtr;
256     int       res;
257     Tcl_DString     ds;
258 
259     if (chan == (Tcl_Channel) NULL) {
260   return TCL_ERROR;
261     }
262     chanPtr = (Channel *) chan;
263     statePtr  = chanPtr->state;
264     chanPtr = statePtr->topChanPtr;
265     chan  = (Tcl_Channel) chanPtr;
266     mode  = (statePtr->flags & (TCL_READABLE|TCL_WRITABLE));
267 
268     /*
269      * Now initialize the transformation state and stack it upon the
270      * specified channel. One of the necessary things to do is to
271      * retrieve the blocking regime of the underlying channel and to
272      * use the same for us too.
273      */
274 
275     dataPtr = (TransformChannelData*) ckalloc(sizeof(TransformChannelData));
276 
277     Tcl_DStringInit (&ds);
278     Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
279 
280     dataPtr->readIsFlushed = 0;
281     dataPtr->flags  = 0;
282 
283     if (ds.string[0] == '0') {
284   dataPtr->flags |= CHANNEL_ASYNC;
285     }
286 
287     Tcl_DStringFree (&ds);
288 
289     dataPtr->self = chan;
290     dataPtr->watchMask  = 0;
291     dataPtr->mode = mode;
292     dataPtr->timer  = (Tcl_TimerToken) NULL;
293     dataPtr->maxRead  = 4096; /* Initial value not relevant */
294     dataPtr->interp = interp;
295     dataPtr->command  = cmdObjPtr;
296 
297     Tcl_IncrRefCount(dataPtr->command);
298 
299     ResultInit(&dataPtr->result);
300 
301     dataPtr->self = Tcl_StackChannel(interp, &transformChannelType,
302       (ClientData) dataPtr, mode, chan);
303     if (dataPtr->self == (Tcl_Channel) NULL) {
304   Tcl_AppendResult(interp, "\nfailed to stack channel \"",
305     Tcl_GetChannelName(chan), "\"", (char *) NULL);
306 
307   Tcl_DecrRefCount(dataPtr->command);
308   ResultClear(&dataPtr->result);
309   ckfree((VOID *) dataPtr);
310   return TCL_ERROR;
311     }
312 
313     /*
314      * At last initialize the transformation at the script level.
315      */
316 
317     if (dataPtr->mode & TCL_WRITABLE) {
318   res = ExecuteCallback (dataPtr, NO_INTERP, A_CREATE_WRITE,
319     NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
320 
321   if (res != TCL_OK) {
322       Tcl_UnstackChannel(interp, chan);
323       return TCL_ERROR;
324   }
325     }
326 
327     if (dataPtr->mode & TCL_READABLE) {
328   res = ExecuteCallback (dataPtr, NO_INTERP, A_CREATE_READ,
329     NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
330 
331   if (res != TCL_OK) {
332       ExecuteCallback (dataPtr, NO_INTERP, A_DELETE_WRITE,
333         NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
334 
335       Tcl_UnstackChannel(interp, chan);
336       return TCL_ERROR;
337   }
338     }
339 
340     return TCL_OK;
341 }
static int TransformBlockModeProc (ClientData instanceData, int mode) [static]

Definition at line 529 of file tclIOGT.c.
References CHANNEL_ASYNC, TransformChannelData::flags, and TCL_MODE_NONBLOCKING.532 {
533     TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
534 
535     if (mode == TCL_MODE_NONBLOCKING) {
536         dataPtr->flags |= CHANNEL_ASYNC;
537     } else {
538         dataPtr->flags &= ~(CHANNEL_ASYNC);
539     }
540     return 0;
541 }
static void TransformChannelHandlerTimer (ClientData clientData) [static]

Definition at line 1248 of file tclIOGT.c.
References NULL, TransformChannelData::result, ResultLength(), TransformChannelData::self, Tcl_NotifyChannel(), TCL_READABLE, TransformChannelData::timer, and TransformChannelData::watchMask.
Referenced by TransformWatchProc().1250 {
1251     TransformChannelData* dataPtr = (TransformChannelData*) clientData;
1252 
1253     dataPtr->timer = (Tcl_TimerToken) NULL;
1254 
1255     if (!(dataPtr->watchMask & TCL_READABLE) ||
1256       (ResultLength (&dataPtr->result) == 0)) {
1257   /* The timer fired, but either is there no (more)
1258    * interest in the events it generates or nothing is available
1259    * for reading, so ignore it and don't recreate it.
1260    */
1261 
1262   return;
1263     }
1264 
1265     Tcl_NotifyChannel(dataPtr->self, TCL_READABLE);
1266 }
static int TransformCloseProc (ClientData instanceData, Tcl_Interp* interp) [static]

Definition at line 562 of file tclIOGT.c.
References A_DELETE_READ, A_DELETE_WRITE, A_FLUSH_READ, A_FLUSH_WRITE, ckfree, TransformChannelData::command, ExecuteCallback(), TransformChannelData::mode, NULL, TransformChannelData::readIsFlushed, TransformChannelData::result, ResultClear(), Tcl_DecrRefCount, Tcl_DeleteTimerHandler(), TCL_OK, TCL_READABLE, TCL_WRITABLE, TransformChannelData::timer, TRANSMIT_DONT, TRANSMIT_DOWN, TRANSMIT_IBUF, and VOID.565 {
566     TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
567 
568     /*
569      * Important: In this procedure 'dataPtr->self' already points to
570      * the underlying channel.
571      */
572 
573     /*
574      * There is no need to cancel an existing channel handler, this is already
575      * done. Either by 'Tcl_UnstackChannel' or by the general cleanup in
576      * 'Tcl_Close'.
577      *
578      * But we have to cancel an active timer to prevent it from firing on the
579      * removed channel.
580      */
581 
582     if (dataPtr->timer != (Tcl_TimerToken) NULL) {
583         Tcl_DeleteTimerHandler (dataPtr->timer);
584   dataPtr->timer = (Tcl_TimerToken) NULL;
585     }
586 
587     /*
588      * Now flush data waiting in internal buffers to output and input. The
589      * input must be done despite the fact that there is no real receiver
590      * for it anymore. But the scripts might have sideeffects other parts
591      * of the system rely on (f.e. signaling the close to interested parties).
592      */
593 
594     if (dataPtr->mode & TCL_WRITABLE) {
595         ExecuteCallback (dataPtr, interp, A_FLUSH_WRITE,
596     NULL, 0, TRANSMIT_DOWN, 1);
597     }
598 
599     if ((dataPtr->mode & TCL_READABLE) && !dataPtr->readIsFlushed) {
600   dataPtr->readIsFlushed = 1;
601         ExecuteCallback (dataPtr, interp, A_FLUSH_READ,
602     NULL, 0, TRANSMIT_IBUF, 1);
603     }
604 
605     if (dataPtr->mode & TCL_WRITABLE) {
606         ExecuteCallback (dataPtr, interp, A_DELETE_WRITE,
607     NULL, 0, TRANSMIT_DONT, 1);
608     }
609 
610     if (dataPtr->mode & TCL_READABLE) {
611         ExecuteCallback (dataPtr, interp, A_DELETE_READ,
612     NULL, 0, TRANSMIT_DONT, 1);
613     }
614 
615     /*
616      * General cleanup
617      */
618 
619     ResultClear(&dataPtr->result);
620     Tcl_DecrRefCount(dataPtr->command);
621     ckfree((VOID*) dataPtr);
622 
623     return TCL_OK;
624 }
static int TransformGetFileHandleProc (ClientData instanceData, int direction, ClientData* handlePtr) [static]

Definition at line 1166 of file tclIOGT.c.
References TransformChannelData::self, Tcl_GetChannelHandle(), and Tcl_GetStackedChannel().1170 {
1171     /*
1172      * Return the handle belonging to parent channel.
1173      * IOW, pass the request down and the result up.
1174      */
1175 
1176     TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
1177 
1178     return Tcl_GetChannelHandle(Tcl_GetStackedChannel(dataPtr->self),
1179       direction, handlePtr);
1180 }
static int TransformGetOptionProc (ClientData instanceData, Tcl_Interp* interp, CONST char* optionName, Tcl_DString* dsPtr) [static]

Definition at line 1047 of file tclIOGT.c.
References CONST, NULL, TransformChannelData::self, Tcl_ChannelGetOptionProc(), TCL_ERROR, Tcl_GetChannelInstanceData(), Tcl_GetChannelType(), Tcl_GetStackedChannel(), and TCL_OK.1052 {
1053     TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
1054     Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
1055     Tcl_DriverGetOptionProc *getOptionProc;
1056 
1057     getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
1058     if (getOptionProc != NULL) {
1059   return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan),
1060     interp, optionName, dsPtr);
1061     } else if (optionName == (CONST char*) NULL) {
1062   /*
1063    * Request is query for all options, this is ok.
1064    */
1065   return TCL_OK;
1066     }
1067     /*
1068      * Request for a specific option has to fail, we don't have any.
1069      */
1070     return TCL_ERROR;
1071 }
static int TransformInputProc (ClientData instanceData, char* buf, int toRead, int* errorCodePtr) [static]

Definition at line 643 of file tclIOGT.c.
References A_FLUSH_READ, A_QUERY_MAXREAD, A_READ, CHANNEL_ASYNC, EAGAIN, EINVAL, EWOULDBLOCK, ExecuteCallback(), TransformChannelData::flags, TransformChannelData::maxRead, NO_INTERP, NULL, P_PRESERVE, TransformChannelData::readIsFlushed, TransformChannelData::result, ResultCopy(), ResultLength(), TransformChannelData::self, Tcl_Eof(), Tcl_GetErrno(), Tcl_GetStackedChannel(), TCL_OK, Tcl_ReadRaw(), TRANSMIT_IBUF, TRANSMIT_NUM, and UCHARP.648 {
649     TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
650     int gotBytes, read, res, copied;
651     Tcl_Channel downChan;
652 
653     /* should assert (dataPtr->mode & TCL_READABLE) */
654 
655     if (toRead == 0) {
656   /* Catch a no-op.
657    */
658   return 0;
659     }
660 
661     gotBytes = 0;
662     downChan = Tcl_GetStackedChannel(dataPtr->self);
663 
664     while (toRead > 0) {
665         /*
666    * Loop until the request is satisfied (or no data is available from
667    * below, possibly EOF).
668    */
669 
670         copied    = ResultCopy (&dataPtr->result, UCHARP (buf), toRead);
671 
672   toRead   -= copied;
673   buf      += copied;
674   gotBytes += copied;
675 
676   if (toRead == 0) {
677       /* The request was completely satisfied from our buffers.
678        * We can break out of the loop and return to the caller.
679        */
680       return gotBytes;
681   }
682 
683   /*
684    * Length (dataPtr->result) == 0, toRead > 0 here . Use the incoming
685    * 'buf'! as target to store the intermediary information read
686    * from the underlying channel.
687    *
688    * Ask the tcl level how much data it allows us to read from
689    * the underlying channel. This feature allows the transform to
690    * signal EOF upstream although there is none downstream. Useful
691    * to control an unbounded 'fcopy', either through counting bytes,
692    * or by pattern matching.
693    */
694 
695   ExecuteCallback (dataPtr, NO_INTERP, A_QUERY_MAXREAD,
696     NULL, 0, TRANSMIT_NUM /* -> maxRead */, 1);
697 
698   if (dataPtr->maxRead >= 0) {
699       if (dataPtr->maxRead < toRead) {
700           toRead = dataPtr->maxRead;
701       }
702   } /* else: 'maxRead < 0' == Accept the current value of toRead */
703 
704   if (toRead <= 0) {
705       return gotBytes;
706   }
707 
708   read = Tcl_ReadRaw(downChan, buf, toRead);
709 
710   if (read < 0) {
711       /* Report errors to caller. EAGAIN is a special situation.
712        * If we had some data before we report that instead of the
713        * request to re-try.
714        */
715 
716       if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
717           return gotBytes;
718       }
719 
720       *errorCodePtr = Tcl_GetErrno();
721       return -1;      
722   }
723 
724   if (read == 0) {
725       /*
726        * Check wether we hit on EOF in the underlying channel or
727        * not. If not differentiate between blocking and
728        * non-blocking modes. In non-blocking mode we ran
729        * temporarily out of data. Signal this to the caller via
730        * EWOULDBLOCK and error return (-1). In the other cases
731        * we simply return what we got and let the caller wait
732        * for more. On the other hand, if we got an EOF we have
733        * to convert and flush all waiting partial data.
734        */
735 
736       if (! Tcl_Eof (downChan)) {
737           if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
738         *errorCodePtr = EWOULDBLOCK;
739         return -1;
740     } else {
741         return gotBytes;
742     }
743       } else {
744           if (dataPtr->readIsFlushed) {
745         /* Already flushed, nothing to do anymore
746          */
747         return gotBytes;
748     }
749 
750     dataPtr->readIsFlushed = 1;
751 
752     ExecuteCallback (dataPtr, NO_INTERP, A_FLUSH_READ,
753       NULL, 0, TRANSMIT_IBUF, P_PRESERVE);
754 
755     if (ResultLength (&dataPtr->result) == 0) {
756         /* we had nothing to flush */
757         return gotBytes;
758     }
759 
760     continue; /* at: while (toRead > 0) */
761       }
762   } /* read == 0 */
763 
764   /* Transform the read chunk and add the result to our
765    * read buffer (dataPtr->result)
766    */
767 
768   res = ExecuteCallback (dataPtr, NO_INTERP, A_READ,
769     UCHARP (buf), read, TRANSMIT_IBUF, P_PRESERVE);
770 
771   if (res != TCL_OK) {
772       *errorCodePtr = EINVAL;
773       return -1;
774   }
775     } /* while toRead > 0 */
776 
777     return gotBytes;
778 }
static int TransformNotifyProc (ClientData clientData, int mask) [static]

Definition at line 1202 of file tclIOGT.c.
References NULL, Tcl_DeleteTimerHandler(), and TransformChannelData::timer.1205 {
1206     TransformChannelData* dataPtr = (TransformChannelData*) clientData;
1207 
1208     /*
1209      * An event occured in the underlying channel.  This
1210      * transformation doesn't process such events thus returns the
1211      * incoming mask unchanged.
1212      */
1213 
1214     if (dataPtr->timer != (Tcl_TimerToken) NULL) {
1215   /*
1216    * Delete an existing timer. It was not fired, yet we are
1217    * here, so the channel below generated such an event and we
1218    * don't have to. The renewal of the interest after the
1219    * execution of channel handlers will eventually cause us to
1220    * recreate the timer (in TransformWatchProc).
1221    */
1222 
1223   Tcl_DeleteTimerHandler (dataPtr->timer);
1224   dataPtr->timer = (Tcl_TimerToken) NULL;
1225     }
1226 
1227     return mask;
1228 }
static int TransformOutputProc (ClientData instanceData, CONST char* buf, int toWrite, int* errorCodePtr) [static]

Definition at line 798 of file tclIOGT.c.
References A_WRITE, EINVAL, ExecuteCallback(), NO_INTERP, P_NO_PRESERVE, TCL_OK, TRANSMIT_DOWN, and UCHARP.803 {
804     TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
805     int res;
806 
807     /* should assert (dataPtr->mode & TCL_WRITABLE) */
808 
809     if (toWrite == 0) {
810   /* Catch a no-op.
811    */
812   return 0;
813     }
814 
815     res = ExecuteCallback (dataPtr, NO_INTERP, A_WRITE,
816       UCHARP (buf), toWrite,
817       TRANSMIT_DOWN, P_NO_PRESERVE);
818 
819     if (res != TCL_OK) {
820         *errorCodePtr = EINVAL;
821   return -1;
822     }
823 
824     return toWrite;
825 }
static int TransformSeekProc (ClientData instanceData, long offset, int mode, int* errorCodePtr) [static]

Definition at line 851 of file tclIOGT.c.
References A_CLEAR_READ, A_FLUSH_WRITE, ExecuteCallback(), TransformChannelData::mode, NO_INTERP, NULL, P_NO_PRESERVE, ResultClear(), SEEK_CUR, TransformChannelData::self, Tcl_ChannelSeekProc(), Tcl_GetChannelInstanceData(), Tcl_GetChannelType(), Tcl_GetStackedChannel(), TCL_READABLE, TCL_WRITABLE, TRANSMIT_DONT, and TRANSMIT_DOWN.856 {
857     TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
858     Tcl_Channel           parent        = Tcl_GetStackedChannel(dataPtr->self);
859     Tcl_ChannelType*      parentType  = Tcl_GetChannelType(parent);
860     Tcl_DriverSeekProc*   parentSeekProc = Tcl_ChannelSeekProc(parentType);
861 
862     if ((offset == 0) && (mode == SEEK_CUR)) {
863         /* This is no seek but a request to tell the caller the current
864    * location. Simply pass the request down.
865    */
866 
867   return (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),
868     offset, mode, errorCodePtr);
869     }
870 
871     /*
872      * It is a real request to change the position. Flush all data waiting
873      * for output and discard everything in the input buffers. Then pass
874      * the request down, unchanged.
875      */
876 
877     if (dataPtr->mode & TCL_WRITABLE) {
878         ExecuteCallback (dataPtr, NO_INTERP, A_FLUSH_WRITE,
879     NULL, 0, TRANSMIT_DOWN, P_NO_PRESERVE);
880     }
881 
882     if (dataPtr->mode & TCL_READABLE) {
883         ExecuteCallback (dataPtr, NO_INTERP, A_CLEAR_READ,
884     NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
885   ResultClear(&dataPtr->result);
886   dataPtr->readIsFlushed = 0;
887     }
888 
889     return (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),
890       offset, mode, errorCodePtr);
891 }
static int TransformSetOptionProc (ClientData instanceData, Tcl_Interp * interp, CONST char * optionName, CONST char * value) [static]

Definition at line 1009 of file tclIOGT.c.
References NULL, TransformChannelData::self, Tcl_ChannelSetOptionProc(), TCL_ERROR, Tcl_GetChannelInstanceData(), Tcl_GetChannelType(), and Tcl_GetStackedChannel().1014 {
1015     TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
1016     Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
1017     Tcl_DriverSetOptionProc *setOptionProc;
1018 
1019     setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(downChan));
1020     if (setOptionProc != NULL) {
1021   return (*setOptionProc)(Tcl_GetChannelInstanceData(downChan),
1022     interp, optionName, value);
1023     }
1024     return TCL_ERROR;
1025 }
static void TransformWatchProc (ClientData instanceData, int mask) [static]

Definition at line 1092 of file tclIOGT.c.
References FLUSH_DELAY, NULL, TransformChannelData::result, ResultLength(), TransformChannelData::self, Tcl_CreateTimerHandler(), Tcl_DeleteTimerHandler(), Tcl_GetChannelInstanceData(), Tcl_GetChannelType(), Tcl_GetStackedChannel(), TCL_READABLE, TransformChannelData::timer, TransformChannelHandlerTimer(), and TransformChannelData::watchMask.1095 {
1096     /* The caller expressed interest in events occuring for this
1097      * channel. We are forwarding the call to the underlying
1098      * channel now.
1099      */
1100 
1101     TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
1102     Tcl_Channel     downChan;
1103 
1104     dataPtr->watchMask = mask;
1105 
1106     /* No channel handlers any more. We will be notified automatically
1107      * about events on the channel below via a call to our
1108      * 'TransformNotifyProc'. But we have to pass the interest down now.
1109      * We are allowed to add additional 'interest' to the mask if we want
1110      * to. But this transformation has no such interest. It just passes
1111      * the request down, unchanged.
1112      */
1113 
1114     downChan = Tcl_GetStackedChannel(dataPtr->self);
1115 
1116     (Tcl_GetChannelType(downChan))
1117   ->watchProc(Tcl_GetChannelInstanceData(downChan), mask);
1118 
1119     /*
1120      * Management of the internal timer.
1121      */
1122 
1123     if ((dataPtr->timer != (Tcl_TimerToken) NULL) &&
1124       (!(mask & TCL_READABLE) || (ResultLength(&dataPtr->result) == 0))) {
1125 
1126         /* A pending timer exists, but either is there no (more)
1127    * interest in the events it generates or nothing is availablee
1128    * for reading, so remove it.
1129    */
1130 
1131         Tcl_DeleteTimerHandler (dataPtr->timer);
1132   dataPtr->timer = (Tcl_TimerToken) NULL;
1133     }
1134 
1135     if ((dataPtr->timer == (Tcl_TimerToken) NULL) &&
1136       (mask & TCL_READABLE) && (ResultLength (&dataPtr->result) > 0)) {
1137 
1138         /* There is no pending timer, but there is interest in readable
1139    * events and we actually have data waiting, so generate a timer
1140    * to flush that.
1141    */
1142 
1143   dataPtr->timer = Tcl_CreateTimerHandler (FLUSH_DELAY,
1144     TransformChannelHandlerTimer, (ClientData) dataPtr);
1145     }
1146 }
static Tcl_WideInt TransformWideSeekProc (ClientData instanceData, Tcl_WideInt offset, int mode, int* errorCodePtr) [static]

Definition at line 915 of file tclIOGT.c.
References A_CLEAR_READ, A_FLUSH_WRITE, EOVERFLOW, ExecuteCallback(), LONG_MAX, LONG_MIN, TransformChannelData::mode, NO_INTERP, NULL, P_NO_PRESERVE, ResultClear(), SEEK_CUR, TransformChannelData::self, Tcl_ChannelSeekProc(), Tcl_ChannelWideSeekProc(), Tcl_GetChannelInstanceData(), Tcl_GetChannelType(), Tcl_GetStackedChannel(), Tcl_LongAsWide, TCL_READABLE, Tcl_WideAsLong, TCL_WRITABLE, TRANSMIT_DONT, and TRANSMIT_DOWN.920 {
921     TransformChannelData* dataPtr =
922   (TransformChannelData*) instanceData;
923     Tcl_Channel parent =
924   Tcl_GetStackedChannel(dataPtr->self);
925     Tcl_ChannelType* parentType =
926   Tcl_GetChannelType(parent);
927     Tcl_DriverSeekProc* parentSeekProc =
928   Tcl_ChannelSeekProc(parentType);
929     Tcl_DriverWideSeekProc* parentWideSeekProc =
930   Tcl_ChannelWideSeekProc(parentType);
931     ClientData parentData =
932   Tcl_GetChannelInstanceData(parent);
933 
934     if ((offset == Tcl_LongAsWide(0)) && (mode == SEEK_CUR)) {
935         /*
936    * This is no seek but a request to tell the caller the current
937    * location. Simply pass the request down.
938    */
939 
940   if (parentWideSeekProc != NULL) {
941       return (*parentWideSeekProc) (parentData, offset, mode,
942         errorCodePtr);
943   }
944 
945   return Tcl_LongAsWide((*parentSeekProc) (parentData, 0, mode,
946     errorCodePtr));
947     }
948 
949     /*
950      * It is a real request to change the position. Flush all data waiting
951      * for output and discard everything in the input buffers. Then pass
952      * the request down, unchanged.
953      */
954 
955     if (dataPtr->mode & TCL_WRITABLE) {
956         ExecuteCallback (dataPtr, NO_INTERP, A_FLUSH_WRITE,
957     NULL, 0, TRANSMIT_DOWN, P_NO_PRESERVE);
958     }
959 
960     if (dataPtr->mode & TCL_READABLE) {
961         ExecuteCallback (dataPtr, NO_INTERP, A_CLEAR_READ,
962     NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
963   ResultClear(&dataPtr->result);
964   dataPtr->readIsFlushed = 0;
965     }
966 
967     /*
968      * If we have a wide seek capability, we should stick with that.
969      */
970     if (parentWideSeekProc != NULL) {
971   return (*parentWideSeekProc) (parentData, offset, mode, errorCodePtr);
972     }
973 
974     /*
975      * We're transferring to narrow seeks at this point; this is a bit
976      * complex because we have to check whether the seek is possible
977      * first (i.e. whether we are losing information in truncating the
978      * bits of the offset.)  Luckily, there's a defined error for what
979      * happens when trying to go out of the representable range.
980      */
981     if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
982   *errorCodePtr = EOVERFLOW;
983   return Tcl_LongAsWide(-1);
984     }
985     return Tcl_LongAsWide((*parentSeekProc) (parentData,
986       Tcl_WideAsLong(offset), mode, errorCodePtr));
987 }

Variable Documentation
Tcl_ChannelType transformChannelType [static]
Initial value: {
    "transform",      
    TCL_CHANNEL_VERSION_3,
    TransformCloseProc,     
    TransformInputProc,     
    TransformOutputProc,    
    TransformSeekProc,      
    TransformSetOptionProc,   
    TransformGetOptionProc,   
    TransformWatchProc,     
    TransformGetFileHandleProc,   
    NULL,       
    TransformBlockModeProc,   
    NULL,       
    TransformNotifyProc,                
    TransformWideSeekProc,    
}
Definition at line 132 of file tclIOGT.c.
Referenced by TclChannelTransform().

generic/tclIOSock.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Functions
int TclSockGetPort (Tcl_Interp *interp, char *string, char *proto, int *portPtr)
int TclSockMinimumBuffers (int sock, int size)

Function Documentation
int TclSockGetPort (Tcl_Interp * interp, char * string, char * proto, int * portPtr)

Definition at line 38 of file tclIOSock.c.
References CONST, getservbyname, ntohs, NULL, Tcl_DStringFree(), TCL_ERROR, Tcl_GetInt(), TCL_OK, and Tcl_UtfToExternalDString().
Referenced by Tcl_SocketObjCmd().43 {
44     struct servent *sp;   /* Protocol info for named services */
45     Tcl_DString ds;
46     CONST char *native;
47 
48     if (Tcl_GetInt(NULL, string, portPtr) != TCL_OK) {
49   /*
50    * Don't bother translating 'proto' to native.
51    */
52    
53   native = Tcl_UtfToExternalDString(NULL, string, -1, &ds);
54   sp = getservbyname(native, proto);    /* INTL: Native. */
55   Tcl_DStringFree(&ds);
56   if (sp != NULL) {
57       *portPtr = ntohs((unsigned short) sp->s_port);
58       return TCL_OK;
59   }
60     }
61     if (Tcl_GetInt(interp, string, portPtr) != TCL_OK) {
62   return TCL_ERROR;
63     }
64     if (*portPtr > 0xFFFF) {
65         Tcl_AppendResult(interp, "couldn't open socket: port number too high",
66                 (char *) NULL);
67   return TCL_ERROR;
68     }
69     return TCL_OK;
70 }
int TclSockMinimumBuffers (int sock, int size)

Definition at line 89 of file tclIOSock.c.
References getsockopt, setsockopt, socklen_t, and TCL_OK.
Referenced by CreateSocket(), and Tcl_MakeTcpClientChannel().92 {
93     int current;
94     socklen_t len;
95 
96     len = sizeof(int);
97     getsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&current, &len);
98     if (current < size) {
99   len = sizeof(int);
100   setsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&size, len);
101     }
102     len = sizeof(int);
103     getsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&current, &len);
104     if (current < size) {
105   len = sizeof(int);
106   setsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&size, len);
107     }
108     return TCL_OK;
109 }

generic/tclIOUtil.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Classes
struct FilesystemRecord
struct StatProc
struct AccessProc
struct OpenFileChannelProc
struct FsDivertLoad
struct FsPath
Defines
#define OUT_OF_RANGE(x)
#define OUT_OF_URANGE(x)  (((Tcl_WideUInt)(x)) > (Tcl_WideUInt)ULONG_MAX)
#define USE_OBSOLETE_FS_HOOKS
#define RW_MODES  (O_RDONLY|O_WRONLY|O_RDWR)
#define PATHOBJ(objPtr)  (objPtr->internalRep.otherValuePtr)
#define PATHFLAGS(objPtr)  (((FsPath*)(objPtr->internalRep.otherValuePtr))->flags)
#define TCLPATH_APPENDED  1
#define TCLPATH_RELATIVE  2
Functions
int TclFSCwdPointerEquals _ANSI_ARGS_ ((Tcl_Obj *objPtr))
int TclFSMakePathFromNormalized _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData clientData))
int TclFSNormalizeToUniquePath _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, int startAt, ClientData *clientDataPtr))
Tcl_Obj *TclFSMakePathRelative _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *cwdPtr))
Tcl_Obj *TclFSInternalToNormalized _ANSI_ARGS_ ((Tcl_Filesystem *fromFilesystem, ClientData clientData, FilesystemRecord **fsRecPtrPtr))
int TclFSEnsureEpochOk _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr, Tcl_Filesystem **fsPtrPtr))
void TclFSSetPathDetails _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr, FilesystemRecord *fsRecPtr, ClientData clientData))
static Tcl_PathType FSGetPathType _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr, Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr))
static Tcl_PathType GetPathType _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr, Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr, Tcl_Obj **driveNameRef))
static Tcl_Obj *TclFSNormalizeAbsolutePath _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, ClientData *clientDataPtr))
static FilesystemRecord * FsGetFirstFilesystem (void)
static void FsThrExitProc (ClientData cd)
static Tcl_Obj *FsListMounts _ANSI_ARGS_ ((Tcl_Obj *pathPtr, CONST char *pattern))
static Tcl_Obj *FsAddMountsToGlobResult _ANSI_ARGS_ ((Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types))
int Tcl_Stat (CONST char *path, struct stat *oldStyleBuf)
int Tcl_Access (CONST char *path, int mode)
Tcl_Channel Tcl_OpenFileChannel (Tcl_Interp *interp, CONST char *path, CONST char *modeString, int permissions)
int Tcl_Chdir (CONST char *dirName)
char * Tcl_GetCwd (Tcl_Interp *interp, Tcl_DString *cwdPtr)
int Tcl_EvalFile (Tcl_Interp *interp, CONST char *fileName)
TCL_DECLARE_MUTEX (obsoleteFsHookMutex)
TCL_DECLARE_MUTEX (filesystemMutex)
int TclFSCwdPointerEquals (Tcl_Obj *objPtr)
static void FsUpdateCwd (Tcl_Obj *cwdObj)
void TclFinalizeFilesystem ()
void TclResetFilesystem ()
int Tcl_FSRegister (ClientData clientData, Tcl_Filesystem *fsPtr)
int Tcl_FSUnregister (Tcl_Filesystem *fsPtr)
int Tcl_FSMatchInDirectory (Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types)
static Tcl_Obj * FsAddMountsToGlobResult (Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types)
void Tcl_FSMountsChanged (Tcl_Filesystem *fsPtr)
ClientData Tcl_FSData (Tcl_Filesystem *fsPtr)
static Tcl_Obj * TclFSNormalizeAbsolutePath (Tcl_Interp *interp, Tcl_Obj *pathPtr, ClientData *clientDataPtr)
int TclFSNormalizeToUniquePath (Tcl_Interp *interp, Tcl_Obj *pathPtr, int startAt, ClientData *clientDataPtr)
int TclGetOpenMode (Tcl_Interp *interp, CONST char *string, int *seekFlagPtr)
int Tcl_FSEvalFile (Tcl_Interp *interp, Tcl_Obj *pathPtr)
int Tcl_GetErrno ()
void Tcl_SetErrno (int err)
CONST char * Tcl_PosixError (Tcl_Interp *interp)
int Tcl_FSStat (Tcl_Obj *pathPtr, Tcl_StatBuf *buf)
int Tcl_FSLstat (Tcl_Obj *pathPtr, Tcl_StatBuf *buf)
int Tcl_FSAccess (Tcl_Obj *pathPtr, int mode)
Tcl_Channel Tcl_FSOpenFileChannel (Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *modeString, int permissions)
int Tcl_FSUtime (Tcl_Obj *pathPtr, struct utimbuf *tval)
static CONST char ** NativeFileAttrStrings (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef)
static int NativeFileAttrsGet (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef)
static int NativeFileAttrsSet (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr)
CONST char ** Tcl_FSFileAttrStrings (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef)
int Tcl_FSFileAttrsGet (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef)
int Tcl_FSFileAttrsSet (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr)
Tcl_Obj * Tcl_FSGetCwd (Tcl_Interp *interp)
int Tcl_FSChdir (Tcl_Obj *pathPtr)
int Tcl_FSLoadFile (Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *sym1, CONST char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr)
int TclpLoadFile (Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *sym1, CONST char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr, Tcl_FSUnloadFileProc **unloadProcPtr)
static void FSUnloadTempFile (Tcl_LoadHandle loadHandle)
Tcl_Obj * Tcl_FSLink (Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction)
Tcl_Obj * Tcl_FSListVolumes (void)
static Tcl_Obj * FsListMounts (Tcl_Obj *pathPtr, CONST char *pattern)
Tcl_Obj * Tcl_FSSplitPath (Tcl_Obj *pathPtr, int *lenPtr)
Tcl_Obj * TclFSInternalToNormalized (Tcl_Filesystem *fromFilesystem, ClientData clientData, FilesystemRecord **fsRecPtrPtr)
static Tcl_PathType GetPathType (Tcl_Obj *pathObjPtr, Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr, Tcl_Obj **driveNameRef)
int Tcl_FSRenameFile (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
int Tcl_FSCopyFile (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
int TclCrossFilesystemCopy (Tcl_Interp *interp, Tcl_Obj *source, Tcl_Obj *target)
int Tcl_FSDeleteFile (Tcl_Obj *pathPtr)
int Tcl_FSCreateDirectory (Tcl_Obj *pathPtr)
int Tcl_FSCopyDirectory (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr)
int Tcl_FSRemoveDirectory (Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr)
Tcl_Filesystem * Tcl_FSGetFileSystemForPath (Tcl_Obj *pathObjPtr)
CONST char * Tcl_FSGetNativePath (Tcl_Obj *pathObjPtr)
static ClientData NativeCreateNativeRep (Tcl_Obj *pathObjPtr)
Tcl_Obj * TclpNativeToNormalized (ClientData clientData)
ClientData TclNativeDupInternalRep (ClientData clientData)
static void NativeFreeInternalRep (ClientData clientData)
Tcl_Obj * Tcl_FSFileSystemInfo (Tcl_Obj *pathObjPtr)
Tcl_Obj * Tcl_FSPathSeparator (Tcl_Obj *pathObjPtr)
static Tcl_Obj * NativeFilesystemSeparator (Tcl_Obj *pathObjPtr)
int TclStatInsertProc (TclStatProc_ *proc)
int TclStatDeleteProc (TclStatProc_ *proc)
int TclAccessInsertProc (TclAccessProc_ *proc)
int TclAccessDeleteProc (TclAccessProc_ *proc)
int TclOpenFileChannelInsertProc (TclOpenFileChannelProc_ *proc)
int TclOpenFileChannelDeleteProc (TclOpenFileChannelProc_ *proc)
static void DupFsPathInternalRep _ANSI_ARGS_ ((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr))
static void FreeFsPathInternalRep _ANSI_ARGS_ ((Tcl_Obj *listPtr))
static int SetFsPathFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
static int FindSplitPos _ANSI_ARGS_ ((char *path, char *separator))
Tcl_PathType Tcl_FSGetPathType (Tcl_Obj *pathObjPtr)
static Tcl_PathType FSGetPathType (Tcl_Obj *pathObjPtr, Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr)
Tcl_Obj * Tcl_FSJoinPath (Tcl_Obj *listObj, int elements)
int Tcl_FSConvertToPathType (Tcl_Interp *interp, Tcl_Obj *objPtr)
static int FindSplitPos (char *path, char *separator)
Tcl_Obj * TclNewFSPathObj (Tcl_Obj *dirPtr, CONST char *addStrRep, int len)
Tcl_Obj * TclFSMakePathRelative (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *cwdPtr)
int TclFSMakePathFromNormalized (Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData nativeRep)
Tcl_Obj * Tcl_FSNewNativePath (Tcl_Filesystem *fromFilesystem, ClientData clientData)
Tcl_Obj * Tcl_FSGetTranslatedPath (Tcl_Interp *interp, Tcl_Obj *pathPtr)
CONST char * Tcl_FSGetTranslatedStringPath (Tcl_Interp *interp, Tcl_Obj *pathPtr)
Tcl_Obj * Tcl_FSGetNormalizedPath (Tcl_Interp *interp, Tcl_Obj *pathObjPtr)
ClientData Tcl_FSGetInternalRep (Tcl_Obj *pathObjPtr, Tcl_Filesystem *fsPtr)
int TclFSEnsureEpochOk (Tcl_Obj *pathObjPtr, Tcl_Filesystem **fsPtrPtr)
void TclFSSetPathDetails (Tcl_Obj *pathObjPtr, FilesystemRecord *fsRecPtr, ClientData clientData)
int Tcl_FSEqualPaths (Tcl_Obj *firstPtr, Tcl_Obj *secondPtr)
static int SetFsPathFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr)
static void FreeFsPathInternalRep (Tcl_Obj *pathObjPtr)
static void DupFsPathInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
static void UpdateStringOfFsPath (Tcl_Obj *objPtr)
static int NativePathInFilesystem (Tcl_Obj *pathPtr, ClientData *clientDataPtr)
Variables
Tcl_Filesystem tclNativeFilesystem
int theFilesystemEpoch
static Tcl_FSPathInFilesystemProc NativePathInFilesystem
CONST char * tclpFileAttrStrings []
CONST TclFileAttrProcs tclpFileAttrProcs []
static StatProc * statProcList = NULL
static AccessProc * accessProcList = NULL
static OpenFileChannelProc * openFileChannelProcList = NULL
static FilesystemRecord nativeFilesystemRecord
int theFilesystemEpoch = 0
static FilesystemRecord * filesystemList = &nativeFilesystemRecord
ThreadSpecificData
static Tcl_ThreadDataKey dataKey
static Tcl_FSUnloadFileProc FSUnloadTempFile
static Tcl_ObjType tclFsPathType

Define Documentation
#define OUT_OF_RANGE(x)
Value:(((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
   ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
Referenced by PretendTclpStat(), and Tcl_Stat().#define OUT_OF_URANGE(x)  (((Tcl_WideUInt)(x)) > (Tcl_WideUInt)ULONG_MAX)

Referenced by PretendTclpStat(), and Tcl_Stat().#define PATHFLAGS(objPtr)  (((FsPath*)(objPtr->internalRep.otherValuePtr))->flags)

Definition at line 4670 of file tclIOUtil.c.
Referenced by FSGetPathType(), SetFsPathFromAny(), Tcl_FSGetNormalizedPath(), Tcl_FSGetTranslatedPath(), Tcl_FSNewNativePath(), TclFSMakePathFromNormalized(), TclFSMakePathRelative(), TclNewFSPathObj(), and UpdateStringOfFsPath().#define PATHOBJ(objPtr)  (objPtr->internalRep.otherValuePtr)

Definition at line 4669 of file tclIOUtil.c.
Referenced by DupFsPathInternalRep(), FreeFsPathInternalRep(), FSGetPathType(), SetFsPathFromAny(), Tcl_FSConvertToPathType(), Tcl_FSGetInternalRep(), Tcl_FSGetNormalizedPath(), Tcl_FSGetTranslatedPath(), Tcl_FSNewNativePath(), TclFSEnsureEpochOk(), TclFSMakePathFromNormalized(), TclFSMakePathRelative(), TclFSSetPathDetails(), TclNewFSPathObj(), and UpdateStringOfFsPath().#define RW_MODES  (O_RDONLY|O_WRONLY|O_RDWR)

Referenced by TclGetOpenMode().#define TCLPATH_APPENDED  1

Definition at line 4673 of file tclIOUtil.c.
Referenced by TclNewFSPathObj().#define TCLPATH_RELATIVE  2

Definition at line 4674 of file tclIOUtil.c.
Referenced by TclNewFSPathObj().#define USE_OBSOLETE_FS_HOOKS

Definition at line 309 of file tclIOUtil.c.
Function Documentation
static int FindSplitPos _ANSI_ARGS_ ((char *path, char *separator)) [static]
static int SetFsPathFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr)) [static]
static void FreeFsPathInternalRep _ANSI_ARGS_ ((Tcl_Obj *listPtr)) [static]
static void DupFsPathInternalRep _ANSI_ARGS_ ((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)) [static]
static Tcl_Obj* FsAddMountsToGlobResult _ANSI_ARGS_ ((Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types)) [static]
static Tcl_Obj* FsListMounts _ANSI_ARGS_ ((Tcl_Obj *pathPtr, CONST char *pattern)) [static]
static Tcl_Obj* TclFSNormalizeAbsolutePath _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, ClientData *clientDataPtr)) [static]
static Tcl_PathType GetPathType _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr, Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr, Tcl_Obj **driveNameRef)) [static]
static Tcl_PathType FSGetPathType _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr, Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr)) [static]
void TclFSSetPathDetails _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr, FilesystemRecord *fsRecPtr, ClientData clientData))
int TclFSEnsureEpochOk _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr, Tcl_Filesystem **fsPtrPtr))
Tcl_Obj* TclFSInternalToNormalized _ANSI_ARGS_ ((Tcl_Filesystem *fromFilesystem, ClientData clientData, FilesystemRecord **fsRecPtrPtr))
Tcl_Obj* TclFSMakePathRelative _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *cwdPtr))
int TclFSNormalizeToUniquePath _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, int startAt, ClientData *clientDataPtr))
int TclFSMakePathFromNormalized _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData clientData))
int TclFSCwdPointerEquals _ANSI_ARGS_ ((Tcl_Obj *objPtr))
static void DupFsPathInternalRep (Tcl_Obj * srcPtr, Tcl_Obj * copyPtr) [static]

Definition at line 6265 of file tclIOUtil.c.
References ckalloc, FsPath::cwdPtr, Tcl_Filesystem::dupInternalRepProc, FilesystemRecord::fileRefCount, FsPath::filesystemEpoch, FsPath::flags, FilesystemRecord::fsPtr, FsPath::fsRecPtr, FsPath::nativePathPtr, FsPath::normPathPtr, PATHOBJ, Tcl_IncrRefCount, tclFsPathType, FsPath::translatedPathPtr, Tcl_Obj::typePtr, and VOID.6268 {
6269     FsPath *srcFsPathPtr = (FsPath*) PATHOBJ(srcPtr);
6270     FsPath *copyFsPathPtr = (FsPath*) ckalloc((unsigned)sizeof(FsPath));
6271       
6272     Tcl_FSDupInternalRepProc *dupProc;
6273     
6274     PATHOBJ(copyPtr) = (VOID *) copyFsPathPtr;
6275 
6276     if (srcFsPathPtr->translatedPathPtr != NULL) {
6277   copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
6278   if (copyFsPathPtr->translatedPathPtr != copyPtr) {
6279       Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
6280   }
6281     } else {
6282   copyFsPathPtr->translatedPathPtr = NULL;
6283     }
6284     
6285     if (srcFsPathPtr->normPathPtr != NULL) {
6286   copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr;
6287   if (copyFsPathPtr->normPathPtr != copyPtr) {
6288       Tcl_IncrRefCount(copyFsPathPtr->normPathPtr);
6289   }
6290     } else {
6291   copyFsPathPtr->normPathPtr = NULL;
6292     }
6293     
6294     if (srcFsPathPtr->cwdPtr != NULL) {
6295   copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr;
6296   Tcl_IncrRefCount(copyFsPathPtr->cwdPtr);
6297     } else {
6298   copyFsPathPtr->cwdPtr = NULL;
6299     }
6300 
6301     copyFsPathPtr->flags = srcFsPathPtr->flags;
6302     
6303     if (srcFsPathPtr->fsRecPtr != NULL 
6304       && srcFsPathPtr->nativePathPtr != NULL) {
6305   dupProc = srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc;
6306   if (dupProc != NULL) {
6307       copyFsPathPtr->nativePathPtr = 
6308         (*dupProc)(srcFsPathPtr->nativePathPtr);
6309   } else {
6310       copyFsPathPtr->nativePathPtr = NULL;
6311   }
6312     } else {
6313   copyFsPathPtr->nativePathPtr = NULL;
6314     }
6315     copyFsPathPtr->fsRecPtr = srcFsPathPtr->fsRecPtr;
6316     copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch;
6317     if (copyFsPathPtr->fsRecPtr != NULL) {
6318   copyFsPathPtr->fsRecPtr->fileRefCount++;
6319     }
6320 
6321     copyPtr->typePtr = &tclFsPathType;
6322 }
static int FindSplitPos (char * path, char * separator) [static]

Definition at line 5028 of file tclIOUtil.c.
References TCL_PLATFORM_MAC, TCL_PLATFORM_UNIX, TCL_PLATFORM_WINDOWS, and tclPlatform.
Referenced by SetFsPathFromAny().5031 {
5032     int count = 0;
5033     switch (tclPlatform) {
5034   case TCL_PLATFORM_UNIX:
5035   case TCL_PLATFORM_MAC:
5036       while (path[count] != 0) {
5037     if (path[count] == *separator) {
5038         return count;
5039     }
5040     count++;
5041       }
5042       break;
5043 
5044   case TCL_PLATFORM_WINDOWS:
5045       while (path[count] != 0) {
5046     if (path[count] == *separator || path[count] == '\\') {
5047         return count;
5048     }
5049     count++;
5050       }
5051       break;
5052     }
5053     return count;
5054 }
static void FreeFsPathInternalRep (Tcl_Obj * pathObjPtr) [static]

Definition at line 6224 of file tclIOUtil.c.
References ckfree, FsPath::cwdPtr, FilesystemRecord::fileRefCount, Tcl_Filesystem::freeInternalRepProc, FilesystemRecord::fsPtr, FsPath::fsRecPtr, FsPath::nativePathPtr, FsPath::normPathPtr, PATHOBJ, Tcl_DecrRefCount, and FsPath::translatedPathPtr.
Referenced by Tcl_FSConvertToPathType(), Tcl_FSGetNormalizedPath(), and TclFSEnsureEpochOk().6226 {
6227     FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
6228 
6229     if (fsPathPtr->translatedPathPtr != NULL) {
6230   if (fsPathPtr->translatedPathPtr != pathObjPtr) {
6231       Tcl_DecrRefCount(fsPathPtr->translatedPathPtr);
6232   }
6233     }
6234     if (fsPathPtr->normPathPtr != NULL) {
6235   if (fsPathPtr->normPathPtr != pathObjPtr) {
6236       Tcl_DecrRefCount(fsPathPtr->normPathPtr);
6237   }
6238   fsPathPtr->normPathPtr = NULL;
6239     }
6240     if (fsPathPtr->cwdPtr != NULL) {
6241   Tcl_DecrRefCount(fsPathPtr->cwdPtr);
6242     }
6243     if (fsPathPtr->nativePathPtr != NULL) {
6244   if (fsPathPtr->fsRecPtr != NULL) {
6245       if (fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc != NULL) {
6246     (*fsPathPtr->fsRecPtr->fsPtr
6247        ->freeInternalRepProc)(fsPathPtr->nativePathPtr);
6248     fsPathPtr->nativePathPtr = NULL;
6249       }
6250   }
6251     }
6252     if (fsPathPtr->fsRecPtr != NULL) {
6253   fsPathPtr->fsRecPtr->fileRefCount--;
6254   if (fsPathPtr->fsRecPtr->fileRefCount <= 0) {
6255       /* It has been unregistered already, so simply free it */
6256       ckfree((char *)fsPathPtr->fsRecPtr);
6257   }
6258     }
6259 
6260     ckfree((char*) fsPathPtr);
6261 }
static Tcl_Obj* FsAddMountsToGlobResult (Tcl_Obj * result, Tcl_Obj * pathPtr, CONST char * pattern, Tcl_GlobTypeData * types) [static]

Definition at line 1124 of file tclIOUtil.c.
References FsListMounts(), Tcl_DecrRefCount, Tcl_DuplicateObj(), Tcl_FSEqualPaths(), TCL_GLOB_TYPE_DIR, Tcl_IsShared, Tcl_ListObjAppendElement(), Tcl_ListObjIndex(), Tcl_ListObjLength(), Tcl_ListObjReplace(), and TCL_OK.
Referenced by Tcl_FSMatchInDirectory().1129 {
1130     int mLength, gLength, i;
1131     int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR));
1132     Tcl_Obj *mounts = FsListMounts(pathPtr, pattern);
1133 
1134     if (mounts == NULL) return result; 
1135 
1136     if (Tcl_ListObjLength(NULL, mounts, &mLength) != TCL_OK || mLength == 0) {
1137   goto endOfMounts;
1138     }
1139     if (Tcl_ListObjLength(NULL, result, &gLength) != TCL_OK) {
1140   goto endOfMounts;
1141     }
1142     for (i = 0; i < mLength; i++) {
1143   Tcl_Obj *mElt;
1144   int j;
1145   int found = 0;
1146   
1147   Tcl_ListObjIndex(NULL, mounts, i, &mElt);
1148 
1149   for (j = 0; j < gLength; j++) {
1150       Tcl_Obj *gElt;
1151       Tcl_ListObjIndex(NULL, result, j, &gElt);
1152       if (Tcl_FSEqualPaths(mElt, gElt)) {
1153     found = 1;
1154     if (!dir) {
1155         /* We don't want to list this */
1156         if (Tcl_IsShared(result)) {
1157       Tcl_Obj *newList;
1158       newList = Tcl_DuplicateObj(result);
1159       Tcl_DecrRefCount(result);
1160       result = newList;
1161         }
1162         Tcl_ListObjReplace(NULL, result, j, 1, 0, NULL);
1163         gLength--;
1164     }
1165     /* Break out of for loop */
1166     break;
1167       }
1168   }
1169   if (!found && dir) {
1170       if (Tcl_IsShared(result)) {
1171     Tcl_Obj *newList;
1172     newList = Tcl_DuplicateObj(result);
1173     Tcl_DecrRefCount(result);
1174     result = newList;
1175       }
1176       Tcl_ListObjAppendElement(NULL, result, mElt);
1177       /* 
1178        * No need to increment gLength, since we
1179        * don't want to compare mounts against
1180        * mounts.
1181        */
1182   }
1183     }
1184   endOfMounts:
1185     Tcl_DecrRefCount(mounts);
1186     return result;
1187 }
static FilesystemRecord * FsGetFirstFilesystem (void) [static]

Definition at line 649 of file tclIOUtil.c.
References filesystemList, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by FsListMounts(), GetPathType(), Tcl_FSData(), Tcl_FSGetCwd(), Tcl_FSGetFileSystemForPath(), Tcl_FSListVolumes(), TclFSInternalToNormalized(), and TclFSNormalizeToUniquePath().649                            {
650     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
651     FilesystemRecord *fsRecPtr;
652 #ifndef TCL_THREADS
653     tsdPtr->filesystemEpoch = theFilesystemEpoch;
654     fsRecPtr = filesystemList;
655 #else
656     Tcl_MutexLock(&filesystemMutex);
657     if (tsdPtr->filesystemList == NULL
658       || (tsdPtr->filesystemEpoch != theFilesystemEpoch)) {
659   FsRecacheFilesystemList();
660   tsdPtr->filesystemEpoch = theFilesystemEpoch;
661     }
662     Tcl_MutexUnlock(&filesystemMutex);
663     fsRecPtr = tsdPtr->filesystemList;
664 #endif
665     return fsRecPtr;
666 }
static Tcl_PathType FSGetPathType (Tcl_Obj * pathObjPtr, Tcl_Filesystem ** filesystemPtrPtr, int * driveNameLengthPtr) [static]

Definition at line 4726 of file tclIOUtil.c.
References FsPath::cwdPtr, GetPathType(), PATHFLAGS, PATHOBJ, Tcl_FSConvertToPathType(), TCL_OK, and TCL_PATH_RELATIVE.
Referenced by Tcl_FSGetPathType(), and Tcl_FSSplitPath().4730 {
4731     if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) {
4732   return GetPathType(pathObjPtr, filesystemPtrPtr, 
4733          driveNameLengthPtr, NULL);
4734     } else {
4735   FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
4736   if (fsPathPtr->cwdPtr != NULL) {
4737       if (PATHFLAGS(pathObjPtr) == 0) {
4738     return TCL_PATH_RELATIVE;
4739       }
4740       return FSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, 
4741          driveNameLengthPtr);
4742   } else {
4743       return GetPathType(pathObjPtr, filesystemPtrPtr, 
4744              driveNameLengthPtr, NULL);
4745   }
4746     }
4747 }
static Tcl_Obj* FsListMounts (Tcl_Obj * pathPtr, CONST char * pattern) [static]

Definition at line 3265 of file tclIOUtil.c.
References FsGetFirstFilesystem(), FilesystemRecord::fsPtr, Tcl_Filesystem::matchInDirectoryProc, FilesystemRecord::nextPtr, TCL_GLOB_TYPE_MOUNT, and Tcl_NewObj().
Referenced by FsAddMountsToGlobResult().3268 {
3269     FilesystemRecord *fsRecPtr;
3270     Tcl_GlobTypeData mountsOnly = { TCL_GLOB_TYPE_MOUNT, 0, NULL, NULL };
3271     Tcl_Obj *resultPtr = NULL;
3272     
3273     /*
3274      * Call each of the "listMounts" functions in succession.
3275      * A non-NULL return value indicates the particular function has
3276      * succeeded.  We call all the functions registered, since we want
3277      * a list from each filesystems.
3278      */
3279 
3280     fsRecPtr = FsGetFirstFilesystem();
3281     while (fsRecPtr != NULL) {
3282   if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
3283       Tcl_FSMatchInDirectoryProc *proc = 
3284           fsRecPtr->fsPtr->matchInDirectoryProc;
3285       if (proc != NULL) {
3286     if (resultPtr == NULL) {
3287         resultPtr = Tcl_NewObj();
3288     }
3289     (*proc)(NULL, resultPtr, pathPtr, pattern, &mountsOnly);
3290       }
3291   }
3292   fsRecPtr = fsRecPtr->nextPtr;
3293     }
3294     
3295     return resultPtr;
3296 }
static void FsThrExitProc (ClientData cd) [static]

Definition at line 539 of file tclIOUtil.c.
References ckfree, FilesystemRecord::fileRefCount, ThreadSpecificData::initialized, FilesystemRecord::nextPtr, and Tcl_DecrRefCount.
Referenced by TclFSCwdPointerEquals().541 {
542     ThreadSpecificData *tsdPtr = (ThreadSpecificData*)cd;
543     FilesystemRecord *fsRecPtr = NULL, *tmpFsRecPtr = NULL;
544 
545     /* Trash the cwd copy */
546     if (tsdPtr->cwdPathPtr != NULL) {
547   Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
548   tsdPtr->cwdPathPtr = NULL;
549     }
550     /* Trash the filesystems cache */
551     fsRecPtr = tsdPtr->filesystemList;
552     while (fsRecPtr != NULL) {
553   tmpFsRecPtr = fsRecPtr->nextPtr;
554   if (--fsRecPtr->fileRefCount <= 0) {
555       ckfree((char *)fsRecPtr);
556   }
557   fsRecPtr = tmpFsRecPtr;
558     }
559     tsdPtr->initialized = 0;
560 }
static void FSUnloadTempFile (Tcl_LoadHandle loadHandle) [static]

Definition at line 3058 of file tclIOUtil.c.
References ckfree, Tcl_Filesystem::deleteFileProc, FsDivertLoad::divertedFile, FsDivertLoad::divertedFileNativeRep, FsDivertLoad::divertedFilesystem, FsDivertLoad::loadHandle, NativeFreeInternalRep(), Tcl_DecrRefCount, TCL_OK, TclpDeleteFile(), and FsDivertLoad::unloadProcPtr.3063 {
3064     FsDivertLoad *tvdlPtr = (FsDivertLoad*)loadHandle;
3065     /* 
3066      * This test should never trigger, since we give
3067      * the client data in the function above.
3068      */
3069     if (tvdlPtr == NULL) { return; }
3070     
3071     /* 
3072      * Call the real 'unloadfile' proc we actually used. It is very
3073      * important that we call this first, so that the shared library
3074      * is actually unloaded by the OS.  Otherwise, the following
3075      * 'delete' may well fail because the shared library is still in
3076      * use.
3077      */
3078     if (tvdlPtr->unloadProcPtr != NULL) {
3079   (*tvdlPtr->unloadProcPtr)(tvdlPtr->loadHandle);
3080     }
3081     
3082     if (tvdlPtr->divertedFilesystem == NULL) {
3083   /* 
3084    * It was the native filesystem, and we have a special
3085    * function available just for this purpose, which we 
3086    * know works even at this late stage.
3087    */
3088   TclpDeleteFile(tvdlPtr->divertedFileNativeRep);
3089   NativeFreeInternalRep(tvdlPtr->divertedFileNativeRep);
3090     } else {
3091   /* 
3092    * Remove the temporary file we created.  Note, we may crash
3093    * here because encodings have been taken down already.
3094    */
3095   if (tvdlPtr->divertedFilesystem->deleteFileProc(tvdlPtr->divertedFile)
3096       != TCL_OK) {
3097       /* 
3098        * The above may have failed because the filesystem, or something
3099        * it depends upon (e.g. encodings) have been taken down because
3100        * Tcl is exiting.
3101        * 
3102        * We may need to work out how to delete this file more
3103        * robustly (or give the filesystem the information it needs
3104        * to delete the file more robustly).
3105        * 
3106        * In particular, one problem might be that the filesystem
3107        * cannot extract the information it needs from the above
3108        * path object because Tcl's entire filesystem apparatus
3109        * (the code in this file) has been finalized, and it
3110        * refuses to pass the internal representation to the
3111        * filesystem.
3112        */
3113   }
3114   
3115   /* 
3116    * And free up the allocations.  This will also of course remove
3117    * a refCount from the Tcl_Filesystem to which this file belongs,
3118    * which could then free up the filesystem if we are exiting.
3119    */
3120   Tcl_DecrRefCount(tvdlPtr->divertedFile);
3121     }
3122 
3123     ckfree((char*)tvdlPtr);
3124 }
static void FsUpdateCwd (Tcl_Obj * cwdObj) [static]

Definition at line 669 of file tclIOUtil.c.
References Tcl_DecrRefCount, Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_NewStringObj(), and TCL_TSD_INIT.
Referenced by Tcl_FSChdir(), and Tcl_FSGetCwd().671 {
672     int len;
673     char *str = NULL;
674     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
675 
676     if (cwdObj != NULL) {
677   str = Tcl_GetStringFromObj(cwdObj, &len);
678     }
679 
680     Tcl_MutexLock(&cwdMutex);
681     if (cwdPathPtr != NULL) {
682         Tcl_DecrRefCount(cwdPathPtr);
683     }
684     if (cwdObj == NULL) {
685   cwdPathPtr = NULL;
686     } else {
687   /* This MUST be stored as string object! */
688   cwdPathPtr = Tcl_NewStringObj(str, len); 
689       Tcl_IncrRefCount(cwdPathPtr);
690     }
691     cwdPathEpoch++;
692     tsdPtr->cwdPathEpoch = cwdPathEpoch;
693     Tcl_MutexUnlock(&cwdMutex);
694 
695     if (tsdPtr->cwdPathPtr) {
696         Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
697     }
698     if (cwdObj == NULL) {
699   tsdPtr->cwdPathPtr = NULL;
700     } else {
701   tsdPtr->cwdPathPtr = Tcl_NewStringObj(str, len); 
702   Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
703     }
704 }
static Tcl_PathType GetPathType (Tcl_Obj * pathObjPtr, Tcl_Filesystem ** filesystemPtrPtr, int * driveNameLengthPtr, Tcl_Obj ** driveNameRef) [static]

Definition at line 3440 of file tclIOUtil.c.
References FsGetFirstFilesystem(), FilesystemRecord::fsPtr, Tcl_Filesystem::listVolumesProc, FilesystemRecord::nextPtr, size_t(), Tcl_DecrRefCount, Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_ListObjIndex(), Tcl_ListObjLength(), TCL_OK, TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, and TclpGetNativePathType().
Referenced by FSGetPathType(), and Tcl_FSJoinPath().3445 {
3446     FilesystemRecord *fsRecPtr;
3447     int pathLen;
3448     char *path;
3449     Tcl_PathType type = TCL_PATH_RELATIVE;
3450     
3451     path = Tcl_GetStringFromObj(pathObjPtr, &pathLen);
3452 
3453     /*
3454      * Call each of the "listVolumes" function in succession, checking
3455      * whether the given path is an absolute path on any of the volumes
3456      * returned (this is done by checking whether the path's prefix
3457      * matches).
3458      */
3459 
3460     fsRecPtr = FsGetFirstFilesystem();
3461     while (fsRecPtr != NULL) {
3462   Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
3463   /* 
3464    * We want to skip the native filesystem in this loop because
3465    * otherwise we won't necessarily pass all the Tcl testsuite --
3466    * this is because some of the tests artificially change the
3467    * current platform (between mac, win, unix) but the list
3468    * of volumes we get by calling (*proc) will reflect the current
3469    * (real) platform only and this may cause some tests to fail.
3470    * In particular, on unix '/' will match the beginning of 
3471    * certain absolute Windows paths starting '//' and those tests
3472    * will go wrong.
3473    * 
3474    * Besides these test-suite issues, there is one other reason
3475    * to skip the native filesystem --- since the tclFilename.c
3476    * code has nice fast 'absolute path' checkers, we don't want
3477    * to waste time repeating that effort here, and this 
3478    * function is actually called quite often, so if we can
3479    * save the overhead of the native filesystem returning us
3480    * a list of volumes all the time, it is better.
3481    */
3482   if ((fsRecPtr->fsPtr != &tclNativeFilesystem) && (proc != NULL)) {
3483       int numVolumes;
3484       Tcl_Obj *thisFsVolumes = (*proc)();
3485       if (thisFsVolumes != NULL) {
3486     if (Tcl_ListObjLength(NULL, thisFsVolumes, 
3487               &numVolumes) != TCL_OK) {
3488         /* 
3489          * This is VERY bad; the Tcl_FSListVolumesProc
3490          * didn't return a valid list.  Set numVolumes to
3491          * -1 so that we skip the while loop below and just
3492          * return with the current value of 'type'.
3493          * 
3494          * It would be better if we could signal an error
3495          * here (but panic seems a bit excessive).
3496          */
3497         numVolumes = -1;
3498     }
3499     while (numVolumes > 0) {
3500         Tcl_Obj *vol;
3501         int len;
3502         char *strVol;
3503 
3504         numVolumes--;
3505         Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
3506         strVol = Tcl_GetStringFromObj(vol,&len);
3507         if (pathLen < len) {
3508       continue;
3509         }
3510         if (strncmp(strVol, path, (size_t) len) == 0) {
3511       type = TCL_PATH_ABSOLUTE;
3512       if (filesystemPtrPtr != NULL) {
3513           *filesystemPtrPtr = fsRecPtr->fsPtr;
3514       }
3515       if (driveNameLengthPtr != NULL) {
3516           *driveNameLengthPtr = len;
3517       }
3518       if (driveNameRef != NULL) {
3519           *driveNameRef = vol;
3520           Tcl_IncrRefCount(vol);
3521       }
3522       break;
3523         }
3524     }
3525     Tcl_DecrRefCount(thisFsVolumes);
3526     if (type == TCL_PATH_ABSOLUTE) {
3527         /* We don't need to examine any more filesystems */
3528         break;
3529     }
3530       }
3531   }
3532   fsRecPtr = fsRecPtr->nextPtr;
3533     }
3534     
3535     if (type != TCL_PATH_ABSOLUTE) {
3536   type = TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, 
3537              driveNameRef);
3538   if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) {
3539       *filesystemPtrPtr = &tclNativeFilesystem;
3540   }
3541     }
3542     return type;
3543 }
static ClientData NativeCreateNativeRep (Tcl_Obj* pathObjPtr) [static]

Definition at line 4004 of file tclIOUtil.c.
References ckalloc, size_t(), Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, Tcl_FSGetNormalizedPath(), Tcl_GetStringFromObj(), Tcl_UtfToExternalDString(), Tcl_WinUtfToTChar(), tclWinProcs, TclWinProcs::useWide, and VOID.4006 {
4007     char *nativePathPtr;
4008     Tcl_DString ds;
4009     Tcl_Obj* validPathObjPtr;
4010     int len;
4011     char *str;
4012 
4013     /* Make sure the normalized path is set */
4014     validPathObjPtr = Tcl_FSGetNormalizedPath(NULL, pathObjPtr);
4015     if (validPathObjPtr == NULL) {
4016   return NULL;
4017     }
4018 
4019     str = Tcl_GetStringFromObj(validPathObjPtr, &len);
4020 #ifdef __WIN32__
4021     Tcl_WinUtfToTChar(str, len, &ds);
4022     if (tclWinProcs->useWide) {
4023   len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
4024     } else {
4025   len = Tcl_DStringLength(&ds) + sizeof(char);
4026     }
4027 #else
4028     Tcl_UtfToExternalDString(NULL, str, len, &ds);
4029     len = Tcl_DStringLength(&ds) + sizeof(char);
4030 #endif
4031     nativePathPtr = ckalloc((unsigned) len);
4032     memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), (size_t) len);
4033 
4034     Tcl_DStringFree(&ds);
4035     return (ClientData)nativePathPtr;
4036 }
static int NativeFileAttrsGet (Tcl_Interp * interp, int index, Tcl_Obj * pathPtr, Tcl_Obj ** objPtrRef) [static]

Definition at line 2282 of file tclIOUtil.c.2287 {
2288     return (*tclpFileAttrProcs[index].getProc)(interp, index, 
2289                  pathPtr, objPtrRef);
2290 }
static int NativeFileAttrsSet (Tcl_Interp * interp, int index, Tcl_Obj * pathPtr, Tcl_Obj * objPtr) [static]

Definition at line 2313 of file tclIOUtil.c.2318 {
2319     return (*tclpFileAttrProcs[index].setProc)(interp, index,
2320                  pathPtr, objPtr);
2321 }
static CONST char** NativeFileAttrStrings (Tcl_Obj * pathPtr, Tcl_Obj** objPtrRef) [static]

Definition at line 2250 of file tclIOUtil.c.2253 {
2254     return tclpFileAttrStrings;
2255 }
static Tcl_Obj* NativeFilesystemSeparator (Tcl_Obj* pathObjPtr) [static]

Definition at line 4260 of file tclIOUtil.c.
References Tcl_NewStringObj(), TCL_PLATFORM_MAC, TCL_PLATFORM_UNIX, TCL_PLATFORM_WINDOWS, and tclPlatform.4262 {
4263     char *separator = NULL; /* lint */
4264     switch (tclPlatform) {
4265   case TCL_PLATFORM_UNIX:
4266       separator = "/";
4267       break;
4268   case TCL_PLATFORM_WINDOWS:
4269       separator = "\\";
4270       break;
4271   case TCL_PLATFORM_MAC:
4272       separator = ":";
4273       break;
4274     }
4275     return Tcl_NewStringObj(separator,1);
4276 }
static void NativeFreeInternalRep (ClientData clientData) [static]

Definition at line 4157 of file tclIOUtil.c.
References ckfree.
Referenced by FSUnloadTempFile().4159 {
4160     ckfree((char*)clientData);
4161 }
static int NativePathInFilesystem (Tcl_Obj * pathPtr, ClientData * clientDataPtr) [static]

Definition at line 6422 of file tclIOUtil.c.
References Tcl_GetStringFromObj(), TCL_OK, and tclFsPathType.6425 {
6426     /* 
6427      * A special case is required to handle the empty path "". 
6428      * This is a valid path (i.e. the user should be able
6429      * to do 'file exists ""' without throwing an error), but
6430      * equally the path doesn't exist.  Those are the semantics
6431      * of Tcl (at present anyway), so we have to abide by them
6432      * here.
6433      */
6434     if (pathPtr->typePtr == &tclFsPathType) {
6435   if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') {
6436       /* We reject the empty path "" */
6437       return -1;
6438   }
6439   /* Otherwise there is no way this path can be empty */
6440     } else {
6441   /* 
6442    * It is somewhat unusual to reach this code path without
6443    * the object being of tclFsPathType.  However, we do
6444    * our best to deal with the situation.
6445    */
6446   int len;
6447   Tcl_GetStringFromObj(pathPtr,&len);
6448   if (len == 0) {
6449       /* We reject the empty path "" */
6450       return -1;
6451   }
6452     }
6453     /* 
6454      * Path is of correct type, or is of non-zero length, 
6455      * so we accept it.
6456      */
6457     return TCL_OK;
6458 }
static int SetFsPathFromAny (Tcl_Interp * interp, Tcl_Obj * objPtr) [static]

Definition at line 6055 of file tclIOUtil.c.
References _ANSI_ARGS_, ckalloc, CONST, FsPath::cwdPtr, FsPath::filesystemEpoch, FindSplitPos(), Tcl_ObjType::freeIntRepProc, FsPath::fsRecPtr, FsPath::nativePathPtr, FsPath::normPathPtr, PATHFLAGS, PATHOBJ, Tcl_DecrRefCount, Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringValue, TCL_ERROR, Tcl_FSJoinToPath(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_JoinPath(), Tcl_ListObjGetElements(), Tcl_NewStringObj(), TCL_OK, TCL_PLATFORM_MAC, Tcl_ResetResult(), Tcl_SetStringObj(), TCL_TSD_INIT, tclFsPathType, TclGetEnv(), TclpGetUserHome(), tclPlatform, TclpNativeJoinPath(), TclpNativeSplitPath(), TclWinNoBackslash(), FsPath::translatedPathPtr, Tcl_Obj::typePtr, and VOID.
Referenced by TclFSEnsureEpochOk().6058 {
6059     int len;
6060     FsPath *fsPathPtr;
6061     Tcl_Obj *transPtr;
6062     char *name;
6063     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
6064     
6065     if (objPtr->typePtr == &tclFsPathType) {
6066   return TCL_OK;
6067     }
6068     
6069     /* 
6070      * First step is to translate the filename.  This is similar to
6071      * Tcl_TranslateFilename, but shouldn't convert everything to
6072      * windows backslashes on that platform.  The current
6073      * implementation of this piece is a slightly optimised version
6074      * of the various Tilde/Split/Join stuff to avoid multiple
6075      * split/join operations.
6076      * 
6077      * We remove any trailing directory separator.
6078      * 
6079      * However, the split/join routines are quite complex, and
6080      * one has to make sure not to break anything on Unix, Win
6081      * or MacOS (fCmd.test, fileName.test and cmdAH.test exercise
6082      * most of the code).
6083      */
6084     name = Tcl_GetStringFromObj(objPtr,&len);
6085 
6086     /*
6087      * Handle tilde substitutions, if needed.
6088      */
6089     if (name[0] == '~') {
6090   char *expandedUser;
6091   Tcl_DString temp;
6092   int split;
6093   char separator='/';
6094   
6095   if (tclPlatform==TCL_PLATFORM_MAC) {
6096       if (strchr(name, ':') != NULL) separator = ':';
6097   }
6098   
6099   split = FindSplitPos(name, &separator);
6100   if (split != len) {
6101       /* We have multiple pieces '~user/foo/bar...' */
6102       name[split] = '\0';
6103   }
6104   /* Do some tilde substitution */
6105   if (name[1] == '\0') {
6106       /* We have just '~' */
6107       CONST char *dir;
6108       Tcl_DString dirString;
6109       if (split != len) { name[split] = separator; }
6110       
6111       dir = TclGetEnv("HOME", &dirString);
6112       if (dir == NULL) {
6113     if (interp) {
6114         Tcl_ResetResult(interp);
6115         Tcl_AppendResult(interp, "couldn't find HOME environment ",
6116           "variable to expand path", (char *) NULL);
6117     }
6118     return TCL_ERROR;
6119       }
6120       Tcl_DStringInit(&temp);
6121       Tcl_JoinPath(1, &dir, &temp);
6122       Tcl_DStringFree(&dirString);
6123   } else {
6124       /* We have a user name '~user' */
6125       Tcl_DStringInit(&temp);
6126       if (TclpGetUserHome(name+1, &temp) == NULL) { 
6127     if (interp != NULL) {
6128         Tcl_ResetResult(interp);
6129         Tcl_AppendResult(interp, "user \"", (name+1), 
6130              "\" doesn't exist", (char *) NULL);
6131     }
6132     Tcl_DStringFree(&temp);
6133     if (split != len) { name[split] = separator; }
6134     return TCL_ERROR;
6135       }
6136       if (split != len) { name[split] = separator; }
6137   }
6138   
6139   expandedUser = Tcl_DStringValue(&temp);
6140   transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp));
6141 
6142   if (split != len) {
6143       /* Join up the tilde substitution with the rest */
6144       if (name[split+1] == separator) {
6145 
6146     /*
6147      * Somewhat tricky case like ~//foo/bar.
6148      * Make use of Split/Join machinery to get it right.
6149      * Assumes all paths beginning with ~ are part of the
6150      * native filesystem.
6151      */
6152 
6153     int objc;
6154     Tcl_Obj **objv;
6155     Tcl_Obj *parts = TclpNativeSplitPath(objPtr, NULL);
6156     Tcl_ListObjGetElements(NULL, parts, &objc, &objv);
6157     /* Skip '~'.  It's replaced by its expansion */
6158     objc--; objv++;
6159     while (objc--) {
6160         TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++));
6161     }
6162     Tcl_DecrRefCount(parts);
6163       } else {
6164     /* Simple case. "rest" is relative path.  Just join it. */
6165     Tcl_Obj *rest = Tcl_NewStringObj(name+split+1,-1);
6166     transPtr = Tcl_FSJoinToPath(transPtr, 1, &rest);
6167       }
6168   }
6169   Tcl_DStringFree(&temp);
6170     } else {
6171   transPtr = Tcl_FSJoinToPath(objPtr,0,NULL);
6172     }
6173 
6174 #if defined(__CYGWIN__) && defined(__WIN32__)
6175     {
6176     extern int cygwin_conv_to_win32_path 
6177   _ANSI_ARGS_((CONST char *, char *));
6178     char winbuf[MAX_PATH+1];
6179 
6180     /*
6181      * In the Cygwin world, call conv_to_win32_path in order to use the
6182      * mount table to translate the file name into something Windows will
6183      * understand.  Take care when converting empty strings!
6184      */
6185     name = Tcl_GetStringFromObj(transPtr, &len);
6186     if (len > 0) {
6187   cygwin_conv_to_win32_path(name, winbuf);
6188   TclWinNoBackslash(winbuf);
6189   Tcl_SetStringObj(transPtr, winbuf, -1);
6190     }
6191     }
6192 #endif /* __CYGWIN__ && __WIN32__ */
6193 
6194     /* 
6195      * Now we have a translated filename in 'transPtr'.  This will have
6196      * forward slashes on Windows, and will not contain any ~user
6197      * sequences.
6198      */
6199     
6200     fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
6201 
6202     fsPathPtr->translatedPathPtr = transPtr;
6203     Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
6204     fsPathPtr->normPathPtr = NULL;
6205     fsPathPtr->cwdPtr = NULL;
6206     fsPathPtr->nativePathPtr = NULL;
6207     fsPathPtr->fsRecPtr = NULL;
6208     fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
6209 
6210     /*
6211      * Free old representation before installing our new one.
6212      */
6213     if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) {
6214   (objPtr->typePtr->freeIntRepProc)(objPtr);
6215     }
6216     PATHOBJ(objPtr) = (VOID *) fsPathPtr;
6217     PATHFLAGS(objPtr) = 0;
6218     objPtr->typePtr = &tclFsPathType;
6219 
6220     return TCL_OK;
6221 }
int Tcl_Access (CONST char * path, int mode)

Definition at line 217 of file tclIOUtil.c.
References Tcl_DecrRefCount, Tcl_FSAccess(), Tcl_IncrRefCount, and Tcl_NewStringObj().220 {
221     int ret;
222     Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
223     Tcl_IncrRefCount(pathPtr);
224     ret = Tcl_FSAccess(pathPtr,mode);
225     Tcl_DecrRefCount(pathPtr);
226     return ret;
227 }
int Tcl_Chdir (CONST char * dirName)

Definition at line 252 of file tclIOUtil.c.
References Tcl_DecrRefCount, Tcl_FSChdir(), Tcl_IncrRefCount, and Tcl_NewStringObj().254 {
255     int ret;
256     Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName,-1);
257     Tcl_IncrRefCount(pathPtr);
258     ret = Tcl_FSChdir(pathPtr);
259     Tcl_DecrRefCount(pathPtr);
260     return ret;
261 }
TCL_DECLARE_MUTEX (filesystemMutex)

Definition at line 487 of file tclIOUtil.c.
References filesystemList, and initialized.504                                   {
505     int initialized;
506     int cwdPathEpoch;
507     int filesystemEpoch; 
508     Tcl_Obj *cwdPathPtr;
509     FilesystemRecord *filesystemList;
510 } ThreadSpecificData;
TCL_DECLARE_MUTEX (obsoleteFsHookMutex)

Definition at line 357 of file tclIOUtil.c.
References NULL, S_IFLNK, TCL_FILESYSTEM_VERSION_1, TclNativeDupInternalRep, TclpDlopen(), TclpObjNormalizePath(), TclpOpenFileChannel(), and TclpUtime().417                                      {
418     "native",
419     sizeof(Tcl_Filesystem),
420     TCL_FILESYSTEM_VERSION_1,
421     &NativePathInFilesystem,
422     &TclNativeDupInternalRep,
423     &NativeFreeInternalRep,
424     &TclpNativeToNormalized,
425     &NativeCreateNativeRep,
426     &TclpObjNormalizePath,
427     &TclpFilesystemPathType,
428     &NativeFilesystemSeparator,
429     &TclpObjStat,
430     &TclpObjAccess,
431     &TclpOpenFileChannel,
432     &TclpMatchInDirectory,
433     &TclpUtime,
434 #ifndef S_IFLNK
435     NULL,
436 #else
437     &TclpObjLink,
438 #endif /* S_IFLNK */
439     &TclpObjListVolumes,
440     &NativeFileAttrStrings,
441     &NativeFileAttrsGet,
442     &NativeFileAttrsSet,
443     &TclpObjCreateDirectory,
444     &TclpObjRemoveDirectory, 
445     &TclpObjDeleteFile,
446     &TclpObjCopyFile,
447     &TclpObjRenameFile,
448     &TclpObjCopyDirectory, 
449     &TclpObjLstat,
450     &TclpDlopen,
451     &TclpObjGetCwd,
452     &TclpObjChdir
453 };
int Tcl_EvalFile (Tcl_Interp * interp, CONST char * fileName)

Definition at line 283 of file tclIOUtil.c.
References Tcl_DecrRefCount, Tcl_FSEvalFile(), Tcl_IncrRefCount, and Tcl_NewStringObj().
Referenced by Tcl_Main(), and Tcl_SourceRCFile().287 {
288     int ret;
289     Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
290     Tcl_IncrRefCount(pathPtr);
291     ret = Tcl_FSEvalFile(interp, pathPtr);
292     Tcl_DecrRefCount(pathPtr);
293     return ret;
294 }
int Tcl_FSAccess (Tcl_Obj * pathPtr, int mode)

Definition at line 2029 of file tclIOUtil.c.
References Tcl_Filesystem::accessProc, accessProcList, ENOENT, AccessProc::nextPtr, AccessProc::proc, Tcl_DecrRefCount, Tcl_FSGetFileSystemForPath(), Tcl_FSGetTranslatedPath(), Tcl_GetString(), Tcl_MutexLock, Tcl_MutexUnlock, and Tcl_SetErrno().
Referenced by CheckAccess(), Tcl_Access(), Tcl_FSChdir(), Tcl_FSLoadFile(), TclpCreateProcess(), and TestReportAccess().2032 {
2033     Tcl_Filesystem *fsPtr;
2034 #ifdef USE_OBSOLETE_FS_HOOKS
2035     int retVal = -1;
2036 
2037     /*
2038      * Call each of the "access" function in succession.  A non-return
2039      * value of -1 indicates the particular function has succeeded.
2040      */
2041 
2042     Tcl_MutexLock(&obsoleteFsHookMutex);
2043 
2044     if (accessProcList != NULL) {
2045   AccessProc *accessProcPtr;
2046   char *path;
2047   Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
2048   if (transPtr == NULL) {
2049       path = NULL;
2050   } else {
2051       path = Tcl_GetString(transPtr);
2052   }
2053 
2054   accessProcPtr = accessProcList;
2055   while ((retVal == -1) && (accessProcPtr != NULL)) {
2056       retVal = (*accessProcPtr->proc)(path, mode);
2057       accessProcPtr = accessProcPtr->nextPtr;
2058   }
2059   if (transPtr != NULL) {
2060       Tcl_DecrRefCount(transPtr);
2061   }
2062     }
2063     
2064     Tcl_MutexUnlock(&obsoleteFsHookMutex);
2065     if (retVal != -1) {
2066   return retVal;
2067     }
2068 #endif /* USE_OBSOLETE_FS_HOOKS */
2069     fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
2070     if (fsPtr != NULL) {
2071   Tcl_FSAccessProc *proc = fsPtr->accessProc;
2072   if (proc != NULL) {
2073       return (*proc)(pathPtr, mode);
2074   }
2075     }
2076 
2077     Tcl_SetErrno(ENOENT);
2078     return -1;
2079 }
int Tcl_FSChdir (Tcl_Obj * pathPtr)

Definition at line 2617 of file tclIOUtil.c.
References Tcl_Filesystem::chdirProc, ENOENT, FsUpdateCwd(), R_OK, S_ISDIR, Tcl_AppendToObj(), Tcl_DecrRefCount, Tcl_FSAccess(), Tcl_FSGetFileSystemForPath(), Tcl_FSGetNormalizedPath(), Tcl_FSGetTranslatedPath(), Tcl_FSStat(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_NewStringObj(), and Tcl_SetErrno().
Referenced by Tcl_CdObjCmd(), Tcl_Chdir(), Tcl_FSRemoveDirectory(), and TestReportChdir().2619 {
2620     Tcl_Filesystem *fsPtr;
2621     int retVal = -1;
2622     
2623 #ifdef WIN32
2624     /*
2625      * This complete hack addresses the bug tested in winFCmd-16.12,
2626      * where having your HOME as "C:" (IOW, a seemingly path relative
2627      * dir) would cause a crash when you cd'd to it and requested 'pwd'.
2628      * The work-around is to force such a dir into an absolute path by
2629      * tacking on '/'.
2630      *
2631      * We check for '~' specifically because that's what Tcl_CdObjCmd
2632      * passes in that triggers the bug.  A direct 'cd C:' call will not
2633      * because that gets the volumerelative pwd.
2634      *
2635      * This is not an issue for 8.5 as that has a more elaborate change
2636      * that requires the use of TCL_FILESYSTEM_VERSION_2.
2637      */
2638     Tcl_Obj *objPtr = NULL;
2639     if (pathPtr->bytes && pathPtr->length == 1 && pathPtr->bytes[0] == '~') {
2640   int len;
2641   char *str;
2642 
2643   objPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
2644   if (objPtr == NULL) {
2645       Tcl_SetErrno(ENOENT);
2646       return -1;
2647   }
2648   Tcl_IncrRefCount(objPtr);
2649   str = Tcl_GetStringFromObj(objPtr, &len);
2650   if (len == 2 && str[1] == ':') {
2651       pathPtr = Tcl_NewStringObj(str, len);
2652       Tcl_AppendToObj(pathPtr, "/", 1);
2653       Tcl_IncrRefCount(pathPtr);
2654       Tcl_DecrRefCount(objPtr);
2655       objPtr = pathPtr;
2656   } else {
2657       Tcl_DecrRefCount(objPtr);
2658       objPtr = NULL;
2659   }
2660     }
2661 #endif
2662     if (Tcl_FSGetNormalizedPath(NULL, pathPtr) == NULL) {
2663 #ifdef WIN32
2664   if (objPtr) { Tcl_DecrRefCount(objPtr); }
2665 #endif
2666   Tcl_SetErrno(ENOENT);
2667         return -1;
2668     }
2669     
2670     fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
2671     if (fsPtr != NULL) {
2672   Tcl_FSChdirProc *proc = fsPtr->chdirProc;
2673   if (proc != NULL) {
2674       retVal = (*proc)(pathPtr);
2675   } else {
2676       /* Fallback on stat-based implementation */
2677       Tcl_StatBuf buf;
2678       /* If the file can be stat'ed and is a directory and
2679        * is readable, then we can chdir. */
2680       if ((Tcl_FSStat(pathPtr, &buf) == 0) 
2681         && (S_ISDIR(buf.st_mode))
2682         && (Tcl_FSAccess(pathPtr, R_OK) == 0)) {
2683     /* We allow the chdir */
2684     retVal = 0;
2685       }
2686   }
2687     }
2688 
2689     if (retVal != -1) {
2690   /* 
2691    * The cwd changed, or an error was thrown.  If an error was
2692    * thrown, we can just continue (and that will report the error
2693    * to the user).  If there was no error we must assume that the
2694    * cwd was actually changed to the normalized value we
2695    * calculated above, and we must therefore cache that
2696    * information.
2697    */
2698   if (retVal == 0) {
2699       /* 
2700        * Note that this normalized path may be different to what
2701        * we found above (or at least a different object), if the
2702        * filesystem epoch changed recently.  This can actually
2703        * happen with scripted documents very easily.  Therefore
2704        * we ask for the normalized path again (the correct value
2705        * will have been cached as a result of the
2706        * Tcl_FSGetFileSystemForPath call above anyway).
2707        */
2708       Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr);
2709       if (normDirName == NULL) {
2710 #ifdef WIN32
2711     if (objPtr) { Tcl_DecrRefCount(objPtr); }
2712 #endif
2713     Tcl_SetErrno(ENOENT);
2714           return -1;
2715       }
2716       FsUpdateCwd(normDirName);
2717   }
2718     } else {
2719   Tcl_SetErrno(ENOENT);
2720     }
2721     
2722 #ifdef WIN32
2723     if (objPtr) { Tcl_DecrRefCount(objPtr); }
2724 #endif
2725     return (retVal);
2726 }
int Tcl_FSConvertToPathType (Tcl_Interp * interp, Tcl_Obj * objPtr)

Definition at line 4990 of file tclIOUtil.c.
References Tcl_Obj::bytes, FsPath::filesystemEpoch, FreeFsPathInternalRep(), PATHOBJ, Tcl_ConvertToType(), TCL_OK, TCL_TSD_INIT, tclFsPathType, Tcl_Obj::typePtr, and UpdateStringOfFsPath().
Referenced by CheckAccess(), CopyRenameOneFile(), FileBasename(), FileCopyRename(), FSGetPathType(), GetStatBuf(), Tcl_CdObjCmd(), Tcl_FileObjCmd(), Tcl_FSGetInternalRep(), Tcl_FSGetNormalizedPath(), Tcl_FSGetTranslatedPath(), Tcl_LoadObjCmd(), TclFileAttrsCmd(), TclFileDeleteCmd(), TclFileMakeDirsCmd(), TclpCreateProcess(), and TestfilelinkCmd().4995 {
4996     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
4997 
4998     /* 
4999      * While it is bad practice to examine an object's type directly,
5000      * this is actually the best thing to do here.  The reason is that
5001      * if we are converting this object to FsPath type for the first
5002      * time, we don't need to worry whether the 'cwd' has changed.
5003      * On the other hand, if this object is already of FsPath type,
5004      * and is a relative path, we do have to worry about the cwd.
5005      * If the cwd has changed, we must recompute the path.
5006      */
5007     if (objPtr->typePtr == &tclFsPathType) {
5008   FsPath *fsPathPtr = (FsPath*) PATHOBJ(objPtr);
5009   if (fsPathPtr->filesystemEpoch != tsdPtr->filesystemEpoch) {
5010       if (objPtr->bytes == NULL) {
5011     UpdateStringOfFsPath(objPtr);
5012       }
5013       FreeFsPathInternalRep(objPtr);
5014       objPtr->typePtr = NULL;
5015       return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
5016   }
5017   return TCL_OK;
5018     } else {
5019   return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
5020     }
5021 }
int Tcl_FSCopyDirectory (Tcl_Obj* srcPathPtr, Tcl_Obj * destPathPtr, Tcl_Obj ** errorPtr)

Definition at line 3780 of file tclIOUtil.c.
References Tcl_Filesystem::copyDirectoryProc, EXDEV, Tcl_FSGetFileSystemForPath(), and Tcl_SetErrno().
Referenced by CopyRenameOneFile(), and TestReportCopyDirectory().3787 {
3788     int retVal = -1;
3789     Tcl_Filesystem *fsPtr, *fsPtr2;
3790     fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
3791     fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
3792 
3793     if (fsPtr == fsPtr2 && fsPtr != NULL) {
3794   Tcl_FSCopyDirectoryProc *proc = fsPtr->copyDirectoryProc;
3795   if (proc != NULL) {
3796       retVal = (*proc)(srcPathPtr, destPathPtr, errorPtr);
3797   }
3798     }
3799     if (retVal == -1) {
3800   Tcl_SetErrno(EXDEV);
3801     }
3802     return retVal;
3803 }
int Tcl_FSCopyFile (Tcl_Obj* srcPathPtr, Tcl_Obj * destPathPtr)

Definition at line 3610 of file tclIOUtil.c.
References Tcl_Filesystem::copyFileProc, EXDEV, Tcl_FSGetFileSystemForPath(), and Tcl_SetErrno().
Referenced by CopyRenameOneFile(), and TestReportCopyFile().3613 {
3614     int retVal = -1;
3615     Tcl_Filesystem *fsPtr, *fsPtr2;
3616     fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
3617     fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
3618 
3619     if (fsPtr == fsPtr2 && fsPtr != NULL) {
3620   Tcl_FSCopyFileProc *proc = fsPtr->copyFileProc;
3621   if (proc != NULL) {
3622       retVal = (*proc)(srcPathPtr, destPathPtr);
3623   }
3624     }
3625     if (retVal == -1) {
3626   Tcl_SetErrno(EXDEV);
3627     }
3628     return retVal;
3629 }
int Tcl_FSCreateDirectory (Tcl_Obj * pathPtr)

Definition at line 3747 of file tclIOUtil.c.
References Tcl_Filesystem::createDirectoryProc, ENOENT, Tcl_FSGetFileSystemForPath(), and Tcl_SetErrno().
Referenced by TclFileMakeDirsCmd(), and TestReportCreateDirectory().3749 {
3750     Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
3751     if (fsPtr != NULL) {
3752   Tcl_FSCreateDirectoryProc *proc = fsPtr->createDirectoryProc;
3753   if (proc != NULL) {
3754       return (*proc)(pathPtr);
3755   }
3756     }
3757     Tcl_SetErrno(ENOENT);
3758     return -1;
3759 }
ClientData Tcl_FSData (Tcl_Filesystem  * fsPtr)

Definition at line 1278 of file tclIOUtil.c.
References FilesystemRecord::clientData, FsGetFirstFilesystem(), FilesystemRecord::fsPtr, and FilesystemRecord::nextPtr.
Referenced by TestReport().1280 {
1281     ClientData retVal = NULL;
1282     FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();
1283 
1284     /*
1285      * Traverse the 'filesystemList' looking for the particular node
1286      * whose 'fsPtr' member matches 'fsPtr' and remove that one from
1287      * the list.  Ensure that the "default" node cannot be removed.
1288      */
1289 
1290     while ((retVal == NULL) && (fsRecPtr != NULL)) {
1291   if (fsRecPtr->fsPtr == fsPtr) {
1292       retVal = fsRecPtr->clientData;
1293   }
1294   fsRecPtr = fsRecPtr->nextPtr;
1295     }
1296 
1297     return retVal;
1298 }
int Tcl_FSDeleteFile (Tcl_Obj * pathPtr)

Definition at line 3715 of file tclIOUtil.c.
References Tcl_Filesystem::deleteFileProc, ENOENT, Tcl_FSGetFileSystemForPath(), and Tcl_SetErrno().
Referenced by CopyRenameOneFile(), SimpleCopy(), SimpleOpenFileChannel(), SimpleStat(), Tcl_FSLoadFile(), TclFileDeleteCmd(), TestReportDeleteFile(), and TestSimpleFilesystemObjCmd().3717 {
3718     Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
3719     if (fsPtr != NULL) {
3720   Tcl_FSDeleteFileProc *proc = fsPtr->deleteFileProc;
3721   if (proc != NULL) {
3722       return (*proc)(pathPtr);
3723   }
3724     }
3725     Tcl_SetErrno(ENOENT);
3726     return -1;
3727 }
int Tcl_FSEqualPaths (Tcl_Obj* firstPtr, Tcl_Obj* secondPtr)

Definition at line 5992 of file tclIOUtil.c.
References Tcl_FSGetNormalizedPath(), Tcl_GetErrno(), Tcl_GetStringFromObj(), and Tcl_SetErrno().
Referenced by CopyRenameOneFile(), FsAddMountsToGlobResult(), Tcl_FSGetCwd(), and TclFileDeleteCmd().5995 {
5996     if (firstPtr == secondPtr) {
5997   return 1;
5998     } else {
5999   char *firstStr, *secondStr;
6000   int firstLen, secondLen, tempErrno;
6001 
6002   if (firstPtr == NULL || secondPtr == NULL) {
6003       return 0;
6004   }
6005   firstStr  = Tcl_GetStringFromObj(firstPtr, &firstLen);
6006   secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
6007   if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) {
6008       return 1;
6009   }
6010   /* 
6011    * Try the most thorough, correct method of comparing fully
6012    * normalized paths
6013    */
6014 
6015   tempErrno = Tcl_GetErrno();
6016   firstPtr = Tcl_FSGetNormalizedPath(NULL, firstPtr);
6017   secondPtr = Tcl_FSGetNormalizedPath(NULL, secondPtr);
6018   Tcl_SetErrno(tempErrno);
6019 
6020   if (firstPtr == NULL || secondPtr == NULL) {
6021       return 0;
6022   }
6023   firstStr  = Tcl_GetStringFromObj(firstPtr, &firstLen);
6024   secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
6025   if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) {
6026       return 1;
6027   }
6028     }
6029 
6030     return 0;
6031 }
int Tcl_FSEvalFile (Tcl_Interp * interp, Tcl_Obj * pathPtr)

Definition at line 1708 of file tclIOUtil.c.
References errno, Interp::scriptFile, Tcl_AddErrorInfo(), Tcl_Close(), Tcl_DecrRefCount, TCL_ERROR, Tcl_EvalEx(), Tcl_FSGetNormalizedPath(), Tcl_FSOpenFileChannel(), Tcl_FSStat(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, TCL_INTEGER_SPACE, Tcl_NewObj(), TCL_OK, Tcl_PosixError(), Tcl_ReadChars(), Tcl_ResetResult(), TCL_RETURN, Tcl_SetChannelOption(), Tcl_SetErrno(), and TclUpdateReturnInfo().
Referenced by Tcl_EvalFile(), Tcl_MacSourceObjCmd(), Tcl_Main(), and Tcl_SourceObjCmd().1712 {
1713     int result, length;
1714     Tcl_StatBuf statBuf;
1715     Tcl_Obj *oldScriptFile;
1716     Interp *iPtr;
1717     char *string;
1718     Tcl_Channel chan;
1719     Tcl_Obj *objPtr;
1720 
1721     if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
1722   return TCL_ERROR;
1723     }
1724 
1725     result = TCL_ERROR;
1726     objPtr = Tcl_NewObj();
1727 
1728     if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
1729         Tcl_SetErrno(errno);
1730   Tcl_AppendResult(interp, "couldn't read file \"", 
1731     Tcl_GetString(pathPtr),
1732     "\": ", Tcl_PosixError(interp), (char *) NULL);
1733   goto end;
1734     }
1735     chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
1736     if (chan == (Tcl_Channel) NULL) {
1737         Tcl_ResetResult(interp);
1738   Tcl_AppendResult(interp, "couldn't read file \"", 
1739     Tcl_GetString(pathPtr),
1740     "\": ", Tcl_PosixError(interp), (char *) NULL);
1741   goto end;
1742     }
1743     /*
1744      * The eofchar is \32 (^Z).  This is the usual on Windows, but we
1745      * effect this cross-platform to allow for scripted documents.
1746      * [Bug: 2040]
1747      */
1748     Tcl_SetChannelOption(interp, chan, "-eofchar", "\32");
1749     if (Tcl_ReadChars(chan, objPtr, -1, 0) < 0) {
1750         Tcl_Close(interp, chan);
1751   Tcl_AppendResult(interp, "couldn't read file \"", 
1752     Tcl_GetString(pathPtr),
1753     "\": ", Tcl_PosixError(interp), (char *) NULL);
1754   goto end;
1755     }
1756     if (Tcl_Close(interp, chan) != TCL_OK) {
1757         goto end;
1758     }
1759 
1760     iPtr = (Interp *) interp;
1761     oldScriptFile = iPtr->scriptFile;
1762     iPtr->scriptFile = pathPtr;
1763     Tcl_IncrRefCount(iPtr->scriptFile);
1764     string = Tcl_GetStringFromObj(objPtr, &length);
1765     result = Tcl_EvalEx(interp, string, length, 0);
1766     /* 
1767      * Now we have to be careful; the script may have changed the
1768      * iPtr->scriptFile value, so we must reset it without
1769      * assuming it still points to 'pathPtr'.
1770      */
1771     if (iPtr->scriptFile != NULL) {
1772   Tcl_DecrRefCount(iPtr->scriptFile);
1773     }
1774     iPtr->scriptFile = oldScriptFile;
1775 
1776     if (result == TCL_RETURN) {
1777   result = TclUpdateReturnInfo(iPtr);
1778     } else if (result == TCL_ERROR) {
1779   char msg[200 + TCL_INTEGER_SPACE];
1780 
1781   /*
1782    * Record information telling where the error occurred.
1783    */
1784 
1785   sprintf(msg, "\n    (file \"%.150s\" line %d)", Tcl_GetString(pathPtr),
1786     interp->errorLine);
1787   Tcl_AddErrorInfo(interp, msg);
1788     }
1789 
1790     end:
1791     Tcl_DecrRefCount(objPtr);
1792     return result;
1793 }
int Tcl_FSFileAttrsGet (Tcl_Interp * interp, int index, Tcl_Obj * pathPtr, Tcl_Obj ** objPtrRef)

Definition at line 2388 of file tclIOUtil.c.
References ENOENT, Tcl_Filesystem::fileAttrsGetProc, Tcl_FSGetFileSystemForPath(), and Tcl_SetErrno().
Referenced by TclFileAttrsCmd(), and TestReportFileAttrsGet().2393 {
2394     Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
2395     if (fsPtr != NULL) {
2396   Tcl_FSFileAttrsGetProc *proc = fsPtr->fileAttrsGetProc;
2397   if (proc != NULL) {
2398       return (*proc)(interp, index, pathPtr, objPtrRef);
2399   }
2400     }
2401     Tcl_SetErrno(ENOENT);
2402     return -1;
2403 }
int Tcl_FSFileAttrsSet (Tcl_Interp * interp, int index, Tcl_Obj * pathPtr, Tcl_Obj * objPtr)

Definition at line 2424 of file tclIOUtil.c.
References ENOENT, Tcl_Filesystem::fileAttrsSetProc, Tcl_FSGetFileSystemForPath(), and Tcl_SetErrno().
Referenced by Tcl_FSLoadFile(), TclFileAttrsCmd(), and TestReportFileAttrsSet().2429 {
2430     Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
2431     if (fsPtr != NULL) {
2432   Tcl_FSFileAttrsSetProc *proc = fsPtr->fileAttrsSetProc;
2433   if (proc != NULL) {
2434       return (*proc)(interp, index, pathPtr, objPtr);
2435   }
2436     }
2437     Tcl_SetErrno(ENOENT);
2438     return -1;
2439 }
CONST char** Tcl_FSFileAttrStrings (Tcl_Obj* pathPtr, Tcl_Obj** objPtrRef)

Definition at line 2349 of file tclIOUtil.c.
References ENOENT, Tcl_Filesystem::fileAttrStringsProc, Tcl_FSGetFileSystemForPath(), and Tcl_SetErrno().
Referenced by TclFileAttrsCmd(), and TestReportFileAttrStrings().2352 {
2353     Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
2354     if (fsPtr != NULL) {
2355   Tcl_FSFileAttrStringsProc *proc = fsPtr->fileAttrStringsProc;
2356   if (proc != NULL) {
2357       return (*proc)(pathPtr, objPtrRef);
2358   }
2359     }
2360     Tcl_SetErrno(ENOENT);
2361     return NULL;
2362 }
Tcl_Obj* Tcl_FSFileSystemInfo (Tcl_Obj* pathObjPtr)

Definition at line 4182 of file tclIOUtil.c.
References Tcl_Filesystem::filesystemPathTypeProc, Tcl_FSGetFileSystemForPath(), Tcl_ListObjAppendElement(), Tcl_NewListObj(), Tcl_NewStringObj(), and Tcl_Filesystem::typeName.
Referenced by Tcl_FileObjCmd().4184 {
4185     Tcl_Obj *resPtr;
4186     Tcl_FSFilesystemPathTypeProc *proc;
4187     Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathObjPtr);
4188     
4189     if (fsPtr == NULL) {
4190   return NULL;
4191     }
4192     
4193     resPtr = Tcl_NewListObj(0,NULL);
4194     
4195     Tcl_ListObjAppendElement(NULL, resPtr, 
4196            Tcl_NewStringObj(fsPtr->typeName,-1));
4197 
4198     proc = fsPtr->filesystemPathTypeProc;
4199     if (proc != NULL) {
4200   Tcl_Obj *typePtr = (*proc)(pathObjPtr);
4201   if (typePtr != NULL) {
4202       Tcl_ListObjAppendElement(NULL, resPtr, typePtr);
4203   }
4204     }
4205     
4206     return resPtr;
4207 }
Tcl_Obj* Tcl_FSGetCwd (Tcl_Interp * interp)

Definition at line 2483 of file tclIOUtil.c.
References FsGetFirstFilesystem(), FilesystemRecord::fsPtr, FsUpdateCwd(), Tcl_Filesystem::getCwdProc, FilesystemRecord::nextPtr, Tcl_DecrRefCount, Tcl_FSEqualPaths(), Tcl_FSGetFileSystemForPath(), Tcl_IncrRefCount, TCL_TSD_INIT, TclFSCwdPointerEquals(), and TclFSNormalizeAbsolutePath().
Referenced by Tcl_FSGetNormalizedPath(), Tcl_FSMatchInDirectory(), Tcl_FSRemoveDirectory(), Tcl_GetCwd(), and Tcl_PwdObjCmd().2485 {
2486     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2487     
2488     if (TclFSCwdPointerEquals(NULL)) {
2489   FilesystemRecord *fsRecPtr;
2490   Tcl_Obj *retVal = NULL;
2491 
2492   /* 
2493    * We've never been called before, try to find a cwd.  Call
2494    * each of the "Tcl_GetCwd" function in succession.  A non-NULL
2495    * return value indicates the particular function has
2496    * succeeded.
2497    */
2498 
2499   fsRecPtr = FsGetFirstFilesystem();
2500   while ((retVal == NULL) && (fsRecPtr != NULL)) {
2501       Tcl_FSGetCwdProc *proc = fsRecPtr->fsPtr->getCwdProc;
2502       if (proc != NULL) {
2503     retVal = (*proc)(interp);
2504       }
2505       fsRecPtr = fsRecPtr->nextPtr;
2506   }
2507   /* 
2508    * Now the 'cwd' may NOT be normalized, at least on some
2509    * platforms.  For the sake of efficiency, we want a completely
2510    * normalized cwd at all times.
2511    * 
2512    * Finally, if retVal is NULL, we do not have a cwd, which
2513    * could be problematic.
2514    */
2515   if (retVal != NULL) {
2516       Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);
2517       if (norm != NULL) {
2518     /* 
2519      * We found a cwd, which is now in our global storage.
2520      * We must make a copy. Norm already has a refCount of 1.
2521      * 
2522      * Threading issue: note that multiple threads at system
2523      * startup could in principle call this procedure 
2524      * simultaneously.  They will therefore each set the
2525      * cwdPathPtr independently.  That behaviour is a bit
2526      * peculiar, but should be fine.  Once we have a cwd,
2527      * we'll always be in the 'else' branch below which
2528      * is simpler.
2529      */
2530     FsUpdateCwd(norm);
2531     Tcl_DecrRefCount(norm);
2532       }
2533       Tcl_DecrRefCount(retVal);
2534   }
2535     } else {
2536   /* 
2537    * We already have a cwd cached, but we want to give the
2538    * filesystem it is in a chance to check whether that cwd
2539    * has changed, or is perhaps no longer accessible.  This
2540    * allows an error to be thrown if, say, the permissions on
2541    * that directory have changed.
2542    */
2543   Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);
2544   /* 
2545    * If the filesystem couldn't be found, or if no cwd function
2546    * exists for this filesystem, then we simply assume the cached
2547    * cwd is ok.  If we do call a cwd, we must watch for errors
2548    * (if the cwd returns NULL).  This ensures that, say, on Unix
2549    * if the permissions of the cwd change, 'pwd' does actually
2550    * throw the correct error in Tcl.  (This is tested for in the
2551    * test suite on unix).
2552    */
2553   if (fsPtr != NULL) {
2554       Tcl_FSGetCwdProc *proc = fsPtr->getCwdProc;
2555       if (proc != NULL) {
2556     Tcl_Obj *retVal = (*proc)(interp);
2557     if (retVal != NULL) {
2558         Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);
2559         /* 
2560          * Check whether cwd has changed from the value
2561          * previously stored in cwdPathPtr.  Really 'norm'
2562          * shouldn't be null, but we are careful.
2563          */
2564         if (norm == NULL) {
2565       /* Do nothing */
2566         } else if (Tcl_FSEqualPaths(tsdPtr->cwdPathPtr, norm)) {
2567       /* 
2568        * If the paths were equal, we can be more
2569        * efficient and retain the old path object
2570        * which will probably already be shared.  In
2571        * this case we can simply free the normalized
2572        * path we just calculated.
2573        */
2574       Tcl_DecrRefCount(norm);
2575         } else {
2576       FsUpdateCwd(norm);
2577       Tcl_DecrRefCount(norm);
2578         }
2579         Tcl_DecrRefCount(retVal);
2580     } else {
2581         /* The 'cwd' function returned an error; reset the cwd */
2582         FsUpdateCwd(NULL);
2583     }
2584       }
2585   }
2586     }
2587     
2588     if (tsdPtr->cwdPathPtr != NULL) {
2589   Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
2590     }
2591     
2592     return tsdPtr->cwdPathPtr; 
2593 }
Tcl_Filesystem* Tcl_FSGetFileSystemForPath (Tcl_Obj* pathObjPtr)

Definition at line 3891 of file tclIOUtil.c.
References FsGetFirstFilesystem(), FilesystemRecord::fsPtr, FilesystemRecord::nextPtr, panic, Tcl_Filesystem::pathInFilesystemProc, TCL_OK, TclFSEnsureEpochOk(), and TclFSSetPathDetails().
Referenced by Tcl_FSAccess(), Tcl_FSChdir(), Tcl_FSCopyDirectory(), Tcl_FSCopyFile(), Tcl_FSCreateDirectory(), Tcl_FSDeleteFile(), Tcl_FSFileAttrsGet(), Tcl_FSFileAttrsSet(), Tcl_FSFileAttrStrings(), Tcl_FSFileSystemInfo(), Tcl_FSGetCwd(), Tcl_FSGetInternalRep(), Tcl_FSLink(), Tcl_FSLoadFile(), Tcl_FSLstat(), Tcl_FSMatchInDirectory(), Tcl_FSOpenFileChannel(), Tcl_FSPathSeparator(), Tcl_FSRemoveDirectory(), Tcl_FSRenameFile(), Tcl_FSStat(), Tcl_FSUtime(), and TestReportInFilesystem().3893 {
3894     FilesystemRecord *fsRecPtr;
3895     Tcl_Filesystem* retVal = NULL;
3896     
3897     /* 
3898      * If the object has a refCount of zero, we reject it.  This
3899      * is to avoid possible segfaults or nondeterministic memory
3900      * leaks (i.e. the user doesn't know if they should decrement
3901      * the ref count on return or not).
3902      */
3903     
3904     if (pathObjPtr->refCount == 0) {
3905   panic("Tcl_FSGetFileSystemForPath called with object with refCount == 0");
3906   return NULL;
3907     }
3908     
3909     /* 
3910      * Check if the filesystem has changed in some way since
3911      * this object's internal representation was calculated.
3912      * Before doing that, assure we have the most up-to-date
3913      * copy of the master filesystem. This is accomplished
3914      * by the FsGetFirstFilesystem() call.
3915      */
3916 
3917     fsRecPtr = FsGetFirstFilesystem();
3918 
3919     if (TclFSEnsureEpochOk(pathObjPtr, &retVal) != TCL_OK) {
3920   return NULL;
3921     }
3922 
3923     /*
3924      * Call each of the "pathInFilesystem" functions in succession.  A
3925      * non-return value of -1 indicates the particular function has
3926      * succeeded.
3927      */
3928 
3929     while ((retVal == NULL) && (fsRecPtr != NULL)) {
3930   Tcl_FSPathInFilesystemProc *proc = fsRecPtr->fsPtr->pathInFilesystemProc;
3931   if (proc != NULL) {
3932       ClientData clientData = NULL;
3933       int ret = (*proc)(pathObjPtr, &clientData);
3934       if (ret != -1) {
3935     /* 
3936      * We assume the type of pathObjPtr hasn't been changed 
3937      * by the above call to the pathInFilesystemProc.
3938      */
3939     TclFSSetPathDetails(pathObjPtr, fsRecPtr, clientData);
3940     retVal = fsRecPtr->fsPtr;
3941       }
3942   }
3943   fsRecPtr = fsRecPtr->nextPtr;
3944     }
3945 
3946     return retVal;
3947 }
ClientData Tcl_FSGetInternalRep (Tcl_Obj* pathObjPtr, Tcl_Filesystem * fsPtr)

Definition at line 5811 of file tclIOUtil.c.
References Tcl_Filesystem::createInternalRepProc, FilesystemRecord::fsPtr, FsPath::fsRecPtr, FsPath::nativePathPtr, PATHOBJ, Tcl_FSConvertToPathType(), Tcl_FSGetFileSystemForPath(), and TCL_OK.
Referenced by Tcl_FSGetNativePath(), Tcl_FSLoadFile(), and TestReportGetNativePath().5814 {
5815     FsPath *srcFsPathPtr;
5816     
5817     if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) {
5818   return NULL;
5819     }
5820     srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
5821     
5822     /* 
5823      * We will only return the native representation for the caller's
5824      * filesystem.  Otherwise we will simply return NULL. This means
5825      * that there must be a unique bi-directional mapping between paths
5826      * and filesystems, and that this mapping will not allow 'remapped'
5827      * files -- files which are in one filesystem but mapped into
5828      * another.  Another way of putting this is that 'stacked'
5829      * filesystems are not allowed.  We recognise that this is a
5830      * potentially useful feature for the future.
5831      * 
5832      * Even something simple like a 'pass through' filesystem which
5833      * logs all activity and passes the calls onto the native system
5834      * would be nice, but not easily achievable with the current
5835      * implementation.
5836      */
5837     if (srcFsPathPtr->fsRecPtr == NULL) {
5838   /* 
5839    * This only usually happens in wrappers like TclpStat which
5840    * create a string object and pass it to TclpObjStat.  Code
5841    * which calls the Tcl_FS..  functions should always have a
5842    * filesystem already set.  Whether this code path is legal or
5843    * not depends on whether we decide to allow external code to
5844    * call the native filesystem directly.  It is at least safer
5845    * to allow this sub-optimal routing.
5846    */
5847   Tcl_FSGetFileSystemForPath(pathObjPtr);
5848   
5849   /* 
5850    * If we fail through here, then the path is probably not a
5851    * valid path in the filesystsem, and is most likely to be a
5852    * use of the empty path "" via a direct call to one of the
5853    * objectified interfaces (e.g. from the Tcl testsuite).
5854    */
5855   srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
5856   if (srcFsPathPtr->fsRecPtr == NULL) {
5857       return NULL;
5858   }
5859     }
5860 
5861     if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) {
5862   /* 
5863    * There is still one possibility we should consider; if the
5864    * file belongs to a different filesystem, perhaps it is
5865    * actually linked through to a file in our own filesystem
5866    * which we do care about.  The way we can check for this
5867    * is we ask what filesystem this path belongs to.
5868    */
5869   Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathObjPtr);
5870   if (actualFs == fsPtr) {
5871       return Tcl_FSGetInternalRep(pathObjPtr, fsPtr);
5872   }
5873   return NULL;
5874     }
5875 
5876     if (srcFsPathPtr->nativePathPtr == NULL) {
5877   Tcl_FSCreateInternalRepProc *proc;
5878   char *nativePathPtr;
5879 
5880   proc = srcFsPathPtr->fsRecPtr->fsPtr->createInternalRepProc;
5881   if (proc == NULL) {
5882       return NULL;
5883   }
5884 
5885   nativePathPtr = (*proc)(pathObjPtr);
5886   srcFsPathPtr  = (FsPath*) PATHOBJ(pathObjPtr);
5887   srcFsPathPtr->nativePathPtr = nativePathPtr;
5888     }
5889 
5890     return srcFsPathPtr->nativePathPtr;
5891 }
CONST char* Tcl_FSGetNativePath (Tcl_Obj * pathObjPtr)

Definition at line 3982 of file tclIOUtil.c.
References CONST, and Tcl_FSGetInternalRep().
Referenced by FindLibraries(), FspLLocationFromFsPath(), FspLocationFromFsPath(), GetFileFinderAttributes(), GetFileReadOnly(), GetWinFileAttributes(), SetFileFinderAttributes(), SetFileReadOnly(), SetGroupAttribute(), SetOwnerAttribute(), SetPermissionsAttribute(), SetWinFileAttributes(), TclpDlopen(), TclpFilesystemPathType(), TclpMatchInDirectory(), TclpObjAccess(), TclpObjChdir(), TclpObjCopyDirectory(), TclpObjCopyFile(), TclpObjCreateDirectory(), TclpObjDeleteFile(), TclpObjLstat(), TclpObjRemoveDirectory(), TclpObjRenameFile(), TclpObjStat(), TclpOpenFileChannel(), and TclpUtime().3984 {
3985     return (CONST char *)Tcl_FSGetInternalRep(pathObjPtr, &tclNativeFilesystem);
3986 }
Tcl_Obj* Tcl_FSGetNormalizedPath (Tcl_Interp * interp, Tcl_Obj* pathObjPtr)

Definition at line 5506 of file tclIOUtil.c.
References Tcl_Obj::bytes, CONST, FsPath::cwdPtr, Tcl_Filesystem::dupInternalRepProc, FreeFsPathInternalRep(), FilesystemRecord::fsPtr, FsPath::fsRecPtr, FsPath::nativePathPtr, FsPath::normPathPtr, PATHFLAGS, PATHOBJ, Tcl_AppendObjToObj(), Tcl_AppendToObj(), Tcl_ConvertToType(), Tcl_DecrRefCount, Tcl_DuplicateObj(), Tcl_FSConvertToPathType(), Tcl_FSGetCwd(), Tcl_FSGetPathType(), Tcl_FSJoinToPath(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_OK, TCL_PATH_RELATIVE, TCL_PATH_VOLUME_RELATIVE, TCL_PLATFORM_MAC, TCL_PLATFORM_UNIX, TCL_PLATFORM_WINDOWS, TclFSCwdPointerEquals(), TclFSNormalizeAbsolutePath(), TclFSNormalizeToUniquePath(), tclFsPathType, tclPlatform, FsPath::translatedPathPtr, Tcl_Obj::typePtr, and UpdateStringOfFsPath().
Referenced by NativeCreateNativeRep(), Tcl_FileObjCmd(), Tcl_FSChdir(), Tcl_FSEqualPaths(), Tcl_FSEvalFile(), Tcl_FSGetTranslatedPath(), Tcl_FSOpenFileChannel(), Tcl_FSRemoveDirectory(), TclFileDirname(), TclFSEnsureEpochOk(), TclpFilesystemPathType(), TclpMatchInDirectory(), TclpObjCopyDirectory(), TclpObjRemoveDirectory(), TclpUtime(), and TestfileCmd().5509 {
5510     FsPath *fsPathPtr;
5511 
5512     if (Tcl_FSConvertToPathType(interp, pathObjPtr) != TCL_OK) {
5513   return NULL;
5514     }
5515     fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
5516 
5517     if (PATHFLAGS(pathObjPtr) != 0) {
5518   /* 
5519    * This is a special path object which is the result of
5520    * something like 'file join' 
5521    */
5522   Tcl_Obj *dir, *copy;
5523   int cwdLen;
5524   int pathType;
5525   CONST char *cwdStr;
5526   ClientData clientData = NULL;
5527   
5528   pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
5529   dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr);
5530   if (dir == NULL) {
5531       return NULL;
5532   }
5533   if (pathObjPtr->bytes == NULL) {
5534       UpdateStringOfFsPath(pathObjPtr);
5535   }
5536   copy = Tcl_DuplicateObj(dir);
5537   Tcl_IncrRefCount(copy);
5538   Tcl_IncrRefCount(dir);
5539   /* We now own a reference on both 'dir' and 'copy' */
5540   
5541   cwdStr = Tcl_GetStringFromObj(copy, &cwdLen);
5542   /* 
5543    * Should we perhaps use 'Tcl_FSPathSeparator'?
5544    * But then what about the Windows special case?
5545    * Perhaps we should just check if cwd is a root volume.
5546    * We should never get cwdLen == 0 in this code path.
5547    */
5548   switch (tclPlatform) {
5549       case TCL_PLATFORM_UNIX:
5550     if (cwdStr[cwdLen-1] != '/') {
5551         Tcl_AppendToObj(copy, "/", 1);
5552         cwdLen++;
5553     }
5554     break;
5555       case TCL_PLATFORM_WINDOWS:
5556     if (cwdStr[cwdLen-1] != '/' 
5557       && cwdStr[cwdLen-1] != '\\') {
5558         Tcl_AppendToObj(copy, "/", 1);
5559         cwdLen++;
5560     }
5561     break;
5562       case TCL_PLATFORM_MAC:
5563     if (cwdStr[cwdLen-1] != ':') {
5564         Tcl_AppendToObj(copy, ":", 1);
5565         cwdLen++;
5566     }
5567     break;
5568   }
5569   Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr);
5570   /* 
5571    * Normalize the combined string, but only starting after
5572    * the end of the previously normalized 'dir'.  This should
5573    * be much faster!  We use 'cwdLen-1' so that we are
5574    * already pointing at the dir-separator that we know about.
5575    * The normalization code will actually start off directly
5576    * after that separator.
5577    */
5578   TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, 
5579     (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
5580   /* Now we need to construct the new path object */
5581   
5582   if (pathType == TCL_PATH_RELATIVE) {
5583       FsPath* origDirFsPathPtr;
5584       Tcl_Obj *origDir = fsPathPtr->cwdPtr;
5585       origDirFsPathPtr = (FsPath*) PATHOBJ(origDir);
5586       
5587       fsPathPtr->cwdPtr = origDirFsPathPtr->cwdPtr;
5588       Tcl_IncrRefCount(fsPathPtr->cwdPtr);
5589       
5590       Tcl_DecrRefCount(fsPathPtr->normPathPtr);
5591       fsPathPtr->normPathPtr = copy;
5592       /* That's our reference to copy used */
5593       Tcl_DecrRefCount(dir);
5594       Tcl_DecrRefCount(origDir);
5595   } else {
5596       Tcl_DecrRefCount(fsPathPtr->cwdPtr);
5597       fsPathPtr->cwdPtr = NULL;
5598       Tcl_DecrRefCount(fsPathPtr->normPathPtr);
5599       fsPathPtr->normPathPtr = copy;
5600       /* That's our reference to copy used */
5601       Tcl_DecrRefCount(dir);
5602   }
5603   if (clientData != NULL) {
5604       fsPathPtr->nativePathPtr = clientData;
5605   }
5606   PATHFLAGS(pathObjPtr) = 0;
5607     }
5608     /* Ensure cwd hasn't changed */
5609     if (fsPathPtr->cwdPtr != NULL) {
5610   if (!TclFSCwdPointerEquals(fsPathPtr->cwdPtr)) {
5611       if (pathObjPtr->bytes == NULL) {
5612     UpdateStringOfFsPath(pathObjPtr);
5613       }
5614       FreeFsPathInternalRep(pathObjPtr);
5615       pathObjPtr->typePtr = NULL;
5616       if (Tcl_ConvertToType(interp, pathObjPtr, 
5617           &tclFsPathType) != TCL_OK) {
5618     return NULL;
5619       }
5620       fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
5621   } else if (fsPathPtr->normPathPtr == NULL) {
5622       int cwdLen;
5623       Tcl_Obj *copy;
5624       CONST char *cwdStr;
5625       ClientData clientData = NULL;
5626       
5627       copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr);
5628       Tcl_IncrRefCount(copy);
5629       cwdStr = Tcl_GetStringFromObj(copy, &cwdLen);
5630       /* 
5631        * Should we perhaps use 'Tcl_FSPathSeparator'?
5632        * But then what about the Windows special case?
5633        * Perhaps we should just check if cwd is a root volume.
5634        * We should never get cwdLen == 0 in this code path.
5635        */
5636       switch (tclPlatform) {
5637     case TCL_PLATFORM_UNIX:
5638         if (cwdStr[cwdLen-1] != '/') {
5639       Tcl_AppendToObj(copy, "/", 1);
5640       cwdLen++;
5641         }
5642         break;
5643     case TCL_PLATFORM_WINDOWS:
5644         if (cwdStr[cwdLen-1] != '/' 
5645           && cwdStr[cwdLen-1] != '\\') {
5646       Tcl_AppendToObj(copy, "/", 1);
5647       cwdLen++;
5648         }
5649         break;
5650     case TCL_PLATFORM_MAC:
5651         if (cwdStr[cwdLen-1] != ':') {
5652       Tcl_AppendToObj(copy, ":", 1);
5653       cwdLen++;
5654         }
5655         break;
5656       }
5657       Tcl_AppendObjToObj(copy, pathObjPtr);
5658       /* 
5659        * Normalize the combined string, but only starting after
5660        * the end of the previously normalized 'dir'.  This should
5661        * be much faster!
5662        */
5663       TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, 
5664         (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
5665       fsPathPtr->normPathPtr = copy;
5666       if (clientData != NULL) {
5667     fsPathPtr->nativePathPtr = clientData;
5668       }
5669   }
5670     }
5671     if (fsPathPtr->normPathPtr == NULL) {
5672   ClientData clientData = NULL;
5673   Tcl_Obj *useThisCwd = NULL;
5674   /* 
5675    * Since normPathPtr is NULL, but this is a valid path
5676    * object, we know that the translatedPathPtr cannot be NULL.
5677    */
5678   Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr;
5679   char *path = Tcl_GetString(absolutePath);
5680   
5681   /* 
5682    * We have to be a little bit careful here to avoid infinite loops
5683    * we're asking Tcl_FSGetPathType to return the path's type, but
5684    * that call can actually result in a lot of other filesystem
5685    * action, which might loop back through here.
5686    */
5687   if (path[0] != '\0') {
5688       Tcl_PathType type = Tcl_FSGetPathType(pathObjPtr);
5689       if (type == TCL_PATH_RELATIVE) {
5690     useThisCwd = Tcl_FSGetCwd(interp);
5691 
5692     if (useThisCwd == NULL) return NULL;
5693 
5694     absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath);
5695     Tcl_IncrRefCount(absolutePath);
5696     /* We have a refCount on the cwd */
5697 #ifdef __WIN32__
5698       } else if (type == TCL_PATH_VOLUME_RELATIVE) {
5699     /* 
5700      * Only Windows has volume-relative paths.  These
5701      * paths are rather rare, but is is nice if Tcl can
5702      * handle them.  It is much better if we can
5703      * handle them here, rather than in the native fs code,
5704      * because we really need to have a real absolute path
5705      * just below.
5706      * 
5707      * We do not let this block compile on non-Windows
5708      * platforms because the test suite's manual forcing
5709      * of tclPlatform can otherwise cause this code path
5710      * to be executed, causing various errors because
5711      * volume-relative paths really do not exist.
5712      */
5713     useThisCwd = Tcl_FSGetCwd(interp);
5714     if (useThisCwd == NULL) return NULL;
5715     
5716     if (path[0] == '/') {
5717         /* 
5718          * Path of form /foo/bar which is a path in the
5719          * root directory of the current volume.
5720          */
5721         CONST char *drive = Tcl_GetString(useThisCwd);
5722         absolutePath = Tcl_NewStringObj(drive,2);
5723         Tcl_AppendToObj(absolutePath, path, -1);
5724         Tcl_IncrRefCount(absolutePath);
5725         /* We have a refCount on the cwd */
5726     } else {
5727         /* 
5728          * Path of form C:foo/bar, but this only makes
5729          * sense if the cwd is also on drive C.
5730          */
5731         CONST char *drive = Tcl_GetString(useThisCwd);
5732         char drive_c = path[0];
5733         if (drive_c >= 'a') {
5734       drive_c -= ('a' - 'A');
5735         }
5736         if (drive[0] == drive_c) {
5737       absolutePath = Tcl_DuplicateObj(useThisCwd);
5738       /* We have a refCount on the cwd */
5739         } else {
5740       Tcl_DecrRefCount(useThisCwd);
5741       useThisCwd = NULL;
5742       /* 
5743        * The path is not in the current drive, but
5744        * is volume-relative.  The way Tcl 8.3 handles
5745        * this is that it treats such a path as
5746        * relative to the root of the drive.  We
5747        * therefore behave the same here.
5748        */
5749       absolutePath = Tcl_NewStringObj(path, 2);
5750         }
5751         Tcl_IncrRefCount(absolutePath);
5752         Tcl_AppendToObj(absolutePath, "/", 1);
5753         Tcl_AppendToObj(absolutePath, path+2, -1);
5754     }
5755 #endif /* __WIN32__ */
5756       }
5757   }
5758   /* Already has refCount incremented */
5759   fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, absolutePath, 
5760            (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
5761   if (0 && (clientData != NULL)) {
5762       fsPathPtr->nativePathPtr = 
5763         (*fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc)(clientData);
5764   }
5765   if (!strcmp(Tcl_GetString(fsPathPtr->normPathPtr),
5766         Tcl_GetString(pathObjPtr))) {
5767       /* 
5768        * The path was already normalized.  
5769        * Get rid of the duplicate.
5770        */
5771       Tcl_DecrRefCount(fsPathPtr->normPathPtr);
5772       /* 
5773        * We do *not* increment the refCount for 
5774        * this circular reference 
5775        */
5776       fsPathPtr->normPathPtr = pathObjPtr;
5777   }
5778   if (useThisCwd != NULL) {
5779       /* This was returned by Tcl_FSJoinToPath above */
5780       Tcl_DecrRefCount(absolutePath);
5781       fsPathPtr->cwdPtr = useThisCwd;
5782   }
5783     }
5784 
5785     return fsPathPtr->normPathPtr;
5786 }
Tcl_PathType Tcl_FSGetPathType (Tcl_Obj * pathObjPtr)

Definition at line 4695 of file tclIOUtil.c.
References FSGetPathType().
Referenced by FileBasename(), Tcl_FileObjCmd(), Tcl_FSGetNormalizedPath(), Tcl_GetPathType(), and TclFileDirname().4697 {
4698     return FSGetPathType(pathObjPtr, NULL, NULL);
4699 }
Tcl_Obj* Tcl_FSGetTranslatedPath (Tcl_Interp * interp, Tcl_Obj* pathPtr)

Definition at line 5413 of file tclIOUtil.c.
References FsPath::normPathPtr, PATHFLAGS, PATHOBJ, Tcl_FSConvertToPathType(), Tcl_FSGetNormalizedPath(), Tcl_IncrRefCount, TCL_OK, and FsPath::translatedPathPtr.
Referenced by Tcl_FSAccess(), Tcl_FSChdir(), Tcl_FSGetTranslatedStringPath(), Tcl_FSOpenFileChannel(), Tcl_FSStat(), Tcl_TranslateFileName(), TclpMatchInDirectory(), TclpObjCopyDirectory(), TclpObjRemoveDirectory(), and TclpObjStat().5416 {
5417     Tcl_Obj *retObj = NULL;
5418     FsPath *srcFsPathPtr;
5419 
5420     if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
5421   return NULL;
5422     }
5423     srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr);
5424     if (srcFsPathPtr->translatedPathPtr == NULL) {
5425   if (PATHFLAGS(pathPtr) != 0) {
5426       retObj = Tcl_FSGetNormalizedPath(interp, pathPtr);
5427   } else {
5428       /* 
5429        * It is a pure absolute, normalized path object.
5430        * This is something like being a 'pure list'.  The
5431        * object's string, translatedPath and normalizedPath
5432        * are all identical.
5433        */
5434       retObj = srcFsPathPtr->normPathPtr;
5435   }
5436     } else {
5437   /* It is an ordinary path object */
5438   retObj = srcFsPathPtr->translatedPathPtr;
5439     }
5440 
5441     if (retObj) {
5442   Tcl_IncrRefCount(retObj);
5443     }
5444     return retObj;
5445 }
CONST char* Tcl_FSGetTranslatedStringPath (Tcl_Interp * interp, Tcl_Obj* pathPtr)

Definition at line 5467 of file tclIOUtil.c.
References ckalloc, CONST, size_t(), Tcl_DecrRefCount, Tcl_FSGetTranslatedPath(), Tcl_GetStringFromObj(), and VOID.5470 {
5471     Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
5472 
5473     if (transPtr != NULL) {
5474   int len;
5475   CONST char *result, *orig;
5476   orig = Tcl_GetStringFromObj(transPtr, &len);
5477   result = (char*) ckalloc((unsigned)(len+1));
5478   memcpy((VOID*) result, (VOID*) orig, (size_t) (len+1));
5479   Tcl_DecrRefCount(transPtr);
5480   return result;
5481     }
5482 
5483     return NULL;
5484 }
Tcl_Obj* Tcl_FSJoinPath (Tcl_Obj * listObj, int elements)

Definition at line 4770 of file tclIOUtil.c.
References CONST, Tcl_Filesystem::filesystemSeparatorProc, FilesystemRecord::fsPtr, GetPathType(), Tcl_AppendToObj(), Tcl_DecrRefCount, Tcl_DuplicateObj(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_ListObjIndex(), Tcl_ListObjLength(), Tcl_NewObj(), Tcl_NewStringObj(), TCL_OK, TCL_PATH_RELATIVE, TCL_PLATFORM_MAC, TCL_PLATFORM_UNIX, TCL_PLATFORM_WINDOWS, Tcl_SetObjLength(), TclDecrRefCount, tclFsPathType, TclNewFSPathObj(), tclPlatform, and TclpNativeJoinPath().
Referenced by ConvertFileNameFormat(), FileCopyRename(), Tcl_FSJoinToPath(), Tcl_JoinPath(), TclFileDirname(), TclFileMakeDirsCmd(), and TclFSNormalizeAbsolutePath().4773 {
4774     Tcl_Obj *res;
4775     int i;
4776     Tcl_Filesystem *fsPtr = NULL;
4777     
4778     if (elements < 0) {
4779   if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) {
4780       return NULL;
4781   }
4782     } else {
4783   /* Just make sure it is a valid list */
4784   int listTest;
4785   if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) {
4786       return NULL;
4787   }
4788   /* 
4789    * Correct this if it is too large, otherwise we will
4790    * waste our time joining null elements to the path 
4791    */
4792   if (elements > listTest) {
4793       elements = listTest;
4794   }
4795     }
4796     
4797     res = Tcl_NewObj();
4798     
4799     for (i = 0; i < elements; i++) {
4800   Tcl_Obj *elt;
4801   int driveNameLength;
4802   Tcl_PathType type;
4803   char *strElt;
4804   int strEltLen;
4805   int length;
4806   char *ptr;
4807   Tcl_Obj *driveName = NULL;
4808   
4809   Tcl_ListObjIndex(NULL, listObj, i, &elt);
4810   
4811   /* 
4812    * This is a special case where we can be much more
4813    * efficient, where we are joining a single relative path
4814    * onto an object that is already of path type.  The 
4815    * 'TclNewFSPathObj' call below creates an object which
4816    * can be normalized more efficiently.  Currently we only
4817    * use the special case when we have exactly two elements,
4818    * but we could expand that in the future.
4819    */
4820   if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType)
4821     && !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) {
4822       Tcl_Obj *tail;
4823       Tcl_PathType type;
4824       Tcl_ListObjIndex(NULL, listObj, i+1, &tail);
4825       type = GetPathType(tail, NULL, NULL, NULL);
4826       if (type == TCL_PATH_RELATIVE) {
4827     CONST char *str;
4828     int len;
4829     str = Tcl_GetStringFromObj(tail,&len);
4830     if (len == 0) {
4831         /* 
4832          * This happens if we try to handle the root volume
4833          * '/'.  There's no need to return a special path
4834          * object, when the base itself is just fine!
4835          */
4836         Tcl_DecrRefCount(res);
4837         return elt;
4838     }
4839     /* 
4840      * If it doesn't begin with '.'  and is a mac or unix
4841      * path or it a windows path without backslashes, then we
4842      * can be very efficient here.  (In fact even a windows
4843      * path with backslashes can be joined efficiently, but
4844      * the path object would not have forward slashes only,
4845      * and this would therefore contradict our 'file join'
4846      * documentation).
4847      */
4848     if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS) 
4849               || (strchr(str, '\\') == NULL))) {
4850         /* 
4851          * Finally, on Windows, 'file join' is defined to 
4852          * convert all backslashes to forward slashes,
4853          * so the base part cannot have backslashes either.
4854          */
4855         if ((tclPlatform != TCL_PLATFORM_WINDOWS)
4856       || (strchr(Tcl_GetString(elt), '\\') == NULL)) {
4857       if (res != NULL) {
4858           TclDecrRefCount(res);
4859       }
4860       return TclNewFSPathObj(elt, str, len);
4861         }
4862     }
4863     /* 
4864      * Otherwise we don't have an easy join, and
4865      * we must let the more general code below handle
4866      * things
4867      */
4868       } else {
4869     if (tclPlatform == TCL_PLATFORM_UNIX) {
4870         Tcl_DecrRefCount(res);
4871         return tail;
4872     } else {
4873         CONST char *str;
4874         int len;
4875         str = Tcl_GetStringFromObj(tail,&len);
4876         if (tclPlatform == TCL_PLATFORM_WINDOWS) {
4877       if (strchr(str, '\\') == NULL) {
4878           Tcl_DecrRefCount(res);
4879           return tail;
4880       }
4881         } else if (tclPlatform == TCL_PLATFORM_MAC) {
4882       if (strchr(str, '/') == NULL) {
4883           Tcl_DecrRefCount(res);
4884           return tail;
4885       }
4886         }
4887     }
4888       }
4889   }
4890   strElt = Tcl_GetStringFromObj(elt, &strEltLen);
4891   type = GetPathType(elt, &fsPtr, &driveNameLength, &driveName);
4892   if (type != TCL_PATH_RELATIVE) {
4893       /* Zero out the current result */
4894       Tcl_DecrRefCount(res);
4895       if (driveName != NULL) {
4896     res = Tcl_DuplicateObj(driveName);
4897     Tcl_DecrRefCount(driveName);
4898       } else {
4899     res = Tcl_NewStringObj(strElt, driveNameLength);
4900       }
4901       strElt += driveNameLength;
4902   }
4903   
4904   ptr = Tcl_GetStringFromObj(res, &length);
4905   
4906   /* 
4907    * Strip off any './' before a tilde, unless this is the
4908    * beginning of the path.
4909    */
4910   if (length > 0 && strEltLen > 0) {
4911       if ((strElt[0] == '.') && (strElt[1] == '/') 
4912         && (strElt[2] == '~')) {
4913     strElt += 2;
4914       }
4915   }
4916 
4917   /* 
4918    * A NULL value for fsPtr at this stage basically means
4919    * we're trying to join a relative path onto something
4920    * which is also relative (or empty).  There's nothing
4921    * particularly wrong with that.
4922    */
4923   if (*strElt == '\0') continue;
4924   
4925   if (fsPtr == &tclNativeFilesystem || fsPtr == NULL) {
4926       TclpNativeJoinPath(res, strElt);
4927   } else {
4928       char separator = '/';
4929       int needsSep = 0;
4930       
4931       if (fsPtr->filesystemSeparatorProc != NULL) {
4932     Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res);
4933     if (sep != NULL) {
4934         separator = Tcl_GetString(sep)[0];
4935     }
4936       }
4937 
4938       if (length > 0 && ptr[length -1] != '/') {
4939     Tcl_AppendToObj(res, &separator, 1);
4940     length++;
4941       }
4942       Tcl_SetObjLength(res, length + (int) strlen(strElt));
4943       
4944       ptr = Tcl_GetString(res) + length;
4945       for (; *strElt != '\0'; strElt++) {
4946     if (*strElt == separator) {
4947         while (strElt[1] == separator) {
4948       strElt++;
4949         }
4950         if (strElt[1] != '\0') {
4951       if (needsSep) {
4952           *ptr++ = separator;
4953       }
4954         }
4955     } else {
4956         *ptr++ = *strElt;
4957         needsSep = 1;
4958     }
4959       }
4960       length = ptr - Tcl_GetString(res);
4961       Tcl_SetObjLength(res, length);
4962   }
4963     }
4964     return res;
4965 }
Tcl_Obj* Tcl_FSLink (Tcl_Obj * pathPtr, Tcl_Obj * toPtr, int linkAction)

Definition at line 3163 of file tclIOUtil.c.
References EINVAL, ENOENT, errno, Tcl_Filesystem::linkProc, Tcl_FSGetFileSystemForPath(), and Tcl_SetErrno().
Referenced by CopyRenameOneFile(), Tcl_FileObjCmd(), TestfilelinkCmd(), and TestReportLink().3167 {
3168     Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
3169     if (fsPtr != NULL) {
3170   Tcl_FSLinkProc *proc = fsPtr->linkProc;
3171   if (proc != NULL) {
3172       return (*proc)(pathPtr, toPtr, linkAction);
3173   }
3174     }
3175     /*
3176      * If S_IFLNK isn't defined it means that the machine doesn't
3177      * support symbolic links, so the file can't possibly be a
3178      * symbolic link.  Generate an EINVAL error, which is what
3179      * happens on machines that do support symbolic links when
3180      * you invoke readlink on a file that isn't a symbolic link.
3181      */
3182 #ifndef S_IFLNK
3183     errno = EINVAL;
3184 #else
3185     Tcl_SetErrno(ENOENT);
3186 #endif /* S_IFLNK */
3187     return NULL;
3188 }
Tcl_Obj* Tcl_FSListVolumes (void)

Definition at line 3217 of file tclIOUtil.c.
References FsGetFirstFilesystem(), FilesystemRecord::fsPtr, Tcl_Filesystem::listVolumesProc, FilesystemRecord::nextPtr, Tcl_DecrRefCount, Tcl_ListObjAppendList(), and Tcl_NewObj().
Referenced by Tcl_FileObjCmd().3218 {
3219     FilesystemRecord *fsRecPtr;
3220     Tcl_Obj *resultPtr = Tcl_NewObj();
3221     
3222     /*
3223      * Call each of the "listVolumes" function in succession.
3224      * A non-NULL return value indicates the particular function has
3225      * succeeded.  We call all the functions registered, since we want
3226      * a list of all drives from all filesystems.
3227      */
3228 
3229     fsRecPtr = FsGetFirstFilesystem();
3230     while (fsRecPtr != NULL) {
3231   Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
3232   if (proc != NULL) {
3233       Tcl_Obj *thisFsVolumes = (*proc)();
3234       if (thisFsVolumes != NULL) {
3235     Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes);
3236     Tcl_DecrRefCount(thisFsVolumes);
3237       }
3238   }
3239   fsRecPtr = fsRecPtr->nextPtr;
3240     }
3241     
3242     return resultPtr;
3243 }
int Tcl_FSLoadFile (Tcl_Interp * interp, Tcl_Obj * pathPtr, CONST char * sym1, CONST char * sym2, Tcl_PackageInitProc ** proc1Ptr, Tcl_PackageInitProc ** proc2Ptr, Tcl_LoadHandle * handlePtr, Tcl_FSUnloadFileProc ** unloadProcPtr)

Definition at line 2758 of file tclIOUtil.c.
References ckalloc, FsDivertLoad::divertedFile, FsDivertLoad::divertedFileNativeRep, FsDivertLoad::divertedFilesystem, ENOENT, Tcl_Filesystem::loadFileProc, FsDivertLoad::loadHandle, R_OK, Tcl_Close(), Tcl_DecrRefCount, TCL_ERROR, Tcl_FSAccess(), Tcl_FSDeleteFile(), Tcl_FSFileAttrsSet(), Tcl_FSGetFileSystemForPath(), Tcl_FSGetInternalRep(), Tcl_FSOpenFileChannel(), Tcl_FSStat(), Tcl_GetString(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_OK, Tcl_PosixError(), Tcl_Read(), Tcl_ResetResult(), Tcl_SetChannelOption(), Tcl_SetErrno(), TclCrossFilesystemCopy(), TclNativeDupInternalRep, TclpFindSymbol(), TclpTempFileName(), and FsDivertLoad::unloadProcPtr.
Referenced by TestReportLoadFile().2775 {
2776     Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
2777     if (fsPtr != NULL) {
2778   Tcl_FSLoadFileProc *proc = fsPtr->loadFileProc;
2779   if (proc != NULL) {
2780       int retVal = (*proc)(interp, pathPtr, handlePtr, unloadProcPtr);
2781       if (retVal != TCL_OK) {
2782     return retVal;
2783       }
2784       if (*handlePtr == NULL) {
2785     return TCL_ERROR;
2786       }
2787       if (sym1 != NULL) {
2788           *proc1Ptr = TclpFindSymbol(interp, *handlePtr, sym1);
2789       }
2790       if (sym2 != NULL) {
2791           *proc2Ptr = TclpFindSymbol(interp, *handlePtr, sym2);
2792       }
2793       return retVal;
2794   } else {
2795       Tcl_Filesystem *copyFsPtr;
2796       Tcl_Obj *copyToPtr;
2797       
2798       /* First check if it is readable -- and exists! */
2799       if (Tcl_FSAccess(pathPtr, R_OK) != 0) {
2800     Tcl_AppendResult(interp, "couldn't load library \"",
2801          Tcl_GetString(pathPtr), "\": ", 
2802          Tcl_PosixError(interp), (char *) NULL);
2803     return TCL_ERROR;
2804       }
2805       
2806 #ifdef TCL_LOAD_FROM_MEMORY
2807   /* 
2808    * The platform supports loading code from memory, so ask for a
2809    * buffer of the appropriate size, read the file into it and 
2810    * load the code from the buffer:
2811    */
2812   do {
2813             int ret, size;
2814             void *buffer;
2815             Tcl_StatBuf statBuf;
2816             Tcl_Channel data;
2817             
2818             ret = Tcl_FSStat(pathPtr, &statBuf);
2819             if (ret < 0) {
2820                 break;
2821             }
2822             size = (int) statBuf.st_size;
2823             /* Tcl_Read takes an int: check that file size isn't wide */
2824             if (size != (Tcl_WideInt)statBuf.st_size) {
2825                 break;
2826             }
2827       data = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0666);
2828             if (!data) {
2829                 break;
2830             }
2831             buffer = TclpLoadMemoryGetBuffer(interp, size);
2832             if (!buffer) {
2833                 Tcl_Close(interp, data);
2834                 break;
2835             }
2836             Tcl_SetChannelOption(interp, data, "-translation", "binary");
2837             ret = Tcl_Read(data, buffer, size);
2838             Tcl_Close(interp, data);
2839             ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr, unloadProcPtr);
2840             if (ret == TCL_OK) {
2841     if (*handlePtr == NULL) {
2842         break;
2843     }
2844                 if (sym1 != NULL) {
2845                     *proc1Ptr = TclpFindSymbol(interp, *handlePtr, sym1);
2846                 }
2847                 if (sym2 != NULL) {
2848                     *proc2Ptr = TclpFindSymbol(interp, *handlePtr, sym2);
2849                 }
2850     return TCL_OK;
2851       }
2852   } while (0); 
2853   Tcl_ResetResult(interp);
2854 #endif
2855 
2856       /* 
2857        * Get a temporary filename to use, first to
2858        * copy the file into, and then to load. 
2859        */
2860       copyToPtr = TclpTempFileName();
2861       if (copyToPtr == NULL) {
2862           return -1;
2863       }
2864       Tcl_IncrRefCount(copyToPtr);
2865       
2866       copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr);
2867       if ((copyFsPtr == NULL) || (copyFsPtr == fsPtr)) {
2868     /* 
2869      * We already know we can't use Tcl_FSLoadFile from 
2870      * this filesystem, and we must avoid a possible
2871      * infinite loop.  Try to delete the file we
2872      * probably created, and then exit.
2873      */
2874     Tcl_FSDeleteFile(copyToPtr);
2875     Tcl_DecrRefCount(copyToPtr);
2876     return -1;
2877       }
2878       
2879       if (TclCrossFilesystemCopy(interp, pathPtr, 
2880                copyToPtr) == TCL_OK) {
2881     Tcl_LoadHandle newLoadHandle = NULL;
2882     Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
2883     FsDivertLoad *tvdlPtr;
2884     int retVal;
2885 
2886 #if !defined(__WIN32__) && !defined(MAC_TCL)
2887     /* 
2888      * Do we need to set appropriate permissions 
2889      * on the file?  This may be required on some
2890      * systems.  On Unix we could loop over
2891      * the file attributes, and set any that are
2892      * called "-permissions" to 0700.  However,
2893      * we just do this directly, like this:
2894      */
2895     
2896     Tcl_Obj* perm = Tcl_NewStringObj("0700",-1);
2897     Tcl_IncrRefCount(perm);
2898     Tcl_FSFileAttrsSet(NULL, 2, copyToPtr, perm);
2899     Tcl_DecrRefCount(perm);
2900 #endif
2901     
2902     /* 
2903      * We need to reset the result now, because the cross-
2904      * filesystem copy may have stored the number of bytes
2905      * in the result
2906      */
2907     Tcl_ResetResult(interp);
2908     
2909     retVal = Tcl_FSLoadFile(interp, copyToPtr, sym1, sym2,
2910           proc1Ptr, proc2Ptr, 
2911           &newLoadHandle,
2912           &newUnloadProcPtr);
2913           if (retVal != TCL_OK) {
2914         /* The file didn't load successfully */
2915         Tcl_FSDeleteFile(copyToPtr);
2916         Tcl_DecrRefCount(copyToPtr);
2917         return retVal;
2918     }
2919     /* 
2920      * Try to delete the file immediately -- this is
2921      * possible in some OSes, and avoids any worries
2922      * about leaving the copy laying around on exit. 
2923      */
2924     if (Tcl_FSDeleteFile(copyToPtr) == TCL_OK) {
2925         Tcl_DecrRefCount(copyToPtr);
2926         /* 
2927          * We tell our caller about the real shared
2928          * library which was loaded.  Note that this
2929          * does mean that the package list maintained
2930          * by 'load' will store the original (vfs)
2931          * path alongside the temporary load handle
2932          * and unload proc ptr.
2933          */
2934         (*handlePtr) = newLoadHandle;
2935         (*unloadProcPtr) = newUnloadProcPtr;
2936         return TCL_OK;
2937     }
2938     /* 
2939      * When we unload this file, we need to divert the 
2940      * unloading so we can unload and cleanup the 
2941      * temporary file correctly.
2942      */
2943     tvdlPtr = (FsDivertLoad*) ckalloc(sizeof(FsDivertLoad));
2944 
2945     /* 
2946      * Remember three pieces of information.  This allows
2947      * us to cleanup the diverted load completely, on
2948      * platforms which allow proper unloading of code.
2949      */
2950     tvdlPtr->loadHandle = newLoadHandle;
2951     tvdlPtr->unloadProcPtr = newUnloadProcPtr;
2952 
2953     if (copyFsPtr != &tclNativeFilesystem) {
2954         /* copyToPtr is already incremented for this reference */
2955         tvdlPtr->divertedFile = copyToPtr;
2956 
2957         /* 
2958          * This is the filesystem we loaded it into.  Since
2959          * we have a reference to 'copyToPtr', we already
2960          * have a refCount on this filesystem, so we don't
2961          * need to worry about it disappearing on us.
2962          */
2963         tvdlPtr->divertedFilesystem = copyFsPtr;
2964         tvdlPtr->divertedFileNativeRep = NULL;
2965     } else {
2966         /* We need the native rep */
2967         tvdlPtr->divertedFileNativeRep = 
2968           TclNativeDupInternalRep(Tcl_FSGetInternalRep(copyToPtr, 
2969                 copyFsPtr));
2970         /* 
2971          * We don't need or want references to the copied
2972          * Tcl_Obj or the filesystem if it is the native
2973          * one.
2974          */
2975         tvdlPtr->divertedFile = NULL;
2976         tvdlPtr->divertedFilesystem = NULL;
2977         Tcl_DecrRefCount(copyToPtr);
2978     }
2979 
2980     copyToPtr = NULL;
2981     (*handlePtr) = (Tcl_LoadHandle) tvdlPtr;
2982     (*unloadProcPtr) = &FSUnloadTempFile;
2983     return retVal;
2984       } else {
2985     /* Cross-platform copy failed */
2986     Tcl_FSDeleteFile(copyToPtr);
2987     Tcl_DecrRefCount(copyToPtr);
2988     return TCL_ERROR;
2989       }
2990   }
2991     }
2992     Tcl_SetErrno(ENOENT);
2993     return -1;
2994 }
int Tcl_FSLstat (Tcl_Obj * pathPtr, Tcl_StatBuf * buf)

Definition at line 1990 of file tclIOUtil.c.
References ENOENT, Tcl_Filesystem::lstatProc, Tcl_Filesystem::statProc, Tcl_FSGetFileSystemForPath(), and Tcl_SetErrno().
Referenced by CopyRenameOneFile(), Tcl_FileObjCmd(), TclCrossFilesystemCopy(), TclFileDeleteCmd(), and TestReportLstat().1993 {
1994     Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
1995     if (fsPtr != NULL) {
1996   Tcl_FSLstatProc *proc = fsPtr->lstatProc;
1997   if (proc != NULL) {
1998       return (*proc)(pathPtr, buf);
1999   } else {
2000       Tcl_FSStatProc *sproc = fsPtr->statProc;
2001       if (sproc != NULL) {
2002     return (*sproc)(pathPtr, buf);
2003       }
2004   }
2005     }
2006     Tcl_SetErrno(ENOENT);
2007     return -1;
2008 }
int Tcl_FSMatchInDirectory (Tcl_Interp * interp, Tcl_Obj * result, Tcl_Obj * pathPtr, CONST char * pattern, Tcl_GlobTypeData * types)

Definition at line 1014 of file tclIOUtil.c.
References ENOENT, FsAddMountsToGlobResult(), Tcl_Filesystem::matchInDirectoryProc, Tcl_DecrRefCount, TCL_ERROR, Tcl_FSGetCwd(), Tcl_FSGetFileSystemForPath(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_ListObjAppendElement(), Tcl_ListObjIndex(), Tcl_ListObjLength(), Tcl_NewListObj(), TCL_OK, Tcl_SetErrno(), Tcl_SetResult(), TCL_STATIC, and TclFSMakePathRelative().
Referenced by TclDoGlob(), and TestReportMatchInDirectory().1022 {
1023     Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
1024     if (fsPtr != NULL) {
1025   Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;
1026   if (proc != NULL) {
1027       int ret = (*proc)(interp, result, pathPtr, pattern, types);
1028       if (ret == TCL_OK && pattern != NULL) {
1029     result = FsAddMountsToGlobResult(result, pathPtr, 
1030              pattern, types);
1031       }
1032       return ret;
1033   }
1034     } else {
1035   Tcl_Obj* cwd;
1036   int ret = -1;
1037   if (pathPtr != NULL) {
1038       int len;
1039       Tcl_GetStringFromObj(pathPtr,&len);
1040       if (len != 0) {
1041     /* 
1042      * We have no idea how to match files in a directory
1043      * which belongs to no known filesystem
1044      */
1045     Tcl_SetErrno(ENOENT);
1046     return -1;
1047       }
1048   }
1049   /* 
1050    * We have an empty or NULL path.  This is defined to mean we
1051    * must search for files within the current 'cwd'.  We
1052    * therefore use that, but then since the proc we call will
1053    * return results which include the cwd we must then trim it
1054    * off the front of each path in the result.  We choose to deal
1055    * with this here (in the generic code), since if we don't,
1056    * every single filesystem's implementation of
1057    * Tcl_FSMatchInDirectory will have to deal with it for us.
1058    */
1059   cwd = Tcl_FSGetCwd(NULL);
1060   if (cwd == NULL) {
1061       if (interp != NULL) {
1062     Tcl_SetResult(interp, "glob couldn't determine "
1063         "the current working directory", TCL_STATIC);
1064       }
1065       return TCL_ERROR;
1066   }
1067   fsPtr = Tcl_FSGetFileSystemForPath(cwd);
1068   if (fsPtr != NULL) {
1069       Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;
1070       if (proc != NULL) {
1071     Tcl_Obj* tmpResultPtr = Tcl_NewListObj(0, NULL);
1072     Tcl_IncrRefCount(tmpResultPtr);
1073     ret = (*proc)(interp, tmpResultPtr, cwd, pattern, types);
1074     if (ret == TCL_OK) {
1075         int resLength;
1076 
1077         tmpResultPtr = FsAddMountsToGlobResult(tmpResultPtr, cwd,
1078                  pattern, types);
1079 
1080         ret = Tcl_ListObjLength(interp, tmpResultPtr, &resLength);
1081         if (ret == TCL_OK) {
1082       int i;
1083 
1084       for (i = 0; i < resLength; i++) {
1085           Tcl_Obj *elt;
1086           
1087           Tcl_ListObjIndex(interp, tmpResultPtr, i, &elt);
1088           Tcl_ListObjAppendElement(interp, result, 
1089         TclFSMakePathRelative(interp, elt, cwd));
1090       }
1091         }
1092     }
1093     Tcl_DecrRefCount(tmpResultPtr);
1094       }
1095   }
1096   Tcl_DecrRefCount(cwd);
1097   return ret;
1098     }
1099     Tcl_SetErrno(ENOENT);
1100     return -1;
1101 }
void Tcl_FSMountsChanged (Tcl_Filesystem * fsPtr)

Definition at line 1240 of file tclIOUtil.c.
References Tcl_MutexLock, Tcl_MutexUnlock, and void().
Referenced by TclSetEnv().1242 {
1243     /* 
1244      * We currently don't do anything with this parameter.  We
1245      * could in the future only invalidate files for this filesystem
1246      * or otherwise take more advanced action.
1247      */
1248     (void)fsPtr;
1249     /* 
1250      * Increment the filesystem epoch counter, since existing paths
1251      * might now belong to different filesystems.
1252      */
1253     Tcl_MutexLock(&filesystemMutex);
1254     theFilesystemEpoch++;
1255     Tcl_MutexUnlock(&filesystemMutex);
1256 }
Tcl_Obj* Tcl_FSNewNativePath (Tcl_Filesystem* fromFilesystem, ClientData clientData)

Definition at line 5343 of file tclIOUtil.c.
References Tcl_Obj::bytes, ckalloc, FsPath::cwdPtr, FilesystemRecord::fileRefCount, FsPath::filesystemEpoch, Tcl_ObjType::freeIntRepProc, FsPath::fsRecPtr, FsPath::nativePathPtr, FsPath::normPathPtr, PATHFLAGS, PATHOBJ, TCL_TSD_INIT, TclFSInternalToNormalized(), tclFsPathType, FsPath::translatedPathPtr, Tcl_Obj::typePtr, Tcl_ObjType::updateStringProc, and VOID.5346 {
5347     Tcl_Obj *objPtr;
5348     FsPath *fsPathPtr;
5349 
5350     FilesystemRecord *fsFromPtr;
5351     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
5352     
5353     objPtr = TclFSInternalToNormalized(fromFilesystem, clientData, &fsFromPtr);
5354     if (objPtr == NULL) {
5355   return NULL;
5356     }
5357     
5358     /* 
5359      * Free old representation; shouldn't normally be any,
5360      * but best to be safe. 
5361      */
5362     if (objPtr->typePtr != NULL) {
5363   if (objPtr->bytes == NULL) {
5364       if (objPtr->typePtr->updateStringProc == NULL) {
5365     return NULL;
5366       }
5367       objPtr->typePtr->updateStringProc(objPtr);
5368   }
5369   if ((objPtr->typePtr->freeIntRepProc) != NULL) {
5370       (*objPtr->typePtr->freeIntRepProc)(objPtr);
5371   }
5372     }
5373     
5374     fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
5375 
5376     fsPathPtr->translatedPathPtr = NULL;
5377     /* Circular reference, by design */
5378     fsPathPtr->normPathPtr = objPtr;
5379     fsPathPtr->cwdPtr = NULL;
5380     fsPathPtr->nativePathPtr = clientData;
5381     fsPathPtr->fsRecPtr = fsFromPtr;
5382     fsPathPtr->fsRecPtr->fileRefCount++;
5383     fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
5384 
5385     PATHOBJ(objPtr) = (VOID *) fsPathPtr;
5386     PATHFLAGS(objPtr) = 0;
5387     objPtr->typePtr = &tclFsPathType;
5388 
5389     return objPtr;
5390 }
Tcl_Channel Tcl_FSOpenFileChannel (Tcl_Interp * interp, Tcl_Obj * pathPtr, CONST char * modeString, int permissions)

Definition at line 2100 of file tclIOUtil.c.
References ENOENT, OpenFileChannelProc::nextPtr, NULL, Tcl_Filesystem::openFileChannelProc, openFileChannelProcList, OpenFileChannelProc::proc, SEEK_END, Tcl_Close(), Tcl_DecrRefCount, Tcl_FSGetFileSystemForPath(), Tcl_FSGetNormalizedPath(), Tcl_FSGetTranslatedPath(), Tcl_GetString(), Tcl_MutexLock, Tcl_MutexUnlock, Tcl_PosixError(), Tcl_Seek(), Tcl_SetErrno(), and TclGetOpenMode().
Referenced by OpenEncodingFile(), SimpleOpenFileChannel(), Tcl_FSEvalFile(), Tcl_FSLoadFile(), Tcl_OpenFileChannel(), Tcl_OpenObjCmd(), and TclCrossFilesystemCopy().2109 {
2110     Tcl_Filesystem *fsPtr;
2111 #ifdef USE_OBSOLETE_FS_HOOKS
2112     Tcl_Channel retVal = NULL;
2113 
2114     /*
2115      * Call each of the "Tcl_OpenFileChannel" functions in succession.
2116      * A non-NULL return value indicates the particular function has
2117      * succeeded.
2118      */
2119 
2120     Tcl_MutexLock(&obsoleteFsHookMutex);
2121     if (openFileChannelProcList != NULL) {
2122   OpenFileChannelProc *openFileChannelProcPtr;
2123   char *path;
2124   Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
2125   
2126   if (transPtr == NULL) {
2127       path = NULL;
2128   } else {
2129       path = Tcl_GetString(transPtr);
2130   }
2131 
2132   openFileChannelProcPtr = openFileChannelProcList;
2133   
2134   while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) {
2135       retVal = (*openFileChannelProcPtr->proc)(interp, path,
2136                  modeString, permissions);
2137       openFileChannelProcPtr = openFileChannelProcPtr->nextPtr;
2138   }
2139   if (transPtr != NULL) {
2140       Tcl_DecrRefCount(transPtr);
2141   }
2142     }
2143     Tcl_MutexUnlock(&obsoleteFsHookMutex);
2144     if (retVal != NULL) {
2145   return retVal;
2146     }
2147 #endif /* USE_OBSOLETE_FS_HOOKS */
2148     
2149     /* 
2150      * We need this just to ensure we return the correct error messages
2151      * under some circumstances.
2152      */
2153     if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
2154         return NULL;
2155     }
2156     
2157     fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
2158     if (fsPtr != NULL) {
2159   Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc;
2160   if (proc != NULL) {
2161       int mode, seekFlag;
2162       mode = TclGetOpenMode(interp, modeString, &seekFlag);
2163       if (mode == -1) {
2164           return NULL;
2165       }
2166       retVal = (*proc)(interp, pathPtr, mode, permissions);
2167       if (retVal != NULL) {
2168     if (seekFlag) {
2169         if (Tcl_Seek(retVal, (Tcl_WideInt)0, 
2170          SEEK_END) < (Tcl_WideInt)0) {
2171       if (interp != (Tcl_Interp *) NULL) {
2172           Tcl_AppendResult(interp,
2173             "could not seek to end of file while opening \"",
2174             Tcl_GetString(pathPtr), "\": ", 
2175             Tcl_PosixError(interp), (char *) NULL);
2176       }
2177       Tcl_Close(NULL, retVal);
2178       return NULL;
2179         }
2180     }
2181       }
2182       return retVal;
2183   }
2184     }
2185     /* File doesn't belong to any filesystem that can open it */
2186     Tcl_SetErrno(ENOENT);
2187     if (interp != NULL) {
2188   Tcl_AppendResult(interp, "couldn't open \"", 
2189        Tcl_GetString(pathPtr), "\": ",
2190        Tcl_PosixError(interp), (char *) NULL);
2191     }
2192     return NULL;
2193 }
Tcl_Obj* Tcl_FSPathSeparator (Tcl_Obj* pathObjPtr)

Definition at line 4228 of file tclIOUtil.c.
References Tcl_Filesystem::filesystemSeparatorProc, and Tcl_FSGetFileSystemForPath().
Referenced by Tcl_FileObjCmd().4230 {
4231     Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathObjPtr);
4232     
4233     if (fsPtr == NULL) {
4234   return NULL;
4235     }
4236     if (fsPtr->filesystemSeparatorProc != NULL) {
4237   return (*fsPtr->filesystemSeparatorProc)(pathObjPtr);
4238     }
4239     
4240     return NULL;
4241 }
int Tcl_FSRegister (ClientData clientData, Tcl_Filesystem  * fsPtr)

Definition at line 842 of file tclIOUtil.c.
References ckalloc, FilesystemRecord::clientData, FilesystemRecord::fileRefCount, filesystemList, FilesystemRecord::fsPtr, FilesystemRecord::nextPtr, FilesystemRecord::prevPtr, TCL_ERROR, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_OK.
Referenced by TestFilesystemObjCmd(), and TestSimpleFilesystemObjCmd().845 {
846     FilesystemRecord *newFilesystemPtr;
847 
848     if (fsPtr == NULL) {
849   return TCL_ERROR;
850     }
851 
852     newFilesystemPtr = (FilesystemRecord *) ckalloc(sizeof(FilesystemRecord));
853 
854     newFilesystemPtr->clientData = clientData;
855     newFilesystemPtr->fsPtr = fsPtr;
856     /* 
857      * We start with a refCount of 1.  If this drops to zero, then
858      * anyone is welcome to ckfree us.
859      */
860     newFilesystemPtr->fileRefCount = 1;
861 
862     /* 
863      * Is this lock and wait strictly speaking necessary?  Since any
864      * iterators out there will have grabbed a copy of the head of
865      * the list and be iterating away from that, if we add a new
866      * element to the head of the list, it can't possibly have any
867      * effect on any of their loops.  In fact it could be better not
868      * to wait, since we are adjusting the filesystem epoch, any
869      * cached representations calculated by existing iterators are
870      * going to have to be thrown away anyway.
871      * 
872      * However, since registering and unregistering filesystems is
873      * a very rare action, this is not a very important point.
874      */
875     Tcl_MutexLock(&filesystemMutex);
876 
877     newFilesystemPtr->nextPtr = filesystemList;
878     newFilesystemPtr->prevPtr = NULL;
879     if (filesystemList) {
880   filesystemList->prevPtr = newFilesystemPtr;
881     }
882     filesystemList = newFilesystemPtr;
883 
884     /* 
885      * Increment the filesystem epoch counter, since existing paths
886      * might conceivably now belong to different filesystems.
887      */
888     theFilesystemEpoch++;
889     Tcl_MutexUnlock(&filesystemMutex);
890 
891     return TCL_OK;
892 }
int Tcl_FSRemoveDirectory (Tcl_Obj * pathPtr, int recursive, Tcl_Obj ** errorPtr)

Definition at line 3823 of file tclIOUtil.c.
References ENOENT, Tcl_Filesystem::removeDirectoryProc, size_t(), Tcl_DecrRefCount, Tcl_FSChdir(), Tcl_FSGetCwd(), Tcl_FSGetFileSystemForPath(), Tcl_FSGetNormalizedPath(), Tcl_GetStringFromObj(), Tcl_SetErrno(), and TclFileDirname().
Referenced by CopyRenameOneFile(), TclFileDeleteCmd(), and TestReportRemoveDirectory().3832 {
3833     Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
3834     if (fsPtr != NULL) {
3835   Tcl_FSRemoveDirectoryProc *proc = fsPtr->removeDirectoryProc;
3836   if (proc != NULL) {
3837       if (recursive) {
3838           /* 
3839            * We check whether the cwd lies inside this directory
3840            * and move it if it does.
3841            */
3842     Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);
3843     if (cwdPtr != NULL) {
3844         char *cwdStr, *normPathStr;
3845         int cwdLen, normLen;
3846         Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
3847         if (normPath != NULL) {
3848             normPathStr = Tcl_GetStringFromObj(normPath, &normLen);
3849       cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
3850       if ((cwdLen >= normLen) && (strncmp(normPathStr, 
3851           cwdStr, (size_t) normLen) == 0)) {
3852           /* 
3853            * the cwd is inside the directory, so we
3854            * perform a 'cd [file dirname $path]'
3855            */
3856           Tcl_Obj *dirPtr = TclFileDirname(NULL, pathPtr);
3857           Tcl_FSChdir(dirPtr);
3858           Tcl_DecrRefCount(dirPtr);
3859       }
3860         }
3861         Tcl_DecrRefCount(cwdPtr);
3862     }
3863       }
3864       return (*proc)(pathPtr, recursive, errorPtr);
3865   }
3866     }
3867     Tcl_SetErrno(ENOENT);
3868     return -1;
3869 }
int Tcl_FSRenameFile (Tcl_Obj* srcPathPtr, Tcl_Obj * destPathPtr)

Definition at line 3564 of file tclIOUtil.c.
References EXDEV, Tcl_Filesystem::renameFileProc, Tcl_FSGetFileSystemForPath(), and Tcl_SetErrno().
Referenced by CopyRenameOneFile(), and TestReportRenameFile().3569 {
3570     int retVal = -1;
3571     Tcl_Filesystem *fsPtr, *fsPtr2;
3572     fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
3573     fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
3574 
3575     if (fsPtr == fsPtr2 && fsPtr != NULL) {
3576   Tcl_FSRenameFileProc *proc = fsPtr->renameFileProc;
3577   if (proc != NULL) {
3578       retVal =  (*proc)(srcPathPtr, destPathPtr);
3579   }
3580     }
3581     if (retVal == -1) {
3582   Tcl_SetErrno(EXDEV);
3583     }
3584     return retVal;
3585 }
Tcl_Obj* Tcl_FSSplitPath (Tcl_Obj * pathPtr, int * lenPtr)

Definition at line 3319 of file tclIOUtil.c.
References Tcl_Filesystem::filesystemSeparatorProc, FSGetPathType(), Tcl_AppendToObj(), Tcl_GetString(), Tcl_ListObjAppendElement(), Tcl_ListObjLength(), Tcl_NewObj(), Tcl_NewStringObj(), TCL_PATH_ABSOLUTE, and TclpNativeSplitPath().
Referenced by ConvertFileNameFormat(), FileBasename(), Tcl_FileObjCmd(), Tcl_SplitPath(), TclFileDirname(), TclFileMakeDirsCmd(), and TclFSNormalizeAbsolutePath().3322 {
3323     Tcl_Obj *result = NULL;  /* Needed only to prevent gcc warnings. */
3324     Tcl_Filesystem *fsPtr;
3325     char separator = '/';
3326     int driveNameLength;
3327     char *p;
3328     
3329     /*
3330      * Perform platform specific splitting. 
3331      */
3332 
3333     if (FSGetPathType(pathPtr, &fsPtr, &driveNameLength) 
3334   == TCL_PATH_ABSOLUTE) {
3335   if (fsPtr == &tclNativeFilesystem) {
3336       return TclpNativeSplitPath(pathPtr, lenPtr);
3337   }
3338     } else {
3339   return TclpNativeSplitPath(pathPtr, lenPtr);
3340     }
3341 
3342     /* We assume separators are single characters */
3343     if (fsPtr->filesystemSeparatorProc != NULL) {
3344   Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(pathPtr);
3345   if (sep != NULL) {
3346       separator = Tcl_GetString(sep)[0];
3347   }
3348     }
3349     
3350     /* 
3351      * Place the drive name as first element of the
3352      * result list.  The drive name may contain strange
3353      * characters, like colons and multiple forward slashes
3354      * (for example 'ftp://' is a valid vfs drive name)
3355      */
3356     result = Tcl_NewObj();
3357     p = Tcl_GetString(pathPtr);
3358     Tcl_ListObjAppendElement(NULL, result, 
3359            Tcl_NewStringObj(p, driveNameLength));
3360     p+= driveNameLength;
3361           
3362     /* Add the remaining path elements to the list */
3363     for (;;) {
3364   char *elementStart = p;
3365   int length;
3366   while ((*p != '\0') && (*p != separator)) {
3367       p++;
3368   }
3369   length = p - elementStart;
3370   if (length > 0) {
3371       Tcl_Obj *nextElt;
3372       if (elementStart[0] == '~') {
3373     nextElt = Tcl_NewStringObj("./",2);
3374     Tcl_AppendToObj(nextElt, elementStart, length);
3375       } else {
3376     nextElt = Tcl_NewStringObj(elementStart, length);
3377       }
3378       Tcl_ListObjAppendElement(NULL, result, nextElt);
3379   }
3380   if (*p++ == '\0') {
3381       break;
3382   }
3383     }
3384            
3385     /*
3386      * Compute the number of elements in the result.
3387      */
3388 
3389     if (lenPtr != NULL) {
3390   Tcl_ListObjLength(NULL, result, lenPtr);
3391     }
3392     return result;
3393 }
int Tcl_FSStat (Tcl_Obj * pathPtr, Tcl_StatBuf * buf)

Definition at line 1898 of file tclIOUtil.c.
References ENOENT, StatProc::nextPtr, StatProc::proc, Tcl_Filesystem::statProc, statProcList, Tcl_DecrRefCount, Tcl_FSGetFileSystemForPath(), Tcl_FSGetTranslatedPath(), Tcl_GetString(), Tcl_LongAsWide, Tcl_MutexLock, Tcl_MutexUnlock, and Tcl_SetErrno().
Referenced by CopyRenameOneFile(), FileCopyRename(), SimpleStat(), Tcl_FileObjCmd(), Tcl_FSChdir(), Tcl_FSEvalFile(), Tcl_FSLoadFile(), Tcl_Stat(), TclFileMakeDirsCmd(), and TestReportStat().1901 {
1902     Tcl_Filesystem *fsPtr;
1903 #ifdef USE_OBSOLETE_FS_HOOKS
1904     struct stat oldStyleStatBuffer;
1905     int retVal = -1;
1906 
1907     /*
1908      * Call each of the "stat" function in succession.  A non-return
1909      * value of -1 indicates the particular function has succeeded.
1910      */
1911 
1912     Tcl_MutexLock(&obsoleteFsHookMutex);
1913     
1914     if (statProcList != NULL) {
1915   StatProc *statProcPtr;
1916   char *path;
1917   Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
1918   if (transPtr == NULL) {
1919       path = NULL;
1920   } else {
1921       path = Tcl_GetString(transPtr);
1922   }
1923 
1924   statProcPtr = statProcList;
1925   while ((retVal == -1) && (statProcPtr != NULL)) {
1926       retVal = (*statProcPtr->proc)(path, &oldStyleStatBuffer);
1927       statProcPtr = statProcPtr->nextPtr;
1928   }
1929   if (transPtr != NULL) {
1930       Tcl_DecrRefCount(transPtr);
1931   }
1932     }
1933     
1934     Tcl_MutexUnlock(&obsoleteFsHookMutex);
1935     if (retVal != -1) {
1936   /*
1937    * Note that EOVERFLOW is not a problem here, and these
1938    * assignments should all be widening (if not identity.)
1939    */
1940   buf->st_mode = oldStyleStatBuffer.st_mode;
1941   buf->st_ino = oldStyleStatBuffer.st_ino;
1942   buf->st_dev = oldStyleStatBuffer.st_dev;
1943   buf->st_rdev = oldStyleStatBuffer.st_rdev;
1944   buf->st_nlink = oldStyleStatBuffer.st_nlink;
1945   buf->st_uid = oldStyleStatBuffer.st_uid;
1946   buf->st_gid = oldStyleStatBuffer.st_gid;
1947   buf->st_size = Tcl_LongAsWide(oldStyleStatBuffer.st_size);
1948   buf->st_atime = oldStyleStatBuffer.st_atime;
1949   buf->st_mtime = oldStyleStatBuffer.st_mtime;
1950   buf->st_ctime = oldStyleStatBuffer.st_ctime;
1951 #ifdef HAVE_ST_BLOCKS
1952   buf->st_blksize = oldStyleStatBuffer.st_blksize;
1953   buf->st_blocks = Tcl_LongAsWide(oldStyleStatBuffer.st_blocks);
1954 #endif
1955         return retVal;
1956     }
1957 #endif /* USE_OBSOLETE_FS_HOOKS */
1958     fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
1959     if (fsPtr != NULL) {
1960   Tcl_FSStatProc *proc = fsPtr->statProc;
1961   if (proc != NULL) {
1962       return (*proc)(pathPtr, buf);
1963   }
1964     }
1965     Tcl_SetErrno(ENOENT);
1966     return -1;
1967 }
int Tcl_FSUnregister (Tcl_Filesystem  * fsPtr)

Definition at line 920 of file tclIOUtil.c.
References ckfree, FilesystemRecord::fileRefCount, filesystemList, FilesystemRecord::fsPtr, FilesystemRecord::nextPtr, FilesystemRecord::prevPtr, TCL_ERROR, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_OK.
Referenced by TestFilesystemObjCmd(), and TestSimpleFilesystemObjCmd().922 {
923     int retVal = TCL_ERROR;
924     FilesystemRecord *fsRecPtr;
925 
926     Tcl_MutexLock(&filesystemMutex);
927 
928     /*
929      * Traverse the 'filesystemList' looking for the particular node
930      * whose 'fsPtr' member matches 'fsPtr' and remove that one from
931      * the list.  Ensure that the "default" node cannot be removed.
932      */
933 
934     fsRecPtr = filesystemList;
935     while ((retVal == TCL_ERROR) && (fsRecPtr->fsPtr != &tclNativeFilesystem)) {
936   if (fsRecPtr->fsPtr == fsPtr) {
937       if (fsRecPtr->prevPtr) {
938     fsRecPtr->prevPtr->nextPtr = fsRecPtr->nextPtr;
939       } else {
940     filesystemList = fsRecPtr->nextPtr;
941       }
942       if (fsRecPtr->nextPtr) {
943     fsRecPtr->nextPtr->prevPtr = fsRecPtr->prevPtr;
944       }
945       /* 
946        * Increment the filesystem epoch counter, since existing
947        * paths might conceivably now belong to different
948        * filesystems.  This should also ensure that paths which
949        * have cached the filesystem which is about to be deleted
950        * do not reference that filesystem (which would of course
951        * lead to memory exceptions).
952        */
953       theFilesystemEpoch++;
954       
955       fsRecPtr->fileRefCount--;
956       if (fsRecPtr->fileRefCount <= 0) {
957           ckfree((char *)fsRecPtr);
958       }
959 
960       retVal = TCL_OK;
961   } else {
962       fsRecPtr = fsRecPtr->nextPtr;
963   }
964     }
965 
966     Tcl_MutexUnlock(&filesystemMutex);
967     return (retVal);
968 }
int Tcl_FSUtime (Tcl_Obj * pathPtr, struct utimbuf * tval)

Definition at line 2214 of file tclIOUtil.c.
References Tcl_FSGetFileSystemForPath(), and Tcl_Filesystem::utimeProc.
Referenced by Tcl_FileObjCmd(), TclCrossFilesystemCopy(), and TestReportUtime().2218 {
2219     Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
2220     if (fsPtr != NULL) {
2221   Tcl_FSUtimeProc *proc = fsPtr->utimeProc;
2222   if (proc != NULL) {
2223       return (*proc)(pathPtr, tval);
2224   }
2225     }
2226     return -1;
2227 }
char* Tcl_GetCwd (Tcl_Interp * interp, Tcl_DString * cwdPtr)

Definition at line 265 of file tclIOUtil.c.
References NULL, Tcl_DecrRefCount, Tcl_DStringAppend(), Tcl_DStringInit(), Tcl_DStringValue, Tcl_FSGetCwd(), and Tcl_GetString().268 {
269     Tcl_Obj *cwd;
270     cwd = Tcl_FSGetCwd(interp);
271     if (cwd == NULL) {
272   return NULL;
273     } else {
274   Tcl_DStringInit(cwdPtr);
275   Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1);
276   Tcl_DecrRefCount(cwd);
277   return Tcl_DStringValue(cwdPtr);
278     }
279 }
int Tcl_GetErrno ()

Definition at line 1815 of file tclIOUtil.c.
References errno.
Referenced by CreateSocket(), DoCopyFile(), DoRemoveDirectory(), DoRemoveJustDirectory(), DoRenameFile(), SocketProc(), Tcl_FSEqualPaths(), TclFileAttrsCmd(), TclpDeleteFile(), TcpCloseProc(), TcpGetOptionProc(), TcpInputProc(), TcpOutputProc(), and TransformInputProc().1816 {
1817     return errno;
1818 }
Tcl_Channel Tcl_OpenFileChannel (Tcl_Interp * interp, CONST char * path, CONST char * modeString, int permissions)

Definition at line 231 of file tclIOUtil.c.
References Tcl_DecrRefCount, Tcl_FSOpenFileChannel(), Tcl_IncrRefCount, and Tcl_NewStringObj().
Referenced by FileRCVariables(), Tcl_AppInit(), and Tcl_SourceRCFile().240 {
241     Tcl_Channel ret;
242     Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
243     Tcl_IncrRefCount(pathPtr);
244     ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions);
245     Tcl_DecrRefCount(pathPtr);
246     return ret;
247 
248 }
CONST char* Tcl_PosixError (Tcl_Interp * interp)

Definition at line 1864 of file tclIOUtil.c.
References CONST, errno, Tcl_ErrnoId(), and Tcl_ErrnoMsg().
Referenced by ApplicationType(), CopyData(), CopyRenameOneFile(), CreateSocket(), FileCopyRename(), FindLibraries(), FlushChannel(), GetFileFinderAttributes(), GetFileReadOnly(), GetGroupAttribute(), GetOwnerAttribute(), GetPermissionsAttribute(), GetStatBuf(), PretendTclpOpenFileChannel(), SetBlockMode(), SetFileFinderAttributes(), SetFileReadOnly(), SetGroupAttribute(), SetOwnerAttribute(), SetPermissionsAttribute(), StatError(), Tcl_CdObjCmd(), TCL_DECLARE_MUTEX(), Tcl_EchoCmd(), Tcl_ExecObjCmd(), Tcl_FileObjCmd(), Tcl_FlushObjCmd(), Tcl_FSEvalFile(), Tcl_FSLoadFile(), Tcl_FSOpenFileChannel(), Tcl_GetsObjCmd(), Tcl_PutsObjCmd(), Tcl_ReadObjCmd(), Tcl_SeekObjCmd(), TclCleanupChildren(), TclCreatePipeline(), TclFileAttrsCmd(), TclFileDeleteCmd(), TclFileMakeDirsCmd(), TclpCreateProcess(), TclpDlopen(), TclpGetCwd(), TclpMatchInDirectory(), TclpOpenFileChannel(), TcpGetOptionProc(), TestalarmCmd(), TestchmodCmd(), TestfilehandlerCmd(), and TestfilelinkCmd().1867 {
1868     CONST char *id, *msg;
1869 
1870     msg = Tcl_ErrnoMsg(errno);
1871     id = Tcl_ErrnoId();
1872     if (interp) {
1873   Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL);
1874     }
1875     return msg;
1876 }
void Tcl_SetErrno (int err)

Definition at line 1837 of file tclIOUtil.c.
References errno.
Referenced by CheckChannelErrors(), CheckForDeadChannel(), CloseChannel(), CopyData(), CopyRenameOneFile(), CreateSocket(), CreateSocketAddress(), DoCopyFile(), DoRemoveJustDirectory(), DoRenameFile(), FileClose(), FlushChannel(), GetInput(), NativeAccess(), NativeReadReparse(), NativeStat(), OpenFileChannel(), StackSetBlockMode(), Tcl_BadChannelOption(), Tcl_FSAccess(), Tcl_FSChdir(), Tcl_FSCopyDirectory(), Tcl_FSCopyFile(), Tcl_FSCreateDirectory(), Tcl_FSDeleteFile(), Tcl_FSEqualPaths(), Tcl_FSEvalFile(), Tcl_FSFileAttrsGet(), Tcl_FSFileAttrsSet(), Tcl_FSFileAttrStrings(), Tcl_FSLink(), Tcl_FSLoadFile(), Tcl_FSLstat(), Tcl_FSMatchInDirectory(), Tcl_FSOpenFileChannel(), Tcl_FSRemoveDirectory(), Tcl_FSRenameFile(), Tcl_FSStat(), Tcl_Seek(), Tcl_Tell(), Tcl_UnstackChannel(), Tcl_WriteRaw(), TclFileAttrsCmd(), TclpDeleteFile(), TclpObjStat(), TclpOpenFileChannel(), TclWinConvertError(), TclWinConvertWSAError(), WinLink(), WinReadLink(), WinReadLinkDirectory(), and WriteChars().1839 {
1840     errno = err;
1841 }
int Tcl_Stat (CONST char * path, struct stat * oldStyleBuf)

Definition at line 131 of file tclIOUtil.c.
References EFBIG, EOVERFLOW, errno, OUT_OF_RANGE, OUT_OF_URANGE, Tcl_DecrRefCount, Tcl_FSStat(), Tcl_IncrRefCount, and Tcl_NewStringObj().134 {
135     int ret;
136     Tcl_StatBuf buf;
137     Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
138 
139     Tcl_IncrRefCount(pathPtr);
140     ret = Tcl_FSStat(pathPtr, &buf);
141     Tcl_DecrRefCount(pathPtr);
142     if (ret != -1) {
143 #ifndef TCL_WIDE_INT_IS_LONG
144 #   define OUT_OF_RANGE(x) \
145   (((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
146    ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
147 #if defined(__GNUC__) && __GNUC__ >= 2
148 /*
149  * Workaround gcc warning of "comparison is always false due to limited range of
150  * data type" in this macro by checking max type size, and when necessary ANDing
151  * with the complement of ULONG_MAX instead of the comparison:
152  */
153 #   define OUT_OF_URANGE(x) \
154   ((((Tcl_WideUInt)(~ (__typeof__(x)) 0)) > (Tcl_WideUInt)ULONG_MAX) && \
155    (((Tcl_WideUInt)(x)) & ~(Tcl_WideUInt)ULONG_MAX))
156 #else
157 #   define OUT_OF_URANGE(x) \
158   (((Tcl_WideUInt)(x)) > (Tcl_WideUInt)ULONG_MAX)
159 #endif
160 
161   /*
162    * Perform the result-buffer overflow check manually.
163    *
164    * Note that ino_t/ino64_t is unsigned...
165    */
166 
167         if (OUT_OF_URANGE(buf.st_ino) || OUT_OF_RANGE(buf.st_size)
168 #ifdef HAVE_ST_BLOCKS
169     || OUT_OF_RANGE(buf.st_blocks)
170 #endif
171       ) {
172 #ifdef EFBIG
173       errno = EFBIG;
174 #else
175 #  ifdef EOVERFLOW
176       errno = EOVERFLOW;
177 #  else
178 #    error  "What status should be returned for file size out of range?"
179 #  endif
180 #endif
181       return -1;
182   }
183 
184 #   undef OUT_OF_RANGE
185 #   undef OUT_OF_URANGE
186 #endif /* !TCL_WIDE_INT_IS_LONG */
187 
188   /*
189    * Copy across all supported fields, with possible type
190    * coercions on those fields that change between the normal
191    * and lf64 versions of the stat structure (on Solaris at
192    * least.)  This is slow when the structure sizes coincide,
193    * but that's what you get for using an obsolete interface.
194    */
195 
196   oldStyleBuf->st_mode    = buf.st_mode;
197   oldStyleBuf->st_ino     = (ino_t) buf.st_ino;
198   oldStyleBuf->st_dev     = buf.st_dev;
199   oldStyleBuf->st_rdev    = buf.st_rdev;
200   oldStyleBuf->st_nlink   = buf.st_nlink;
201   oldStyleBuf->st_uid     = buf.st_uid;
202   oldStyleBuf->st_gid     = buf.st_gid;
203   oldStyleBuf->st_size    = (off_t) buf.st_size;
204   oldStyleBuf->st_atime   = buf.st_atime;
205   oldStyleBuf->st_mtime   = buf.st_mtime;
206   oldStyleBuf->st_ctime   = buf.st_ctime;
207 #ifdef HAVE_ST_BLOCKS
208   oldStyleBuf->st_blksize = buf.st_blksize;
209   oldStyleBuf->st_blocks  = (blkcnt_t) buf.st_blocks;
210 #endif
211     }
212     return ret;
213 }
int TclAccessDeleteProc (TclAccessProc_ * proc)

Definition at line 4453 of file tclIOUtil.c.
References accessProcList, ckfree, AccessProc::nextPtr, AccessProc::proc, TCL_ERROR, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_OK.
Referenced by TestaccessprocCmd().4455 {
4456     int retVal = TCL_ERROR;
4457     AccessProc *tmpAccessProcPtr;
4458     AccessProc *prevAccessProcPtr = NULL;
4459 
4460     /*
4461      * Traverse the 'accessProcList' looking for the particular node
4462      * whose 'proc' member matches 'proc' and remove that one from
4463      * the list.  Ensure that the "default" node cannot be removed.
4464      */
4465 
4466     Tcl_MutexLock(&obsoleteFsHookMutex);
4467     tmpAccessProcPtr = accessProcList;
4468     while ((retVal == TCL_ERROR) && (tmpAccessProcPtr != NULL)) {
4469   if (tmpAccessProcPtr->proc == proc) {
4470       if (prevAccessProcPtr == NULL) {
4471     accessProcList = tmpAccessProcPtr->nextPtr;
4472       } else {
4473     prevAccessProcPtr->nextPtr = tmpAccessProcPtr->nextPtr;
4474       }
4475 
4476       ckfree((char *)tmpAccessProcPtr);
4477 
4478       retVal = TCL_OK;
4479   } else {
4480       prevAccessProcPtr = tmpAccessProcPtr;
4481       tmpAccessProcPtr = tmpAccessProcPtr->nextPtr;
4482   }
4483     }
4484     Tcl_MutexUnlock(&obsoleteFsHookMutex);
4485 
4486     return retVal;
4487 }
int TclAccessInsertProc (TclAccessProc_ * proc)

Definition at line 4409 of file tclIOUtil.c.
References accessProcList, ckalloc, AccessProc::nextPtr, AccessProc::proc, TCL_ERROR, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_OK.
Referenced by TestaccessprocCmd().4411 {
4412     int retVal = TCL_ERROR;
4413 
4414     if (proc != NULL) {
4415   AccessProc *newAccessProcPtr;
4416 
4417   newAccessProcPtr = (AccessProc *)ckalloc(sizeof(AccessProc));
4418 
4419   if (newAccessProcPtr != NULL) {
4420       newAccessProcPtr->proc = proc;
4421       Tcl_MutexLock(&obsoleteFsHookMutex);
4422       newAccessProcPtr->nextPtr = accessProcList;
4423       accessProcList = newAccessProcPtr;
4424       Tcl_MutexUnlock(&obsoleteFsHookMutex);
4425 
4426       retVal = TCL_OK;
4427   }
4428     }
4429 
4430     return retVal;
4431 }
int TclCrossFilesystemCopy (Tcl_Interp * interp, Tcl_Obj * source, Tcl_Obj * target)

Definition at line 3649 of file tclIOUtil.c.
References Tcl_Close(), TCL_ERROR, Tcl_FSLstat(), Tcl_FSOpenFileChannel(), Tcl_FSUtime(), TCL_OK, Tcl_SetChannelOption(), and TclCopyChannel().
Referenced by CopyRenameOneFile(), SimpleCopy(), and Tcl_FSLoadFile().3653 {
3654     int result = TCL_ERROR;
3655     int prot = 0666;
3656     
3657     Tcl_Channel out = Tcl_FSOpenFileChannel(interp, target, "w", prot);
3658     if (out != NULL) {
3659   /* It looks like we can copy it over */
3660   Tcl_Channel in = Tcl_FSOpenFileChannel(interp, source, 
3661                  "r", prot);
3662   if (in == NULL) {
3663       /* This is very strange, we checked this above */
3664       Tcl_Close(interp, out);
3665   } else {
3666       Tcl_StatBuf sourceStatBuf;
3667       struct utimbuf tval;
3668       /* 
3669        * Copy it synchronously.  We might wish to add an
3670        * asynchronous option to support vfs's which are
3671        * slow (e.g. network sockets).
3672        */
3673       Tcl_SetChannelOption(interp, in, "-translation", "binary");
3674       Tcl_SetChannelOption(interp, out, "-translation", "binary");
3675       
3676       if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) {
3677     result = TCL_OK;
3678       }
3679       /* 
3680        * If the copy failed, assume that copy channel left
3681        * a good error message.
3682        */
3683       Tcl_Close(interp, in);
3684       Tcl_Close(interp, out);
3685       
3686       /* Set modification date of copied file */
3687       if (Tcl_FSLstat(source, &sourceStatBuf) == 0) {
3688     tval.actime = sourceStatBuf.st_atime;
3689     tval.modtime = sourceStatBuf.st_mtime;
3690     Tcl_FSUtime(target, &tval);
3691       }
3692   }
3693     }
3694     return result;
3695 }
void TclFinalizeFilesystem ()

Definition at line 727 of file tclIOUtil.c.
References accessProcList, ckfree, FilesystemRecord::fileRefCount, filesystemList, FilesystemRecord::fsPtr, FilesystemRecord::nextPtr, openFileChannelProcList, statProcList, Tcl_DecrRefCount, and TclWinEncodingsCleanup().
Referenced by Tcl_Finalize().728 {
729     FilesystemRecord *fsRecPtr;
730 
731     /* 
732      * Assumption that only one thread is active now.  Otherwise
733      * we would need to put various mutexes around this code.
734      */
735     
736     if (cwdPathPtr != NULL) {
737   Tcl_DecrRefCount(cwdPathPtr);
738   cwdPathPtr = NULL;
739         cwdPathEpoch = 0;
740     }
741 
742     /* 
743      * Remove all filesystems, freeing any allocated memory
744      * that is no longer needed
745      */
746 
747     fsRecPtr = filesystemList;
748     while (fsRecPtr != NULL) {
749   FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr;
750   if (fsRecPtr->fileRefCount <= 0) {
751       /* The native filesystem is static, so we don't free it */
752       if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
753     ckfree((char *)fsRecPtr);
754       }
755   }
756   fsRecPtr = tmpFsRecPtr;
757     }
758     filesystemList = NULL;
759 
760     /*
761      * Now filesystemList is NULL.  This means that any attempt
762      * to use the filesystem is likely to fail.
763      */
764 
765     statProcList = NULL;
766     accessProcList = NULL;
767     openFileChannelProcList = NULL;
768 #ifdef __WIN32__
769     TclWinEncodingsCleanup();
770 #endif
771 }
int TclFSCwdPointerEquals (Tcl_Obj* objPtr)

Definition at line 563 of file tclIOUtil.c.
References FsThrExitProc(), ThreadSpecificData::initialized, Tcl_CreateThreadExitHandler(), Tcl_DecrRefCount, Tcl_DuplicateObj(), Tcl_IncrRefCount, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by Tcl_FSGetCwd(), and Tcl_FSGetNormalizedPath().565 {
566     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
567 
568     Tcl_MutexLock(&cwdMutex);
569     if (tsdPtr->cwdPathPtr == NULL) {
570   if (cwdPathPtr == NULL) {
571       tsdPtr->cwdPathPtr = NULL;
572   } else {
573       tsdPtr->cwdPathPtr = Tcl_DuplicateObj(cwdPathPtr);
574       Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
575   }
576   tsdPtr->cwdPathEpoch = cwdPathEpoch;
577     } else if (tsdPtr->cwdPathEpoch != cwdPathEpoch) { 
578   Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
579   if (cwdPathPtr == NULL) {
580       tsdPtr->cwdPathPtr = NULL;
581   } else {
582       tsdPtr->cwdPathPtr = Tcl_DuplicateObj(cwdPathPtr);
583       Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
584   }
585     }
586     Tcl_MutexUnlock(&cwdMutex);
587 
588     if (tsdPtr->initialized == 0) {
589   Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData)tsdPtr);
590   tsdPtr->initialized = 1;
591     }
592     return (tsdPtr->cwdPathPtr == objPtr); 
593 }
int TclFSEnsureEpochOk (Tcl_Obj* pathObjPtr, Tcl_Filesystem ** fsPtrPtr)

Definition at line 5913 of file tclIOUtil.c.
References FsPath::filesystemEpoch, FreeFsPathInternalRep(), FilesystemRecord::fsPtr, FsPath::fsRecPtr, PATHOBJ, SetFsPathFromAny(), TCL_ERROR, Tcl_FSGetNormalizedPath(), TCL_OK, TCL_TSD_INIT, and UpdateStringOfFsPath().
Referenced by Tcl_FSGetFileSystemForPath().5916 {
5917     FsPath *srcFsPathPtr;
5918     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
5919 
5920     /* 
5921      * SHOULD BE ABLE TO IMPROVE EFFICIENCY HERE.
5922      */
5923 
5924     if (Tcl_FSGetNormalizedPath(NULL, pathObjPtr) == NULL) {
5925   return TCL_ERROR;
5926     }
5927 
5928     srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
5929 
5930     /* 
5931      * Check if the filesystem has changed in some way since
5932      * this object's internal representation was calculated.
5933      */
5934     if (srcFsPathPtr->filesystemEpoch != tsdPtr->filesystemEpoch) {
5935   /* 
5936    * We have to discard the stale representation and 
5937    * recalculate it 
5938    */
5939   if (pathObjPtr->bytes == NULL) {
5940       UpdateStringOfFsPath(pathObjPtr);
5941   }
5942   FreeFsPathInternalRep(pathObjPtr);
5943   pathObjPtr->typePtr = NULL;
5944   if (SetFsPathFromAny(NULL, pathObjPtr) != TCL_OK) {
5945       return TCL_ERROR;
5946   }
5947   srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
5948     }
5949     /* Check whether the object is already assigned to a fs */
5950     if (srcFsPathPtr->fsRecPtr != NULL) {
5951   *fsPtrPtr = srcFsPathPtr->fsRecPtr->fsPtr;
5952     }
5953 
5954     return TCL_OK;
5955 }
Tcl_Obj* TclFSInternalToNormalized (Tcl_Filesystem * fromFilesystem, ClientData clientData, FilesystemRecord ** fsRecPtrPtr)

Definition at line 3397 of file tclIOUtil.c.
References FsGetFirstFilesystem(), FilesystemRecord::fsPtr, and FilesystemRecord::nextPtr.
Referenced by Tcl_FSNewNativePath().3401 {
3402     FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();
3403 
3404     while (fsRecPtr != NULL) {
3405   if (fsRecPtr->fsPtr == fromFilesystem) {
3406       *fsRecPtrPtr = fsRecPtr;
3407       break;
3408   }
3409   fsRecPtr = fsRecPtr->nextPtr;
3410     }
3411     
3412     if ((fsRecPtr != NULL) 
3413       && (fromFilesystem->internalToNormalizedProc != NULL)) {
3414   return (*fromFilesystem->internalToNormalizedProc)(clientData);
3415     } else {
3416   return NULL;
3417     }
3418 }
int TclFSMakePathFromNormalized (Tcl_Interp * interp, Tcl_Obj * objPtr, ClientData nativeRep)

Definition at line 5269 of file tclIOUtil.c.
References Tcl_Obj::bytes, ckalloc, FsPath::cwdPtr, FsPath::filesystemEpoch, Tcl_ObjType::freeIntRepProc, FsPath::fsRecPtr, FsPath::nativePathPtr, FsPath::normPathPtr, PATHFLAGS, PATHOBJ, TCL_ERROR, TCL_OK, Tcl_ResetResult(), TCL_TSD_INIT, tclFsPathType, FsPath::translatedPathPtr, Tcl_Obj::typePtr, Tcl_ObjType::updateStringProc, and VOID.
Referenced by TclFSNormalizeAbsolutePath().5274 {
5275     FsPath *fsPathPtr;
5276     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
5277 
5278     if (objPtr->typePtr == &tclFsPathType) {
5279   return TCL_OK;
5280     }
5281     
5282     /* Free old representation */
5283     if (objPtr->typePtr != NULL) {
5284   if (objPtr->bytes == NULL) {
5285       if (objPtr->typePtr->updateStringProc == NULL) {
5286     if (interp != NULL) {
5287         Tcl_ResetResult(interp);
5288         Tcl_AppendResult(interp, "can't find object",
5289              "string representation", (char *) NULL);
5290     }
5291     return TCL_ERROR;
5292       }
5293       objPtr->typePtr->updateStringProc(objPtr);
5294   }
5295   if ((objPtr->typePtr->freeIntRepProc) != NULL) {
5296       (*objPtr->typePtr->freeIntRepProc)(objPtr);
5297   }
5298     }
5299 
5300     fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
5301     /* It's a pure normalized absolute path */
5302     fsPathPtr->translatedPathPtr = NULL;
5303     fsPathPtr->normPathPtr = objPtr;
5304     fsPathPtr->cwdPtr = NULL;
5305     fsPathPtr->nativePathPtr = nativeRep;
5306     fsPathPtr->fsRecPtr = NULL;
5307     fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
5308 
5309     PATHOBJ(objPtr) = (VOID *) fsPathPtr;
5310     PATHFLAGS(objPtr) = 0;
5311     objPtr->typePtr = &tclFsPathType;
5312 
5313     return TCL_OK;
5314 }
Tcl_Obj* TclFSMakePathRelative (Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_Obj * cwdPtr)

Definition at line 5149 of file tclIOUtil.c.
References Tcl_Obj::bytes, ckalloc, CONST, FsPath::cwdPtr, FsPath::filesystemEpoch, Tcl_ObjType::freeIntRepProc, FsPath::fsRecPtr, FsPath::nativePathPtr, FsPath::normPathPtr, PATHFLAGS, PATHOBJ, Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_PLATFORM_MAC, TCL_PLATFORM_UNIX, TCL_PLATFORM_WINDOWS, Tcl_ResetResult(), TCL_TSD_INIT, tclFsPathType, tclPlatform, FsPath::translatedPathPtr, Tcl_Obj::typePtr, Tcl_ObjType::updateStringProc, and VOID.
Referenced by Tcl_FSMatchInDirectory().5153 {
5154     int cwdLen, len;
5155     CONST char *tempStr;
5156     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
5157     
5158     if (objPtr->typePtr == &tclFsPathType) {
5159   FsPath *fsPathPtr = (FsPath*) PATHOBJ(objPtr);
5160   if (PATHFLAGS(objPtr) != 0 
5161     && fsPathPtr->cwdPtr == cwdPtr) {
5162       objPtr = fsPathPtr->normPathPtr;
5163       /* Free old representation */
5164       if (objPtr->typePtr != NULL) {
5165     if (objPtr->bytes == NULL) {
5166         if (objPtr->typePtr->updateStringProc == NULL) {
5167       if (interp != NULL) {
5168           Tcl_ResetResult(interp);
5169           Tcl_AppendResult(interp, "can't find object",
5170                "string representation", (char *) NULL);
5171       }
5172       return NULL;
5173         }
5174         objPtr->typePtr->updateStringProc(objPtr);
5175     }
5176     if ((objPtr->typePtr->freeIntRepProc) != NULL) {
5177         (*objPtr->typePtr->freeIntRepProc)(objPtr);
5178     }
5179       }
5180       /* Now objPtr is a string object */
5181       
5182       if (Tcl_GetString(objPtr)[0] == '~') {
5183     /* 
5184      * If the first character of the path is a tilde,
5185      * we must just return the path as is, to agree
5186      * with the defined behaviour of 'glob'.
5187      */
5188     return objPtr;
5189       }
5190 
5191       fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
5192 
5193       /* Circular reference, by design */
5194       fsPathPtr->translatedPathPtr = objPtr;
5195       fsPathPtr->normPathPtr = NULL;
5196       fsPathPtr->cwdPtr = cwdPtr;
5197       Tcl_IncrRefCount(cwdPtr);
5198       fsPathPtr->nativePathPtr = NULL;
5199       fsPathPtr->fsRecPtr = NULL;
5200       fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
5201 
5202       PATHOBJ(objPtr) = (VOID *) fsPathPtr;
5203       PATHFLAGS(objPtr) = 0;
5204       objPtr->typePtr = &tclFsPathType;
5205 
5206       return objPtr;
5207   }
5208     }
5209     /* 
5210      * We know the cwd is a normalised object which does
5211      * not end in a directory delimiter, unless the cwd
5212      * is the name of a volume, in which case it will
5213      * end in a delimiter!  We handle this situation here.
5214      * A better test than the '!= sep' might be to simply
5215      * check if 'cwd' is a root volume.
5216      * 
5217      * Note that if we get this wrong, we will strip off
5218      * either too much or too little below, leading to
5219      * wrong answers returned by glob.
5220      */
5221     tempStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
5222     /* 
5223      * Should we perhaps use 'Tcl_FSPathSeparator'?
5224      * But then what about the Windows special case?
5225      * Perhaps we should just check if cwd is a root
5226      * volume.
5227      */
5228     switch (tclPlatform) {
5229   case TCL_PLATFORM_UNIX:
5230       if (tempStr[cwdLen-1] != '/') {
5231     cwdLen++;
5232       }
5233       break;
5234   case TCL_PLATFORM_WINDOWS:
5235       if (tempStr[cwdLen-1] != '/' 
5236         && tempStr[cwdLen-1] != '\\') {
5237     cwdLen++;
5238       }
5239       break;
5240   case TCL_PLATFORM_MAC:
5241       if (tempStr[cwdLen-1] != ':') {
5242     cwdLen++;
5243       }
5244       break;
5245     }
5246     tempStr = Tcl_GetStringFromObj(objPtr, &len);
5247 
5248     return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen);
5249 }
static Tcl_Obj* TclFSNormalizeAbsolutePath (Tcl_Interp* interp, Tcl_Obj * pathPtr, ClientData * clientDataPtr) [static]

Definition at line 1335 of file tclIOUtil.c.
References Tcl_DecrRefCount, Tcl_FSJoinPath(), Tcl_FSSplitPath(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_ListObjIndex(), Tcl_ListObjReplace(), Tcl_NewStringObj(), TclFSMakePathFromNormalized(), and TclFSNormalizeToUniquePath().
Referenced by Tcl_FSGetCwd(), and Tcl_FSGetNormalizedPath().1339 {
1340     int splen = 0, nplen, eltLen, i;
1341     char *eltName;
1342     Tcl_Obj *retVal;
1343     Tcl_Obj *split;
1344     Tcl_Obj *elt;
1345     
1346     /* Split has refCount zero */
1347     split = Tcl_FSSplitPath(pathPtr, &splen);
1348 
1349     /* 
1350      * Modify the list of entries in place, by removing '.', and
1351      * removing '..' and the entry before -- unless that entry before
1352      * is the top-level entry, i.e. the name of a volume.
1353      */
1354     nplen = 0;
1355     for (i = 0; i < splen; i++) {
1356   Tcl_ListObjIndex(NULL, split, nplen, &elt);
1357   eltName = Tcl_GetStringFromObj(elt, &eltLen);
1358 
1359   if ((eltLen == 1) && (eltName[0] == '.')) {
1360       Tcl_ListObjReplace(NULL, split, nplen, 1, 0, NULL);
1361   } else if ((eltLen == 2)
1362     && (eltName[0] == '.') && (eltName[1] == '.')) {
1363       if (nplen > 1) {
1364           nplen--;
1365     Tcl_ListObjReplace(NULL, split, nplen, 2, 0, NULL);
1366       } else {
1367     Tcl_ListObjReplace(NULL, split, nplen, 1, 0, NULL);
1368       }
1369   } else {
1370       nplen++;
1371   }
1372     }
1373     if (nplen > 0) {
1374   ClientData clientData = NULL;
1375   
1376   retVal = Tcl_FSJoinPath(split, nplen);
1377   /* 
1378    * Now we have an absolute path, with no '..', '.' sequences,
1379    * but it still may not be in 'unique' form, depending on the
1380    * platform.  For instance, Unix is case-sensitive, so the
1381    * path is ok.  Windows is case-insensitive, and also has the
1382    * weird 'longname/shortname' thing (e.g. C:/Program Files/ and
1383    * C:/Progra~1/ are equivalent).  MacOS is case-insensitive.
1384    * 
1385    * Virtual file systems which may be registered may have
1386    * other criteria for normalizing a path.
1387    */
1388   Tcl_IncrRefCount(retVal);
1389   TclFSNormalizeToUniquePath(interp, retVal, 0, &clientData);
1390   /* 
1391    * Since we know it is a normalized path, we can
1392    * actually convert this object into an "path" object for
1393    * greater efficiency 
1394    */
1395   TclFSMakePathFromNormalized(interp, retVal, clientData);
1396   if (clientDataPtr != NULL) {
1397       *clientDataPtr = clientData;
1398   }
1399     } else {
1400   /* Init to an empty string */
1401   retVal = Tcl_NewStringObj("",0);
1402   Tcl_IncrRefCount(retVal);
1403     }
1404     /* 
1405      * We increment and then decrement the refCount of split to free
1406      * it.  We do this right at the end, in case there are
1407      * optimisations in Tcl_FSJoinPath(split, nplen) above which would
1408      * let it make use of split more effectively if it has a refCount
1409      * of zero.  Also we can't just decrement the ref count, in case
1410      * 'split' was actually returned by the join call above, in a
1411      * single-element optimisation when nplen == 1.
1412      */
1413     Tcl_IncrRefCount(split);
1414     Tcl_DecrRefCount(split);
1415 
1416     /* This has a refCount of 1 for the caller */
1417     return retVal;
1418 }
int TclFSNormalizeToUniquePath (Tcl_Interp * interp, Tcl_Obj * pathPtr, int startAt, ClientData * clientDataPtr)

Definition at line 1454 of file tclIOUtil.c.
References FsGetFirstFilesystem(), FilesystemRecord::fsPtr, FilesystemRecord::nextPtr, Tcl_Filesystem::normalizePathProc, and void().
Referenced by Tcl_FSGetNormalizedPath(), and TclFSNormalizeAbsolutePath().1459 {
1460     FilesystemRecord *fsRecPtr, *firstFsRecPtr;
1461     /* Ignore this variable */
1462     (void)clientDataPtr;
1463     
1464     /*
1465      * Call each of the "normalise path" functions in succession. This is
1466      * a special case, in which if we have a native filesystem handler,
1467      * we call it first.  This is because the root of Tcl's filesystem
1468      * is always a native filesystem (i.e. '/' on unix is native).
1469      */
1470 
1471     firstFsRecPtr = FsGetFirstFilesystem();
1472 
1473     fsRecPtr = firstFsRecPtr;
1474     while (fsRecPtr != NULL) {
1475         if (fsRecPtr->fsPtr == &tclNativeFilesystem) {
1476       Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
1477       if (proc != NULL) {
1478     startAt = (*proc)(interp, pathPtr, startAt);
1479       }
1480       break;
1481         }
1482   fsRecPtr = fsRecPtr->nextPtr;
1483     }
1484     
1485     fsRecPtr = firstFsRecPtr; 
1486     while (fsRecPtr != NULL) {
1487   /* Skip the native system next time through */
1488   if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
1489       Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
1490       if (proc != NULL) {
1491     startAt = (*proc)(interp, pathPtr, startAt);
1492       }
1493       /* 
1494        * We could add an efficiency check like this:
1495        * 
1496        *   if (retVal == length-of(pathPtr)) {break;}
1497        * 
1498        * but there's not much benefit.
1499        */
1500   }
1501   fsRecPtr = fsRecPtr->nextPtr;
1502     }
1503 
1504     return startAt;
1505 }
void TclFSSetPathDetails (Tcl_Obj * pathObjPtr, FilesystemRecord * fsRecPtr, ClientData clientData)

Definition at line 5958 of file tclIOUtil.c.
References FilesystemRecord::fileRefCount, FsPath::filesystemEpoch, FsPath::fsRecPtr, FsPath::nativePathPtr, PATHOBJ, and TCL_TSD_INIT.
Referenced by Tcl_FSGetFileSystemForPath().5962 {
5963     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
5964     /* We assume pathObjPtr is already of the correct type */
5965     FsPath *srcFsPathPtr;
5966     
5967     srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
5968     srcFsPathPtr->fsRecPtr = fsRecPtr;
5969     srcFsPathPtr->nativePathPtr = clientData;
5970     srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
5971     fsRecPtr->fileRefCount++;
5972 }
int TclGetOpenMode (Tcl_Interp * interp, CONST char * string, int * seekFlagPtr)

Definition at line 1534 of file tclIOUtil.c.
References ckfree, CONST, NULL, O_NONBLOCK, RW_MODES, Tcl_AddErrorInfo(), TCL_OK, Tcl_SplitList(), and UCHAR.
Referenced by PretendTclpOpenFileChannel(), Tcl_FSOpenFileChannel(), Tcl_OpenObjCmd(), and Tcl_ResourceObjCmd().1542 {
1543     int mode, modeArgc, c, i, gotRW;
1544     CONST char **modeArgv, *flag;
1545 #define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR)
1546 
1547     /*
1548      * Check for the simpler fopen-like access modes (e.g. "r").  They
1549      * are distinguished from the POSIX access modes by the presence
1550      * of a lower-case first letter.
1551      */
1552 
1553     *seekFlagPtr = 0;
1554     mode = 0;
1555 
1556     /*
1557      * Guard against international characters before using byte oriented
1558      * routines.
1559      */
1560 
1561     if (!(string[0] & 0x80)
1562       && islower(UCHAR(string[0]))) { /* INTL: ISO only. */
1563   switch (string[0]) {
1564       case 'r':
1565     mode = O_RDONLY;
1566     break;
1567       case 'w':
1568     mode = O_WRONLY|O_CREAT|O_TRUNC;
1569     break;
1570       case 'a':
1571           /* [Bug 680143].
1572      * Added O_APPEND for proper automatic
1573      * seek-to-end-on-write by the OS.
1574      */
1575           mode = O_WRONLY|O_CREAT|O_APPEND;
1576                 *seekFlagPtr = 1;
1577     break;
1578       default:
1579     error:
1580                 if (interp != (Tcl_Interp *) NULL) {
1581                     Tcl_AppendResult(interp,
1582                             "illegal access mode \"", string, "\"",
1583                             (char *) NULL);
1584                 }
1585     return -1;
1586   }
1587   if (string[1] == '+') {
1588       mode &= ~(O_RDONLY|O_WRONLY);
1589       mode |= O_RDWR;
1590       if (string[2] != 0) {
1591     goto error;
1592       }
1593   } else if (string[1] != 0) {
1594       goto error;
1595   }
1596         return mode;
1597     }
1598 
1599     /*
1600      * The access modes are specified using a list of POSIX modes
1601      * such as O_CREAT.
1602      *
1603      * IMPORTANT NOTE: We rely on Tcl_SplitList working correctly when
1604      * a NULL interpreter is passed in.
1605      */
1606 
1607     if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) {
1608         if (interp != (Tcl_Interp *) NULL) {
1609             Tcl_AddErrorInfo(interp,
1610                     "\n    while processing open access modes \"");
1611             Tcl_AddErrorInfo(interp, string);
1612             Tcl_AddErrorInfo(interp, "\"");
1613         }
1614         return -1;
1615     }
1616     
1617     gotRW = 0;
1618     for (i = 0; i < modeArgc; i++) {
1619   flag = modeArgv[i];
1620   c = flag[0];
1621   if ((c == 'R') && (strcmp(flag, "RDONLY") == 0)) {
1622       mode = (mode & ~RW_MODES) | O_RDONLY;
1623       gotRW = 1;
1624   } else if ((c == 'W') && (strcmp(flag, "WRONLY") == 0)) {
1625       mode = (mode & ~RW_MODES) | O_WRONLY;
1626       gotRW = 1;
1627   } else if ((c == 'R') && (strcmp(flag, "RDWR") == 0)) {
1628       mode = (mode & ~RW_MODES) | O_RDWR;
1629       gotRW = 1;
1630   } else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) {
1631       mode |= O_APPEND;
1632             *seekFlagPtr = 1;
1633   } else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) {
1634       mode |= O_CREAT;
1635   } else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) {
1636       mode |= O_EXCL;
1637   } else if ((c == 'N') && (strcmp(flag, "NOCTTY") == 0)) {
1638 #ifdef O_NOCTTY
1639       mode |= O_NOCTTY;
1640 #else
1641       if (interp != (Tcl_Interp *) NULL) {
1642                 Tcl_AppendResult(interp, "access mode \"", flag,
1643                         "\" not supported by this system", (char *) NULL);
1644             }
1645             ckfree((char *) modeArgv);
1646       return -1;
1647 #endif
1648   } else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {
1649 #if defined(O_NDELAY) || defined(O_NONBLOCK)
1650 #   ifdef O_NONBLOCK
1651       mode |= O_NONBLOCK;
1652 #   else
1653       mode |= O_NDELAY;
1654 #   endif
1655 #else
1656             if (interp != (Tcl_Interp *) NULL) {
1657                 Tcl_AppendResult(interp, "access mode \"", flag,
1658                         "\" not supported by this system", (char *) NULL);
1659             }
1660             ckfree((char *) modeArgv);
1661       return -1;
1662 #endif
1663   } else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
1664       mode |= O_TRUNC;
1665   } else {
1666             if (interp != (Tcl_Interp *) NULL) {
1667                 Tcl_AppendResult(interp, "invalid access mode \"", flag,
1668                         "\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT",
1669                         " EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL);
1670             }
1671       ckfree((char *) modeArgv);
1672       return -1;
1673   }
1674     }
1675     ckfree((char *) modeArgv);
1676     if (!gotRW) {
1677         if (interp != (Tcl_Interp *) NULL) {
1678             Tcl_AppendResult(interp, "access mode must include either",
1679                     " RDONLY, WRONLY, or RDWR", (char *) NULL);
1680         }
1681   return -1;
1682     }
1683     return mode;
1684 }
ClientData TclNativeDupInternalRep (ClientData clientData)

Definition at line 4113 of file tclIOUtil.c.
References ckalloc, CONST, size_t(), tclWinProcs, TclWinProcs::useWide, and VOID.4115 {
4116     ClientData copy;
4117     size_t len;
4118 
4119     if (clientData == NULL) {
4120   return NULL;
4121     }
4122 
4123 #ifdef __WIN32__
4124     if (tclWinProcs->useWide) {
4125   /* unicode representation when running on NT/2K/XP */
4126   len = sizeof(WCHAR) + (wcslen((CONST WCHAR*)clientData) * sizeof(WCHAR));
4127     } else {
4128   /* ansi representation when running on 95/98/ME */
4129   len = sizeof(char) + (strlen((CONST char*)clientData) * sizeof(char));
4130     }
4131 #else
4132     /* ansi representation when running on Unix/MacOS */
4133     len = sizeof(char) + (strlen((CONST char*)clientData) * sizeof(char));
4134 #endif
4135     
4136     copy = (ClientData) ckalloc(len);
4137     memcpy((VOID*)copy, (VOID*)clientData, len);
4138     return copy;
4139 }
Tcl_Obj* TclNewFSPathObj (Tcl_Obj * dirPtr, CONST char * addStrRep, int len)

Definition at line 5079 of file tclIOUtil.c.
References ckalloc, FsPath::cwdPtr, FsPath::filesystemEpoch, FsPath::fsRecPtr, FsPath::nativePathPtr, FsPath::normPathPtr, PATHFLAGS, PATHOBJ, Tcl_IncrRefCount, Tcl_NewObj(), Tcl_NewStringObj(), TCL_PLATFORM_MAC, TCL_TSD_INIT, tclFsPathType, TCLPATH_APPENDED, TCLPATH_RELATIVE, tclPlatform, FsPath::translatedPathPtr, and VOID.
Referenced by Tcl_FSJoinPath(), and TclpMatchInDirectory().5080 {
5081     FsPath *fsPathPtr;
5082     Tcl_Obj *objPtr;
5083     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
5084     
5085     objPtr = Tcl_NewObj();
5086     fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
5087     
5088     if (tclPlatform == TCL_PLATFORM_MAC) { 
5089   /* 
5090    * Mac relative paths may begin with a directory separator ':'. 
5091    * If present, we need to skip this ':' because we assume that 
5092    * we can join dirPtr and addStrRep by concatenating them as 
5093    * strings (and we ensure that dirPtr is terminated by a ':'). 
5094    */ 
5095   if (addStrRep[0] == ':') { 
5096       addStrRep++; 
5097       len--; 
5098   } 
5099     } 
5100     /* Setup the path */
5101     fsPathPtr->translatedPathPtr = NULL;
5102     fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len);
5103     Tcl_IncrRefCount(fsPathPtr->normPathPtr);
5104     fsPathPtr->cwdPtr = dirPtr;
5105     Tcl_IncrRefCount(dirPtr);
5106     fsPathPtr->nativePathPtr = NULL;
5107     fsPathPtr->fsRecPtr = NULL;
5108     fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
5109 
5110     PATHOBJ(objPtr) = (VOID *) fsPathPtr;
5111     PATHFLAGS(objPtr) = TCLPATH_RELATIVE | TCLPATH_APPENDED;
5112     objPtr->typePtr = &tclFsPathType;
5113     objPtr->bytes = NULL;
5114     objPtr->length = 0;
5115 
5116     return objPtr;
5117 }
int TclOpenFileChannelDeleteProc (TclOpenFileChannelProc_ * proc)

Definition at line 4558 of file tclIOUtil.c.
References ckfree, OpenFileChannelProc::nextPtr, openFileChannelProcList, OpenFileChannelProc::proc, TCL_ERROR, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_OK.
Referenced by TestopenfilechannelprocCmd().4560 {
4561     int retVal = TCL_ERROR;
4562     OpenFileChannelProc *tmpOpenFileChannelProcPtr = openFileChannelProcList;
4563     OpenFileChannelProc *prevOpenFileChannelProcPtr = NULL;
4564 
4565     /*
4566      * Traverse the 'openFileChannelProcList' looking for the particular
4567      * node whose 'proc' member matches 'proc' and remove that one from
4568      * the list.  
4569      */
4570 
4571     Tcl_MutexLock(&obsoleteFsHookMutex);
4572     tmpOpenFileChannelProcPtr = openFileChannelProcList;
4573     while ((retVal == TCL_ERROR) &&
4574       (tmpOpenFileChannelProcPtr != NULL)) {
4575   if (tmpOpenFileChannelProcPtr->proc == proc) {
4576       if (prevOpenFileChannelProcPtr == NULL) {
4577     openFileChannelProcList = tmpOpenFileChannelProcPtr->nextPtr;
4578       } else {
4579     prevOpenFileChannelProcPtr->nextPtr =
4580       tmpOpenFileChannelProcPtr->nextPtr;
4581       }
4582 
4583       ckfree((char *)tmpOpenFileChannelProcPtr);
4584 
4585       retVal = TCL_OK;
4586   } else {
4587       prevOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr;
4588       tmpOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr->nextPtr;
4589   }
4590     }
4591     Tcl_MutexUnlock(&obsoleteFsHookMutex);
4592 
4593     return retVal;
4594 }
int TclOpenFileChannelInsertProc (TclOpenFileChannelProc_ * proc)

Definition at line 4513 of file tclIOUtil.c.
References ckalloc, OpenFileChannelProc::nextPtr, openFileChannelProcList, OpenFileChannelProc::proc, TCL_ERROR, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_OK.
Referenced by TestopenfilechannelprocCmd().4515 {
4516     int retVal = TCL_ERROR;
4517 
4518     if (proc != NULL) {
4519   OpenFileChannelProc *newOpenFileChannelProcPtr;
4520 
4521   newOpenFileChannelProcPtr =
4522     (OpenFileChannelProc *)ckalloc(sizeof(OpenFileChannelProc));
4523 
4524   if (newOpenFileChannelProcPtr != NULL) {
4525       newOpenFileChannelProcPtr->proc = proc;
4526       Tcl_MutexLock(&obsoleteFsHookMutex);
4527       newOpenFileChannelProcPtr->nextPtr = openFileChannelProcList;
4528       openFileChannelProcList = newOpenFileChannelProcPtr;
4529       Tcl_MutexUnlock(&obsoleteFsHookMutex);
4530 
4531       retVal = TCL_OK;
4532   }
4533     }
4534 
4535     return retVal;
4536 }
int TclpLoadFile (Tcl_Interp * interp, Tcl_Obj * pathPtr, CONST char * sym1, CONST char * sym2, Tcl_PackageInitProc ** proc1Ptr, Tcl_PackageInitProc ** proc2Ptr, ClientData * clientDataPtr, Tcl_FSUnloadFileProc ** unloadProcPtr)

Definition at line 3000 of file tclIOUtil.c.
References TCL_ERROR, TCL_OK, TclpDlopen(), and TclpFindSymbol().3017 {
3018     Tcl_LoadHandle handle = NULL;
3019     int res;
3020     
3021     res = TclpDlopen(interp, pathPtr, &handle, unloadProcPtr);
3022     
3023     if (res != TCL_OK) {
3024         return res;
3025     }
3026 
3027     if (handle == NULL) {
3028   return TCL_ERROR;
3029     }
3030     
3031     *clientDataPtr = (ClientData)handle;
3032     
3033     *proc1Ptr = TclpFindSymbol(interp, handle, sym1);
3034     *proc2Ptr = TclpFindSymbol(interp, handle, sym2);
3035     return TCL_OK;
3036 }
Tcl_Obj* TclpNativeToNormalized (ClientData clientData)

Definition at line 4055 of file tclIOUtil.c.
References CONST, Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, Tcl_ExternalToUtfDString(), Tcl_NewStringObj(), and Tcl_WinTCharToUtf().
Referenced by TclpTempFileName().4057 {
4058     Tcl_DString ds;
4059     Tcl_Obj *objPtr;
4060     CONST char *copy;
4061     int len;
4062     
4063 #ifdef __WIN32__
4064     Tcl_WinTCharToUtf((CONST char*)clientData, -1, &ds);
4065 #else
4066     Tcl_ExternalToUtfDString(NULL, (CONST char*)clientData, -1, &ds);
4067 #endif
4068     
4069     copy = Tcl_DStringValue(&ds);
4070     len = Tcl_DStringLength(&ds);
4071 
4072 #ifdef __WIN32__
4073     /* 
4074      * Certain native path representations on Windows have this special
4075      * prefix to indicate that they are to be treated specially.  For
4076      * example extremely long paths, or symlinks 
4077      */
4078     if (*copy == '\\') {
4079         if (0 == strncmp(copy,"\\??\\",4)) {
4080       copy += 4;
4081       len -= 4;
4082   } else if (0 == strncmp(copy,"\\\\?\\",4)) {
4083       copy += 4;
4084       len -= 4;
4085   }
4086     }
4087 #endif
4088 
4089     objPtr = Tcl_NewStringObj(copy,len);
4090     Tcl_DStringFree(&ds);
4091     
4092     return objPtr;
4093 }
void TclResetFilesystem ()

Definition at line 790 of file tclIOUtil.c.
References filesystemList, nativeFilesystemRecord, and TclWinResetInterfaces().
Referenced by Tcl_Finalize().791 {
792     filesystemList = &nativeFilesystemRecord;
793 
794     /* 
795      * Note, at this point, I believe nativeFilesystemRecord ->
796      * fileRefCount should equal 1 and if not, we should try to track
797      * down the cause.
798      */
799     
800 #ifdef __WIN32__
801     /* 
802      * Cleans up the win32 API filesystem proc lookup table. This must
803      * happen very late in finalization so that deleting of copied
804      * dlls can occur.
805      */
806     TclWinResetInterfaces();
807 #endif
808 }
int TclStatDeleteProc (TclStatProc_ * proc)

Definition at line 4348 of file tclIOUtil.c.
References ckfree, StatProc::nextPtr, StatProc::proc, statProcList, TCL_ERROR, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_OK.
Referenced by TeststatprocCmd().4350 {
4351     int retVal = TCL_ERROR;
4352     StatProc *tmpStatProcPtr;
4353     StatProc *prevStatProcPtr = NULL;
4354 
4355     Tcl_MutexLock(&obsoleteFsHookMutex);
4356     tmpStatProcPtr = statProcList;
4357     /*
4358      * Traverse the 'statProcList' looking for the particular node
4359      * whose 'proc' member matches 'proc' and remove that one from
4360      * the list.  Ensure that the "default" node cannot be removed.
4361      */
4362 
4363     while ((retVal == TCL_ERROR) && (tmpStatProcPtr != NULL)) {
4364   if (tmpStatProcPtr->proc == proc) {
4365       if (prevStatProcPtr == NULL) {
4366     statProcList = tmpStatProcPtr->nextPtr;
4367       } else {
4368     prevStatProcPtr->nextPtr = tmpStatProcPtr->nextPtr;
4369       }
4370 
4371       ckfree((char *)tmpStatProcPtr);
4372 
4373       retVal = TCL_OK;
4374   } else {
4375       prevStatProcPtr = tmpStatProcPtr;
4376       tmpStatProcPtr = tmpStatProcPtr->nextPtr;
4377   }
4378     }
4379 
4380     Tcl_MutexUnlock(&obsoleteFsHookMutex);
4381 
4382     return retVal;
4383 }
int TclStatInsertProc (TclStatProc_ * proc)

Definition at line 4304 of file tclIOUtil.c.
References ckalloc, StatProc::nextPtr, StatProc::proc, statProcList, TCL_ERROR, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_OK.
Referenced by TeststatprocCmd().4306 {
4307     int retVal = TCL_ERROR;
4308 
4309     if (proc != NULL) {
4310   StatProc *newStatProcPtr;
4311 
4312   newStatProcPtr = (StatProc *)ckalloc(sizeof(StatProc));
4313 
4314   if (newStatProcPtr != NULL) {
4315       newStatProcPtr->proc = proc;
4316       Tcl_MutexLock(&obsoleteFsHookMutex);
4317       newStatProcPtr->nextPtr = statProcList;
4318       statProcList = newStatProcPtr;
4319       Tcl_MutexUnlock(&obsoleteFsHookMutex);
4320 
4321       retVal = TCL_OK;
4322   }
4323     }
4324 
4325     return retVal;
4326 }
static void UpdateStringOfFsPath (Tcl_Obj * objPtr) [static]

Definition at line 6341 of file tclIOUtil.c.
References Tcl_Obj::bytes, CONST, FsPath::cwdPtr, Tcl_Obj::length, FsPath::normPathPtr, panic, PATHFLAGS, PATHOBJ, Tcl_AppendObjToObj(), Tcl_AppendToObj(), Tcl_DecrRefCount, Tcl_DuplicateObj(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, TCL_PLATFORM_MAC, TCL_PLATFORM_UNIX, TCL_PLATFORM_WINDOWS, tclEmptyStringRep, and tclPlatform.
Referenced by Tcl_FSConvertToPathType(), Tcl_FSGetNormalizedPath(), and TclFSEnsureEpochOk().6343 {
6344     FsPath *fsPathPtr = (FsPath*) PATHOBJ(objPtr);
6345     CONST char *cwdStr;
6346     int cwdLen;
6347     Tcl_Obj *copy;
6348     
6349     if (PATHFLAGS(objPtr) == 0 || fsPathPtr->cwdPtr == NULL) {
6350   panic("Called UpdateStringOfFsPath with invalid object");
6351     }
6352     
6353     copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr);
6354     Tcl_IncrRefCount(copy);
6355     
6356     cwdStr = Tcl_GetStringFromObj(copy, &cwdLen);
6357     /* 
6358      * Should we perhaps use 'Tcl_FSPathSeparator'?
6359      * But then what about the Windows special case?
6360      * Perhaps we should just check if cwd is a root volume.
6361      * We should never get cwdLen == 0 in this code path.
6362      */
6363     switch (tclPlatform) {
6364   case TCL_PLATFORM_UNIX:
6365       if (cwdStr[cwdLen-1] != '/') {
6366     Tcl_AppendToObj(copy, "/", 1);
6367     cwdLen++;
6368       }
6369       break;
6370   case TCL_PLATFORM_WINDOWS:
6371       /* 
6372        * We need the extra 'cwdLen != 2', and ':' checks because 
6373        * a volume relative path doesn't get a '/'.  For example 
6374        * 'glob C:*cat*.exe' will return 'C:cat32.exe'
6375        */
6376       if (cwdStr[cwdLen-1] != '/'
6377         && cwdStr[cwdLen-1] != '\\') {
6378     if (cwdLen != 2 || cwdStr[1] != ':') {
6379         Tcl_AppendToObj(copy, "/", 1);
6380         cwdLen++;
6381     }
6382       }
6383       break;
6384   case TCL_PLATFORM_MAC:
6385       if (cwdStr[cwdLen-1] != ':') {
6386     Tcl_AppendToObj(copy, ":", 1);
6387     cwdLen++;
6388       }
6389       break;
6390     }
6391     Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr);
6392     objPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen);
6393     objPtr->length = cwdLen;
6394     copy->bytes = tclEmptyStringRep;
6395     copy->length = 0;
6396     Tcl_DecrRefCount(copy);
6397 }

Variable Documentation
AccessProc* accessProcList = NULL [static]

Definition at line 354 of file tclIOUtil.c.
Referenced by Tcl_FSAccess(), TclAccessDeleteProc(), TclAccessInsertProc(), and TclFinalizeFilesystem().Tcl_ThreadDataKey dataKey [static]

Definition at line 512 of file tclIOUtil.c.FilesystemRecord* filesystemList = &nativeFilesystemRecord [static]

Definition at line 485 of file tclIOUtil.c.
Referenced by FsGetFirstFilesystem(), TCL_DECLARE_MUTEX(), Tcl_FSRegister(), Tcl_FSUnregister(), TclFinalizeFilesystem(), and TclResetFilesystem().Tcl_FSUnloadFileProc FSUnloadTempFile [static]

Definition at line 518 of file tclIOUtil.c.FilesystemRecord nativeFilesystemRecord [static]
Initial value: {
    NULL,
    &tclNativeFilesystem,
    1,
    NULL
}
Definition at line 464 of file tclIOUtil.c.
Referenced by TclResetFilesystem().Tcl_FSPathInFilesystemProc NativePathInFilesystem [static]

Definition at line 95 of file tclIOUtil.c.OpenFileChannelProc* openFileChannelProcList = NULL [static]

Definition at line 355 of file tclIOUtil.c.
Referenced by Tcl_FSOpenFileChannel(), TclFinalizeFilesystem(), TclOpenFileChannelDeleteProc(), and TclOpenFileChannelInsertProc().StatProc* statProcList = NULL [static]

Definition at line 353 of file tclIOUtil.c.
Referenced by Tcl_FSStat(), TclFinalizeFilesystem(), TclStatDeleteProc(), and TclStatInsertProc().Tcl_ObjType tclFsPathType [static]
Initial value: {
    "path",       
    FreeFsPathInternalRep,    
    DupFsPathInternalRep,         
    UpdateStringOfFsPath,   
    SetFsPathFromAny      
}
Definition at line 4616 of file tclIOUtil.c.
Referenced by DupFsPathInternalRep(), NativePathInFilesystem(), SetFsPathFromAny(), Tcl_FSConvertToPathType(), Tcl_FSGetNormalizedPath(), Tcl_FSJoinPath(), Tcl_FSNewNativePath(), TclFSMakePathFromNormalized(), TclFSMakePathRelative(), and TclNewFSPathObj().Tcl_Filesystem tclNativeFilesystem
CONST TclFileAttrProcs tclpFileAttrProcs[]

Definition at line 62 of file tclMacFCmd.c.CONST char* tclpFileAttrStrings[]

Definition at line 60 of file tclMacFCmd.c.int theFilesystemEpoch = 0

Definition at line 478 of file tclIOUtil.c.int theFilesystemEpoch

Definition at line 478 of file tclIOUtil.c.ThreadSpecificData

Definition at line 510 of file tclIOUtil.c.

generic/tclLink.c File Reference
#include "tclInt.h"
Classes
struct Link
Defines
#define LINK_READ_ONLY  1
#define LINK_BEING_UPDATED  2
Functions
static char *LinkTraceProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags))
static Tcl_Obj *ObjValue _ANSI_ARGS_ ((Link *linkPtr))
int Tcl_LinkVar (Tcl_Interp *interp, CONST char *varName, char *addr, int type)
void Tcl_UnlinkVar (Tcl_Interp *interp, CONST char *varName)
void Tcl_UpdateLinkedVar (Tcl_Interp *interp, CONST char *varName)
static char * LinkTraceProc (ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags)
static Tcl_Obj * ObjValue (Link *linkPtr)

Define Documentation
#define LINK_BEING_UPDATED  2

Definition at line 56 of file tclLink.c.
Referenced by LinkTraceProc(), and Tcl_UpdateLinkedVar().#define LINK_READ_ONLY  1

Definition at line 55 of file tclLink.c.
Referenced by LinkTraceProc(), and Tcl_LinkVar().
Function Documentation
static Tcl_Obj* ObjValue _ANSI_ARGS_ ((Link *linkPtr)) [static]
static char* LinkTraceProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags)) [static]
static char* LinkTraceProc (ClientData clientData, Tcl_Interp * interp, CONST char * name1, CONST char * name2, int flags) [static]

Definition at line 234 of file tclLink.c.
References Link::addr, ckalloc, ckfree, CONST, Link::d, Link::flags, Link::i, Link::lastValue, LINK_BEING_UPDATED, LINK_READ_ONLY, NULL, ObjValue(), Tcl_DecrRefCount, Tcl_GetBooleanFromObj(), Tcl_GetDoubleFromObj(), Tcl_GetIntFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_GetWideIntFromObj(), TCL_GLOBAL_ONLY, Tcl_IncrRefCount, TCL_INTERP_DESTROYED, TCL_LINK_BOOLEAN, TCL_LINK_DOUBLE, TCL_LINK_INT, TCL_LINK_STRING, TCL_LINK_WIDE_INT, Tcl_ObjGetVar2(), Tcl_ObjSetVar2(), TCL_OK, Tcl_ResetResult(), Tcl_SetObjResult(), TCL_TRACE_DESTROYED, TCL_TRACE_READS, TCL_TRACE_UNSETS, TCL_TRACE_WRITES, Tcl_TraceVar(), Link::type, Link::varName, and Link::w.
Referenced by Tcl_LinkVar(), Tcl_UnlinkVar(), and Tcl_UpdateLinkedVar().240 {
241     Link *linkPtr = (Link *) clientData;
242     int changed, valueLength;
243     CONST char *value;
244     char **pp, *result;
245     Tcl_Obj *objPtr, *valueObj, *tmpPtr;
246 
247     /*
248      * If the variable is being unset, then just re-create it (with a
249      * trace) unless the whole interpreter is going away.
250      */
251 
252     if (flags & TCL_TRACE_UNSETS) {
253   if (flags & TCL_INTERP_DESTROYED) {
254       Tcl_DecrRefCount(linkPtr->varName);
255       ckfree((char *) linkPtr);
256   } else if (flags & TCL_TRACE_DESTROYED) {
257       tmpPtr = ObjValue(linkPtr);
258       Tcl_IncrRefCount(tmpPtr);
259       Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
260         TCL_GLOBAL_ONLY);
261       Tcl_DecrRefCount(tmpPtr);
262       Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName),
263         TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
264         |TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr);
265   }
266   return NULL;
267     }
268 
269     /*
270      * If we were invoked because of a call to Tcl_UpdateLinkedVar, then
271      * don't do anything at all.  In particular, we don't want to get
272      * upset that the variable is being modified, even if it is
273      * supposed to be read-only.
274      */
275 
276     if (linkPtr->flags & LINK_BEING_UPDATED) {
277   return NULL;
278     }
279 
280     /*
281      * For read accesses, update the Tcl variable if the C variable
282      * has changed since the last time we updated the Tcl variable.
283      */
284 
285     if (flags & TCL_TRACE_READS) {
286   switch (linkPtr->type) {
287   case TCL_LINK_INT:
288   case TCL_LINK_BOOLEAN:
289       changed = *(int *)(linkPtr->addr) != linkPtr->lastValue.i;
290       break;
291   case TCL_LINK_DOUBLE:
292       changed = *(double *)(linkPtr->addr) != linkPtr->lastValue.d;
293       break;
294   case TCL_LINK_WIDE_INT:
295       changed = *(Tcl_WideInt *)(linkPtr->addr) != linkPtr->lastValue.w;
296       break;
297   case TCL_LINK_STRING:
298       changed = 1;
299       break;
300   default:
301       return "internal error: bad linked variable type";
302   }
303   if (changed) {
304       tmpPtr = ObjValue(linkPtr);
305       Tcl_IncrRefCount(tmpPtr);
306       Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
307         TCL_GLOBAL_ONLY);
308       Tcl_DecrRefCount(tmpPtr);
309   }
310   return NULL;
311     }
312 
313     /*
314      * For writes, first make sure that the variable is writable.  Then
315      * convert the Tcl value to C if possible.  If the variable isn't
316      * writable or can't be converted, then restore the varaible's old
317      * value and return an error.  Another tricky thing: we have to save
318      * and restore the interpreter's result, since the variable access
319      * could occur when the result has been partially set.
320      */
321 
322     if (linkPtr->flags & LINK_READ_ONLY) {
323   tmpPtr = ObjValue(linkPtr);
324   Tcl_IncrRefCount(tmpPtr);
325   Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
326     TCL_GLOBAL_ONLY);
327   Tcl_DecrRefCount(tmpPtr);
328   return "linked variable is read-only";
329     }
330     valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY);
331     if (valueObj == NULL) {
332   /*
333    * This shouldn't ever happen.
334    */
335   return "internal error: linked variable couldn't be read";
336     }
337 
338     objPtr = Tcl_GetObjResult(interp);
339     Tcl_IncrRefCount(objPtr);
340     Tcl_ResetResult(interp);
341     result = NULL;
342 
343     switch (linkPtr->type) {
344     case TCL_LINK_INT:
345   if (Tcl_GetIntFromObj(interp, valueObj, &linkPtr->lastValue.i)
346     != TCL_OK) {
347       Tcl_SetObjResult(interp, objPtr);
348       tmpPtr = ObjValue(linkPtr);
349       Tcl_IncrRefCount(tmpPtr);
350       Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
351         TCL_GLOBAL_ONLY);
352       Tcl_DecrRefCount(tmpPtr);
353       result = "variable must have integer value";
354       goto end;
355   }
356   *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
357   break;
358 
359     case TCL_LINK_WIDE_INT:
360   if (Tcl_GetWideIntFromObj(interp, valueObj, &linkPtr->lastValue.w)
361     != TCL_OK) {
362       Tcl_SetObjResult(interp, objPtr);
363       tmpPtr = ObjValue(linkPtr);
364       Tcl_IncrRefCount(tmpPtr);
365       Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
366         TCL_GLOBAL_ONLY);
367       Tcl_DecrRefCount(tmpPtr);
368       result = "variable must have integer value";
369       goto end;
370   }
371   *(Tcl_WideInt *)(linkPtr->addr) = linkPtr->lastValue.w;
372   break;
373 
374     case TCL_LINK_DOUBLE:
375   if (Tcl_GetDoubleFromObj(interp, valueObj, &linkPtr->lastValue.d)
376     != TCL_OK) {
377       Tcl_SetObjResult(interp, objPtr);
378       tmpPtr = ObjValue(linkPtr);
379       Tcl_IncrRefCount(tmpPtr);
380       Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
381         TCL_GLOBAL_ONLY);
382       Tcl_DecrRefCount(tmpPtr);
383       result = "variable must have real value";
384       goto end;
385   }
386   *(double *)(linkPtr->addr) = linkPtr->lastValue.d;
387   break;
388 
389     case TCL_LINK_BOOLEAN:
390   if (Tcl_GetBooleanFromObj(interp, valueObj, &linkPtr->lastValue.i)
391       != TCL_OK) {
392       Tcl_SetObjResult(interp, objPtr);
393       tmpPtr = ObjValue(linkPtr);
394       Tcl_IncrRefCount(tmpPtr);
395       Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
396         TCL_GLOBAL_ONLY);
397       Tcl_DecrRefCount(tmpPtr);
398       result = "variable must have boolean value";
399       goto end;
400   }
401   *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
402   break;
403 
404     case TCL_LINK_STRING:
405   value = Tcl_GetStringFromObj(valueObj, &valueLength);
406   valueLength++;
407   pp = (char **)(linkPtr->addr);
408   if (*pp != NULL) {
409       ckfree(*pp);
410   }
411   *pp = (char *) ckalloc((unsigned) valueLength);
412   memcpy(*pp, value, (unsigned) valueLength);
413   break;
414 
415     default:
416   return "internal error: bad linked variable type";
417     }
418     end:
419     Tcl_DecrRefCount(objPtr);
420     return result;
421 }
static Tcl_Obj* ObjValue (Link * linkPtr) [static]

Definition at line 442 of file tclLink.c.
References NULL, TCL_LINK_BOOLEAN, TCL_LINK_DOUBLE, TCL_LINK_INT, TCL_LINK_STRING, TCL_LINK_WIDE_INT, Tcl_NewBooleanObj(), Tcl_NewDoubleObj(), Tcl_NewIntObj(), Tcl_NewStringObj(), and Tcl_NewWideIntObj().
Referenced by LinkTraceProc(), Tcl_LinkVar(), and Tcl_UpdateLinkedVar().444 {
445     char *p;
446 
447     switch (linkPtr->type) {
448     case TCL_LINK_INT:
449   linkPtr->lastValue.i = *(int *)(linkPtr->addr);
450   return Tcl_NewIntObj(linkPtr->lastValue.i);
451     case TCL_LINK_WIDE_INT:
452   linkPtr->lastValue.w = *(Tcl_WideInt *)(linkPtr->addr);
453   return Tcl_NewWideIntObj(linkPtr->lastValue.w);
454     case TCL_LINK_DOUBLE:
455   linkPtr->lastValue.d = *(double *)(linkPtr->addr);
456   return Tcl_NewDoubleObj(linkPtr->lastValue.d);
457     case TCL_LINK_BOOLEAN:
458   linkPtr->lastValue.i = *(int *)(linkPtr->addr);
459   return Tcl_NewBooleanObj(linkPtr->lastValue.i != 0);
460     case TCL_LINK_STRING:
461   p = *(char **)(linkPtr->addr);
462   if (p == NULL) {
463       return Tcl_NewStringObj("NULL", 4);
464   }
465   return Tcl_NewStringObj(p, -1);
466 
467     /*
468      * This code only gets executed if the link type is unknown
469      * (shouldn't ever happen).
470      */
471     default:
472   return Tcl_NewStringObj("??", 2);
473     }
474 }
int Tcl_LinkVar (Tcl_Interp * interp, CONST char * varName, char * addr, int type)

Definition at line 89 of file tclLink.c.
References Link::addr, ckalloc, ckfree, Link::flags, Link::interp, LINK_READ_ONLY, LinkTraceProc(), NULL, ObjValue(), Tcl_DecrRefCount, TCL_ERROR, TCL_GLOBAL_ONLY, Tcl_IncrRefCount, TCL_LEAVE_ERR_MSG, TCL_LINK_READ_ONLY, Tcl_NewStringObj(), Tcl_ObjSetVar2(), TCL_OK, TCL_TRACE_READS, TCL_TRACE_UNSETS, TCL_TRACE_WRITES, Tcl_TraceVar(), Link::type, and Link::varName.
Referenced by InitByteCodeExecution(), Tcl_Main(), TclSetByteCodeFromAny(), and TestlinkCmd().94                                        : TCL_LINK_INT, etc. 
95          * Also may have TCL_LINK_READ_ONLY
96          * OR'ed in. */
97 {
98     Tcl_Obj *objPtr, *resPtr;
99     Link *linkPtr;
100     int code;
101 
102     linkPtr = (Link *) ckalloc(sizeof(Link));
103     linkPtr->interp = interp;
104     linkPtr->varName = Tcl_NewStringObj(varName, -1);
105     Tcl_IncrRefCount(linkPtr->varName);
106     linkPtr->addr = addr;
107     linkPtr->type = type & ~TCL_LINK_READ_ONLY;
108     if (type & TCL_LINK_READ_ONLY) {
109   linkPtr->flags = LINK_READ_ONLY;
110     } else {
111   linkPtr->flags = 0;
112     }
113     objPtr = ObjValue(linkPtr);
114     Tcl_IncrRefCount(objPtr);
115     resPtr = Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
116       TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
117     Tcl_DecrRefCount(objPtr);
118     if (resPtr == NULL) {
119   Tcl_DecrRefCount(linkPtr->varName);
120   ckfree((char *) linkPtr);
121   return TCL_ERROR;
122     }
123     code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
124       |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc,
125       (ClientData) linkPtr);
126     if (code != TCL_OK) {
127   Tcl_DecrRefCount(linkPtr->varName);
128   ckfree((char *) linkPtr);
129     }
130     return code;
131 }
void Tcl_UnlinkVar (Tcl_Interp * interp, CONST char * varName)

Definition at line 152 of file tclLink.c.
References ckfree, LinkTraceProc(), NULL, Tcl_DecrRefCount, TCL_GLOBAL_ONLY, TCL_TRACE_READS, TCL_TRACE_UNSETS, TCL_TRACE_WRITES, Tcl_UntraceVar(), and Tcl_VarTraceInfo().
Referenced by Tcl_Main(), and TestlinkCmd().155 {
156     Link *linkPtr;
157 
158     linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
159       LinkTraceProc, (ClientData) NULL);
160     if (linkPtr == NULL) {
161   return;
162     }
163     Tcl_UntraceVar(interp, varName,
164       TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
165       LinkTraceProc, (ClientData) linkPtr);
166     Tcl_DecrRefCount(linkPtr->varName);
167     ckfree((char *) linkPtr);
168 }
void Tcl_UpdateLinkedVar (Tcl_Interp * interp, CONST char * varName)

Definition at line 190 of file tclLink.c.
References Link::flags, LINK_BEING_UPDATED, LinkTraceProc(), NULL, ObjValue(), Tcl_DecrRefCount, TCL_GLOBAL_ONLY, Tcl_IncrRefCount, Tcl_ObjSetVar2(), Tcl_VarTraceInfo(), and Link::varName.
Referenced by TestlinkCmd().193 {
194     Link *linkPtr;
195     int savedFlag;
196     Tcl_Obj *objPtr;
197 
198     linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
199       LinkTraceProc, (ClientData) NULL);
200     if (linkPtr == NULL) {
201   return;
202     }
203     savedFlag = linkPtr->flags & LINK_BEING_UPDATED;
204     linkPtr->flags |= LINK_BEING_UPDATED;
205     objPtr = ObjValue(linkPtr);
206     Tcl_IncrRefCount(objPtr);
207     Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr, TCL_GLOBAL_ONLY);
208     Tcl_DecrRefCount(objPtr);
209     linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
210 }

generic/tclListObj.c File Reference
#include "tclInt.h"
Defines
#define LOCAL_SIZE  20
Functions
static void DupListInternalRep _ANSI_ARGS_ ((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr))
static void FreeListInternalRep _ANSI_ARGS_ ((Tcl_Obj *listPtr))
static int SetListFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
Tcl_Obj * Tcl_NewListObj (int objc, objv)
Tcl_Obj * Tcl_DbNewListObj (int objc, objv, CONST char *file, int line)
void Tcl_SetListObj (Tcl_Obj *objPtr, int objc, objv)
int Tcl_ListObjGetElements (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr)
int Tcl_ListObjAppendList (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr)
int Tcl_ListObjAppendElement (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr)
int Tcl_ListObjIndex (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr)
int Tcl_ListObjLength (Tcl_Interp *interp, Tcl_Obj *listPtr, int *intPtr)
int Tcl_ListObjReplace (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, objv)
Tcl_Obj * TclLsetList (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *indexArgPtr, Tcl_Obj *valuePtr)
Tcl_Obj * TclLsetFlat (Tcl_Interp *interp, Tcl_Obj *listPtr, int indexCount, indexArray, Tcl_Obj *valuePtr)
int TclListObjSetElement (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr)
static void FreeListInternalRep (Tcl_Obj *listPtr)
static void DupListInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
static int SetListFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr)
static void UpdateStringOfList (Tcl_Obj *listPtr)
Variables
Tcl_ObjType tclListType

Define Documentation
#define LOCAL_SIZE  20

Referenced by Tcl_Merge(), and UpdateStringOfList().
Function Documentation
static int SetListFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr)) [static]
static void FreeListInternalRep _ANSI_ARGS_ ((Tcl_Obj *listPtr)) [static]
static void DupListInternalRep _ANSI_ARGS_ ((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)) [static]
static void DupListInternalRep (Tcl_Obj * srcPtr, Tcl_Obj * copyPtr) [static]

Definition at line 1411 of file tclListObj.c.
References ckalloc, List::elemCount, List::elements, Tcl_Obj::internalRep, List::maxElemCount, NULL, Tcl_IncrRefCount, tclListType, Tcl_Obj::twoPtrValue, Tcl_Obj::typePtr, and VOID.1414 {
1415     List *srcListRepPtr = (List *) srcPtr->internalRep.twoPtrValue.ptr1;
1416     int numElems = srcListRepPtr->elemCount;
1417     int maxElems = srcListRepPtr->maxElemCount;
1418     register Tcl_Obj **srcElemPtrs = srcListRepPtr->elements;
1419     register Tcl_Obj **copyElemPtrs;
1420     register List *copyListRepPtr;
1421     int i;
1422 
1423     /*
1424      * Allocate a new List structure that points to "srcPtr"s element
1425      * objects. Increment the ref counts for those (now shared) element
1426      * objects.
1427      */
1428     
1429     copyElemPtrs = (Tcl_Obj **)
1430   ckalloc((unsigned) maxElems * sizeof(Tcl_Obj *));
1431     for (i = 0;  i < numElems;  i++) {
1432   copyElemPtrs[i] = srcElemPtrs[i];
1433   Tcl_IncrRefCount(copyElemPtrs[i]);
1434     }
1435     
1436     copyListRepPtr = (List *) ckalloc(sizeof(List));
1437     copyListRepPtr->maxElemCount = maxElems;
1438     copyListRepPtr->elemCount    = numElems;
1439     copyListRepPtr->elements     = copyElemPtrs;
1440     
1441     copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) copyListRepPtr;
1442     copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
1443     copyPtr->typePtr = &tclListType;
1444 }
static void FreeListInternalRep (Tcl_Obj * listPtr) [static]

Definition at line 1368 of file tclListObj.c.
References ckfree, List::elemCount, List::elements, NULL, and Tcl_DecrRefCount.1370 {
1371     register List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
1372     register Tcl_Obj **elemPtrs = listRepPtr->elements;
1373     register Tcl_Obj *objPtr;
1374     int numElems = listRepPtr->elemCount;
1375     int i;
1376     
1377     for (i = 0;  i < numElems;  i++) {
1378   objPtr = elemPtrs[i];
1379   Tcl_DecrRefCount(objPtr);
1380     }
1381     ckfree((char *) elemPtrs);
1382     ckfree((char *) listRepPtr);
1383 
1384     listPtr->internalRep.twoPtrValue.ptr1 = NULL;
1385     listPtr->internalRep.twoPtrValue.ptr2 = NULL;
1386 }
static int SetListFromAny (Tcl_Interp * interp, Tcl_Obj * objPtr) [static]

Definition at line 1467 of file tclListObj.c.
References Tcl_Obj::bytes, ckalloc, ckfree, CONST, List::elemCount, List::elements, Tcl_ObjType::freeIntRepProc, Tcl_Obj::internalRep, Tcl_Obj::length, List::maxElemCount, NULL, panic, size_t(), Tcl_DecrRefCount, Tcl_GetStringFromObj(), Tcl_IncrRefCount, TCL_OK, TclCopyAndCollapse(), TclFindElement(), tclListType, TclNewObj, Tcl_Obj::twoPtrValue, Tcl_Obj::typePtr, UCHAR, and VOID.
Referenced by Tcl_ListObjAppendElement(), Tcl_ListObjAppendList(), Tcl_ListObjGetElements(), Tcl_ListObjIndex(), Tcl_ListObjLength(), Tcl_ListObjReplace(), and TclListObjSetElement().1470 {
1471     Tcl_ObjType *oldTypePtr = objPtr->typePtr;
1472     char *string, *s;
1473     CONST char *elemStart, *nextElem;
1474     int lenRemain, length, estCount, elemSize, hasBrace, i, j, result;
1475     char *limit;    /* Points just after string's last byte. */
1476     register CONST char *p;
1477     register Tcl_Obj **elemPtrs;
1478     register Tcl_Obj *elemPtr;
1479     List *listRepPtr;
1480 
1481     /*
1482      * Get the string representation. Make it up-to-date if necessary.
1483      */
1484 
1485     string = Tcl_GetStringFromObj(objPtr, &length);
1486 
1487     /*
1488      * Parse the string into separate string objects, and create a List
1489      * structure that points to the element string objects. We use a
1490      * modified version of Tcl_SplitList's implementation to avoid one
1491      * malloc and a string copy for each list element. First, estimate the
1492      * number of elements by counting the number of space characters in the
1493      * list.
1494      */
1495 
1496     limit = (string + length);
1497     estCount = 1;
1498     for (p = string;  p < limit;  p++) {
1499   if (isspace(UCHAR(*p))) { /* INTL: ISO space. */
1500       estCount++;
1501   }
1502     }
1503 
1504     /*
1505      * Allocate a new List structure with enough room for "estCount"
1506      * elements. Each element is a pointer to a Tcl_Obj with the appropriate
1507      * string rep. The initial "estCount" elements are set using the
1508      * corresponding "argv" strings.
1509      */
1510 
1511     elemPtrs = (Tcl_Obj **)
1512       ckalloc((unsigned) (estCount * sizeof(Tcl_Obj *)));
1513     for (p = string, lenRemain = length, i = 0;
1514       lenRemain > 0;
1515       p = nextElem, lenRemain = (limit - nextElem), i++) {
1516   result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem,
1517         &elemSize, &hasBrace);
1518   if (result != TCL_OK) {
1519       for (j = 0;  j < i;  j++) {
1520     elemPtr = elemPtrs[j];
1521     Tcl_DecrRefCount(elemPtr);
1522       }
1523       ckfree((char *) elemPtrs);
1524       return result;
1525   }
1526   if (elemStart >= limit) {
1527       break;
1528   }
1529   if (i > estCount) {
1530       panic("SetListFromAny: bad size estimate for list");
1531   }
1532 
1533   /*
1534    * Allocate a Tcl object for the element and initialize it from the
1535    * "elemSize" bytes starting at "elemStart".
1536    */
1537 
1538   s = ckalloc((unsigned) elemSize + 1);
1539   if (hasBrace) {
1540       memcpy((VOID *) s, (VOID *) elemStart,  (size_t) elemSize);
1541       s[elemSize] = 0;
1542   } else {
1543       elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
1544   }
1545   
1546   TclNewObj(elemPtr);
1547         elemPtr->bytes  = s;
1548         elemPtr->length = elemSize;
1549         elemPtrs[i] = elemPtr;
1550   Tcl_IncrRefCount(elemPtr); /* since list now holds ref to it */
1551     }
1552 
1553     listRepPtr = (List *) ckalloc(sizeof(List));
1554     listRepPtr->maxElemCount = estCount;
1555     listRepPtr->elemCount    = i;
1556     listRepPtr->elements     = elemPtrs;
1557 
1558     /*
1559      * Free the old internalRep before setting the new one. We do this as
1560      * late as possible to allow the conversion code, in particular
1561      * Tcl_GetStringFromObj, to use that old internalRep.
1562      */
1563 
1564     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
1565   oldTypePtr->freeIntRepProc(objPtr);
1566     }
1567 
1568     objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
1569     objPtr->internalRep.twoPtrValue.ptr2 = NULL;
1570     objPtr->typePtr = &tclListType;
1571     return TCL_OK;
1572 }
Tcl_Obj* Tcl_DbNewListObj (int objc, objv, CONST char * file, int line)

Definition at line 198 of file tclListObj.c.
References Tcl_NewListObj().205 {
206     return Tcl_NewListObj(objc, objv);
207 }
int Tcl_ListObjAppendElement (Tcl_Interp * interp, Tcl_Obj * listPtr, Tcl_Obj * objPtr)

Definition at line 428 of file tclListObj.c.
References ckalloc, ckfree, List::elemCount, List::elements, Tcl_Obj::internalRep, List::maxElemCount, panic, SetListFromAny(), size_t(), Tcl_IncrRefCount, Tcl_InvalidateStringRep(), Tcl_IsShared, TCL_OK, tclListType, Tcl_Obj::twoPtrValue, Tcl_Obj::typePtr, and VOID.
Referenced by AliasList(), AppendDllPath(), AppendEnvironment(), AppendLocals(), BroadcastValue(), CopyData(), CopyRenameOneFile(), DdeServicesOnAck(), ExecuteCallback(), ExecuteRemoteObject(), FsAddMountsToGlobResult(), GetKeyNames(), GetValue(), GetValueNames(), InfoArgsCmd(), InfoCommandsCmd(), InfoGlobalsCmd(), InfoProcsCmd(), InfoVarsCmd(), NamespaceChildrenCmd(), NamespaceCodeCmd(), NamespaceInscopeCmd(), PrintParse(), SlaveHidden(), SplitMacPath(), SplitUnixPath(), SplitWinPath(), Tcl_AfterObjCmd(), Tcl_AppendAllObjTypes(), Tcl_AppendExportList(), Tcl_ArrayObjCmd(), Tcl_BeepObjCmd(), Tcl_BinaryObjCmd(), Tcl_FSFileSystemInfo(), Tcl_FSJoinToPath(), Tcl_FSMatchInDirectory(), Tcl_FSSplitPath(), Tcl_GetChannelNamesEx(), Tcl_GetEncodingNames(), Tcl_InterpObjCmd(), Tcl_JoinPath(), Tcl_LinsertObjCmd(), Tcl_ListMathFuncs(), Tcl_LsearchObjCmd(), Tcl_LsortObjCmd(), Tcl_Main(), Tcl_PidObjCmd(), Tcl_RegexpObjCmd(), Tcl_ResourceObjCmd(), Tcl_ScanObjCmd(), Tcl_SplitObjCmd(), Tcl_TraceObjCmd(), TclFileAttrsCmd(), TclGlob(), TclMacRegisterResourceFork(), TclpInitLibraryPath(), TclpMatchInDirectory(), TclpObjListVolumes(), TclPtrSetVar(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), TestChannelEventCmd(), and TestwinclockCmd().432 {
433     register List *listRepPtr;
434     register Tcl_Obj **elemPtrs;
435     int numElems, numRequired;
436     
437     if (Tcl_IsShared(listPtr)) {
438   panic("Tcl_ListObjAppendElement called with shared object");
439     }
440     if (listPtr->typePtr != &tclListType) {
441   int result = SetListFromAny(interp, listPtr);
442   if (result != TCL_OK) {
443       return result;
444   }
445     }
446 
447     listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
448     elemPtrs = listRepPtr->elements;
449     numElems = listRepPtr->elemCount;
450     numRequired = numElems + 1 ;
451     
452     /*
453      * If there is no room in the current array of element pointers,
454      * allocate a new, larger array and copy the pointers to it.
455      */
456 
457     if (numRequired > listRepPtr->maxElemCount) {
458   int newMax = (2 * numRequired);
459   Tcl_Obj **newElemPtrs = (Tcl_Obj **)
460       ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
461   
462   memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
463          (size_t) (numElems * sizeof(Tcl_Obj *)));
464 
465   listRepPtr->maxElemCount = newMax;
466   listRepPtr->elements = newElemPtrs;
467   ckfree((char *) elemPtrs);
468   elemPtrs = newElemPtrs;
469     }
470 
471     /*
472      * Add objPtr to the end of listPtr's array of element
473      * pointers. Increment the ref count for the (now shared) objPtr.
474      */
475 
476     elemPtrs[numElems] = objPtr;
477     Tcl_IncrRefCount(objPtr);
478     listRepPtr->elemCount++;
479 
480     /*
481      * Invalidate any old string representation since the list's internal
482      * representation has changed.
483      */
484 
485     Tcl_InvalidateStringRep(listPtr);
486     return TCL_OK;
487 }
int Tcl_ListObjAppendList (Tcl_Interp * interp, Tcl_Obj * listPtr, Tcl_Obj * elemListPtr)

Definition at line 366 of file tclListObj.c.
References List::elemCount, panic, SetListFromAny(), Tcl_IsShared, Tcl_ListObjGetElements(), Tcl_ListObjReplace(), TCL_OK, and tclListType.
Referenced by Tcl_FSListVolumes(), and TclpInitLibraryPath().370 {
371     register List *listRepPtr;
372     int listLen, objc, result;
373     Tcl_Obj **objv;
374 
375     if (Tcl_IsShared(listPtr)) {
376   panic("Tcl_ListObjAppendList called with shared object");
377     }
378     if (listPtr->typePtr != &tclListType) {
379   result = SetListFromAny(interp, listPtr);
380   if (result != TCL_OK) {
381       return result;
382   }
383     }
384     listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
385     listLen = listRepPtr->elemCount;
386 
387     result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv);
388     if (result != TCL_OK) {
389   return result;
390     }
391 
392     /*
393      * Insert objc new elements starting after the lists's last element.
394      * Delete zero existing elements.
395      */
396     
397     return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);
398 }
int Tcl_ListObjGetElements (Tcl_Interp * interp, Tcl_Obj * listPtr, int * objcPtr, Tcl_Obj *** objvPtr)

Definition at line 316 of file tclListObj.c.
References List::elemCount, List::elements, SetListFromAny(), TCL_OK, and tclListType.
Referenced by GetInterp(), LoadEncodingFile(), SetFsPathFromAny(), SetValue(), SlaveCreate(), SortCompare(), Tcl_AppendAllObjTypes(), Tcl_ArrayObjCmd(), Tcl_BinaryObjCmd(), Tcl_CaseObjCmd(), Tcl_ForeachObjCmd(), Tcl_GetEncodingNames(), Tcl_JoinObjCmd(), Tcl_ListObjAppendList(), Tcl_LrangeObjCmd(), Tcl_LsearchObjCmd(), Tcl_LsObjCmd(), Tcl_StringObjCmd(), Tcl_SwitchObjCmd(), TclArraySet(), TclGlob(), TclLindexFlat(), TclLindexList(), TclLsetFlat(), TclLsetList(), TclMacUnRegisterResourceFork(), TclpSetInitialEncodings(), TclpSetVariables(), Tcltest_Init(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), and TclTraceVariableObjCmd().324 {
325     register List *listRepPtr;
326 
327     if (listPtr->typePtr != &tclListType) {
328   int result = SetListFromAny(interp, listPtr);
329   if (result != TCL_OK) {
330       return result;
331   }
332     }
333     listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
334     *objcPtr = listRepPtr->elemCount;
335     *objvPtr = listRepPtr->elements;
336     return TCL_OK;
337 }
int Tcl_ListObjIndex (Tcl_Interp * interp, Tcl_Obj * listPtr, int index, Tcl_Obj ** objPtrPtr)

Definition at line 516 of file tclListObj.c.
References List::elemCount, List::elements, NULL, SetListFromAny(), TCL_OK, and tclListType.
Referenced by ConvertFileNameFormat(), FileBasename(), FsAddMountsToGlobResult(), GetPathType(), SortCompare(), Tcl_DdeObjCmd(), Tcl_FileObjCmd(), Tcl_FSJoinPath(), Tcl_FSMatchInDirectory(), Tcl_GlobObjCmd(), Tcl_SplitPath(), TclDoGlob(), TclFileAttrsCmd(), TclFileDirname(), and TclFSNormalizeAbsolutePath().521 {
522     register List *listRepPtr;
523     
524     if (listPtr->typePtr != &tclListType) {
525   int result = SetListFromAny(interp, listPtr);
526   if (result != TCL_OK) {
527       return result;
528   }
529     }
530 
531     listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
532     if ((index < 0) || (index >= listRepPtr->elemCount)) {
533   *objPtrPtr = NULL;
534     } else {
535   *objPtrPtr = listRepPtr->elements[index];
536     }
537     
538     return TCL_OK;
539 }
int Tcl_ListObjLength (Tcl_Interp * interp, Tcl_Obj * listPtr, int * intPtr)

Definition at line 564 of file tclListObj.c.
References List::elemCount, SetListFromAny(), TCL_OK, and tclListType.
Referenced by FsAddMountsToGlobResult(), GetPathType(), SortCompare(), Tcl_FSJoinPath(), Tcl_FSMatchInDirectory(), Tcl_FSSplitPath(), Tcl_GlobObjCmd(), Tcl_LappendObjCmd(), Tcl_LinsertObjCmd(), Tcl_LlengthObjCmd(), Tcl_LreplaceObjCmd(), TclDoGlob(), TclExecuteByteCode(), TclFileAttrsCmd(), TclpNativeSplitPath(), TclTraceCommandObjCmd(), and TclTraceExecutionObjCmd().568 {
569     register List *listRepPtr;
570     
571     if (listPtr->typePtr != &tclListType) {
572   int result = SetListFromAny(interp, listPtr);
573   if (result != TCL_OK) {
574       return result;
575   }
576     }
577 
578     listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
579     *intPtr = listRepPtr->elemCount;
580     return TCL_OK;
581 }
int Tcl_ListObjReplace (Tcl_Interp * interp, Tcl_Obj * listPtr, int first, int count, int objc, objv)

Definition at line 622 of file tclListObj.c.
References ckalloc, ckfree, List::elemCount, List::elements, Tcl_Obj::internalRep, List::maxElemCount, panic, SetListFromAny(), size_t(), Tcl_IncrRefCount, Tcl_InvalidateStringRep(), Tcl_IsShared, TCL_OK, TclDecrRefCount, tclListType, Tcl_Obj::twoPtrValue, Tcl_Obj::typePtr, and VOID.
Referenced by ConvertFileNameFormat(), FsAddMountsToGlobResult(), SortCompare(), Tcl_LinsertObjCmd(), Tcl_ListObjAppendList(), Tcl_LreplaceObjCmd(), TclFSNormalizeAbsolutePath(), TclMacRegisterResourceFork(), and TclMacUnRegisterResourceFork().630 {
631     List *listRepPtr;
632     register Tcl_Obj **elemPtrs, **newPtrs;
633     Tcl_Obj *victimPtr;
634     int numElems, numRequired, numAfterLast;
635     int start, shift, newMax, i, j, result;
636      
637     if (Tcl_IsShared(listPtr)) {
638   panic("Tcl_ListObjReplace called with shared object");
639     }
640     if (listPtr->typePtr != &tclListType) {
641   result = SetListFromAny(interp, listPtr);
642   if (result != TCL_OK) {
643       return result;
644   }
645     }
646     listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
647     elemPtrs = listRepPtr->elements;
648     numElems = listRepPtr->elemCount;
649 
650     if (first < 0)  {
651       first = 0;
652     }
653     if (first >= numElems) {
654   first = numElems; /* so we'll insert after last element */
655     }
656     if (count < 0) {
657   count = 0;
658     }
659     
660     numRequired = (numElems - count + objc);
661     if (numRequired <= listRepPtr->maxElemCount) {
662   /*
663    * Enough room in the current array. First "delete" count
664    * elements starting at first.
665    */
666 
667   for (i = 0, j = first;  i < count;  i++, j++) {
668       victimPtr = elemPtrs[j];
669       TclDecrRefCount(victimPtr);
670   }
671 
672   /*
673    * Shift the elements after the last one removed to their
674    * new locations.
675    */
676 
677   start = (first + count);
678   numAfterLast = (numElems - start);
679   shift = (objc - count); /* numNewElems - numDeleted */
680   if ((numAfterLast > 0) && (shift != 0)) {
681       Tcl_Obj **src, **dst;
682 
683       src = elemPtrs + start; dst = src + shift;
684       memmove((VOID*) dst, (VOID*) src, 
685               (size_t) (numAfterLast * sizeof(Tcl_Obj*)));
686   }
687 
688   /*
689    * Insert the new elements into elemPtrs before "first".
690    */
691 
692   for (i = 0, j = first;  i < objc;  i++, j++) {
693             elemPtrs[j] = objv[i];
694             Tcl_IncrRefCount(objv[i]);
695         }
696 
697   /*
698    * Update the count of elements.
699    */
700 
701   listRepPtr->elemCount = numRequired;
702     } else {
703   /*
704    * Not enough room in the current array. Allocate a larger array and
705    * insert elements into it. 
706    */
707 
708   newMax = (2 * numRequired);
709   newPtrs = (Tcl_Obj **)
710       ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
711 
712   /*
713    * Copy over the elements before "first".
714    */
715 
716   if (first > 0) {
717       memcpy((VOID *) newPtrs, (VOID *) elemPtrs,
718         (size_t) (first * sizeof(Tcl_Obj *)));
719   }
720 
721   /*
722    * "Delete" count elements starting at first.
723    */
724 
725   for (i = 0, j = first;  i < count;  i++, j++) {
726       victimPtr = elemPtrs[j];
727       TclDecrRefCount(victimPtr);
728   }
729 
730   /*
731    * Copy the elements after the last one removed, shifted to
732    * their new locations.
733    */
734 
735   start = (first + count);
736   numAfterLast = (numElems - start);
737   if (numAfterLast > 0) {
738       memcpy((VOID *) &(newPtrs[first + objc]),
739         (VOID *) &(elemPtrs[start]),
740         (size_t) (numAfterLast * sizeof(Tcl_Obj *)));
741   }
742   
743   /*
744    * Insert the new elements before "first" and update the
745    * count of elements.
746    */
747 
748   for (i = 0, j = first;  i < objc;  i++, j++) {
749       newPtrs[j] = objv[i];
750       Tcl_IncrRefCount(objv[i]);
751   }
752 
753   listRepPtr->elemCount = numRequired;
754   listRepPtr->maxElemCount = newMax;
755   listRepPtr->elements = newPtrs;
756   ckfree((char *) elemPtrs);
757     }
758     
759     /*
760      * Invalidate and free any old string representation since it no longer
761      * reflects the list's internal representation.
762      */
763 
764     Tcl_InvalidateStringRep(listPtr);
765     return TCL_OK;
766 }
Tcl_Obj* Tcl_NewListObj (int objc, objv)

Definition at line 92 of file tclListObj.c.
References ckalloc, List::elemCount, List::elements, Tcl_Obj::internalRep, List::maxElemCount, NULL, Tcl_IncrRefCount, Tcl_InvalidateStringRep(), tclListType, TclNewObj, Tcl_Obj::twoPtrValue, Tcl_Obj::typePtr, and VOID.
Referenced by AliasDescribe(), CopyRenameOneFile(), DdeServicesOnAck(), ExecuteRemoteObject(), FileCopyRename(), InfoArgsCmd(), InfoCommandsCmd(), InfoGlobalsCmd(), InfoLevelCmd(), InfoLocalsCmd(), InfoProcsCmd(), InfoVarsCmd(), NamespaceChildrenCmd(), NamespaceCodeCmd(), NamespaceExportCmd(), NamespaceInscopeCmd(), SlaveCreate(), Tcl_DbNewListObj(), Tcl_FSFileSystemInfo(), Tcl_FSJoinToPath(), Tcl_FSMatchInDirectory(), Tcl_LsearchObjCmd(), Tcl_Main(), Tcl_RecordAndEvalObj(), Tcl_RegexpObjCmd(), Tcl_TimeObjCmd(), Tcl_TraceObjCmd(), TclDoGlob(), TclExecuteByteCode(), TclFileAttrsCmd(), TclObjInterpProc(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), TestregexpObjCmd(), and TestwincpuidCmd().95 {
96     register Tcl_Obj *listPtr;
97     register Tcl_Obj **elemPtrs;
98     register List *listRepPtr;
99     int i;
100     
101     TclNewObj(listPtr);
102     
103     if (objc > 0) {
104   Tcl_InvalidateStringRep(listPtr);
105   
106   elemPtrs = (Tcl_Obj **)
107       ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
108   for (i = 0;  i < objc;  i++) {
109       elemPtrs[i] = objv[i];
110       Tcl_IncrRefCount(elemPtrs[i]);
111   }
112   
113   listRepPtr = (List *) ckalloc(sizeof(List));
114   listRepPtr->maxElemCount = objc;
115   listRepPtr->elemCount    = objc;
116   listRepPtr->elements     = elemPtrs;
117   
118   listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
119   listPtr->internalRep.twoPtrValue.ptr2 = NULL;
120   listPtr->typePtr = &tclListType;
121     }
122     return listPtr;
123 }
void Tcl_SetListObj (Tcl_Obj * objPtr, int objc, objv)

Definition at line 233 of file tclListObj.c.
References ckalloc, List::elemCount, List::elements, Tcl_ObjType::freeIntRepProc, Tcl_Obj::internalRep, List::maxElemCount, NULL, panic, Tcl_IncrRefCount, Tcl_InvalidateStringRep(), Tcl_IsShared, tclEmptyStringRep, tclListType, Tcl_Obj::twoPtrValue, and VOID.
Referenced by Tcl_ListObjCmd(), Tcl_LrangeObjCmd(), Tcl_RegexpObjCmd(), and Tcl_ScanObjCmd().237 {
238     register Tcl_Obj **elemPtrs;
239     register List *listRepPtr;
240     Tcl_ObjType *oldTypePtr = objPtr->typePtr;
241     int i;
242 
243     if (Tcl_IsShared(objPtr)) {
244   panic("Tcl_SetListObj called with shared object");
245     }
246     
247     /*
248      * Free any old string rep and any internal rep for the old type.
249      */
250 
251     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
252   oldTypePtr->freeIntRepProc(objPtr);
253     }
254     objPtr->typePtr = NULL;
255     Tcl_InvalidateStringRep(objPtr);
256         
257     /*
258      * Set the object's type to "list" and initialize the internal rep.
259      * However, if there are no elements to put in the list, just give
260      * the object an empty string rep and a NULL type.
261      */
262 
263     if (objc > 0) {
264   elemPtrs = (Tcl_Obj **)
265       ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
266   for (i = 0;  i < objc;  i++) {
267       elemPtrs[i] = objv[i];
268       Tcl_IncrRefCount(elemPtrs[i]);
269   }
270   
271   listRepPtr = (List *) ckalloc(sizeof(List));
272   listRepPtr->maxElemCount = objc;
273   listRepPtr->elemCount    = objc;
274   listRepPtr->elements     = elemPtrs;
275   
276   objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
277   objPtr->internalRep.twoPtrValue.ptr2 = NULL;
278   objPtr->typePtr = &tclListType;
279     } else {
280   objPtr->bytes = tclEmptyStringRep;
281   objPtr->length = 0;
282     }
283 }
int TclListObjSetElement (Tcl_Interp* interp, Tcl_Obj* listPtr, int index, Tcl_Obj* valuePtr)

Definition at line 1291 of file tclListObj.c.
References List::elemCount, List::elements, Tcl_Obj::internalRep, NULL, panic, SetListFromAny(), Tcl_DecrRefCount, TCL_ERROR, Tcl_IncrRefCount, Tcl_IsShared, Tcl_NewStringObj(), TCL_OK, Tcl_SetObjResult(), tclListType, Tcl_Obj::twoPtrValue, and Tcl_Obj::typePtr.
Referenced by TclLsetFlat(), and TclLsetList().1299 {
1300     int result;     /* Return value from this function */
1301     List* listRepPtr;   /* Internal representation of the list
1302          * being modified */
1303     Tcl_Obj** elemPtrs;   /* Pointers to elements of the list */
1304     int elemCount;    /* Number of elements in the list */
1305 
1306     /* Ensure that the listPtr parameter designates an unshared list */
1307 
1308     if ( Tcl_IsShared( listPtr ) ) {
1309   panic( "Tcl_ListObjSetElement called with shared object" );
1310     }
1311     if ( listPtr->typePtr != &tclListType ) {
1312   result = SetListFromAny( interp, listPtr );
1313   if ( result != TCL_OK ) {
1314       return result;
1315   }
1316     }
1317     listRepPtr = (List*) listPtr->internalRep.twoPtrValue.ptr1;
1318     elemPtrs = listRepPtr->elements;
1319     elemCount = listRepPtr->elemCount;
1320 
1321     /* Ensure that the index is in bounds */
1322 
1323     if ( index < 0 || index >= elemCount ) {
1324   if ( interp != NULL ) {
1325       Tcl_SetObjResult( interp,
1326             Tcl_NewStringObj( "list index out of range",
1327             -1 ) );
1328       return TCL_ERROR;
1329   }
1330     }
1331 
1332     /* Add a reference to the new list element */
1333 
1334     Tcl_IncrRefCount( valuePtr );
1335 
1336     /* Remove a reference from the old list element */
1337 
1338     Tcl_DecrRefCount( elemPtrs[ index ] );
1339 
1340     /* Stash the new object in the list */
1341 
1342     elemPtrs[ index ] = valuePtr;
1343 
1344     return TCL_OK;
1345     
1346 }
Tcl_Obj* TclLsetFlat (Tcl_Interp* interp, Tcl_Obj* listPtr, int indexCount, indexArray, Tcl_Obj* valuePtr)

Definition at line 1085 of file tclListObj.c.
References Tcl_Obj::internalRep, NULL, Tcl_DecrRefCount, Tcl_DuplicateObj(), TCL_ERROR, Tcl_IncrRefCount, Tcl_InvalidateStringRep(), Tcl_IsShared, Tcl_ListObjGetElements(), Tcl_NewStringObj(), TCL_OK, Tcl_SetObjResult(), TclGetIntForIndex(), TclListObjSetElement(), Tcl_Obj::twoPtrValue, and VOID.
Referenced by Tcl_LsetObjCmd(), TclExecuteByteCode(), and TclLsetList().1092 {
1093 
1094     int duplicated;   /* Flag == 1 if the obj has been
1095          * duplicated, 0 otherwise */
1096     Tcl_Obj* retValuePtr; /* Pointer to the list to be returned */
1097 
1098     int elemCount;    /* Length of one sublist being changed */
1099     Tcl_Obj** elemPtrs;   /* Pointers to the elements of a sublist */
1100 
1101     Tcl_Obj* subListPtr;  /* Pointer to the current sublist */
1102 
1103     int index;      /* Index of the element to replace in the
1104          * current sublist */
1105     Tcl_Obj* chainPtr;    /* Pointer to the enclosing list of
1106          * the current sublist. */
1107 
1108     int result;     /* Status return from library calls */
1109 
1110 
1111 
1112     int i;
1113 
1114     /*
1115      * If there are no indices, then simply return the new value,
1116      * counting the returned pointer as a reference
1117      */
1118 
1119     if ( indexCount == 0 ) {
1120   Tcl_IncrRefCount( valuePtr );
1121   return valuePtr;
1122     }
1123 
1124     /*
1125      * If the list is shared, make a private copy.
1126      */
1127 
1128     if ( Tcl_IsShared( listPtr ) ) {
1129   duplicated = 1;
1130   listPtr = Tcl_DuplicateObj( listPtr );
1131   Tcl_IncrRefCount( listPtr );
1132     } else {
1133   duplicated = 0;
1134     }
1135 
1136     /*
1137      * Anchor the linked list of Tcl_Obj's whose string reps must be
1138      * invalidated if the operation succeeds.
1139      */
1140 
1141     retValuePtr = listPtr;
1142     chainPtr = NULL;
1143 
1144     /*
1145      * Handle each index arg by diving into the appropriate sublist
1146      */
1147 
1148     for ( i = 0; ; ++i ) {
1149 
1150   /*
1151    * Take the sublist apart.
1152    */
1153 
1154   result = Tcl_ListObjGetElements( interp, listPtr,
1155            &elemCount, &elemPtrs );
1156   if ( result != TCL_OK ) {
1157       break;
1158   }
1159   listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
1160 
1161   /*
1162    * Determine the index of the requested element.
1163    */
1164 
1165   result = TclGetIntForIndex( interp, indexArray[ i ],
1166             (elemCount - 1), &index );
1167   if ( result != TCL_OK ) {
1168       break;
1169   }
1170   
1171   /*
1172    * Check that the index is in range.
1173    */
1174 
1175   if ( ( index < 0 ) || ( index >= elemCount ) ) {
1176       Tcl_SetObjResult( interp,
1177             Tcl_NewStringObj( "list index out of range",
1178             -1 ) );
1179       result = TCL_ERROR;
1180       break;
1181   }
1182 
1183   /*
1184    * Break the loop after extracting the innermost sublist
1185    */
1186 
1187   if ( i >= indexCount-1 ) {
1188       result = TCL_OK;
1189       break;
1190   }
1191   
1192   /*
1193    * Extract the appropriate sublist, and make sure that it is unshared.
1194    */
1195 
1196   subListPtr = elemPtrs[ index ];
1197   if ( Tcl_IsShared( subListPtr ) ) {
1198       subListPtr = Tcl_DuplicateObj( subListPtr );
1199       result = TclListObjSetElement( interp, listPtr, index,
1200               subListPtr );
1201       if ( result != TCL_OK ) {
1202     /* 
1203      * We actually shouldn't be able to get here.
1204      * If we do, it would result in leaking subListPtr,
1205      * but everything's been validated already; the error
1206      * exit from TclListObjSetElement should never happen.
1207      */
1208     break;
1209       }
1210   }
1211 
1212   /* 
1213    * Chain the current sublist onto the linked list of Tcl_Obj's
1214    * whose string reps must be spoilt.
1215    */
1216 
1217   chainPtr = listPtr;
1218   listPtr = subListPtr;
1219 
1220     }
1221 
1222     /* Store the result in the list element */
1223 
1224     if ( result == TCL_OK ) {
1225   result = TclListObjSetElement( interp, listPtr, index, valuePtr );
1226     }
1227 
1228     if ( result == TCL_OK ) {
1229 
1230   listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
1231 
1232   /* Spoil all the string reps */
1233   
1234   while ( listPtr != NULL ) {
1235       subListPtr = (Tcl_Obj *) listPtr->internalRep.twoPtrValue.ptr2;
1236       Tcl_InvalidateStringRep( listPtr );
1237       listPtr->internalRep.twoPtrValue.ptr2 = NULL;
1238       listPtr = subListPtr;
1239   }
1240 
1241   /* Return the new list if everything worked. */
1242   
1243   if ( !duplicated ) {
1244       Tcl_IncrRefCount( retValuePtr );
1245   }
1246   return retValuePtr;
1247     }
1248 
1249     /* Clean up the one dangling reference otherwise */
1250 
1251     if ( duplicated ) {
1252   Tcl_DecrRefCount( retValuePtr );
1253     }
1254     return NULL;
1255 
1256 }
Tcl_Obj* TclLsetList (Tcl_Interp* interp, Tcl_Obj* listPtr, Tcl_Obj* indexArgPtr, Tcl_Obj* valuePtr)

Definition at line 816 of file tclListObj.c.
References Tcl_Obj::internalRep, NULL, Tcl_DecrRefCount, Tcl_DuplicateObj(), TCL_ERROR, Tcl_IncrRefCount, Tcl_InvalidateStringRep(), Tcl_IsShared, Tcl_ListObjGetElements(), Tcl_NewStringObj(), TCL_OK, Tcl_SetObjResult(), TclGetIntForIndex(), TclListObjSetElement(), tclListType, TclLsetFlat(), Tcl_Obj::twoPtrValue, Tcl_Obj::typePtr, and VOID.
Referenced by Tcl_LsetObjCmd(), and TclExecuteByteCode().821 {
822     int indexCount;   /* Number of indices in the index list */
823     Tcl_Obj** indices;    /* Vector of indices in the index list*/
824 
825     int duplicated;   /* Flag == 1 if the obj has been
826          * duplicated, 0 otherwise */
827     Tcl_Obj* retValuePtr; /* Pointer to the list to be returned */
828     int index;      /* Current index in the list - discarded */
829     int result;     /* Status return from library calls */
830     Tcl_Obj* subListPtr;  /* Pointer to the current sublist */
831     int elemCount;    /* Count of elements in the current sublist */
832     Tcl_Obj** elemPtrs;   /* Pointers to elements of current sublist  */
833     Tcl_Obj* chainPtr;    /* Pointer to the enclosing sublist
834          * of the current sublist */
835     int i;
836 
837 
838     /*
839      * Determine whether the index arg designates a list or a single
840      * index.  We have to be careful about the order of the checks to
841      * avoid repeated shimmering; see TIP #22 and #23 for details.
842      */
843 
844     if ( indexArgPtr->typePtr != &tclListType
845    && TclGetIntForIndex( NULL, indexArgPtr, 0, &index ) == TCL_OK ) {
846 
847   /*
848    * indexArgPtr designates a single index.
849    */
850 
851   return TclLsetFlat( interp, listPtr, 1, &indexArgPtr, valuePtr );
852 
853     } else if ( Tcl_ListObjGetElements( NULL, indexArgPtr,
854           &indexCount, &indices ) != TCL_OK ) {
855 
856   /*
857    * indexArgPtr designates something that is neither an index nor a
858    * well formed list.  Report the error via TclLsetFlat.
859    */
860 
861   return TclLsetFlat( interp, listPtr, 1, &indexArgPtr, valuePtr );
862 
863     }
864 
865     /*
866      * At this point, we know that argPtr designates a well formed list,
867      * and the 'else if' above has parsed it into indexCount and indices.
868      * If there are no indices, simply return 'valuePtr', counting the
869      * returned pointer as a reference.
870      */
871 
872     if ( indexCount == 0 ) {
873   Tcl_IncrRefCount( valuePtr );
874   return valuePtr;
875     }
876 
877     /*
878      * Duplicate the list arg if necessary.
879      */
880 
881     if ( Tcl_IsShared( listPtr ) ) {
882   duplicated = 1;
883   listPtr = Tcl_DuplicateObj( listPtr );
884   Tcl_IncrRefCount( listPtr );
885     } else {
886   duplicated = 0;
887     }
888 
889     /*
890      * It would be tempting simply to go off to TclLsetFlat to finish the
891      * processing.  Alas, it is also incorrect!  The problem is that
892      * 'indexArgPtr' may designate a sublist of 'listPtr' whose value
893      * is to be manipulated.  The fact that 'listPtr' is itself unshared
894      * does not guarantee that no sublist is.  Therefore, it's necessary
895      * to replicate all the work here, expanding the index list on each
896      * trip through the loop.
897      */
898 
899     /*
900      * Anchor the linked list of Tcl_Obj's whose string reps must be
901      * invalidated if the operation succeeds.
902      */
903 
904     retValuePtr = listPtr;
905     chainPtr = NULL;
906 
907     /*
908      * Handle each index arg by diving into the appropriate sublist
909      */
910 
911     for ( i = 0; ; ++i ) {
912 
913   /*
914    * Take the sublist apart.
915    */
916 
917   result = Tcl_ListObjGetElements( interp, listPtr,
918            &elemCount, &elemPtrs );
919   if ( result != TCL_OK ) {
920       break;
921   }
922   listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
923 
924   /*
925    * Reconstitute the index array
926    */
927 
928   result = Tcl_ListObjGetElements( interp, indexArgPtr,
929            &indexCount, &indices );
930   if ( result != TCL_OK ) {
931       /* 
932        * Shouldn't be able to get here, because we already
933        * parsed the thing successfully once.
934        */
935       break;
936   }
937 
938   /*
939    * Determine the index of the requested element.
940    */
941 
942   result = TclGetIntForIndex( interp, indices[ i ],
943             (elemCount - 1), &index );
944   if ( result != TCL_OK ) {
945       break;
946   }
947   
948   /*
949    * Check that the index is in range.
950    */
951 
952   if ( ( index < 0 ) || ( index >= elemCount ) ) {
953       Tcl_SetObjResult( interp,
954             Tcl_NewStringObj( "list index out of range",
955             -1 ) );
956       result = TCL_ERROR;
957       break;
958   }
959 
960   /*
961    * Break the loop after extracting the innermost sublist
962    */
963 
964   if ( i >= indexCount-1 ) {
965       result = TCL_OK;
966       break;
967   }
968   
969   /*
970    * Extract the appropriate sublist, and make sure that it is unshared.
971    */
972 
973   subListPtr = elemPtrs[ index ];
974   if ( Tcl_IsShared( subListPtr ) ) {
975       subListPtr = Tcl_DuplicateObj( subListPtr );
976       result = TclListObjSetElement( interp, listPtr, index,
977               subListPtr );
978       if ( result != TCL_OK ) {
979     /* 
980      * We actually shouldn't be able to get here, because
981      * we've already checked everything that TclListObjSetElement
982      * checks. If we were to get here, it would result in leaking
983      * subListPtr.
984      */
985     break;
986       }
987   }
988 
989   /* 
990    * Chain the current sublist onto the linked list of Tcl_Obj's
991    * whose string reps must be spoilt.
992    */
993 
994   chainPtr = listPtr;
995   listPtr = subListPtr;
996 
997     }
998 
999     /*
1000      * Store the new element into the correct slot in the innermost sublist.
1001      */
1002 
1003     if ( result == TCL_OK ) {
1004   result = TclListObjSetElement( interp, listPtr, index, valuePtr );
1005     }
1006 
1007     if ( result == TCL_OK ) {
1008 
1009   listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
1010 
1011   /* Spoil all the string reps */
1012   
1013   while ( listPtr != NULL ) {
1014       subListPtr = (Tcl_Obj *) listPtr->internalRep.twoPtrValue.ptr2;
1015       Tcl_InvalidateStringRep( listPtr );
1016       listPtr->internalRep.twoPtrValue.ptr2 = NULL;
1017       listPtr = subListPtr;
1018   }
1019 
1020   /* Return the new list if everything worked. */
1021   
1022   if ( !duplicated ) {
1023       Tcl_IncrRefCount( retValuePtr );
1024   }
1025   return retValuePtr;
1026     }
1027 
1028     /* Clean up the one dangling reference otherwise */
1029 
1030     if ( duplicated ) {
1031   Tcl_DecrRefCount( retValuePtr );
1032     }
1033     return NULL;
1034 
1035 }
static void UpdateStringOfList (Tcl_Obj * listPtr) [static]

Definition at line 1596 of file tclListObj.c.
References ckalloc, List::elemCount, List::elements, LOCAL_SIZE, Tcl_GetStringFromObj(), and Tcl_ScanCountedElement().1598 {
1599 #   define LOCAL_SIZE 20
1600     int localFlags[LOCAL_SIZE], *flagPtr;
1601     List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
1602     int numElems = listRepPtr->elemCount;
1603     register int i;
1604     char *elem, *dst;
1605     int length;
1606 
1607     /*
1608      * Convert each element of the list to string form and then convert it
1609      * to proper list element form, adding it to the result buffer.
1610      */
1611 
1612     /*
1613      * Pass 1: estimate space, gather flags.
1614      */
1615 
1616     if (numElems <= LOCAL_SIZE) {
1617   flagPtr = localFlags;
1618     } else {
1619   flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
1620     }
1621     listPtr->length = 1;
1622     for (i = 0; i < numElems; i++) {
1623   elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
1624   listPtr->length += Tcl_ScanCountedElement(elem, length,
1625     &flagPtr[i]) + 1;
1626   /*
1627    * Check for continued sanity. [Bug 1267380]
1628    */
1629   if (listPtr->length < 1) {
1630       Tcl_Panic("string representation size exceeds sane bounds");
1631   }
1632     }
1633 
1634     /*
1635      * Pass 2: copy into string rep buffer.
1636      */
1637 
1638     listPtr->bytes = ckalloc((unsigned) listPtr->length);
1639     dst = listPtr->bytes;
1640     for (i = 0; i < numElems; i++) {
1641   elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
1642   dst += Tcl_ConvertCountedElement(elem, length, dst, flagPtr[i]);
1643   *dst = ' ';
1644   dst++;
1645     }
1646     if (flagPtr != localFlags) {
1647   ckfree((char *) flagPtr);
1648     }
1649     if (dst == listPtr->bytes) {
1650   *dst = 0;
1651     } else {
1652   dst--;
1653   *dst = 0;
1654     }
1655     listPtr->length = dst - listPtr->bytes;
1656 }

Variable Documentation
Tcl_ObjType tclListType
Initial value: {
    "list",       
    FreeListInternalRep,    
    DupListInternalRep,           
    UpdateStringOfList,     
    SetListFromAny      
}
Definition at line 44 of file tclListObj.c.
Referenced by DupListInternalRep(), SetListFromAny(), Tcl_ConcatObj(), Tcl_EvalObjEx(), Tcl_LappendObjCmd(), Tcl_ListObjAppendElement(), Tcl_ListObjAppendList(), Tcl_ListObjGetElements(), Tcl_ListObjIndex(), Tcl_ListObjLength(), Tcl_ListObjReplace(), Tcl_LrangeObjCmd(), Tcl_NewListObj(), Tcl_SetListObj(), TclExecuteByteCode(), TclInitObjSubsystem(), TclLindexFlat(), TclLindexList(), TclListObjSetElement(), and TclLsetList().

generic/tclLiteral.c File Reference
#include "tclInt.h"
#include "tclCompile.h"
#include "tclPort.h"
Defines
#define REBUILD_MULTIPLIER  3
Functions
static int AddLocalLiteralEntry _ANSI_ARGS_ ((CompileEnv *envPtr, LiteralEntry *globalPtr, int localHash))
static void ExpandLocalLiteralArray _ANSI_ARGS_ ((CompileEnv *envPtr))
static unsigned int HashString _ANSI_ARGS_ ((CONST char *bytes, int length))
static void RebuildLiteralTable _ANSI_ARGS_ ((LiteralTable *tablePtr))
void TclInitLiteralTable (LiteralTable *tablePtr)
void TclDeleteLiteralTable (Tcl_Interp *interp, LiteralTable *tablePtr)
int TclRegisterLiteral (CompileEnv *envPtr, char *bytes, int length, int onHeap)
LiteralEntry * TclLookupLiteralEntry (Tcl_Interp *interp, Tcl_Obj *objPtr)
void TclHideLiteral (Tcl_Interp *interp, CompileEnv *envPtr, int index)
int TclAddLiteralObj (CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr)
static int AddLocalLiteralEntry (CompileEnv *envPtr, LiteralEntry *globalPtr, int localHash)
static void ExpandLocalLiteralArray (CompileEnv *envPtr)
void TclReleaseLiteral (Tcl_Interp *interp, Tcl_Obj *objPtr)
static unsigned int HashString (CONST char *bytes, int length)
static void RebuildLiteralTable (LiteralTable *tablePtr)

Define Documentation
#define REBUILD_MULTIPLIER  3

Definition at line 26 of file tclLiteral.c.
Function Documentation
static void RebuildLiteralTable _ANSI_ARGS_ ((LiteralTable *tablePtr)) [static]
static unsigned int HashString _ANSI_ARGS_ ((CONST char *bytes, int length)) [static]
static void ExpandLocalLiteralArray _ANSI_ARGS_ ((CompileEnv *envPtr)) [static]
static int AddLocalLiteralEntry _ANSI_ARGS_ ((CompileEnv *envPtr, LiteralEntry *globalPtr, int localHash)) [static]
static int AddLocalLiteralEntry (CompileEnv * envPtr, LiteralEntry * globalPtr, int localHash) [static]

Definition at line 518 of file tclLiteral.c.
References LiteralTable::buckets, LiteralEntry::nextPtr, NULL, LiteralTable::numBuckets, LiteralTable::numEntries, LiteralEntry::objPtr, RebuildLiteralTable(), LiteralTable::rebuildSize, LiteralEntry::refCount, and TclAddLiteralObj().
Referenced by TclRegisterLiteral().524 {
525     register LiteralTable *localTablePtr = &(envPtr->localLitTable);
526     LiteralEntry *localPtr;
527     int objIndex;
528     
529     objIndex = TclAddLiteralObj(envPtr, globalPtr->objPtr, &localPtr);
530 
531     /*
532      * Add the literal to the local table.
533      */
534 
535     localPtr->nextPtr = localTablePtr->buckets[localHash];
536     localTablePtr->buckets[localHash] = localPtr;
537     localTablePtr->numEntries++;
538 
539     globalPtr->refCount++;
540 
541     /*
542      * If the CompileEnv's local literal table has exceeded a decent size,
543      * rebuild it with more buckets.
544      */
545 
546     if (localTablePtr->numEntries >= localTablePtr->rebuildSize) {
547   RebuildLiteralTable(localTablePtr);
548     }
549 
550 #ifdef TCL_COMPILE_DEBUG
551     TclVerifyLocalLiteralTable(envPtr);
552     {
553   char *bytes;
554   int length, found, i;
555   found = 0;
556   for (i = 0;  i < localTablePtr->numBuckets;  i++) {
557       for (localPtr = localTablePtr->buckets[i];
558         localPtr != NULL;  localPtr = localPtr->nextPtr) {
559     if (localPtr->objPtr == globalPtr->objPtr) {
560         found = 1;
561     }
562       }
563   }
564   if (!found) {
565       bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
566       panic("AddLocalLiteralEntry: literal \"%.*s\" wasn't found locally",
567               (length>60? 60 : length), bytes);
568   }
569     }
570 #endif /*TCL_COMPILE_DEBUG*/
571     return objIndex;
572 }
static void ExpandLocalLiteralArray (CompileEnv * envPtr) [static]

Definition at line 596 of file tclLiteral.c.
References LiteralTable::buckets, ckalloc, NULL, LiteralTable::numBuckets, size_t(), and VOID.
Referenced by TclAddLiteralObj().599 {
600     /*
601      * The current allocated local literal entries are stored between
602      * elements 0 and (envPtr->literalArrayNext - 1) [inclusive].
603      */
604 
605     LiteralTable *localTablePtr = &(envPtr->localLitTable);
606     int currElems = envPtr->literalArrayNext;
607     size_t currBytes = (currElems * sizeof(LiteralEntry));
608     register LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
609     register LiteralEntry *newArrayPtr =
610       (LiteralEntry *) ckalloc((unsigned) (2 * currBytes));
611     int i;
612     
613     /*
614      * Copy from the old literal array to the new, then update the local
615      * literal table's bucket array.
616      */
617 
618     memcpy((VOID *) newArrayPtr, (VOID *) currArrayPtr, currBytes);
619     for (i = 0;  i < currElems;  i++) {
620   if (currArrayPtr[i].nextPtr == NULL) {
621       newArrayPtr[i].nextPtr = NULL;
622   } else {
623       newArrayPtr[i].nextPtr = newArrayPtr
624         + (currArrayPtr[i].nextPtr - currArrayPtr);
625   }
626     }
627     for (i = 0;  i < localTablePtr->numBuckets;  i++) {
628   if (localTablePtr->buckets[i] != NULL) {
629       localTablePtr->buckets[i] = newArrayPtr
630               + (localTablePtr->buckets[i] - currArrayPtr);
631   }
632     }
633 
634     /*
635      * Free the old literal array if needed, and mark the new literal
636      * array as malloced.
637      */
638     
639     if (envPtr->mallocedLiteralArray) {
640   ckfree((char *) currArrayPtr);
641     }
642     envPtr->literalArrayPtr = newArrayPtr;
643     envPtr->literalArrayEnd = (2 * currElems);
644     envPtr->mallocedLiteralArray = 1;
645 }
static unsigned int HashString (CONST char * bytes, int length) [static]

Definition at line 767 of file tclLiteral.c.
Referenced by RebuildLiteralTable(), TclHideLiteral(), TclLookupLiteralEntry(), TclRegisterLiteral(), and TclReleaseLiteral().771 {
772     register unsigned int result;
773     register int i;
774 
775     /*
776      * I tried a zillion different hash functions and asked many other
777      * people for advice.  Many people had their own favorite functions,
778      * all different, but no-one had much idea why they were good ones.
779      * I chose the one below (multiply by 9 and add new character)
780      * because of the following reasons:
781      *
782      * 1. Multiplying by 10 is perfect for keys that are decimal strings,
783      *    and multiplying by 9 is just about as good.
784      * 2. Times-9 is (shift-left-3) plus (old).  This means that each
785      *    character's bits hang around in the low-order bits of the
786      *    hash value for ever, plus they spread fairly rapidly up to
787      *    the high-order bits to fill out the hash value.  This seems
788      *    works well both for decimal and non-decimal strings.
789      */
790 
791     result = 0;
792     for (i = 0;  i < length;  i++) {
793   result += (result<<3) + *bytes++;
794     }
795     return result;
796 }
static void RebuildLiteralTable (LiteralTable * tablePtr) [static]

Definition at line 817 of file tclLiteral.c.
References ckalloc, ckfree, HashString(), LiteralEntry::nextPtr, NULL, LiteralEntry::objPtr, and Tcl_GetStringFromObj().
Referenced by AddLocalLiteralEntry(), and TclRegisterLiteral().819 {
820     LiteralEntry **oldBuckets;
821     register LiteralEntry **oldChainPtr, **newChainPtr;
822     register LiteralEntry *entryPtr;
823     LiteralEntry **bucketPtr;
824     char *bytes;
825     int oldSize, count, index, length;
826 
827     oldSize = tablePtr->numBuckets;
828     oldBuckets = tablePtr->buckets;
829 
830     /*
831      * Allocate and initialize the new bucket array, and set up
832      * hashing constants for new array size.
833      */
834 
835     tablePtr->numBuckets *= 4;
836     tablePtr->buckets = (LiteralEntry **) ckalloc((unsigned)
837       (tablePtr->numBuckets * sizeof(LiteralEntry *)));
838     for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
839       count > 0;
840       count--, newChainPtr++) {
841   *newChainPtr = NULL;
842     }
843     tablePtr->rebuildSize *= 4;
844     tablePtr->mask = (tablePtr->mask << 2) + 3;
845 
846     /*
847      * Rehash all of the existing entries into the new bucket array.
848      */
849 
850     for (oldChainPtr = oldBuckets;
851       oldSize > 0;
852       oldSize--, oldChainPtr++) {
853   for (entryPtr = *oldChainPtr;  entryPtr != NULL;
854           entryPtr = *oldChainPtr) {
855       bytes = Tcl_GetStringFromObj(entryPtr->objPtr, &length);
856       index = (HashString(bytes, length) & tablePtr->mask);
857       
858       *oldChainPtr = entryPtr->nextPtr;
859       bucketPtr = &(tablePtr->buckets[index]);
860       entryPtr->nextPtr = *bucketPtr;
861       *bucketPtr = entryPtr;
862   }
863     }
864 
865     /*
866      * Free up the old bucket array, if it was dynamically allocated.
867      */
868 
869     if (oldBuckets != tablePtr->staticBuckets) {
870   ckfree((char *) oldBuckets);
871     }
872 }
int TclAddLiteralObj (CompileEnv * envPtr, Tcl_Obj * objPtr, LiteralEntry ** litPtrPtr)

Definition at line 467 of file tclLiteral.c.
References ExpandLocalLiteralArray(), LiteralEntry::nextPtr, NULL, LiteralEntry::objPtr, LiteralEntry::refCount, and Tcl_IncrRefCount.
Referenced by AddLocalLiteralEntry().474 {
475     register LiteralEntry *lPtr;
476     int objIndex;
477 
478     if (envPtr->literalArrayNext >= envPtr->literalArrayEnd) {
479   ExpandLocalLiteralArray(envPtr);
480     }
481     objIndex = envPtr->literalArrayNext;
482     envPtr->literalArrayNext++;
483 
484     lPtr = &(envPtr->literalArrayPtr[objIndex]);
485     lPtr->objPtr = objPtr;
486     Tcl_IncrRefCount(objPtr);
487     lPtr->refCount = -1;  /* i.e., unused */
488     lPtr->nextPtr = NULL;
489 
490     if (litPtrPtr) {
491   *litPtrPtr = lPtr;
492     }
493 
494     return objIndex;
495 }
void TclDeleteLiteralTable (Tcl_Interp * interp, LiteralTable * tablePtr)

Definition at line 100 of file tclLiteral.c.
References LiteralTable::buckets, ckfree, NULL, LiteralTable::numBuckets, LiteralTable::numEntries, LiteralEntry::objPtr, LiteralTable::staticBuckets, and TclReleaseLiteral().
Referenced by DeleteInterpProc().104 {
105     LiteralEntry *entryPtr;
106     int i, start;
107 
108     /*
109      * Release remaining literals in the table. Note that releasing a
110      * literal might release other literals, modifying the table, so we
111      * restart the search from the bucket chain we last found an entry.
112      */
113 
114 #ifdef TCL_COMPILE_DEBUG
115     TclVerifyGlobalLiteralTable((Interp *) interp);
116 #endif /*TCL_COMPILE_DEBUG*/
117 
118     start = 0;
119     while (tablePtr->numEntries > 0) {
120   for (i = start;  i < tablePtr->numBuckets;  i++) {
121       entryPtr = tablePtr->buckets[i];
122       if (entryPtr != NULL) {
123     TclReleaseLiteral(interp, entryPtr->objPtr);
124     start = i;
125     break;
126       }
127   }
128     }
129 
130     /*
131      * Free up the table's bucket array if it was dynamically allocated.
132      */
133 
134     if (tablePtr->buckets != tablePtr->staticBuckets) {
135   ckfree((char *) tablePtr->buckets);
136     }
137 }
void TclHideLiteral (Tcl_Interp * interp, CompileEnv * envPtr, int index)

Definition at line 401 of file tclLiteral.c.
References LiteralTable::buckets, HashString(), LiteralTable::mask, LiteralEntry::nextPtr, NULL, LiteralTable::numEntries, LiteralEntry::objPtr, Tcl_DuplicateObj(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, and TclReleaseLiteral().408 {
409     LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
410     LiteralTable *localTablePtr = &(envPtr->localLitTable);
411     int localHash, length;
412     char *bytes;
413     Tcl_Obj *newObjPtr;
414 
415     lPtr = &(envPtr->literalArrayPtr[index]);
416 
417     /*
418      * To avoid unwanted sharing we need to copy the object and remove it from
419      * the local and global literal tables.  It still has a slot in the literal
420      * array so it can be referred to by byte codes, but it will not be matched
421      * by literal searches.
422      */
423 
424     newObjPtr = Tcl_DuplicateObj(lPtr->objPtr);
425     Tcl_IncrRefCount(newObjPtr);
426     TclReleaseLiteral(interp, lPtr->objPtr);
427     lPtr->objPtr = newObjPtr;
428 
429     bytes = Tcl_GetStringFromObj(newObjPtr, &length);
430     localHash = (HashString(bytes, length) & localTablePtr->mask);
431     nextPtrPtr = &localTablePtr->buckets[localHash];
432 
433     for (entryPtr = *nextPtrPtr; entryPtr != NULL; entryPtr = *nextPtrPtr) {
434   if (entryPtr == lPtr) {
435       *nextPtrPtr = lPtr->nextPtr;
436       lPtr->nextPtr = NULL;
437       localTablePtr->numEntries--;
438       break;
439   }
440   nextPtrPtr = &entryPtr->nextPtr;
441     }
442 }
void TclInitLiteralTable (LiteralTable * tablePtr)

Definition at line 61 of file tclLiteral.c.
References panic, REBUILD_MULTIPLIER, and TCL_SMALL_HASH_TABLE.
Referenced by Tcl_CreateInterp(), and TclInitCompileEnv().64 {
65 #if (TCL_SMALL_HASH_TABLE != 4) 
66     panic("TclInitLiteralTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
67       TCL_SMALL_HASH_TABLE);
68 #endif
69     
70     tablePtr->buckets = tablePtr->staticBuckets;
71     tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
72     tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
73     tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
74     tablePtr->numEntries = 0;
75     tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
76     tablePtr->mask = 3;
77 }
LiteralEntry* TclLookupLiteralEntry (Tcl_Interp * interp, Tcl_Obj * objPtr)

Definition at line 356 of file tclLiteral.c.
References LiteralTable::buckets, HashString(), Interp::literalTable, LiteralTable::mask, LiteralEntry::nextPtr, NULL, LiteralEntry::objPtr, and Tcl_GetStringFromObj().
Referenced by TclRegisterLiteral().362 {
363     Interp *iPtr = (Interp *) interp;
364     LiteralTable *globalTablePtr = &(iPtr->literalTable);
365     register LiteralEntry *entryPtr;
366     char *bytes;
367     int length, globalHash;
368 
369     bytes = Tcl_GetStringFromObj(objPtr, &length);
370     globalHash = (HashString(bytes, length) & globalTablePtr->mask);
371     for (entryPtr = globalTablePtr->buckets[globalHash];
372             entryPtr != NULL;  entryPtr = entryPtr->nextPtr) {
373         if (entryPtr->objPtr == objPtr) {
374             return entryPtr;
375         }
376     }
377     return NULL;
378 }
int TclRegisterLiteral (CompileEnv * envPtr, char * bytes, int length, int onHeap)

Definition at line 168 of file tclLiteral.c.
References AddLocalLiteralEntry(), LiteralTable::buckets, Tcl_Obj::bytes, ckalloc, ckfree, hash(), HashString(), Tcl_Obj::internalRep, Tcl_Obj::length, Interp::literalTable, Tcl_Obj::longValue, LiteralTable::mask, memcmp(), LiteralEntry::nextPtr, NULL, LiteralTable::numBuckets, LiteralTable::numEntries, LiteralEntry::objPtr, panic, RebuildLiteralTable(), LiteralTable::rebuildSize, LiteralEntry::refCount, Tcl_IncrRefCount, TCL_INTEGER_SPACE, TCL_OK, TclFormatInt(), TclGetLong(), TclInitStringRep, tclIntType, TclLooksLikeInt(), TclLookupLiteralEntry(), TclNewObj, and Tcl_Obj::typePtr.
Referenced by Tcl_ExprObj(), TclCompileExprWords(), TclCompileScript(), and TclCompileTokens().180 {
181     Interp *iPtr = envPtr->iPtr;
182     LiteralTable *globalTablePtr = &(iPtr->literalTable);
183     LiteralTable *localTablePtr = &(envPtr->localLitTable);
184     register LiteralEntry *globalPtr, *localPtr;
185     register Tcl_Obj *objPtr;
186     unsigned int hash;
187     int localHash, globalHash, objIndex;
188     long n;
189     char buf[TCL_INTEGER_SPACE];
190 
191     if (length < 0) {
192   length = (bytes? strlen(bytes) : 0);
193     }
194     hash = HashString(bytes, length);
195 
196     /*
197      * Is the literal already in the CompileEnv's local literal array?
198      * If so, just return its index.
199      */
200 
201     localHash = (hash & localTablePtr->mask);
202     for (localPtr = localTablePtr->buckets[localHash];
203     localPtr != NULL;  localPtr = localPtr->nextPtr) {
204   objPtr = localPtr->objPtr;
205   if ((objPtr->length == length) && ((length == 0)
206     || ((objPtr->bytes[0] == bytes[0])
207       && (memcmp(objPtr->bytes, bytes, (unsigned) length)
208         == 0)))) {
209       if (onHeap) {
210     ckfree(bytes);
211       }
212       objIndex = (localPtr - envPtr->literalArrayPtr);
213 #ifdef TCL_COMPILE_DEBUG
214       TclVerifyLocalLiteralTable(envPtr);
215 #endif /*TCL_COMPILE_DEBUG*/
216 
217       return objIndex;
218   }
219     }
220 
221     /*
222      * The literal is new to this CompileEnv. Is it in the interpreter's
223      * global literal table?
224      */
225 
226     globalHash = (hash & globalTablePtr->mask);
227     for (globalPtr = globalTablePtr->buckets[globalHash];
228    globalPtr != NULL;  globalPtr = globalPtr->nextPtr) {
229   objPtr = globalPtr->objPtr;
230   if ((objPtr->length == length) && ((length == 0)
231     || ((objPtr->bytes[0] == bytes[0])
232       && (memcmp(objPtr->bytes, bytes, (unsigned) length)
233         == 0)))) {
234       /*
235        * A global literal was found. Add an entry to the CompileEnv's
236        * local literal array.
237        */
238       
239       if (onHeap) {
240     ckfree(bytes);
241       }
242       objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash);
243 #ifdef TCL_COMPILE_DEBUG
244       if (globalPtr->refCount < 1) {
245     panic("TclRegisterLiteral: global literal \"%.*s\" had bad refCount %d",
246       (length>60? 60 : length), bytes,
247       globalPtr->refCount);
248       }
249       TclVerifyLocalLiteralTable(envPtr);
250 #endif /*TCL_COMPILE_DEBUG*/ 
251       return objIndex;
252   }
253     }
254 
255     /*
256      * The literal is new to the interpreter. Add it to the global literal
257      * table then add an entry to the CompileEnv's local literal array.
258      * Convert the object to an integer object if possible.
259      */
260 
261     TclNewObj(objPtr);
262     Tcl_IncrRefCount(objPtr);
263     if (onHeap) {
264   objPtr->bytes = bytes;
265   objPtr->length = length;
266     } else {
267   TclInitStringRep(objPtr, bytes, length);
268     }
269 
270     if (TclLooksLikeInt(bytes, length)) {
271   /*
272    * From here we use the objPtr, because it is NULL terminated
273    */
274   if (TclGetLong((Tcl_Interp *) NULL, objPtr->bytes, &n) == TCL_OK) {
275       TclFormatInt(buf, n);
276       if (strcmp(objPtr->bytes, buf) == 0) {
277     objPtr->internalRep.longValue = n;
278     objPtr->typePtr = &tclIntType;
279       }
280   }
281     }
282     
283 #ifdef TCL_COMPILE_DEBUG
284     if (TclLookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
285   panic("TclRegisterLiteral: literal \"%.*s\" found globally but shouldn't be",
286           (length>60? 60 : length), bytes);
287     }
288 #endif
289 
290     globalPtr = (LiteralEntry *) ckalloc((unsigned) sizeof(LiteralEntry));
291     globalPtr->objPtr = objPtr;
292     globalPtr->refCount = 0;
293     globalPtr->nextPtr = globalTablePtr->buckets[globalHash];
294     globalTablePtr->buckets[globalHash] = globalPtr;
295     globalTablePtr->numEntries++;
296 
297     /*
298      * If the global literal table has exceeded a decent size, rebuild it
299      * with more buckets.
300      */
301 
302     if (globalTablePtr->numEntries >= globalTablePtr->rebuildSize) {
303   RebuildLiteralTable(globalTablePtr);
304     }
305     objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash);
306 
307 #ifdef TCL_COMPILE_DEBUG
308     TclVerifyGlobalLiteralTable(iPtr);
309     TclVerifyLocalLiteralTable(envPtr);
310     {
311   LiteralEntry *entryPtr;
312   int found, i;
313   found = 0;
314   for (i = 0;  i < globalTablePtr->numBuckets;  i++) {
315       for (entryPtr = globalTablePtr->buckets[i];
316         entryPtr != NULL;  entryPtr = entryPtr->nextPtr) {
317     if ((entryPtr == globalPtr)
318             && (entryPtr->objPtr == objPtr)) {
319         found = 1;
320     }
321       }
322   }
323   if (!found) {
324       panic("TclRegisterLiteral: literal \"%.*s\" wasn't global",
325               (length>60? 60 : length), bytes);
326   }
327     }
328 #endif /*TCL_COMPILE_DEBUG*/
329 #ifdef TCL_COMPILE_STATS   
330     iPtr->stats.numLiteralsCreated++;
331     iPtr->stats.totalLitStringBytes   += (double) (length + 1);
332     iPtr->stats.currentLitStringBytes += (double) (length + 1);
333     iPtr->stats.literalCount[TclLog2(length)]++;
334 #endif /*TCL_COMPILE_STATS*/
335     return objIndex;
336 }
void TclReleaseLiteral (Tcl_Interp * interp, Tcl_Obj * objPtr)

Definition at line 669 of file tclLiteral.c.
References LiteralTable::buckets, ckfree, HashString(), Interp::literalTable, LiteralTable::mask, LiteralEntry::nextPtr, NULL, LiteralTable::numEntries, ByteCode::numLitObjects, ByteCode::objArrayPtr, LiteralEntry::objPtr, LiteralEntry::refCount, Tcl_DecrRefCount, Tcl_GetStringFromObj(), tclByteCodeType, and TclDecrRefCount.
Referenced by Tcl_ExprObj(), TclCleanupByteCode(), TclDeleteLiteralTable(), TclHideLiteral(), and TclSetByteCodeFromAny().675 {
676     Interp *iPtr = (Interp *) interp;
677     LiteralTable *globalTablePtr = &(iPtr->literalTable);
678     register LiteralEntry *entryPtr, *prevPtr;
679     ByteCode* codePtr;
680     char *bytes;
681     int length, index;
682 
683     bytes = Tcl_GetStringFromObj(objPtr, &length);
684     index = (HashString(bytes, length) & globalTablePtr->mask);
685 
686     /*
687      * Check to see if the object is in the global literal table and 
688      * remove this reference.  The object may not be in the table if
689      * it is a hidden local literal.
690      */
691 
692     for (prevPtr = NULL, entryPtr = globalTablePtr->buckets[index];
693       entryPtr != NULL;
694       prevPtr = entryPtr, entryPtr = entryPtr->nextPtr) {
695   if (entryPtr->objPtr == objPtr) {
696       entryPtr->refCount--;
697 
698       /*
699        * If the literal is no longer being used by any ByteCode,
700        * delete the entry then remove the reference corresponding 
701        * to the global literal table entry (decrement the ref count 
702        * of the object).
703        */
704     
705       if (entryPtr->refCount == 0) {
706     if (prevPtr == NULL) {
707         globalTablePtr->buckets[index] = entryPtr->nextPtr;
708     } else {
709         prevPtr->nextPtr = entryPtr->nextPtr;
710     }
711     ckfree((char *) entryPtr);
712     globalTablePtr->numEntries--;
713 
714     TclDecrRefCount(objPtr);
715 
716     /*
717      * Check if the LiteralEntry is only being kept alive by 
718      * a circular reference from a ByteCode stored as its 
719      * internal rep. In that case, set the ByteCode object array 
720      * entry NULL to signal to TclCleanupByteCode to not try to 
721      * release this about to be freed literal again.
722      */
723       
724     if (objPtr->typePtr == &tclByteCodeType) {
725         codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
726         if ((codePtr->numLitObjects == 1)
727                 && (codePtr->objArrayPtr[0] == objPtr)) {     
728       codePtr->objArrayPtr[0] = NULL;
729         }
730     }
731 
732 #ifdef TCL_COMPILE_STATS
733     iPtr->stats.currentLitStringBytes -= (double) (length + 1);
734 #endif /*TCL_COMPILE_STATS*/
735       }
736       break;
737   }
738     }
739     
740     /*
741      * Remove the reference corresponding to the local literal table
742      * entry.
743      */
744 
745     Tcl_DecrRefCount(objPtr);
746 }

generic/tclLoad.c File Reference
#include "tclInt.h"
Classes
struct LoadedPackage
Functions
TCL_DECLARE_MUTEX (packageMutex)
static void LoadCleanupProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp))
int Tcl_LoadObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
void Tcl_StaticPackage (Tcl_Interp *interp, CONST char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
int TclGetLoadedPackages (Tcl_Interp *interp, char *targetName)
static void LoadCleanupProc (ClientData clientData, Tcl_Interp *interp)
void TclFinalizeLoad ()
Variables
static LoadedPackage * firstPackagePtr = NULL
InterpPackage

Function Documentation
static void LoadCleanupProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp)) [static]
static void LoadCleanupProc (ClientData clientData, Tcl_Interp * interp) [static]

Definition at line 633 of file tclLoad.c.
References ckfree, and InterpPackage.637 {
638     InterpPackage *ipPtr, *nextPtr;
639 
640     ipPtr = (InterpPackage *) clientData;
641     while (ipPtr != NULL) {
642   nextPtr = ipPtr->nextPtr;
643   ckfree((char *) ipPtr);
644   ipPtr = nextPtr;
645     }
646 }
TCL_DECLARE_MUTEX (packageMutex)

Definition at line 71 of file tclLoad.c.81                              {
82     LoadedPackage *pkgPtr;  /* Points to detailed information about
83          * package. */
84     struct InterpPackage *nextPtr;
85         /* Next package in this interpreter, or
86          * NULL for end of list. */
87 } InterpPackage;
int Tcl_LoadObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 114 of file tclLoad.c.
References LoadedPackage::fileName, firstPackagePtr, InterpPackage, LoadedPackage::nextPtr, NULL, LoadedPackage::packageName, packageName, Tcl_DStringAppend(), Tcl_DStringInit(), Tcl_DStringSetLength(), Tcl_DStringValue, TCL_ERROR, Tcl_FSConvertToPathType(), Tcl_GetAssocData(), Tcl_GetSlave(), Tcl_GetString(), Tcl_MutexLock, Tcl_MutexUnlock, TCL_OK, Tcl_SetResult(), TCL_STATIC, Tcl_UtfToLower(), and Tcl_WrongNumArgs().119 {
120     Tcl_Interp *target;
121     LoadedPackage *pkgPtr, *defaultPtr;
122     Tcl_DString pkgName, tmp, initName, safeInitName;
123     Tcl_PackageInitProc *initProc, *safeInitProc;
124     InterpPackage *ipFirstPtr, *ipPtr;
125     int code, namesMatch, filesMatch;
126     char *p, *fullFileName, *packageName;
127     Tcl_LoadHandle loadHandle;
128     Tcl_FSUnloadFileProc *unLoadProcPtr = NULL;
129     Tcl_UniChar ch;
130     int offset;
131 
132     if ((objc < 2) || (objc > 4)) {
133         Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?");
134   return TCL_ERROR;
135     }
136     if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
137   return TCL_ERROR;
138     }
139     fullFileName = Tcl_GetString(objv[1]);
140     
141     Tcl_DStringInit(&pkgName);
142     Tcl_DStringInit(&initName);
143     Tcl_DStringInit(&safeInitName);
144     Tcl_DStringInit(&tmp);
145 
146     packageName = NULL;
147     if (objc >= 3) {
148   packageName = Tcl_GetString(objv[2]);
149   if (packageName[0] == '\0') {
150       packageName = NULL;
151   }
152     }
153     if ((fullFileName[0] == 0) && (packageName == NULL)) {
154   Tcl_SetResult(interp,
155     "must specify either file name or package name",
156     TCL_STATIC);
157   code = TCL_ERROR;
158   goto done;
159     }
160 
161     /*
162      * Figure out which interpreter we're going to load the package into.
163      */
164 
165     target = interp;
166     if (objc == 4) {
167   char *slaveIntName;
168   slaveIntName = Tcl_GetString(objv[3]);
169   target = Tcl_GetSlave(interp, slaveIntName);
170   if (target == NULL) {
171       return TCL_ERROR;
172   }
173     }
174 
175     /*
176      * Scan through the packages that are currently loaded to see if the
177      * package we want is already loaded.  We'll use a loaded package if
178      * it meets any of the following conditions:
179      *  - Its name and file match the once we're looking for.
180      *  - Its file matches, and we weren't given a name.
181      *  - Its name matches, the file name was specified as empty, and there
182      *    is only no statically loaded package with the same name.
183      */
184     Tcl_MutexLock(&packageMutex);
185 
186     defaultPtr = NULL;
187     for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
188   if (packageName == NULL) {
189       namesMatch = 0;
190   } else {
191       Tcl_DStringSetLength(&pkgName, 0);
192       Tcl_DStringAppend(&pkgName, packageName, -1);
193       Tcl_DStringSetLength(&tmp, 0);
194       Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
195       Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
196       Tcl_UtfToLower(Tcl_DStringValue(&tmp));
197       if (strcmp(Tcl_DStringValue(&tmp),
198         Tcl_DStringValue(&pkgName)) == 0) {
199     namesMatch = 1;
200       } else {
201     namesMatch = 0;
202       }
203   }
204   Tcl_DStringSetLength(&pkgName, 0);
205 
206   filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
207   if (filesMatch && (namesMatch || (packageName == NULL))) {
208       break;
209   }
210   if (namesMatch && (fullFileName[0] == 0)) {
211       defaultPtr = pkgPtr;
212   }
213   if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
214       /*
215        * Can't have two different packages loaded from the same
216        * file.
217        */
218 
219       Tcl_AppendResult(interp, "file \"", fullFileName,
220         "\" is already loaded for package \"",
221         pkgPtr->packageName, "\"", (char *) NULL);
222       code = TCL_ERROR;
223       Tcl_MutexUnlock(&packageMutex);
224       goto done;
225   }
226     }
227     Tcl_MutexUnlock(&packageMutex);
228     if (pkgPtr == NULL) {
229   pkgPtr = defaultPtr;
230     }
231 
232     /*
233      * Scan through the list of packages already loaded in the target
234      * interpreter.  If the package we want is already loaded there,
235      * then there's nothing for us to to.
236      */
237 
238     if (pkgPtr != NULL) {
239   ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
240     (Tcl_InterpDeleteProc **) NULL);
241   for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
242       if (ipPtr->pkgPtr == pkgPtr) {
243     code = TCL_OK;
244     goto done;
245       }
246   }
247     }
248 
249     if (pkgPtr == NULL) {
250   /*
251    * The desired file isn't currently loaded, so load it.  It's an
252    * error if the desired package is a static one.
253    */
254 
255   if (fullFileName[0] == 0) {
256       Tcl_AppendResult(interp, "package \"", packageName,
257         "\" isn't loaded statically", (char *) NULL);
258       code = TCL_ERROR;
259       goto done;
260   }
261 
262   /*
263    * Figure out the module name if it wasn't provided explicitly.
264    */
265 
266   if (packageName != NULL) {
267       Tcl_DStringAppend(&pkgName, packageName, -1);
268   } else {
269       int retc;
270       /*
271        * Threading note - this call used to be protected by a mutex.
272        */
273       retc = TclGuessPackageName(fullFileName, &pkgName);
274       if (!retc) {
275     Tcl_Obj *splitPtr;
276     Tcl_Obj *pkgGuessPtr;
277     int pElements;
278     char *pkgGuess;
279 
280     /*
281      * The platform-specific code couldn't figure out the
282      * module name.  Make a guess by taking the last element
283      * of the file name, stripping off any leading "lib",
284      * and then using all of the alphabetic and underline
285      * characters that follow that.
286      */
287 
288     splitPtr = Tcl_FSSplitPath(objv[1], &pElements);
289     Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr);
290     pkgGuess = Tcl_GetString(pkgGuessPtr);
291     if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i')
292       && (pkgGuess[2] == 'b')) {
293         pkgGuess += 3;
294     }
295     for (p = pkgGuess; *p != 0; p += offset) {
296         offset = Tcl_UtfToUniChar(p, &ch);
297         if ((ch > 0x100)
298           || !(isalpha(UCHAR(ch)) /* INTL: ISO only */
299             || (UCHAR(ch) == '_'))) {
300       break;
301         }
302     }
303     if (p == pkgGuess) {
304         Tcl_DecrRefCount(splitPtr);
305         Tcl_AppendResult(interp,
306           "couldn't figure out package name for ",
307           fullFileName, (char *) NULL);
308         code = TCL_ERROR;
309         goto done;
310     }
311     Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess));
312     Tcl_DecrRefCount(splitPtr);
313       }
314   }
315 
316   /*
317    * Fix the capitalization in the package name so that the first
318    * character is in caps (or title case) but the others are all
319    * lower-case.
320    */
321     
322   Tcl_DStringSetLength(&pkgName,
323     Tcl_UtfToTitle(Tcl_DStringValue(&pkgName)));
324 
325   /*
326    * Compute the names of the two initialization procedures,
327    * based on the package name.
328    */
329     
330   Tcl_DStringAppend(&initName, Tcl_DStringValue(&pkgName), -1);
331   Tcl_DStringAppend(&initName, "_Init", 5);
332   Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1);
333   Tcl_DStringAppend(&safeInitName, "_SafeInit", 9);
334 
335   /*
336    * Call platform-specific code to load the package and find the
337    * two initialization procedures.
338    */
339 
340   Tcl_MutexLock(&packageMutex);
341   code = Tcl_FSLoadFile(interp, objv[1], Tcl_DStringValue(&initName),
342     Tcl_DStringValue(&safeInitName), &initProc, &safeInitProc,
343     &loadHandle,&unLoadProcPtr);
344   Tcl_MutexUnlock(&packageMutex);
345   if (code != TCL_OK) {
346       goto done;
347   }
348   if (initProc == NULL) {
349       Tcl_AppendResult(interp, "couldn't find procedure ",
350         Tcl_DStringValue(&initName), (char *) NULL);
351       if (unLoadProcPtr != NULL) {
352     (*unLoadProcPtr)(loadHandle);
353       }
354       code = TCL_ERROR;
355       goto done;
356   }
357 
358   /*
359    * Create a new record to describe this package.
360    */
361 
362   pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
363   pkgPtr->fileName  = (char *) ckalloc((unsigned)
364     (strlen(fullFileName) + 1));
365   strcpy(pkgPtr->fileName, fullFileName);
366   pkgPtr->packageName = (char *) ckalloc((unsigned)
367     (Tcl_DStringLength(&pkgName) + 1));
368   strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName));
369   pkgPtr->loadHandle  = loadHandle;
370   pkgPtr->unLoadProcPtr = unLoadProcPtr;
371   pkgPtr->initProc  = initProc;
372   pkgPtr->safeInitProc  = safeInitProc;
373   Tcl_MutexLock(&packageMutex);
374   pkgPtr->nextPtr   = firstPackagePtr;
375   firstPackagePtr   = pkgPtr;
376   Tcl_MutexUnlock(&packageMutex);
377     }
378 
379     /*
380      * Invoke the package's initialization procedure (either the
381      * normal one or the safe one, depending on whether or not the
382      * interpreter is safe).
383      */
384 
385     if (Tcl_IsSafe(target)) {
386   if (pkgPtr->safeInitProc != NULL) {
387       code = (*pkgPtr->safeInitProc)(target);
388   } else {
389       Tcl_AppendResult(interp,
390         "can't use package in a safe interpreter: ",
391         "no ", pkgPtr->packageName, "_SafeInit procedure",
392         (char *) NULL);
393       code = TCL_ERROR;
394       goto done;
395   }
396     } else {
397   code = (*pkgPtr->initProc)(target);
398     }
399 
400     /*
401      * Record the fact that the package has been loaded in the
402      * target interpreter.
403      */
404 
405     if (code == TCL_OK) {
406   /*
407    * Refetch ipFirstPtr: loading the package may have introduced
408    * additional static packages at the head of the linked list!
409    */
410 
411   ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
412     (Tcl_InterpDeleteProc **) NULL);
413   ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
414   ipPtr->pkgPtr = pkgPtr;
415   ipPtr->nextPtr = ipFirstPtr;
416   Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
417     (ClientData) ipPtr);
418     } else {
419   TclTransferResult(target, code, interp);
420     }
421 
422     done:
423     Tcl_DStringFree(&pkgName);
424     Tcl_DStringFree(&initName);
425     Tcl_DStringFree(&safeInitName);
426     Tcl_DStringFree(&tmp);
427     return code;
428 }
void Tcl_StaticPackage (Tcl_Interp * interp, CONST char * pkgName, Tcl_PackageInitProc * initProc, Tcl_PackageInitProc * safeInitProc)

Definition at line 449 of file tclLoad.c.
References firstPackagePtr, LoadedPackage::initProc, InterpPackage, LoadedPackage::nextPtr, LoadedPackage::packageName, LoadedPackage::safeInitProc, and Tcl_MutexLock.
Referenced by Tcl_AppInit(), and TeststaticpkgCmd().455                         : first letter upper
456            * case, others lower case). */
457     Tcl_PackageInitProc *initProc;  /* Procedure to call to incorporate
458            * this package into a trusted
459            * interpreter. */
460     Tcl_PackageInitProc *safeInitProc;  /* Procedure to call to incorporate
461            * this package into a safe interpreter
462            * (one that will execute untrusted
463            * scripts).   NULL means the package
464            * can't be used in safe
465            * interpreters. */
466 {
467     LoadedPackage *pkgPtr;
468     InterpPackage *ipPtr, *ipFirstPtr;
469 
470     /*
471      * Check to see if someone else has already reported this package as
472      * statically loaded in the process.
473      */
474 
475     Tcl_MutexLock(&packageMutex);
476     for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
477   if ((pkgPtr->initProc == initProc)
478     && (pkgPtr->safeInitProc == safeInitProc)
479     && (strcmp(pkgPtr->packageName, pkgName) == 0)) {
480       break;
481   }
482     }
483     Tcl_MutexUnlock(&packageMutex);
484 
485     /*
486      * If the package is not yet recorded as being loaded statically,
487      * add it to the list now.
488      */
489 
490     if ( pkgPtr == NULL ) {
491   pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
492   pkgPtr->fileName  = (char *) ckalloc((unsigned) 1);
493   pkgPtr->fileName[0] = 0;
494   pkgPtr->packageName = (char *) ckalloc((unsigned)
495                (strlen(pkgName) + 1));
496   strcpy(pkgPtr->packageName, pkgName);
497   pkgPtr->loadHandle  = NULL;
498   pkgPtr->initProc  = initProc;
499   pkgPtr->safeInitProc  = safeInitProc;
500   Tcl_MutexLock(&packageMutex);
501   pkgPtr->nextPtr   = firstPackagePtr;
502   firstPackagePtr   = pkgPtr;
503   Tcl_MutexUnlock(&packageMutex);
504     }
505 
506     if (interp != NULL) {
507 
508   /*
509    * If we're loading the package into an interpreter,
510    * determine whether it's already loaded. 
511    */
512 
513   ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(interp, "tclLoad",
514     (Tcl_InterpDeleteProc **) NULL);
515   for ( ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr ) {
516       if ( ipPtr->pkgPtr == pkgPtr ) {
517     return;
518       }
519   }
520 
521   /*
522    * Package isn't loade in the current interp yet. Mark it as
523    * now being loaded.
524    */
525 
526   ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
527   ipPtr->pkgPtr = pkgPtr;
528   ipPtr->nextPtr = ipFirstPtr;
529   Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc,
530     (ClientData) ipPtr);
531     }
532 }
void TclFinalizeLoad ()

Definition at line 666 of file tclLoad.c.
References ckfree, LoadedPackage::fileName, firstPackagePtr, LoadedPackage::loadHandle, LoadedPackage::nextPtr, LoadedPackage::packageName, and LoadedPackage::unLoadProcPtr.
Referenced by Tcl_Finalize().667 {
668     LoadedPackage *pkgPtr;
669 
670     /*
671      * No synchronization here because there should just be
672      * one thread alive at this point.  Logically, 
673      * packageMutex should be grabbed at this point, but
674      * the Mutexes get finalized before the call to this routine.
675      * The only subsystem left alive at this point is the
676      * memory allocator.
677      */
678 
679     while (firstPackagePtr != NULL) {
680   pkgPtr = firstPackagePtr;
681   firstPackagePtr = pkgPtr->nextPtr;
682 #if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
683   /*
684    * Some Unix dlls are poorly behaved - registering things like
685    * atexit calls that can't be unregistered.  If you unload
686    * such dlls, you get a core on exit because it wants to
687    * call a function in the dll after it's been unloaded.
688    */
689   if (pkgPtr->fileName[0] != '\0') {
690       Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr;
691       if (unLoadProcPtr != NULL) {
692           (*unLoadProcPtr)(pkgPtr->loadHandle);
693       }
694   }
695 #endif
696   ckfree(pkgPtr->fileName);
697   ckfree(pkgPtr->packageName);
698   ckfree((char *) pkgPtr);
699     }
700 }
int TclGetLoadedPackages (Tcl_Interp * interp, char * targetName)

Definition at line 558 of file tclLoad.c.
References LoadedPackage::fileName, firstPackagePtr, InterpPackage, LoadedPackage::nextPtr, LoadedPackage::packageName, Tcl_AppendElement(), TCL_ERROR, Tcl_GetAssocData(), Tcl_GetSlave(), Tcl_MutexLock, Tcl_MutexUnlock, and TCL_OK.
Referenced by InfoLoadedCmd().565 {
566     Tcl_Interp *target;
567     LoadedPackage *pkgPtr;
568     InterpPackage *ipPtr;
569     char *prefix;
570 
571     if (targetName == NULL) {
572   /* 
573    * Return information about all of the available packages.
574    */
575 
576   prefix = "{";
577   Tcl_MutexLock(&packageMutex);
578   for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
579     pkgPtr = pkgPtr->nextPtr) {
580       Tcl_AppendResult(interp, prefix, (char *) NULL);
581       Tcl_AppendElement(interp, pkgPtr->fileName);
582       Tcl_AppendElement(interp, pkgPtr->packageName);
583       Tcl_AppendResult(interp, "}", (char *) NULL);
584       prefix = " {";
585   }
586   Tcl_MutexUnlock(&packageMutex);
587   return TCL_OK;
588     }
589 
590     /*
591      * Return information about only the packages that are loaded in
592      * a given interpreter.
593      */
594 
595     target = Tcl_GetSlave(interp, targetName);
596     if (target == NULL) {
597   return TCL_ERROR;
598     }
599     ipPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
600       (Tcl_InterpDeleteProc **) NULL);
601     prefix = "{";
602     for ( ; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
603   pkgPtr = ipPtr->pkgPtr;
604   Tcl_AppendResult(interp, prefix, (char *) NULL);
605   Tcl_AppendElement(interp, pkgPtr->fileName);
606   Tcl_AppendElement(interp, pkgPtr->packageName);
607   Tcl_AppendResult(interp, "}", (char *) NULL);
608   prefix = " {";
609     }
610     return TCL_OK;
611 }

Variable Documentation
LoadedPackage* firstPackagePtr = NULL [static]

Definition at line 67 of file tclLoad.c.
Referenced by Tcl_LoadObjCmd(), Tcl_StaticPackage(), TclFinalizeLoad(), and TclGetLoadedPackages().InterpPackage

Definition at line 87 of file tclLoad.c.
Referenced by LoadCleanupProc(), Tcl_LoadObjCmd(), Tcl_StaticPackage(), and TclGetLoadedPackages().

generic/tclLoadNone.c File Reference
#include "tclInt.h"
Functions
int TclpDlopen (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr)
Tcl_PackageInitProc * TclpFindSymbol (Tcl_Interp *interp, Tcl_LoadHandle loadHandle, CONST char *symbol)
int TclGuessPackageName (CONST char *fileName, Tcl_DString *bufPtr)
void TclpUnloadFile (Tcl_LoadHandle loadHandle)

Function Documentation
int TclGuessPackageName (CONST char * fileName, Tcl_DString * bufPtr)

Definition at line 101 of file tclLoadNone.c.
Referenced by TclpDlopen().106 {
107     return 0;
108 }
int TclpDlopen (Tcl_Interp * interp, Tcl_Obj * pathPtr, Tcl_LoadHandle * loadHandle, Tcl_FSUnloadFileProc ** unloadProcPtr)

Definition at line 38 of file tclLoadNone.c.
References TCL_ERROR, Tcl_SetResult(), and TCL_STATIC.
Referenced by TCL_DECLARE_MUTEX(), and TclpLoadFile().49 {
50     Tcl_SetResult(interp,
51       "dynamic loading is not currently available on this system",
52       TCL_STATIC);
53     return TCL_ERROR;
54 }
Tcl_PackageInitProc* TclpFindSymbol (Tcl_Interp * interp, Tcl_LoadHandle loadHandle, CONST char * symbol)

Definition at line 72 of file tclLoadNone.c.
References NULL.
Referenced by Tcl_FSLoadFile(), and TclpLoadFile().76 {
77     return NULL;
78 }
void TclpUnloadFile (Tcl_LoadHandle loadHandle)

Definition at line 129 of file tclLoadNone.c.
Referenced by TclpDlopen().134 {
135 }

generic/tclMain.c File Reference
#include "tcl.h"
#include "tclInt.h"
Classes
struct InteractiveState
Defines
#define TCL_STORAGE_CLASS  DLLEXPORT
Enumerations
enum PromptType { PROMPT_NONE, PROMPT_START, PROMPT_CONTINUE }
Functions
int isatty _ANSI_ARGS_ ((int fd))
static void Prompt _ANSI_ARGS_ ((Tcl_Interp *interp, PromptType *promptPtr))
static void StdinProc _ANSI_ARGS_ ((ClientData clientData, int mask))
void TclSetStartupScriptPath (Tcl_Obj *pathPtr)
Tcl_Obj * TclGetStartupScriptPath ()
void TclSetStartupScriptFileName (CONST char *fileName)
CONST char * TclGetStartupScriptFileName ()
void Tcl_Main (int argc, char **argv, Tcl_AppInitProc *appInitProc)
void Tcl_SetMainLoop (Tcl_MainLoopProc *proc)
static void StdinProc (ClientData clientData, int mask)
static void Prompt (Tcl_Interp *interp, PromptType *promptPtr)
Variables
static Tcl_Obj * tclStartupScriptPath = NULL
static Tcl_MainLoopProc * mainLoopProc = NULL

Define Documentation
#define TCL_STORAGE_CLASS  DLLEXPORT

Definition at line 20 of file tclMain.c.
Enumeration Type Documentation
enum PromptType

Enumerator: 
PROMPT_NONE  
PROMPT_START  
PROMPT_CONTINUE  

Definition at line 44 of file tclMain.c.44              {
45     PROMPT_NONE,  /* Print no prompt */
46     PROMPT_START, /* Print prompt for command start */
47     PROMPT_CONTINUE /* Print prompt for command continuation */
48 } PromptType;

Function Documentation
static void StdinProc _ANSI_ARGS_ ((ClientData clientData, int mask)) [static]
static void Prompt _ANSI_ARGS_ ((Tcl_Interp *interp, PromptType *promptPtr)) [static]
int isatty _ANSI_ARGS_ ((int fd))
static void Prompt (Tcl_Interp * interp, PromptType * promptPtr) [static]

Definition at line 683 of file tclMain.c.
References NULL, PROMPT_CONTINUE, PROMPT_NONE, PROMPT_START, Tcl_AddErrorInfo(), TCL_EVAL_GLOBAL, Tcl_EvalObjEx(), Tcl_Flush(), Tcl_GetObjResult(), Tcl_GetStdChannel(), Tcl_GetVar2Ex(), TCL_GLOBAL_ONLY, Tcl_InterpDeleted(), TCL_OK, TCL_STDERR, TCL_STDOUT, Tcl_WriteChars(), and Tcl_WriteObj().
Referenced by StdinProc(), and Tcl_Main().688 {
689     Tcl_Obj *promptCmdPtr;
690     int code;
691     Tcl_Channel outChannel, errChannel;
692 
693     if (*promptPtr == PROMPT_NONE) {
694   return;
695     }
696 
697     promptCmdPtr = Tcl_GetVar2Ex(interp,
698       ((*promptPtr == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"),
699       NULL, TCL_GLOBAL_ONLY);
700     if (Tcl_InterpDeleted(interp)) {
701   return;
702     }
703     if (promptCmdPtr == NULL) {
704   defaultPrompt:
705   outChannel = Tcl_GetStdChannel(TCL_STDOUT);
706   if ((*promptPtr == PROMPT_START)
707     && (outChannel != (Tcl_Channel) NULL)) {
708       Tcl_WriteChars(outChannel, "% ", 2);
709   }
710     } else {
711   code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL);
712   if (code != TCL_OK) {
713       Tcl_AddErrorInfo(interp,
714         "\n    (script that generates prompt)");
715       errChannel = Tcl_GetStdChannel(TCL_STDERR);
716             if (errChannel != (Tcl_Channel) NULL) {
717                 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
718                 Tcl_WriteChars(errChannel, "\n", 1);
719             }
720       goto defaultPrompt;
721   }
722     }
723     outChannel = Tcl_GetStdChannel(TCL_STDOUT);
724     if (outChannel != (Tcl_Channel) NULL) {
725   Tcl_Flush(outChannel);
726     }
727     *promptPtr = PROMPT_NONE;
728 }
static void StdinProc (ClientData clientData, int mask) [static]

Definition at line 573 of file tclMain.c.
References InteractiveState::commandPtr, InteractiveState::input, InteractiveState::interp, NULL, Prompt(), InteractiveState::prompt, PROMPT_CONTINUE, PROMPT_START, Tcl_AppendToObj(), Tcl_CreateChannelHandler(), Tcl_DecrRefCount, Tcl_DeleteChannelHandler(), Tcl_DuplicateObj(), TCL_EVAL_GLOBAL, Tcl_Exit(), Tcl_GetObjResult(), Tcl_GetsObj(), Tcl_GetStdChannel(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_InputBlocked(), Tcl_IsShared, Tcl_NewObj(), TCL_OK, TCL_READABLE, Tcl_RecordAndEvalObj(), TCL_STDERR, TCL_STDIN, TCL_STDOUT, Tcl_WriteChars(), Tcl_WriteObj(), TclObjCommandComplete(), and InteractiveState::tty.
Referenced by Tcl_Main().576 {
577     InteractiveState *isPtr = (InteractiveState *) clientData;
578     Tcl_Channel chan = isPtr->input;
579     Tcl_Obj *commandPtr = isPtr->commandPtr;
580     Tcl_Interp *interp = isPtr->interp;
581     int code, length;
582 
583     if (Tcl_IsShared(commandPtr)) {
584   Tcl_DecrRefCount(commandPtr);
585   commandPtr = Tcl_DuplicateObj(commandPtr);
586   Tcl_IncrRefCount(commandPtr);
587     }
588     length = Tcl_GetsObj(chan, commandPtr);
589     if (length < 0) {
590   if (Tcl_InputBlocked(chan)) {
591       return;
592   }
593   if (isPtr->tty) {
594       /*
595        * Would be better to find a way to exit the mainLoop?
596        * Or perhaps evaluate [exit]?  Leaving as is for now due
597        * to compatibility concerns.
598        */
599       Tcl_Exit(0);
600   }
601   Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) isPtr);
602   return;
603     }
604 
605     if (Tcl_IsShared(commandPtr)) {
606   Tcl_DecrRefCount(commandPtr);
607   commandPtr = Tcl_DuplicateObj(commandPtr);
608   Tcl_IncrRefCount(commandPtr);
609     }
610     Tcl_AppendToObj(commandPtr, "\n", 1);
611     if (!TclObjCommandComplete(commandPtr)) {
612         isPtr->prompt = PROMPT_CONTINUE;
613         goto prompt;
614     }
615     isPtr->prompt = PROMPT_START;
616 
617     /*
618      * Disable the stdin channel handler while evaluating the command;
619      * otherwise if the command re-enters the event loop we might
620      * process commands from stdin before the current command is
621      * finished.  Among other things, this will trash the text of the
622      * command being evaluated.
623      */
624 
625     Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) isPtr);
626     code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
627     isPtr->input = chan = Tcl_GetStdChannel(TCL_STDIN);
628     Tcl_DecrRefCount(commandPtr);
629     isPtr->commandPtr = commandPtr = Tcl_NewObj();
630     Tcl_IncrRefCount(commandPtr);
631     if (chan != (Tcl_Channel) NULL) {
632   Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
633     (ClientData) isPtr);
634     }
635     if (code != TCL_OK) {
636   Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
637   if (errChannel != (Tcl_Channel) NULL) {
638       Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
639       Tcl_WriteChars(errChannel, "\n", 1);
640   }
641     } else if (isPtr->tty) {
642   Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
643   Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT);
644   Tcl_IncrRefCount(resultPtr);
645   Tcl_GetStringFromObj(resultPtr, &length);
646   if ((length >0) && (outChannel != (Tcl_Channel) NULL)) {
647       Tcl_WriteObj(outChannel, resultPtr);
648       Tcl_WriteChars(outChannel, "\n", 1);
649   }
650   Tcl_DecrRefCount(resultPtr);
651     }
652 
653     /*
654      * If a tty stdin is still around, output a prompt.
655      */
656 
657     prompt:
658     if (isPtr->tty && (isPtr->input != (Tcl_Channel) NULL)) {
659   Prompt(interp, &(isPtr->prompt));
660   isPtr->input = Tcl_GetStdChannel(TCL_STDIN);
661     }
662 }
void Tcl_Main (int argc, char ** argv, Tcl_AppInitProc * appInitProc)

Definition at line 198 of file tclMain.c.
References ckalloc, ckfree, InteractiveState::commandPtr, InteractiveState::input, InteractiveState::interp, NULL, InteractiveState::prompt, Prompt(), PROMPT_CONTINUE, PROMPT_START, StdinProc(), Tcl_AddErrorInfo(), Tcl_AppendToObj(), Tcl_CreateChannelHandler(), Tcl_CreateInterp(), Tcl_DecrRefCount, Tcl_DeleteChannelHandler(), Tcl_DeleteInterp(), Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, Tcl_DuplicateObj(), Tcl_Eval(), TCL_EVAL_GLOBAL, Tcl_Exit(), Tcl_ExternalToUtfDString(), Tcl_FindExecutable(), Tcl_FSEvalFile(), Tcl_GetObjResult(), Tcl_GetsObj(), Tcl_GetStdChannel(), Tcl_GetStringFromObj(), Tcl_GetVar2Ex(), TCL_GLOBAL_ONLY, Tcl_IncrRefCount, Tcl_InitMemory, Tcl_InputBlocked(), TCL_INTEGER_SPACE, Tcl_InterpDeleted(), Tcl_IsShared, TCL_LINK_BOOLEAN, Tcl_LinkVar(), Tcl_ListObjAppendElement(), Tcl_NewIntObj(), Tcl_NewListObj(), Tcl_NewObj(), Tcl_NewStringObj(), TCL_OK, Tcl_Preserve(), TCL_READABLE, Tcl_RecordAndEvalObj(), Tcl_Release(), Tcl_SetVar(), Tcl_SetVar2Ex(), Tcl_SourceRCFile(), TCL_STDERR, TCL_STDIN, TCL_STDOUT, Tcl_UnlinkVar(), Tcl_WriteChars(), Tcl_WriteObj(), TclGetStartupScriptFileName(), TclGetStartupScriptPath(), tclMemDumpFileName, TclObjCommandComplete(), TclSetStartupScriptFileName(), TclSetStartupScriptPath(), and InteractiveState::tty.
Referenced by main().206 {
207     Tcl_Obj *resultPtr, *argvPtr, *commandPtr = NULL;
208     PromptType prompt = PROMPT_START;
209     int code, length, tty, exitCode = 0;
210     Tcl_Channel inChannel, outChannel, errChannel;
211     Tcl_Interp *interp;
212     Tcl_DString appName;
213     Tcl_Obj *objPtr;
214 
215     Tcl_FindExecutable(argv[0]);
216 
217     interp = Tcl_CreateInterp();
218     Tcl_InitMemory(interp);
219 
220     /*
221      * Make command-line arguments available in the Tcl variables "argc"
222      * and "argv".  If the first argument doesn't start with a "-" then
223      * strip it off and use it as the name of a script file to process.
224      */
225 
226     if (TclGetStartupScriptPath() == NULL) {
227   if ((argc > 1) && (argv[1][0] != '-')) {
228       TclSetStartupScriptFileName(argv[1]);
229       argc--;
230       argv++;
231   }
232     }
233 
234     if (TclGetStartupScriptPath() == NULL) {
235   Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName);
236     } else {
237   TclSetStartupScriptFileName(Tcl_ExternalToUtfDString(NULL,
238     TclGetStartupScriptFileName(), -1, &appName));
239     }
240     Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY);
241     Tcl_DStringFree(&appName);
242     argc--;
243     argv++;
244 
245     objPtr = Tcl_NewIntObj(argc);
246     Tcl_IncrRefCount(objPtr);
247     Tcl_SetVar2Ex(interp, "argc", NULL, objPtr, TCL_GLOBAL_ONLY);
248     Tcl_DecrRefCount(objPtr);
249     
250     argvPtr = Tcl_NewListObj(0, NULL);
251     while (argc--) {
252   Tcl_DString ds;
253   Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds);
254   Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj(
255     Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
256   Tcl_DStringFree(&ds);
257     }
258     Tcl_IncrRefCount(argvPtr);
259     Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
260     Tcl_DecrRefCount(argvPtr);
261 
262     /*
263      * Set the "tcl_interactive" variable.
264      */
265 
266     tty = isatty(0);
267     Tcl_SetVar(interp, "tcl_interactive",
268       ((TclGetStartupScriptPath() == NULL) && tty) ? "1" : "0",
269       TCL_GLOBAL_ONLY);
270     
271     /*
272      * Invoke application-specific initialization.
273      */
274 
275     Tcl_Preserve((ClientData) interp);
276     if ((*appInitProc)(interp) != TCL_OK) {
277   errChannel = Tcl_GetStdChannel(TCL_STDERR);
278   if (errChannel) {
279       Tcl_WriteChars(errChannel,
280         "application-specific initialization failed: ", -1);
281       Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
282       Tcl_WriteChars(errChannel, "\n", 1);
283   }
284     }
285     if (Tcl_InterpDeleted(interp)) {
286   goto done;
287     }
288 
289     /*
290      * If a script file was specified then just source that file
291      * and quit.
292      */
293 
294     if (TclGetStartupScriptPath() != NULL) {
295   code = Tcl_FSEvalFile(interp, TclGetStartupScriptPath());
296   if (code != TCL_OK) {
297       errChannel = Tcl_GetStdChannel(TCL_STDERR);
298       if (errChannel) {
299 
300     /*
301      * The following statement guarantees that the errorInfo
302      * variable is set properly.
303      */
304 
305     Tcl_AddErrorInfo(interp, "");
306     Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp, "errorInfo",
307       NULL, TCL_GLOBAL_ONLY));
308     Tcl_WriteChars(errChannel, "\n", 1);
309       }
310       exitCode = 1;
311   }
312   goto done;
313     }
314 
315     /*
316      * We're running interactively.  Source a user-specific startup
317      * file if the application specified one and if the file exists.
318      */
319 
320     Tcl_SourceRCFile(interp);
321 
322     /*
323      * Process commands from stdin until there's an end-of-file.  Note
324      * that we need to fetch the standard channels again after every
325      * eval, since they may have been changed.
326      */
327 
328     commandPtr = Tcl_NewObj();
329     Tcl_IncrRefCount(commandPtr);
330 
331     /*
332      * Get a new value for tty if anyone writes to ::tcl_interactive
333      */
334     Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN);
335     inChannel = Tcl_GetStdChannel(TCL_STDIN);
336     outChannel = Tcl_GetStdChannel(TCL_STDOUT);
337     while ((inChannel != (Tcl_Channel) NULL) && !Tcl_InterpDeleted(interp)) {
338   if (mainLoopProc == NULL) {
339       if (tty) {
340     Prompt(interp, &prompt);
341     if (Tcl_InterpDeleted(interp)) {
342         break;
343     }
344     inChannel = Tcl_GetStdChannel(TCL_STDIN);
345     if (inChannel == (Tcl_Channel) NULL) {
346               break;
347     }
348       }
349       if (Tcl_IsShared(commandPtr)) {
350     Tcl_DecrRefCount(commandPtr);
351     commandPtr = Tcl_DuplicateObj(commandPtr);
352     Tcl_IncrRefCount(commandPtr);
353       }
354             length = Tcl_GetsObj(inChannel, commandPtr);
355       if (length < 0) {
356     if (Tcl_InputBlocked(inChannel)) {
357 
358         /*
359          * This can only happen if stdin has been set to
360          * non-blocking.  In that case cycle back and try
361          * again.  This sets up a tight polling loop (since
362          * we have no event loop running).  If this causes
363          * bad CPU hogging, we might try toggling the blocking
364          * on stdin instead.
365          */
366 
367         continue;
368     }
369 
370     /* 
371      * Either EOF, or an error on stdin; we're done
372      */
373 
374     break;
375       }
376 
377             /*
378              * Add the newline removed by Tcl_GetsObj back to the string.
379              */
380 
381       if (Tcl_IsShared(commandPtr)) {
382     Tcl_DecrRefCount(commandPtr);
383     commandPtr = Tcl_DuplicateObj(commandPtr);
384     Tcl_IncrRefCount(commandPtr);
385       }
386       Tcl_AppendToObj(commandPtr, "\n", 1);
387       if (!TclObjCommandComplete(commandPtr)) {
388     prompt = PROMPT_CONTINUE;
389     continue;
390       }
391 
392       prompt = PROMPT_START;
393       code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
394       inChannel = Tcl_GetStdChannel(TCL_STDIN);
395       outChannel = Tcl_GetStdChannel(TCL_STDOUT);
396       errChannel = Tcl_GetStdChannel(TCL_STDERR);
397       Tcl_DecrRefCount(commandPtr);
398       commandPtr = Tcl_NewObj();
399       Tcl_IncrRefCount(commandPtr);
400       if (code != TCL_OK) {
401     if (errChannel) {
402         Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
403         Tcl_WriteChars(errChannel, "\n", 1);
404     }
405       } else if (tty) {
406     resultPtr = Tcl_GetObjResult(interp);
407     Tcl_IncrRefCount(resultPtr);
408     Tcl_GetStringFromObj(resultPtr, &length);
409     if ((length > 0) && outChannel) {
410         Tcl_WriteObj(outChannel, resultPtr);
411         Tcl_WriteChars(outChannel, "\n", 1);
412     }
413     Tcl_DecrRefCount(resultPtr);
414       }
415   } else {  /* (mainLoopProc != NULL) */
416       /*
417        * If a main loop has been defined while running interactively,
418        * we want to start a fileevent based prompt by establishing a
419        * channel handler for stdin.
420        */
421 
422       InteractiveState *isPtr = NULL;
423 
424       if (inChannel) {
425           if (tty) {
426         Prompt(interp, &prompt);
427           }
428     isPtr = (InteractiveState *) 
429       ckalloc((int) sizeof(InteractiveState));
430     isPtr->input = inChannel;
431     isPtr->tty = tty;
432     isPtr->commandPtr = commandPtr;
433     isPtr->prompt = prompt;
434     isPtr->interp = interp;
435 
436     Tcl_UnlinkVar(interp, "tcl_interactive");
437     Tcl_LinkVar(interp, "tcl_interactive", (char *) &(isPtr->tty),
438       TCL_LINK_BOOLEAN);
439 
440     Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
441       (ClientData) isPtr);
442       }
443 
444       (*mainLoopProc)();
445       mainLoopProc = NULL;
446 
447       if (inChannel) {
448     tty = isPtr->tty;
449     Tcl_UnlinkVar(interp, "tcl_interactive");
450     Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty,
451       TCL_LINK_BOOLEAN);
452     prompt = isPtr->prompt;
453     commandPtr = isPtr->commandPtr;
454     if (isPtr->input != (Tcl_Channel) NULL) {
455         Tcl_DeleteChannelHandler(isPtr->input, StdinProc,
456           (ClientData) isPtr);
457     }
458     ckfree((char *)isPtr);
459       }
460       inChannel = Tcl_GetStdChannel(TCL_STDIN);
461       outChannel = Tcl_GetStdChannel(TCL_STDOUT);
462       errChannel = Tcl_GetStdChannel(TCL_STDERR);
463   }
464 #ifdef TCL_MEM_DEBUG
465 
466   /*
467    * This code here only for the (unsupported and deprecated)
468    * [checkmem] command.
469    */
470 
471   if (tclMemDumpFileName != NULL) {
472       mainLoopProc = NULL;
473       Tcl_DeleteInterp(interp);
474   }
475 #endif
476     }
477 
478     done:
479     if ((exitCode == 0) && (mainLoopProc != NULL)) {
480 
481   /*
482    * If everything has gone OK so far, call the main loop proc,
483    * if it exists.  Packages (like Tk) can set it to start processing
484    * events at this point.
485    */
486 
487   (*mainLoopProc)();
488   mainLoopProc = NULL;
489     }
490     if (commandPtr != NULL) {
491   Tcl_DecrRefCount(commandPtr);
492     }
493 
494     /*
495      * Rather than calling exit, invoke the "exit" command so that
496      * users can replace "exit" with some other command to do additional
497      * cleanup on exit.  The Tcl_Eval call should never return.
498      */
499 
500     if (!Tcl_InterpDeleted(interp)) {
501   char buffer[TCL_INTEGER_SPACE + 5];
502         sprintf(buffer, "exit %d", exitCode);
503         Tcl_Eval(interp, buffer);
504 
505         /*
506          * If Tcl_Eval returns, trying to eval [exit], something
507          * unusual is happening.  Maybe interp has been deleted;
508          * maybe [exit] was redefined.  We still want to cleanup
509          * and exit.
510          */
511 
512         if (!Tcl_InterpDeleted(interp)) {
513             Tcl_DeleteInterp(interp);
514         }
515     }
516     TclSetStartupScriptPath(NULL);
517 
518     /*
519      * If we get here, the master interp has been deleted.  Allow
520      * its destruction with the last matching Tcl_Release.
521      */
522 
523     Tcl_Release((ClientData) interp);
524     Tcl_Exit(exitCode);
525 }
void Tcl_SetMainLoop (Tcl_MainLoopProc * proc)

Definition at line 545 of file tclMain.c.
Referenced by TestsetmainloopCmd().547 {
548     mainLoopProc = proc;
549 }
CONST char* TclGetStartupScriptFileName ()

Definition at line 166 of file tclMain.c.
References NULL, Tcl_GetString(), and TclGetStartupScriptPath().
Referenced by Tcl_Main().167 {
168     Tcl_Obj *pathPtr = TclGetStartupScriptPath();
169 
170     if (pathPtr == NULL) {
171   return NULL;
172     }
173     return Tcl_GetString(pathPtr);
174 }
Tcl_Obj* TclGetStartupScriptPath ()

Definition at line 119 of file tclMain.c.
References tclStartupScriptPath.
Referenced by Tcl_Main(), and TclGetStartupScriptFileName().120 {
121     return tclStartupScriptPath;
122 }
void TclSetStartupScriptFileName (CONST char * fileName)

Definition at line 142 of file tclMain.c.
References Tcl_NewStringObj(), and TclSetStartupScriptPath().
Referenced by Tcl_Main().144 {
145     Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
146     TclSetStartupScriptPath(pathPtr);
147 }
void TclSetStartupScriptPath (Tcl_Obj * pathPtr)

Definition at line 90 of file tclMain.c.
References NULL, Tcl_DecrRefCount, Tcl_IncrRefCount, and tclStartupScriptPath.
Referenced by Tcl_Main(), and TclSetStartupScriptFileName().92 {
93     if (tclStartupScriptPath != NULL) {
94   Tcl_DecrRefCount(tclStartupScriptPath);
95     }
96     tclStartupScriptPath = pathPtr;
97     if (tclStartupScriptPath != NULL) {
98   Tcl_IncrRefCount(tclStartupScriptPath);
99     }
100 }

Variable Documentation
Tcl_MainLoopProc* mainLoopProc = NULL [static]

Definition at line 36 of file tclMain.c.Tcl_Obj* tclStartupScriptPath = NULL [static]

Definition at line 34 of file tclMain.c.
Referenced by TclGetStartupScriptPath(), and TclSetStartupScriptPath().

generic/tclMath.h File Reference
#include <math.h>

generic/tclNamesp.c File Reference
#include "tclInt.h"
Defines
#define FIND_ONLY_NS  0x1000
#define NUM_TRAIL_ELEMS  5
#define INIT_EXPORT_PATTERNS  5
Functions
TCL_DECLARE_MUTEX (nsMutex)
static void DeleteImportedCmd _ANSI_ARGS_ ((ClientData clientData))
static void DupNsNameInternalRep _ANSI_ARGS_ ((Tcl_Obj *objPtr, Tcl_Obj *copyPtr))
static void FreeNsNameInternalRep _ANSI_ARGS_ ((Tcl_Obj *objPtr))
static int GetNamespaceFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr))
static int InvokeImportedCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
static int NamespaceChildrenCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
static void NamespaceFree _ANSI_ARGS_ ((Namespace *nsPtr))
static int SetNsNameFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
void TclInitNamespaceSubsystem ()
Tcl_Namespace * Tcl_GetCurrentNamespace (Tcl_Interp *interp)
Tcl_Namespace * Tcl_GetGlobalNamespace (Tcl_Interp *interp)
int Tcl_PushCallFrame (Tcl_Interp *interp, Tcl_CallFrame *callFramePtr, Tcl_Namespace *namespacePtr, int isProcCallFrame)
void Tcl_PopCallFrame (Tcl_Interp *interp)
Tcl_Namespace * Tcl_CreateNamespace (Tcl_Interp *interp, CONST char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
void Tcl_DeleteNamespace (Tcl_Namespace *namespacePtr)
void TclTeardownNamespace (Namespace *nsPtr)
static void NamespaceFree (Namespace *nsPtr)
int Tcl_Export (Tcl_Interp *interp, Tcl_Namespace *namespacePtr, CONST char *pattern, int resetListFirst)
int Tcl_AppendExportList (Tcl_Interp *interp, Tcl_Namespace *namespacePtr, Tcl_Obj *objPtr)
int Tcl_Import (Tcl_Interp *interp, Tcl_Namespace *namespacePtr, CONST char *pattern, int allowOverwrite)
int Tcl_ForgetImport (Tcl_Interp *interp, Tcl_Namespace *namespacePtr, CONST char *pattern)
Tcl_Command TclGetOriginalCommand (Tcl_Command command)
static int InvokeImportedCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static void DeleteImportedCmd (ClientData clientData)
int TclGetNamespaceForQualName (Tcl_Interp *interp, CONST char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, CONST char **simpleNamePtr)
Tcl_Namespace * Tcl_FindNamespace (Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags)
Tcl_Command Tcl_FindCommand (Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags)
Tcl_Var Tcl_FindNamespaceVar (Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags)
void TclResetShadowedCmdRefs (Tcl_Interp *interp, Command *newCmdPtr)
static int GetNamespaceFromObj (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr)
int Tcl_NamespaceObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static int NamespaceChildrenCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int NamespaceCodeCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int NamespaceCurrentCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int NamespaceDeleteCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int NamespaceEvalCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int NamespaceExistsCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int NamespaceExportCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int NamespaceForgetCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int NamespaceImportCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int NamespaceInscopeCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int NamespaceOriginCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int NamespaceParentCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int NamespaceQualifiersCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int NamespaceTailCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int NamespaceWhichCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static void FreeNsNameInternalRep (Tcl_Obj *objPtr)
static void DupNsNameInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
static int SetNsNameFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr)
static void UpdateStringOfNsName (Tcl_Obj *objPtr)
Variables
static long numNsCreated = 0
ResolvedNsName
Tcl_ObjType tclNsNameType

Define Documentation
#define FIND_ONLY_NS  0x1000

Definition at line 34 of file tclNamesp.c.
Referenced by SetNsNameFromAny(), Tcl_FindNamespace(), and TclGetNamespaceForQualName().#define INIT_EXPORT_PATTERNS  5
#define NUM_TRAIL_ELEMS  5

Definition at line 41 of file tclNamesp.c.
Referenced by TclResetShadowedCmdRefs().
Function Documentation
static int SetNsNameFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr)) [static]
static void NamespaceFree _ANSI_ARGS_ ((Namespace *nsPtr)) [static]
static int NamespaceChildrenCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])) [static]
static int InvokeImportedCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])) [static]
static int GetNamespaceFromObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr)) [static]
static void FreeNsNameInternalRep _ANSI_ARGS_ ((Tcl_Obj *objPtr)) [static]
static void DupNsNameInternalRep _ANSI_ARGS_ ((Tcl_Obj *objPtr, Tcl_Obj *copyPtr)) [static]
static void DeleteImportedCmd _ANSI_ARGS_ ((ClientData clientData)) [static]
static void DeleteImportedCmd (ClientData clientData) [static]

Definition at line 1528 of file tclNamesp.c.
References ckfree, ImportRef::importedCmdPtr, Command::importRefPtr, ImportRef::nextPtr, NULL, panic, ImportedCmdData::realCmdPtr, and ImportedCmdData::selfPtr.
Referenced by Tcl_ForgetImport(), Tcl_Import(), and TclGetOriginalCommand().1531 {
1532     ImportedCmdData *dataPtr = (ImportedCmdData *) clientData;
1533     Command *realCmdPtr = dataPtr->realCmdPtr;
1534     Command *selfPtr = dataPtr->selfPtr;
1535     register ImportRef *refPtr, *prevPtr;
1536 
1537     prevPtr = NULL;
1538     for (refPtr = realCmdPtr->importRefPtr;  refPtr != NULL;
1539             refPtr = refPtr->nextPtr) {
1540   if (refPtr->importedCmdPtr == selfPtr) {
1541       /*
1542        * Remove *refPtr from real command's list of imported commands
1543        * that refer to it.
1544        */
1545       
1546       if (prevPtr == NULL) { /* refPtr is first in list */
1547     realCmdPtr->importRefPtr = refPtr->nextPtr;
1548       } else {
1549     prevPtr->nextPtr = refPtr->nextPtr;
1550       }
1551       ckfree((char *) refPtr);
1552       ckfree((char *) dataPtr);
1553       return;
1554   }
1555   prevPtr = refPtr;
1556     }
1557   
1558     panic("DeleteImportedCmd: did not find cmd in real cmd's list of import references");
1559 }
static void DupNsNameInternalRep (Tcl_Obj * srcPtr, Tcl_Obj * copyPtr) [static]

Definition at line 3848 of file tclNamesp.c.
References NULL, ResolvedNsName, and tclNsNameType.3851 {
3852     register ResolvedNsName *resNamePtr =
3853         (ResolvedNsName *) srcPtr->internalRep.otherValuePtr;
3854 
3855     copyPtr->internalRep.otherValuePtr = (VOID *) resNamePtr;
3856     if (resNamePtr != NULL) {
3857         resNamePtr->refCount++;
3858     }
3859     copyPtr->typePtr = &tclNsNameType;
3860 }
static void FreeNsNameInternalRep (Tcl_Obj * objPtr) [static]

Definition at line 3795 of file tclNamesp.c.
References ckfree, NamespaceFree(), NS_DEAD, NULL, and ResolvedNsName.3798 {
3799     register ResolvedNsName *resNamePtr =
3800         (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
3801     Namespace *nsPtr;
3802 
3803     /*
3804      * Decrement the reference count of the namespace. If there are no
3805      * more references, free it up.
3806      */
3807 
3808     if (resNamePtr != NULL) {
3809         resNamePtr->refCount--;
3810         if (resNamePtr->refCount == 0) {
3811 
3812             /*
3813        * Decrement the reference count for the cached namespace.  If
3814        * the namespace is dead, and there are no more references to
3815        * it, free it.
3816        */
3817 
3818             nsPtr = resNamePtr->nsPtr;
3819             nsPtr->refCount--;
3820             if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
3821                 NamespaceFree(nsPtr);
3822             }
3823             ckfree((char *) resNamePtr);
3824         }
3825     }
3826 }
static int GetNamespaceFromObj (Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_Namespace ** nsPtrPtr) [static]

Definition at line 2383 of file tclNamesp.c.
References Namespace::flags, Tcl_Obj::internalRep, NS_DEAD, NULL, Tcl_Obj::otherValuePtr, ResolvedNsName, Tcl_ObjType::setFromAnyProc, Tcl_GetCurrentNamespace(), Tcl_GetString(), TCL_OK, tclNsNameType, Tcl_Obj::typePtr, and Interp::varFramePtr.
Referenced by NamespaceChildrenCmd(), NamespaceEvalCmd(), NamespaceExistsCmd(), NamespaceInscopeCmd(), and NamespaceParentCmd().2388 {
2389     Interp *iPtr = (Interp *) interp;
2390     register ResolvedNsName *resNamePtr;
2391     register Namespace *nsPtr;
2392     Namespace *currNsPtr;
2393     CallFrame *savedFramePtr;
2394     int result = TCL_OK;
2395     char *name;
2396 
2397     /*
2398      * If the namespace name is fully qualified, do as if the lookup were
2399      * done from the global namespace; this helps avoid repeated lookups 
2400      * of fully qualified names. 
2401      */
2402 
2403     savedFramePtr = iPtr->varFramePtr;
2404     name = Tcl_GetString(objPtr);
2405     if ((*name++ == ':') && (*name == ':')) {
2406   iPtr->varFramePtr = NULL;
2407     }
2408 
2409     currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
2410     
2411     /*
2412      * Get the internal representation, converting to a namespace type if
2413      * needed. The internal representation is a ResolvedNsName that points
2414      * to the actual namespace.
2415      */
2416 
2417     if (objPtr->typePtr != &tclNsNameType) {
2418         result = tclNsNameType.setFromAnyProc(interp, objPtr);
2419         if (result != TCL_OK) {
2420       goto done;
2421         }
2422     }
2423     resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
2424 
2425     /*
2426      * Check the context namespace of the resolved symbol to make sure that
2427      * it is fresh. If not, then force another conversion to the namespace
2428      * type, to discard the old rep and create a new one. Note that we
2429      * verify that the namespace id of the cached namespace is the same as
2430      * the id when we cached it; this insures that the namespace wasn't
2431      * deleted and a new one created at the same address.
2432      */
2433 
2434     nsPtr = NULL;
2435     if ((resNamePtr != NULL)
2436       && (resNamePtr->refNsPtr == currNsPtr)
2437       && (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) {
2438         nsPtr = resNamePtr->nsPtr;
2439   if (nsPtr->flags & NS_DEAD) {
2440       nsPtr = NULL;
2441   }
2442     }
2443     if (nsPtr == NULL) {  /* try again */
2444         result = tclNsNameType.setFromAnyProc(interp, objPtr);
2445         if (result != TCL_OK) {
2446       goto done;
2447         }
2448         resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
2449         if (resNamePtr != NULL) {
2450             nsPtr = resNamePtr->nsPtr;
2451             if (nsPtr->flags & NS_DEAD) {
2452                 nsPtr = NULL;
2453             }
2454         }
2455     }
2456     *nsPtrPtr = (Tcl_Namespace *) nsPtr;
2457 
2458     done:
2459     iPtr->varFramePtr = savedFramePtr;
2460     return result;
2461 }
static int InvokeImportedCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1492 of file tclNamesp.c.
References Command::objClientData, Command::objProc, and ImportedCmdData::realCmdPtr.
Referenced by Tcl_Import().1498 {
1499     register ImportedCmdData *dataPtr = (ImportedCmdData *) clientData;
1500     register Command *realCmdPtr = dataPtr->realCmdPtr;
1501 
1502     return (*realCmdPtr->objProc)(realCmdPtr->objClientData, interp,
1503             objc, objv);
1504 }
static int NamespaceChildrenCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 2611 of file tclNamesp.c.
References Namespace::childTable, Namespace::fullName, GetNamespaceFromObj(), NULL, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, TCL_ERROR, Tcl_FirstHashEntry(), Tcl_GetCurrentNamespace(), Tcl_GetGlobalNamespace(), Tcl_GetHashValue, Tcl_GetObjResult(), Tcl_GetString(), Tcl_ListObjAppendElement(), Tcl_NewListObj(), Tcl_NewStringObj(), Tcl_NextHashEntry(), TCL_OK, Tcl_SetObjResult(), Tcl_StringMatch(), and Tcl_WrongNumArgs().
Referenced by Tcl_NamespaceObjCmd().2616 {
2617     Tcl_Namespace *namespacePtr;
2618     Namespace *nsPtr, *childNsPtr;
2619     Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
2620     char *pattern = NULL;
2621     Tcl_DString buffer;
2622     register Tcl_HashEntry *entryPtr;
2623     Tcl_HashSearch search;
2624     Tcl_Obj *listPtr, *elemPtr;
2625 
2626     /*
2627      * Get a pointer to the specified namespace, or the current namespace.
2628      */
2629 
2630     if (objc == 2) {
2631   nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
2632     } else if ((objc == 3) || (objc == 4)) {
2633         if (GetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
2634             return TCL_ERROR;
2635         }
2636         if (namespacePtr == NULL) {
2637       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
2638                     "unknown namespace \"", Tcl_GetString(objv[2]),
2639         "\" in namespace children command", (char *) NULL);
2640             return TCL_ERROR;
2641         }
2642         nsPtr = (Namespace *) namespacePtr;
2643     } else {
2644   Tcl_WrongNumArgs(interp, 2, objv, "?name? ?pattern?");
2645         return TCL_ERROR;
2646     }
2647 
2648     /*
2649      * Get the glob-style pattern, if any, used to narrow the search.
2650      */
2651 
2652     Tcl_DStringInit(&buffer);
2653     if (objc == 4) {
2654         char *name = Tcl_GetString(objv[3]);
2655   
2656         if ((*name == ':') && (*(name+1) == ':')) {
2657             pattern = name;
2658         } else {
2659             Tcl_DStringAppend(&buffer, nsPtr->fullName, -1);
2660             if (nsPtr != globalNsPtr) {
2661                 Tcl_DStringAppend(&buffer, "::", 2);
2662             }
2663             Tcl_DStringAppend(&buffer, name, -1);
2664             pattern = Tcl_DStringValue(&buffer);
2665         }
2666     }
2667 
2668     /*
2669      * Create a list containing the full names of all child namespaces
2670      * whose names match the specified pattern, if any.
2671      */
2672 
2673     listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
2674     entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
2675     while (entryPtr != NULL) {
2676         childNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
2677         if ((pattern == NULL)
2678           || Tcl_StringMatch(childNsPtr->fullName, pattern)) {
2679             elemPtr = Tcl_NewStringObj(childNsPtr->fullName, -1);
2680             Tcl_ListObjAppendElement(interp, listPtr, elemPtr);
2681         }
2682         entryPtr = Tcl_NextHashEntry(&search);
2683     }
2684 
2685     Tcl_SetObjResult(interp, listPtr);
2686     Tcl_DStringFree(&buffer);
2687     return TCL_OK;
2688 }
static int NamespaceCodeCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 2719 of file tclNamesp.c.
References Namespace::fullName, NULL, TCL_ERROR, Tcl_GetCurrentNamespace(), Tcl_GetGlobalNamespace(), Tcl_GetStringFromObj(), Tcl_ListObjAppendElement(), Tcl_NewListObj(), Tcl_NewStringObj(), TCL_OK, Tcl_SetObjResult(), and Tcl_WrongNumArgs().
Referenced by Tcl_NamespaceObjCmd().2724 {
2725     Namespace *currNsPtr;
2726     Tcl_Obj *listPtr, *objPtr;
2727     register char *arg, *p;
2728     int length;
2729 
2730     if (objc != 3) {
2731   Tcl_WrongNumArgs(interp, 2, objv, "arg");
2732         return TCL_ERROR;
2733     }
2734 
2735     /*
2736      * If "arg" is already a scoped value, then return it directly.
2737      */
2738 
2739     arg = Tcl_GetStringFromObj(objv[2], &length);
2740     while (*arg == ':') { 
2741   arg++; 
2742   length--; 
2743     } 
2744     if ((*arg == 'n') && (length > 17)
2745       && (strncmp(arg, "namespace", 9) == 0)) {
2746   for (p = (arg + 9);  (*p == ' ');  p++) {
2747       /* empty body: skip over spaces */
2748   }
2749   if ((*p == 'i') && ((p + 7) <= (arg + length))
2750           && (strncmp(p, "inscope", 7) == 0)) {
2751       Tcl_SetObjResult(interp, objv[2]);
2752       return TCL_OK;
2753   }
2754     }
2755 
2756     /*
2757      * Otherwise, construct a scoped command by building a list with
2758      * "namespace inscope", the full name of the current namespace, and 
2759      * the argument "arg". By constructing a list, we ensure that scoped
2760      * commands are interpreted properly when they are executed later,
2761      * by the "namespace inscope" command.
2762      */
2763 
2764     listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
2765     Tcl_ListObjAppendElement(interp, listPtr,
2766             Tcl_NewStringObj("::namespace", -1));
2767     Tcl_ListObjAppendElement(interp, listPtr,
2768       Tcl_NewStringObj("inscope", -1));
2769 
2770     currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
2771     if (currNsPtr == (Namespace *) Tcl_GetGlobalNamespace(interp)) {
2772   objPtr = Tcl_NewStringObj("::", -1);
2773     } else {
2774   objPtr = Tcl_NewStringObj(currNsPtr->fullName, -1);
2775     }
2776     Tcl_ListObjAppendElement(interp, listPtr, objPtr);
2777     
2778     Tcl_ListObjAppendElement(interp, listPtr, objv[2]);
2779 
2780     Tcl_SetObjResult(interp, listPtr);
2781     return TCL_OK;
2782 }
static int NamespaceCurrentCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 2806 of file tclNamesp.c.
References Namespace::fullName, NULL, Tcl_AppendToObj(), TCL_ERROR, Tcl_GetCurrentNamespace(), Tcl_GetGlobalNamespace(), Tcl_GetObjResult(), TCL_OK, and Tcl_WrongNumArgs().
Referenced by Tcl_NamespaceObjCmd().2811 {
2812     register Namespace *currNsPtr;
2813 
2814     if (objc != 2) {
2815   Tcl_WrongNumArgs(interp, 2, objv, NULL);
2816         return TCL_ERROR;
2817     }
2818 
2819     /*
2820      * The "real" name of the global namespace ("::") is the null string,
2821      * but we return "::" for it as a convenience to programmers. Note that
2822      * "" and "::" are treated as synonyms by the namespace code so that it
2823      * is still easy to do things like:
2824      *
2825      *    namespace [namespace current]::bar { ... }
2826      */
2827 
2828     currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
2829     if (currNsPtr == (Namespace *) Tcl_GetGlobalNamespace(interp)) {
2830         Tcl_AppendToObj(Tcl_GetObjResult(interp), "::", -1);
2831     } else {
2832   Tcl_AppendToObj(Tcl_GetObjResult(interp), currNsPtr->fullName, -1);
2833     }
2834     return TCL_OK;
2835 }
static int NamespaceDeleteCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 2870 of file tclNamesp.c.
References NULL, Tcl_DeleteNamespace(), TCL_ERROR, Tcl_FindNamespace(), Tcl_GetObjResult(), Tcl_GetString(), TCL_OK, and Tcl_WrongNumArgs().
Referenced by Tcl_NamespaceObjCmd().2875 {
2876     Tcl_Namespace *namespacePtr;
2877     char *name;
2878     register int i;
2879 
2880     if (objc < 2) {
2881         Tcl_WrongNumArgs(interp, 2, objv, "?name name...?");
2882         return TCL_ERROR;
2883     }
2884 
2885     /*
2886      * Destroying one namespace may cause another to be destroyed. Break
2887      * this into two passes: first check to make sure that all namespaces on
2888      * the command line are valid, and report any errors.
2889      */
2890 
2891     for (i = 2;  i < objc;  i++) {
2892         name = Tcl_GetString(objv[i]);
2893   namespacePtr = Tcl_FindNamespace(interp, name,
2894     (Tcl_Namespace *) NULL, /*flags*/ 0);
2895   if (namespacePtr == NULL) {
2896       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
2897                     "unknown namespace \"", Tcl_GetString(objv[i]),
2898         "\" in namespace delete command", (char *) NULL);
2899             return TCL_ERROR;
2900         }
2901     }
2902 
2903     /*
2904      * Okay, now delete each namespace.
2905      */
2906 
2907     for (i = 2;  i < objc;  i++) {
2908         name = Tcl_GetString(objv[i]);
2909   namespacePtr = Tcl_FindNamespace(interp, name,
2910       (Tcl_Namespace *) NULL, /* flags */ 0);
2911   if (namespacePtr) {
2912             Tcl_DeleteNamespace(namespacePtr);
2913         }
2914     }
2915     return TCL_OK;
2916 }
static int NamespaceEvalCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 2946 of file tclNamesp.c.
References Tcl_Interp::errorLine, Tcl_Namespace::fullName, GetNamespaceFromObj(), NULL, Tcl_AddObjErrorInfo(), Tcl_ConcatObj(), Tcl_CreateNamespace(), TCL_ERROR, TCL_EVAL_DIRECT, Tcl_EvalObjEx(), Tcl_GetStringFromObj(), TCL_INTEGER_SPACE, TCL_OK, Tcl_PopCallFrame(), Tcl_PushCallFrame(), and Tcl_WrongNumArgs().
Referenced by Tcl_NamespaceObjCmd().2951 {
2952     Tcl_Namespace *namespacePtr;
2953     CallFrame frame;
2954     Tcl_Obj *objPtr;
2955     char *name;
2956     int length, result;
2957 
2958     if (objc < 4) {
2959         Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
2960         return TCL_ERROR;
2961     }
2962 
2963     /*
2964      * Try to resolve the namespace reference, caching the result in the
2965      * namespace object along the way.
2966      */
2967 
2968     result = GetNamespaceFromObj(interp, objv[2], &namespacePtr);
2969     if (result != TCL_OK) {
2970         return result;
2971     }
2972 
2973     /*
2974      * If the namespace wasn't found, try to create it.
2975      */
2976     
2977     if (namespacePtr == NULL) {
2978   name = Tcl_GetStringFromObj(objv[2], &length);
2979   namespacePtr = Tcl_CreateNamespace(interp, name, (ClientData) NULL, 
2980                 (Tcl_NamespaceDeleteProc *) NULL);
2981   if (namespacePtr == NULL) {
2982       return TCL_ERROR;
2983   }
2984     }
2985 
2986     /*
2987      * Make the specified namespace the current namespace and evaluate
2988      * the command(s).
2989      */
2990 
2991     result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) &frame, 
2992             namespacePtr, /*isProcCallFrame*/ 0);
2993     if (result != TCL_OK) {
2994         return TCL_ERROR;
2995     }
2996     frame.objc = objc;
2997     frame.objv = objv;  /* ref counts do not need to be incremented here */
2998 
2999     if (objc == 4) {
3000         result = Tcl_EvalObjEx(interp, objv[3], 0);
3001     } else {
3002   /*
3003    * More than one argument: concatenate them together with spaces
3004    * between, then evaluate the result.  Tcl_EvalObjEx will delete
3005    * the object when it decrements its refcount after eval'ing it.
3006    */
3007         objPtr = Tcl_ConcatObj(objc-3, objv+3);
3008         result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
3009     }
3010     if (result == TCL_ERROR) {
3011         char msg[256 + TCL_INTEGER_SPACE];
3012   
3013         sprintf(msg, "\n    (in namespace eval \"%.200s\" script line %d)",
3014             namespacePtr->fullName, interp->errorLine);
3015         Tcl_AddObjErrorInfo(interp, msg, -1);
3016     }
3017 
3018     /*
3019      * Restore the previous "current" namespace.
3020      */
3021     
3022     Tcl_PopCallFrame(interp);
3023     return result;
3024 }
static int NamespaceExistsCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 3048 of file tclNamesp.c.
References GetNamespaceFromObj(), NULL, TCL_ERROR, Tcl_GetObjResult(), TCL_OK, Tcl_SetBooleanObj(), and Tcl_WrongNumArgs().
Referenced by Tcl_NamespaceObjCmd().3053 {
3054     Tcl_Namespace *namespacePtr;
3055 
3056     if (objc != 3) {
3057         Tcl_WrongNumArgs(interp, 2, objv, "name");
3058         return TCL_ERROR;
3059     }
3060 
3061     /*
3062      * Check whether the given namespace exists
3063      */
3064 
3065     if (GetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
3066         return TCL_ERROR;
3067     }
3068 
3069     Tcl_SetBooleanObj(Tcl_GetObjResult(interp), (namespacePtr != NULL));
3070     return TCL_OK;
3071 }
static int NamespaceExportCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 3110 of file tclNamesp.c.
References NULL, Tcl_AppendExportList(), TCL_ERROR, Tcl_Export(), Tcl_GetCurrentNamespace(), Tcl_GetString(), Tcl_NewListObj(), TCL_OK, Tcl_SetObjResult(), and Tcl_WrongNumArgs().
Referenced by Tcl_NamespaceObjCmd().3115 {
3116     Namespace *currNsPtr = (Namespace*) Tcl_GetCurrentNamespace(interp);
3117     char *pattern, *string;
3118     int resetListFirst = 0;
3119     int firstArg, patternCt, i, result;
3120 
3121     if (objc < 2) {
3122   Tcl_WrongNumArgs(interp, 2, objv,
3123           "?-clear? ?pattern pattern...?");
3124         return TCL_ERROR;
3125     }
3126 
3127     /*
3128      * Process the optional "-clear" argument.
3129      */
3130 
3131     firstArg = 2;
3132     if (firstArg < objc) {
3133   string = Tcl_GetString(objv[firstArg]);
3134   if (strcmp(string, "-clear") == 0) {
3135       resetListFirst = 1;
3136       firstArg++;
3137   }
3138     }
3139 
3140     /*
3141      * If no pattern arguments are given, and "-clear" isn't specified,
3142      * return the namespace's current export pattern list.
3143      */
3144 
3145     patternCt = (objc - firstArg);
3146     if (patternCt == 0) {
3147   if (firstArg > 2) {
3148       return TCL_OK;
3149   } else {    /* create list with export patterns */
3150       Tcl_Obj *listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
3151       result = Tcl_AppendExportList(interp,
3152         (Tcl_Namespace *) currNsPtr, listPtr);
3153       if (result != TCL_OK) {
3154     return result;
3155       }
3156       Tcl_SetObjResult(interp, listPtr);
3157       return TCL_OK;
3158   }
3159     }
3160 
3161     /*
3162      * Add each pattern to the namespace's export pattern list.
3163      */
3164     
3165     for (i = firstArg;  i < objc;  i++) {
3166   pattern = Tcl_GetString(objv[i]);
3167   result = Tcl_Export(interp, (Tcl_Namespace *) currNsPtr, pattern,
3168     ((i == firstArg)? resetListFirst : 0));
3169         if (result != TCL_OK) {
3170             return result;
3171         }
3172     }
3173     return TCL_OK;
3174 }
static int NamespaceForgetCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 3207 of file tclNamesp.c.
References NULL, TCL_ERROR, Tcl_ForgetImport(), Tcl_GetString(), TCL_OK, and Tcl_WrongNumArgs().
Referenced by Tcl_NamespaceObjCmd().3212 {
3213     char *pattern;
3214     register int i, result;
3215 
3216     if (objc < 2) {
3217         Tcl_WrongNumArgs(interp, 2, objv, "?pattern pattern...?");
3218         return TCL_ERROR;
3219     }
3220 
3221     for (i = 2;  i < objc;  i++) {
3222         pattern = Tcl_GetString(objv[i]);
3223   result = Tcl_ForgetImport(interp, (Tcl_Namespace *) NULL, pattern);
3224         if (result != TCL_OK) {
3225             return result;
3226         }
3227     }
3228     return TCL_OK;
3229 }
static void NamespaceFree (Namespace * nsPtr) [static]

Definition at line 839 of file tclNamesp.c.
References ckfree.
Referenced by FreeNsNameInternalRep(), and Tcl_DeleteNamespace().841 {
842     /*
843      * Most of the namespace's contents are freed when the namespace is
844      * deleted by Tcl_DeleteNamespace. All that remains is to free its names
845      * (for error messages), and the structure itself.
846      */
847 
848     ckfree(nsPtr->name);
849     ckfree(nsPtr->fullName);
850 
851     ckfree((char *) nsPtr);
852 }
static int NamespaceImportCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 3269 of file tclNamesp.c.
References NULL, TCL_ERROR, Tcl_GetString(), Tcl_Import(), TCL_OK, and Tcl_WrongNumArgs().
Referenced by Tcl_NamespaceObjCmd().3274 {
3275     int allowOverwrite = 0;
3276     char *string, *pattern;
3277     register int i, result;
3278     int firstArg;
3279 
3280     if (objc < 2) {
3281         Tcl_WrongNumArgs(interp, 2, objv,
3282           "?-force? ?pattern pattern...?");
3283         return TCL_ERROR;
3284     }
3285 
3286     /*
3287      * Skip over the optional "-force" as the first argument.
3288      */
3289 
3290     firstArg = 2;
3291     if (firstArg < objc) {
3292   string = Tcl_GetString(objv[firstArg]);
3293   if ((*string == '-') && (strcmp(string, "-force") == 0)) {
3294       allowOverwrite = 1;
3295       firstArg++;
3296   }
3297     }
3298 
3299     /*
3300      * Handle the imports for each of the patterns.
3301      */
3302 
3303     for (i = firstArg;  i < objc;  i++) {
3304         pattern = Tcl_GetString(objv[i]);
3305   result = Tcl_Import(interp, (Tcl_Namespace *) NULL, pattern,
3306           allowOverwrite);
3307         if (result != TCL_OK) {
3308             return result;
3309         }
3310     }
3311     return TCL_OK;
3312 }
static int NamespaceInscopeCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 3353 of file tclNamesp.c.
References Tcl_Interp::errorLine, Tcl_Namespace::fullName, GetNamespaceFromObj(), NULL, Tcl_AddObjErrorInfo(), Tcl_ConcatObj(), Tcl_DecrRefCount, TCL_ERROR, TCL_EVAL_DIRECT, Tcl_EvalObjEx(), Tcl_GetObjResult(), Tcl_GetString(), TCL_INTEGER_SPACE, Tcl_ListObjAppendElement(), Tcl_NewListObj(), TCL_OK, Tcl_PopCallFrame(), Tcl_PushCallFrame(), and Tcl_WrongNumArgs().
Referenced by Tcl_NamespaceObjCmd().3358 {
3359     Tcl_Namespace *namespacePtr;
3360     Tcl_CallFrame frame;
3361     int i, result;
3362 
3363     if (objc < 4) {
3364   Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
3365         return TCL_ERROR;
3366     }
3367 
3368     /*
3369      * Resolve the namespace reference.
3370      */
3371 
3372     result = GetNamespaceFromObj(interp, objv[2], &namespacePtr);
3373     if (result != TCL_OK) {
3374         return result;
3375     }
3376     if (namespacePtr == NULL) {
3377   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
3378           "unknown namespace \"", Tcl_GetString(objv[2]),
3379     "\" in inscope namespace command", (char *) NULL);
3380         return TCL_ERROR;
3381     }
3382 
3383     /*
3384      * Make the specified namespace the current namespace.
3385      */
3386 
3387     result = Tcl_PushCallFrame(interp, &frame, namespacePtr,
3388       /*isProcCallFrame*/ 0);
3389     if (result != TCL_OK) {
3390         return result;
3391     }
3392 
3393     /*
3394      * Execute the command. If there is just one argument, just treat it as
3395      * a script and evaluate it. Otherwise, create a list from the arguments
3396      * after the first one, then concatenate the first argument and the list
3397      * of extra arguments to form the command to evaluate.
3398      */
3399 
3400     if (objc == 4) {
3401         result = Tcl_EvalObjEx(interp, objv[3], 0);
3402     } else {
3403   Tcl_Obj *concatObjv[2];
3404   register Tcl_Obj *listPtr, *cmdObjPtr;
3405   
3406         listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
3407         for (i = 4;  i < objc;  i++) {
3408       result = Tcl_ListObjAppendElement(interp, listPtr, objv[i]);
3409             if (result != TCL_OK) {
3410                 Tcl_DecrRefCount(listPtr); /* free unneeded obj */
3411                 return result;
3412             }
3413         }
3414 
3415   concatObjv[0] = objv[3];
3416   concatObjv[1] = listPtr;
3417   cmdObjPtr = Tcl_ConcatObj(2, concatObjv);
3418         result = Tcl_EvalObjEx(interp, cmdObjPtr, TCL_EVAL_DIRECT);
3419   Tcl_DecrRefCount(listPtr);    /* we're done with the list object */
3420     }
3421     if (result == TCL_ERROR) {
3422         char msg[256 + TCL_INTEGER_SPACE];
3423   
3424         sprintf(msg,
3425       "\n    (in namespace inscope \"%.200s\" script line %d)",
3426             namespacePtr->fullName, interp->errorLine);
3427         Tcl_AddObjErrorInfo(interp, msg, -1);
3428     }
3429 
3430     /*
3431      * Restore the previous "current" namespace.
3432      */
3433 
3434     Tcl_PopCallFrame(interp);
3435     return result;
3436 }
static int NamespaceOriginCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 3468 of file tclNamesp.c.
References NULL, TCL_ERROR, Tcl_GetCommandFromObj(), Tcl_GetCommandFullName(), Tcl_GetObjResult(), Tcl_GetString(), TCL_OK, Tcl_WrongNumArgs(), and TclGetOriginalCommand().
Referenced by Tcl_NamespaceObjCmd().3473 {
3474     Tcl_Command command, origCommand;
3475 
3476     if (objc != 3) {
3477         Tcl_WrongNumArgs(interp, 2, objv, "name");
3478         return TCL_ERROR;
3479     }
3480 
3481     command = Tcl_GetCommandFromObj(interp, objv[2]);
3482     if (command == (Tcl_Command) NULL) {
3483   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
3484     "invalid command name \"", Tcl_GetString(objv[2]),
3485     "\"", (char *) NULL);
3486   return TCL_ERROR;
3487     }
3488     origCommand = TclGetOriginalCommand(command);
3489     if (origCommand == (Tcl_Command) NULL) {
3490   /*
3491    * The specified command isn't an imported command. Return the
3492    * command's name qualified by the full name of the namespace it
3493    * was defined in.
3494    */
3495   
3496   Tcl_GetCommandFullName(interp, command, Tcl_GetObjResult(interp));
3497     } else {
3498   Tcl_GetCommandFullName(interp, origCommand, Tcl_GetObjResult(interp));
3499     }
3500     return TCL_OK;
3501 }
static int NamespaceParentCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 3525 of file tclNamesp.c.
References Tcl_Namespace::fullName, GetNamespaceFromObj(), NULL, Tcl_Namespace::parentPtr, TCL_ERROR, Tcl_GetCurrentNamespace(), Tcl_GetObjResult(), Tcl_GetString(), TCL_OK, Tcl_SetStringObj(), and Tcl_WrongNumArgs().
Referenced by Tcl_NamespaceObjCmd().3530 {
3531     Tcl_Namespace *nsPtr;
3532     int result;
3533 
3534     if (objc == 2) {
3535         nsPtr = Tcl_GetCurrentNamespace(interp);
3536     } else if (objc == 3) {
3537   result = GetNamespaceFromObj(interp, objv[2], &nsPtr);
3538         if (result != TCL_OK) {
3539             return result;
3540         }
3541         if (nsPtr == NULL) {
3542             Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
3543                     "unknown namespace \"", Tcl_GetString(objv[2]),
3544         "\" in namespace parent command", (char *) NULL);
3545             return TCL_ERROR;
3546         }
3547     } else {
3548         Tcl_WrongNumArgs(interp, 2, objv, "?name?");
3549         return TCL_ERROR;
3550     }
3551 
3552     /*
3553      * Report the parent of the specified namespace.
3554      */
3555 
3556     if (nsPtr->parentPtr != NULL) {
3557         Tcl_SetStringObj(Tcl_GetObjResult(interp),
3558           nsPtr->parentPtr->fullName, -1);
3559     }
3560     return TCL_OK;
3561 }
static int NamespaceQualifiersCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 3590 of file tclNamesp.c.
References Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), TCL_OK, and Tcl_WrongNumArgs().
Referenced by Tcl_NamespaceObjCmd().3595 {
3596     register char *name, *p;
3597     int length;
3598 
3599     if (objc != 3) {
3600   Tcl_WrongNumArgs(interp, 2, objv, "string");
3601         return TCL_ERROR;
3602     }
3603 
3604     /*
3605      * Find the end of the string, then work backward and find
3606      * the start of the last "::" qualifier.
3607      */
3608 
3609     name = Tcl_GetString(objv[2]);
3610     for (p = name;  *p != '\0';  p++) {
3611   /* empty body */
3612     }
3613     while (--p >= name) {
3614         if ((*p == ':') && (p > name) && (*(p-1) == ':')) {
3615       p -= 2;   /* back up over the :: */
3616       while ((p >= name) && (*p == ':')) {
3617     p--;    /* back up over the preceeding : */
3618       }
3619       break;
3620         }
3621     }
3622 
3623     if (p >= name) {
3624         length = p-name+1;
3625         Tcl_AppendToObj(Tcl_GetObjResult(interp), name, length);
3626     }
3627     return TCL_OK;
3628 }
static int NamespaceTailCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 3657 of file tclNamesp.c.
References Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), TCL_OK, and Tcl_WrongNumArgs().
Referenced by Tcl_NamespaceObjCmd().3662 {
3663     register char *name, *p;
3664 
3665     if (objc != 3) {
3666   Tcl_WrongNumArgs(interp, 2, objv, "string");
3667         return TCL_ERROR;
3668     }
3669 
3670     /*
3671      * Find the end of the string, then work backward and find the
3672      * last "::" qualifier.
3673      */
3674 
3675     name = Tcl_GetString(objv[2]);
3676     for (p = name;  *p != '\0';  p++) {
3677   /* empty body */
3678     }
3679     while (--p > name) {
3680         if ((*p == ':') && (*(p-1) == ':')) {
3681             p++;    /* just after the last "::" */
3682             break;
3683         }
3684     }
3685     
3686     if (p >= name) {
3687         Tcl_AppendToObj(Tcl_GetObjResult(interp), p, -1);
3688     }
3689     return TCL_OK;
3690 }
static int NamespaceWhichCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 3715 of file tclNamesp.c.
References NULL, TCL_ERROR, Tcl_FindNamespaceVar(), Tcl_GetCommandFromObj(), Tcl_GetCommandFullName(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetVariableFullName(), TCL_OK, and Tcl_WrongNumArgs().
Referenced by Tcl_NamespaceObjCmd().3720 {
3721     register char *arg;
3722     Tcl_Command cmd;
3723     Tcl_Var variable;
3724     int argIndex, lookup;
3725 
3726     if (objc < 3) {
3727         badArgs:
3728         Tcl_WrongNumArgs(interp, 2, objv,
3729           "?-command? ?-variable? name");
3730         return TCL_ERROR;
3731     }
3732 
3733     /*
3734      * Look for a flag controlling the lookup.
3735      */
3736 
3737     argIndex = 2;
3738     lookup = 0;     /* assume command lookup by default */
3739     arg = Tcl_GetString(objv[2]);
3740     if (*arg == '-') {
3741   if (strncmp(arg, "-command", 8) == 0) {
3742       lookup = 0;
3743   } else if (strncmp(arg, "-variable", 9) == 0) {
3744       lookup = 1;
3745   } else {
3746       goto badArgs;
3747   }
3748   argIndex = 3;
3749     }
3750     if (objc != (argIndex + 1)) {
3751   goto badArgs;
3752     }
3753 
3754     switch (lookup) {
3755     case 0:     /* -command */
3756   cmd = Tcl_GetCommandFromObj(interp, objv[argIndex]);
3757         if (cmd == (Tcl_Command) NULL) {  
3758             return TCL_OK;  /* cmd not found, just return (no error) */
3759         }
3760   Tcl_GetCommandFullName(interp, cmd, Tcl_GetObjResult(interp));
3761         break;
3762 
3763     case 1:     /* -variable */
3764         arg = Tcl_GetString(objv[argIndex]);
3765   variable = Tcl_FindNamespaceVar(interp, arg, (Tcl_Namespace *) NULL,
3766     /*flags*/ 0);
3767         if (variable != (Tcl_Var) NULL) {
3768             Tcl_GetVariableFullName(interp, variable, Tcl_GetObjResult(interp));
3769         }
3770         break;
3771     }
3772     return TCL_OK;
3773 }
static int SetNsNameFromAny (Tcl_Interp * interp, Tcl_Obj * objPtr) [static]

Definition at line 3886 of file tclNamesp.c.
References ckalloc, CONST, FIND_ONLY_NS, Tcl_ObjType::freeIntRepProc, Namespace::nsId, NULL, Namespace::refCount, ResolvedNsName, Tcl_GetCurrentNamespace(), Tcl_GetString(), TCL_OK, TclGetNamespaceForQualName(), tclNsNameType, and Tcl_Obj::typePtr.3891 {
3892     register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
3893     char *name;
3894     CONST char *dummy;
3895     Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
3896     register ResolvedNsName *resNamePtr;
3897 
3898     /*
3899      * Get the string representation. Make it up-to-date if necessary.
3900      */
3901 
3902     name = objPtr->bytes;
3903     if (name == NULL) {
3904   name = Tcl_GetString(objPtr);
3905     }
3906 
3907     /*
3908      * Look for the namespace "name" in the current namespace. If there is
3909      * an error parsing the (possibly qualified) name, return an error.
3910      * If the namespace isn't found, we convert the object to an nsName
3911      * object with a NULL ResolvedNsName* internal rep.
3912      */
3913 
3914     TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
3915             FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
3916 
3917     /*
3918      * If we found a namespace, then create a new ResolvedNsName structure
3919      * that holds a reference to it.
3920      */
3921 
3922     if (nsPtr != NULL) {
3923   Namespace *currNsPtr =
3924           (Namespace *) Tcl_GetCurrentNamespace(interp);
3925   
3926         nsPtr->refCount++;
3927         resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName));
3928         resNamePtr->nsPtr = nsPtr;
3929         resNamePtr->nsId = nsPtr->nsId;
3930         resNamePtr->refNsPtr = currNsPtr;
3931         resNamePtr->refCount = 1;
3932     } else {
3933         resNamePtr = NULL;
3934     }
3935 
3936     /*
3937      * Free the old internalRep before setting the new one.
3938      * We do this as late as possible to allow the conversion code
3939      * (in particular, Tcl_GetStringFromObj) to use that old internalRep.
3940      */
3941 
3942     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
3943         oldTypePtr->freeIntRepProc(objPtr);
3944     }
3945 
3946     objPtr->internalRep.otherValuePtr = (VOID *) resNamePtr;
3947     objPtr->typePtr = &tclNsNameType;
3948     return TCL_OK;
3949 }
int Tcl_AppendExportList (Tcl_Interp * interp, Tcl_Namespace * namespacePtr, Tcl_Obj * objPtr)

Definition at line 1015 of file tclNamesp.c.
References Namespace::exportArrayPtr, NULL, Namespace::numExportPatterns, Tcl_GetCurrentNamespace(), Tcl_ListObjAppendElement(), Tcl_NewStringObj(), and TCL_OK.
Referenced by NamespaceExportCmd().1022 {
1023     Namespace *nsPtr;
1024     int i, result;
1025 
1026     /*
1027      * If the specified namespace is NULL, use the current namespace.
1028      */
1029 
1030     if (namespacePtr == NULL) {
1031         nsPtr = (Namespace *) (Namespace *) Tcl_GetCurrentNamespace(interp);
1032     } else {
1033         nsPtr = (Namespace *) namespacePtr;
1034     }
1035 
1036     /*
1037      * Append the export pattern list onto objPtr.
1038      */
1039 
1040     for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
1041   result = Tcl_ListObjAppendElement(interp, objPtr,
1042     Tcl_NewStringObj(nsPtr->exportArrayPtr[i], -1));
1043   if (result != TCL_OK) {
1044       return result;
1045   }
1046     }
1047     return TCL_OK;
1048 }
Tcl_Namespace* Tcl_CreateNamespace (Tcl_Interp * interp, CONST char * name, ClientData clientData, Tcl_NamespaceDeleteProc * deleteProc)

Definition at line 413 of file tclNamesp.c.
References Namespace::activationCount, Namespace::childTable, ckalloc, Namespace::clientData, Namespace::cmdRefEpoch, Namespace::cmdResProc, Namespace::cmdTable, Namespace::compiledVarResProc, CONST, CREATE_NS_IF_UNKNOWN, Namespace::deleteProc, Namespace::exportArrayPtr, Namespace::flags, Namespace::fullName, Interp::globalNsPtr, Namespace::interp, Namespace::maxExportPatterns, Namespace::name, Namespace::nsId, NULL, Namespace::numExportPatterns, numNsCreated, Namespace::parentPtr, Namespace::refCount, Namespace::resolverEpoch, Tcl_CreateHashEntry, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringSetLength(), Tcl_DStringValue, Tcl_FindHashEntry, Tcl_GetObjResult(), Tcl_InitHashTable(), TCL_LEAVE_ERR_MSG, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_SetHashValue, TCL_STRING_KEYS, TclGetNamespaceForQualName(), Interp::varFramePtr, Namespace::varResProc, and Namespace::varTable.
Referenced by NamespaceEvalCmd(), Tcl_CreateInterp(), TclGetNamespaceForQualName(), and TclpSetVariables().427 {
428     Interp *iPtr = (Interp *) interp;
429     register Namespace *nsPtr, *ancestorPtr;
430     Namespace *parentPtr, *dummy1Ptr, *dummy2Ptr;
431     Namespace *globalNsPtr = iPtr->globalNsPtr;
432     CONST char *simpleName;
433     Tcl_HashEntry *entryPtr;
434     Tcl_DString buffer1, buffer2;
435     int newEntry;
436 
437     /*
438      * If there is no active namespace, the interpreter is being
439      * initialized. 
440      */
441 
442     if ((globalNsPtr == NULL) && (iPtr->varFramePtr == NULL)) {
443   /*
444    * Treat this namespace as the global namespace, and avoid
445    * looking for a parent.
446    */
447   
448         parentPtr = NULL;
449         simpleName = "";
450     } else if (*name == '\0') {
451   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
452     "can't create namespace \"\": only global namespace can have empty name", (char *) NULL);
453   return NULL;
454     } else {
455   /*
456    * Find the parent for the new namespace.
457    */
458 
459   TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
460     /*flags*/ (CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG),
461     &parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName);
462 
463   /*
464    * If the unqualified name at the end is empty, there were trailing
465    * "::"s after the namespace's name which we ignore. The new
466    * namespace was already (recursively) created and is pointed to
467    * by parentPtr.
468    */
469 
470   if (*simpleName == '\0') {
471       return (Tcl_Namespace *) parentPtr;
472   }
473 
474         /*
475          * Check for a bad namespace name and make sure that the name
476    * does not already exist in the parent namespace.
477    */
478 
479         if (Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL) {
480       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
481         "can't create namespace \"", name,
482                 "\": already exists", (char *) NULL);
483             return NULL;
484         }
485     }
486 
487     /*
488      * Create the new namespace and root it in its parent. Increment the
489      * count of namespaces created.
490      */
491 
492 
493     nsPtr = (Namespace *) ckalloc(sizeof(Namespace));
494     nsPtr->name            = (char *) ckalloc((unsigned) (strlen(simpleName)+1));
495     strcpy(nsPtr->name, simpleName);
496     nsPtr->fullName        = NULL;   /* set below */
497     nsPtr->clientData      = clientData;
498     nsPtr->deleteProc      = deleteProc;
499     nsPtr->parentPtr       = parentPtr;
500     Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);
501     Tcl_MutexLock(&nsMutex);
502     numNsCreated++;
503     nsPtr->nsId            = numNsCreated;
504     Tcl_MutexUnlock(&nsMutex);
505     nsPtr->interp          = interp;
506     nsPtr->flags           = 0;
507     nsPtr->activationCount = 0;
508     nsPtr->refCount        = 0;
509     Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
510     Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
511     nsPtr->exportArrayPtr  = NULL;
512     nsPtr->numExportPatterns = 0;
513     nsPtr->maxExportPatterns = 0;
514     nsPtr->cmdRefEpoch       = 0;
515     nsPtr->resolverEpoch     = 0;
516     nsPtr->cmdResProc        = NULL;
517     nsPtr->varResProc        = NULL;
518     nsPtr->compiledVarResProc = NULL;
519 
520     if (parentPtr != NULL) {
521         entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,
522           &newEntry);
523         Tcl_SetHashValue(entryPtr, (ClientData) nsPtr);
524     }
525 
526     /*
527      * Build the fully qualified name for this namespace.
528      */
529 
530     Tcl_DStringInit(&buffer1);
531     Tcl_DStringInit(&buffer2);
532     for (ancestorPtr = nsPtr;  ancestorPtr != NULL;
533       ancestorPtr = ancestorPtr->parentPtr) {
534         if (ancestorPtr != globalNsPtr) {
535             Tcl_DStringAppend(&buffer1, "::", 2);
536             Tcl_DStringAppend(&buffer1, ancestorPtr->name, -1);
537         }
538         Tcl_DStringAppend(&buffer1, Tcl_DStringValue(&buffer2), -1);
539 
540         Tcl_DStringSetLength(&buffer2, 0);
541         Tcl_DStringAppend(&buffer2, Tcl_DStringValue(&buffer1), -1);
542         Tcl_DStringSetLength(&buffer1, 0);
543     }
544     
545     name = Tcl_DStringValue(&buffer2);
546     nsPtr->fullName = (char *) ckalloc((unsigned) (strlen(name)+1));
547     strcpy(nsPtr->fullName, name);
548 
549     Tcl_DStringFree(&buffer1);
550     Tcl_DStringFree(&buffer2);
551 
552     /*
553      * Return a pointer to the new namespace.
554      */
555 
556     return (Tcl_Namespace *) nsPtr;
557 }
TCL_DECLARE_MUTEX (nsMutex)

Definition at line 49 of file tclNamesp.c.59                               {
60     Namespace *nsPtr;   /* A cached namespace pointer. */
61     long nsId;      /* nsPtr's unique namespace id. Used to
62          * verify that nsPtr is still valid
63          * (e.g., it's possible that the namespace
64          * was deleted and a new one created at
65          * the same address). */
66     Namespace *refNsPtr;  /* Points to the namespace containing the
67          * reference (not the namespace that
68          * contains the referenced namespace). */
69     int refCount;   /* Reference count: 1 for each nsName
70          * object that has a pointer to this
71          * ResolvedNsName structure as its internal
72          * rep. This structure can be freed when
73          * refCount becomes zero. */
74 } ResolvedNsName;
void Tcl_DeleteNamespace (Tcl_Namespace * namespacePtr)

Definition at line 579 of file tclNamesp.c.
References Namespace::activationCount, Namespace::childTable, DELETED, Namespace::flags, Namespace::interp, Namespace::name, NamespaceFree(), NS_DEAD, NS_DYING, NS_KILLED, NULL, Namespace::parentPtr, Tcl_DeleteHashEntry(), Tcl_DeleteHashTable(), Tcl_FindHashEntry, Tcl_GetGlobalNamespace(), TclDeleteNamespaceVars(), and TclTeardownNamespace().
Referenced by DeleteInterpProc(), NamespaceDeleteCmd(), Tcl_PopCallFrame(), and TclTeardownNamespace().581 {
582     register Namespace *nsPtr = (Namespace *) namespacePtr;
583     Interp *iPtr = (Interp *) nsPtr->interp;
584     Namespace *globalNsPtr =
585       (Namespace *) Tcl_GetGlobalNamespace((Tcl_Interp *) iPtr);
586     Tcl_HashEntry *entryPtr;
587 
588     /*
589      * If the namespace is on the call frame stack, it is marked as "dying"
590      * (NS_DYING is OR'd into its flags): the namespace can't be looked up
591      * by name but its commands and variables are still usable by those
592      * active call frames. When all active call frames referring to the
593      * namespace have been popped from the Tcl stack, Tcl_PopCallFrame will
594      * call this procedure again to delete everything in the namespace.
595      * If no nsName objects refer to the namespace (i.e., if its refCount 
596      * is zero), its commands and variables are deleted and the storage for
597      * its namespace structure is freed. Otherwise, if its refCount is
598      * nonzero, the namespace's commands and variables are deleted but the
599      * structure isn't freed. Instead, NS_DEAD is OR'd into the structure's
600      * flags to allow the namespace resolution code to recognize that the
601      * namespace is "deleted". The structure's storage is freed by
602      * FreeNsNameInternalRep when its refCount reaches 0.
603      */
604 
605     if (nsPtr->activationCount > 0) {
606         nsPtr->flags |= NS_DYING;
607         if (nsPtr->parentPtr != NULL) {
608             entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
609         nsPtr->name);
610             if (entryPtr != NULL) {
611                 Tcl_DeleteHashEntry(entryPtr);
612             }
613         }
614         nsPtr->parentPtr = NULL;
615     } else if (!(nsPtr->flags & NS_KILLED)) {
616   /*
617    * Delete the namespace and everything in it. If this is the global
618    * namespace, then clear it but don't free its storage unless the
619    * interpreter is being torn down. Set the NS_KILLED flag to avoid
620    * recursive calls here - if the namespace is really in the process of
621    * being deleted, ignore any second call.
622    */
623 
624   nsPtr->flags |= (NS_DYING|NS_KILLED);
625   
626         TclTeardownNamespace(nsPtr);
627 
628         if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) {
629             /*
630        * If this is the global namespace, then it may have residual
631              * "errorInfo" and "errorCode" variables for errors that
632              * occurred while it was being torn down.  Try to clear the
633              * variable list one last time.
634        */
635 
636             TclDeleteNamespaceVars(nsPtr);
637       
638             Tcl_DeleteHashTable(&nsPtr->childTable);
639             Tcl_DeleteHashTable(&nsPtr->cmdTable);
640 
641             /*
642              * If the reference count is 0, then discard the namespace.
643              * Otherwise, mark it as "dead" so that it can't be used.
644              */
645 
646             if (nsPtr->refCount == 0) {
647                 NamespaceFree(nsPtr);
648             } else {
649                 nsPtr->flags |= NS_DEAD;
650             }
651         }
652     }
653 }
int Tcl_Export (Tcl_Interp * interp, Tcl_Namespace * namespacePtr, CONST char * pattern, int resetListFirst)

Definition at line 878 of file tclNamesp.c.
References ckfree, CONST, Namespace::exportArrayPtr, Namespace::maxExportPatterns, NULL, Namespace::numExportPatterns, TCL_ERROR, Tcl_GetCurrentNamespace(), Tcl_GetObjResult(), TCL_LEAVE_ERR_MSG, TCL_NAMESPACE_ONLY, TCL_OK, and TclGetNamespaceForQualName().
Referenced by NamespaceExportCmd().890 {
891 #define INIT_EXPORT_PATTERNS 5    
892     Namespace *nsPtr, *exportNsPtr, *dummyPtr;
893     Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
894     CONST char *simplePattern;
895     char *patternCpy;
896     int neededElems, len, i;
897 
898     /*
899      * If the specified namespace is NULL, use the current namespace.
900      */
901 
902     if (namespacePtr == NULL) {
903         nsPtr = (Namespace *) currNsPtr;
904     } else {
905         nsPtr = (Namespace *) namespacePtr;
906     }
907 
908     /*
909      * If resetListFirst is true (nonzero), clear the namespace's export
910      * pattern list.
911      */
912 
913     if (resetListFirst) {
914   if (nsPtr->exportArrayPtr != NULL) {
915       for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
916     ckfree(nsPtr->exportArrayPtr[i]);
917       }
918       ckfree((char *) nsPtr->exportArrayPtr);
919       nsPtr->exportArrayPtr = NULL;
920       nsPtr->numExportPatterns = 0;
921       nsPtr->maxExportPatterns = 0;
922   }
923     }
924 
925     /*
926      * Check that the pattern doesn't have namespace qualifiers.
927      */
928 
929     TclGetNamespaceForQualName(interp, pattern, nsPtr,
930       /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
931       &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
932 
933     if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
934   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
935           "invalid export pattern \"", pattern,
936     "\": pattern can't specify a namespace",
937     (char *) NULL);
938   return TCL_ERROR;
939     }
940 
941     /*
942      * Make sure that we don't already have the pattern in the array
943      */
944     if (nsPtr->exportArrayPtr != NULL) {
945   for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
946       if (strcmp(pattern, nsPtr->exportArrayPtr[i]) == 0) {
947     /*
948      * The pattern already exists in the list
949      */
950     return TCL_OK;
951       }
952   }
953     }
954 
955     /*
956      * Make sure there is room in the namespace's pattern array for the
957      * new pattern.
958      */
959 
960     neededElems = nsPtr->numExportPatterns + 1;
961     if (nsPtr->exportArrayPtr == NULL) {
962   nsPtr->exportArrayPtr = (char **)
963           ckalloc((unsigned) (INIT_EXPORT_PATTERNS * sizeof(char *)));
964   nsPtr->numExportPatterns = 0;
965   nsPtr->maxExportPatterns = INIT_EXPORT_PATTERNS;
966     } else if (neededElems > nsPtr->maxExportPatterns) {
967   int numNewElems = 2 * nsPtr->maxExportPatterns;
968   size_t currBytes = nsPtr->numExportPatterns * sizeof(char *);
969   size_t newBytes  = numNewElems * sizeof(char *);
970   char **newPtr = (char **) ckalloc((unsigned) newBytes);
971 
972   memcpy((VOID *) newPtr, (VOID *) nsPtr->exportArrayPtr,
973           currBytes);
974   ckfree((char *) nsPtr->exportArrayPtr);
975   nsPtr->exportArrayPtr = (char **) newPtr;
976   nsPtr->maxExportPatterns = numNewElems;
977     }
978 
979     /*
980      * Add the pattern to the namespace's array of export patterns.
981      */
982 
983     len = strlen(pattern);
984     patternCpy = (char *) ckalloc((unsigned) (len + 1));
985     strcpy(patternCpy, pattern);
986     
987     nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
988     nsPtr->numExportPatterns++;
989     return TCL_OK;
990 #undef INIT_EXPORT_PATTERNS
991 }
Tcl_Command Tcl_FindCommand (Tcl_Interp * interp, CONST char * name, Tcl_Namespace * contextNsPtr, int flags)

Definition at line 1961 of file tclNamesp.c.
References ResolverScheme::cmdResProc, Namespace::cmdResProc, CONST, ResolverScheme::nextPtr, NULL, Interp::resolverPtr, TCL_CONTINUE, Tcl_FindHashEntry, Tcl_GetCurrentNamespace(), Tcl_GetGlobalNamespace(), Tcl_GetHashValue, Tcl_GetObjResult(), TCL_GLOBAL_ONLY, TCL_LEAVE_ERR_MSG, TCL_OK, Tcl_ResetResult(), and TclGetNamespaceForQualName().
Referenced by HandleBgErrors(), ProcBodyTestProcObjCmd(), SetCmdNameFromAny(), Tcl_CommandTraceInfo(), Tcl_DeleteCommand(), Tcl_GetCommandInfo(), Tcl_HideCommand(), Tcl_Import(), Tcl_SetCommandInfo(), Tcl_TraceCommand(), Tcl_UntraceCommand(), TclCompileScript(), TclFindProc(), TclObjInvoke(), TclPreventAliasLoop(), TclRenameCommand(), TclTraceCommandObjCmd(), and TclTraceExecutionObjCmd().1973                                                                 :
1974           * TCL_GLOBAL_ONLY (look up name only in
1975           * global namespace), TCL_NAMESPACE_ONLY
1976           * (look up only in contextNsPtr, or the
1977           * current namespace if contextNsPtr is
1978           * NULL), and TCL_LEAVE_ERR_MSG. If both
1979           * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY
1980           * are given, TCL_GLOBAL_ONLY is
1981           * ignored. */
1982 {
1983     Interp *iPtr = (Interp*)interp;
1984 
1985     ResolverScheme *resPtr;
1986     Namespace *nsPtr[2], *cxtNsPtr;
1987     CONST char *simpleName;
1988     register Tcl_HashEntry *entryPtr;
1989     register Command *cmdPtr;
1990     register int search;
1991     int result;
1992     Tcl_Command cmd;
1993 
1994     /*
1995      * If this namespace has a command resolver, then give it first
1996      * crack at the command resolution.  If the interpreter has any
1997      * command resolvers, consult them next.  The command resolver
1998      * procedures may return a Tcl_Command value, they may signal
1999      * to continue onward, or they may signal an error.
2000      */
2001     if ((flags & TCL_GLOBAL_ONLY) != 0) {
2002         cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
2003     }
2004     else if (contextNsPtr != NULL) {
2005         cxtNsPtr = (Namespace *) contextNsPtr;
2006     }
2007     else {
2008         cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
2009     }
2010 
2011     if (cxtNsPtr->cmdResProc != NULL || iPtr->resolverPtr != NULL) {
2012         resPtr = iPtr->resolverPtr;
2013 
2014         if (cxtNsPtr->cmdResProc) {
2015             result = (*cxtNsPtr->cmdResProc)(interp, name,
2016                 (Tcl_Namespace *) cxtNsPtr, flags, &cmd);
2017         } else {
2018             result = TCL_CONTINUE;
2019         }
2020 
2021         while (result == TCL_CONTINUE && resPtr) {
2022             if (resPtr->cmdResProc) {
2023                 result = (*resPtr->cmdResProc)(interp, name,
2024                     (Tcl_Namespace *) cxtNsPtr, flags, &cmd);
2025             }
2026             resPtr = resPtr->nextPtr;
2027         }
2028 
2029         if (result == TCL_OK) {
2030             return cmd;
2031         }
2032         else if (result != TCL_CONTINUE) {
2033             return (Tcl_Command) NULL;
2034         }
2035     }
2036 
2037     /*
2038      * Find the namespace(s) that contain the command.
2039      */
2040 
2041     TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
2042       flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
2043 
2044     /*
2045      * Look for the command in the command table of its namespace.
2046      * Be sure to check both possible search paths: from the specified
2047      * namespace context and from the global namespace.
2048      */
2049 
2050     cmdPtr = NULL;
2051     for (search = 0;  (search < 2) && (cmdPtr == NULL);  search++) {
2052         if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
2053       entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable,
2054         simpleName);
2055       if (entryPtr != NULL) {
2056     cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
2057       }
2058   }
2059     }
2060 
2061     if (cmdPtr != NULL) {
2062         return (Tcl_Command) cmdPtr;
2063     } else if (flags & TCL_LEAVE_ERR_MSG) {
2064   Tcl_ResetResult(interp);
2065   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
2066                 "unknown command \"", name, "\"", (char *) NULL);
2067     }
2068 
2069     return (Tcl_Command) NULL;
2070 }

Tcl_Namespace* Tcl_FindNamespace (Tcl_Interp * interp, CONST char * name, Tcl_Namespace * contextNsPtr, int flags)

Definition at line 1902 of file tclNamesp.c.
References CONST, FIND_ONLY_NS, NULL, Tcl_GetObjResult(), TCL_LEAVE_ERR_MSG, Tcl_ResetResult(), and TclGetNamespaceForQualName().
Referenced by NamespaceDeleteCmd(), and TestgetvarfullnameCmd().1915                                                                 : an
1916           * OR'd combination of TCL_GLOBAL_ONLY and
1917           * TCL_LEAVE_ERR_MSG flags. */
1918 {
1919     Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
1920     CONST char *dummy;
1921 
1922     /*
1923      * Find the namespace(s) that contain the specified namespace name.
1924      * Add the FIND_ONLY_NS flag to resolve the name all the way down
1925      * to its last component, a namespace.
1926      */
1927 
1928     TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
1929       (flags | FIND_ONLY_NS), &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
1930     
1931     if (nsPtr != NULL) {
1932        return (Tcl_Namespace *) nsPtr;
1933     } else if (flags & TCL_LEAVE_ERR_MSG) {
1934   Tcl_ResetResult(interp);
1935   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1936                 "unknown namespace \"", name, "\"", (char *) NULL);
1937     }
1938     return NULL;
1939 }
Tcl_Var Tcl_FindNamespaceVar (Tcl_Interp * interp, CONST char * name, Tcl_Namespace * contextNsPtr, int flags)

Definition at line 2094 of file tclNamesp.c.
References CONST, ResolverScheme::nextPtr, NULL, Interp::resolverPtr, TCL_CONTINUE, Tcl_FindHashEntry, Tcl_GetCurrentNamespace(), Tcl_GetGlobalNamespace(), Tcl_GetHashValue, Tcl_GetObjResult(), TCL_GLOBAL_ONLY, TCL_LEAVE_ERR_MSG, TCL_OK, Tcl_ResetResult(), TclGetNamespaceForQualName(), varPtr, ResolverScheme::varResProc, and Namespace::varResProc.
Referenced by NamespaceWhichCmd(), TclLookupSimpleVar(), and TestgetvarfullnameCmd().2106                                                     :
2107           * TCL_GLOBAL_ONLY (look up name only in
2108           * global namespace), TCL_NAMESPACE_ONLY
2109           * (look up only in contextNsPtr, or the
2110           * current namespace if contextNsPtr is
2111           * NULL), and TCL_LEAVE_ERR_MSG. If both
2112           * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY
2113           * are given, TCL_GLOBAL_ONLY is
2114           * ignored. */
2115 {
2116     Interp *iPtr = (Interp*)interp;
2117     ResolverScheme *resPtr;
2118     Namespace *nsPtr[2], *cxtNsPtr;
2119     CONST char *simpleName;
2120     Tcl_HashEntry *entryPtr;
2121     Var *varPtr;
2122     register int search;
2123     int result;
2124     Tcl_Var var;
2125 
2126     /*
2127      * If this namespace has a variable resolver, then give it first
2128      * crack at the variable resolution.  It may return a Tcl_Var
2129      * value, it may signal to continue onward, or it may signal
2130      * an error.
2131      */
2132     if ((flags & TCL_GLOBAL_ONLY) != 0) {
2133         cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
2134     }
2135     else if (contextNsPtr != NULL) {
2136         cxtNsPtr = (Namespace *) contextNsPtr;
2137     }
2138     else {
2139         cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
2140     }
2141 
2142     if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
2143         resPtr = iPtr->resolverPtr;
2144 
2145         if (cxtNsPtr->varResProc) {
2146             result = (*cxtNsPtr->varResProc)(interp, name,
2147                 (Tcl_Namespace *) cxtNsPtr, flags, &var);
2148         } else {
2149             result = TCL_CONTINUE;
2150         }
2151 
2152         while (result == TCL_CONTINUE && resPtr) {
2153             if (resPtr->varResProc) {
2154                 result = (*resPtr->varResProc)(interp, name,
2155                     (Tcl_Namespace *) cxtNsPtr, flags, &var);
2156             }
2157             resPtr = resPtr->nextPtr;
2158         }
2159 
2160         if (result == TCL_OK) {
2161             return var;
2162         }
2163         else if (result != TCL_CONTINUE) {
2164             return (Tcl_Var) NULL;
2165         }
2166     }
2167 
2168     /*
2169      * Find the namespace(s) that contain the variable.
2170      */
2171 
2172     TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
2173       flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
2174 
2175     /*
2176      * Look for the variable in the variable table of its namespace.
2177      * Be sure to check both possible search paths: from the specified
2178      * namespace context and from the global namespace.
2179      */
2180 
2181     varPtr = NULL;
2182     for (search = 0;  (search < 2) && (varPtr == NULL);  search++) {
2183         if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
2184             entryPtr = Tcl_FindHashEntry(&nsPtr[search]->varTable,
2185         simpleName);
2186             if (entryPtr != NULL) {
2187                 varPtr = (Var *) Tcl_GetHashValue(entryPtr);
2188             }
2189         }
2190     }
2191     if (varPtr != NULL) {
2192   return (Tcl_Var) varPtr;
2193     } else if (flags & TCL_LEAVE_ERR_MSG) {
2194   Tcl_ResetResult(interp);
2195   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
2196                 "unknown variable \"", name, "\"", (char *) NULL);
2197     }
2198     return (Tcl_Var) NULL;
2199 }

int Tcl_ForgetImport (Tcl_Interp * interp, Tcl_Namespace * namespacePtr, CONST char * pattern)

Definition at line 1333 of file tclNamesp.c.
References Namespace::cmdTable, CONST, DeleteImportedCmd(), Command::deleteProc, Tcl_CmdInfo::namespacePtr, NULL, Command::objClientData, ImportedCmdData::realCmdPtr, Tcl_DeleteCommandFromToken(), TCL_ERROR, Tcl_FirstHashEntry(), Tcl_GetCommandInfoFromToken(), Tcl_GetCommandName(), Tcl_GetCurrentNamespace(), Tcl_GetHashKey, Tcl_GetHashValue, Tcl_GetObjResult(), TCL_LEAVE_ERR_MSG, TCL_NAMESPACE_ONLY, Tcl_NextHashEntry(), TCL_OK, Tcl_StringMatch(), TclGetNamespaceForQualName(), and TclGetOriginalCommand().
Referenced by NamespaceForgetCmd().1340 {
1341     Namespace *nsPtr, *sourceNsPtr, *dummyPtr;
1342     CONST char *simplePattern;
1343     char *cmdName;
1344     register Tcl_HashEntry *hPtr;
1345     Tcl_HashSearch search;
1346 
1347     /*
1348      * If the specified namespace is NULL, use the current namespace.
1349      */
1350 
1351     if (namespacePtr == NULL) {
1352         nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
1353     } else {
1354         nsPtr = (Namespace *) namespacePtr;
1355     }
1356 
1357     /*
1358      * Parse the pattern into its namespace-qualification (if any)
1359      * and the simple pattern.
1360      */
1361 
1362     TclGetNamespaceForQualName(interp, pattern, nsPtr,
1363       /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
1364       &sourceNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
1365 
1366     if (sourceNsPtr == NULL) {
1367         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1368     "unknown namespace in namespace forget pattern \"",
1369     pattern, "\"", (char *) NULL);
1370         return TCL_ERROR;
1371     }
1372 
1373     if (strcmp(pattern, simplePattern) == 0) {
1374   /*
1375    * The pattern is simple.
1376    * Delete any imported commands that match it.
1377    */
1378 
1379   for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
1380     (hPtr != NULL);
1381     hPtr = Tcl_NextHashEntry(&search)) {
1382       Command *cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
1383       if (cmdPtr->deleteProc != DeleteImportedCmd) {
1384     continue;
1385       }
1386       cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, hPtr);
1387       if (Tcl_StringMatch(cmdName, simplePattern)) {
1388     Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
1389       }
1390   }
1391   return TCL_OK;
1392     }
1393 
1394     /* The pattern was namespace-qualified */
1395 
1396     for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); (hPtr != NULL);
1397       hPtr = Tcl_NextHashEntry(&search)) {
1398   Tcl_CmdInfo info;
1399   Tcl_Command token = (Tcl_Command) Tcl_GetHashValue(hPtr);
1400   Tcl_Command origin = TclGetOriginalCommand(token);
1401 
1402   if (Tcl_GetCommandInfoFromToken(origin, &info) == 0) {
1403       continue; /* Not an imported command */
1404   }
1405   if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) {
1406       /*
1407        * Original not in namespace we're matching.
1408        * Check the first link in the import chain.
1409        */
1410       Command *cmdPtr = (Command *) token;
1411       ImportedCmdData *dataPtr =
1412         (ImportedCmdData *) cmdPtr->objClientData;
1413       Tcl_Command firstToken = (Tcl_Command) dataPtr->realCmdPtr;
1414       if (firstToken == origin) {
1415     continue;
1416       }
1417       Tcl_GetCommandInfoFromToken(firstToken, &info);
1418       if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) {
1419     continue;
1420       }
1421       origin = firstToken;
1422   }
1423   if (Tcl_StringMatch(Tcl_GetCommandName(NULL, origin), simplePattern)) {
1424       Tcl_DeleteCommandFromToken(interp, token);
1425   }
1426     }
1427     return TCL_OK;
1428 }
Tcl_Namespace* Tcl_GetCurrentNamespace (Tcl_Interp * interp)

Definition at line 199 of file tclNamesp.c.
References Interp::globalNsPtr, CallFrame::nsPtr, NULL, and Interp::varFramePtr.
Referenced by GetNamespaceFromObj(), InfoCommandsCmd(), InfoProcsCmd(), InfoVarsCmd(), NamespaceChildrenCmd(), NamespaceCodeCmd(), NamespaceCurrentCmd(), NamespaceExportCmd(), NamespaceParentCmd(), SetNsNameFromAny(), Tcl_AppendExportList(), Tcl_Export(), Tcl_FindCommand(), Tcl_FindNamespaceVar(), Tcl_ForgetImport(), Tcl_Import(), Tcl_PushCallFrame(), TclDeleteNamespaceVars(), and TclDeleteVars().202 {
203     register Interp *iPtr = (Interp *) interp;
204     register Namespace *nsPtr;
205 
206     if (iPtr->varFramePtr != NULL) {
207         nsPtr = iPtr->varFramePtr->nsPtr;
208     } else {
209         nsPtr = iPtr->globalNsPtr;
210     }
211     return (Tcl_Namespace *) nsPtr;
212 }
Tcl_Namespace* Tcl_GetGlobalNamespace (Tcl_Interp * interp)

Definition at line 231 of file tclNamesp.c.
References Interp::globalNsPtr.
Referenced by InfoCommandsCmd(), InfoGlobalsCmd(), InfoProcsCmd(), InfoVarsCmd(), NamespaceChildrenCmd(), NamespaceCodeCmd(), NamespaceCurrentCmd(), Tcl_DeleteNamespace(), Tcl_FindCommand(), Tcl_FindNamespaceVar(), TclPreventAliasLoop(), TclResetShadowedCmdRefs(), and TclTeardownNamespace().234 {
235     register Interp *iPtr = (Interp *) interp;
236     
237     return (Tcl_Namespace *) iPtr->globalNsPtr;
238 }
int Tcl_Import (Tcl_Interp * interp, Tcl_Namespace * namespacePtr, CONST char * pattern, int allowOverwrite)

Definition at line 1077 of file tclNamesp.c.
References ckalloc, Namespace::cmdTable, Command::compileProc, CONST, DeleteImportedCmd(), Command::deleteProc, Namespace::exportArrayPtr, Namespace::fullName, Interp::globalNsPtr, ImportRef::importedCmdPtr, Command::importRefPtr, InvokeImportedCmd(), Namespace::name, ImportRef::nextPtr, NULL, Namespace::numExportPatterns, Command::objClientData, Command::objProc, ImportedCmdData::realCmdPtr, Tcl_CreateObjCommand(), Tcl_DecrRefCount, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, TCL_ERROR, Tcl_FindCommand(), Tcl_FindHashEntry, Tcl_FirstHashEntry(), Tcl_GetCurrentNamespace(), Tcl_GetHashKey, Tcl_GetHashValue, Tcl_GetObjResult(), TCL_GLOBAL_ONLY, Tcl_IncrRefCount, TCL_LEAVE_ERR_MSG, TCL_NAMESPACE_ONLY, Tcl_NewStringObj(), Tcl_NextHashEntry(), TCL_OK, Tcl_ResetResult(), Tcl_SetStringObj(), Tcl_StringMatch(), and TclGetNamespaceForQualName().
Referenced by NamespaceImportCmd().1090 {
1091     Interp *iPtr = (Interp *) interp;
1092     Namespace *nsPtr, *importNsPtr, *dummyPtr;
1093     Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
1094     CONST char *simplePattern;
1095     char *cmdName;
1096     register Tcl_HashEntry *hPtr;
1097     Tcl_HashSearch search;
1098     Command *cmdPtr;
1099     ImportRef *refPtr;
1100     Tcl_Command autoCmd, importedCmd;
1101     ImportedCmdData *dataPtr;
1102     int wasExported, i, result;
1103 
1104     /*
1105      * If the specified namespace is NULL, use the current namespace.
1106      */
1107 
1108     if (namespacePtr == NULL) {
1109         nsPtr = (Namespace *) currNsPtr;
1110     } else {
1111         nsPtr = (Namespace *) namespacePtr;
1112     }
1113  
1114     /*
1115      * First, invoke the "auto_import" command with the pattern
1116      * being imported.  This command is part of the Tcl library.
1117      * It looks for imported commands in autoloaded libraries and
1118      * loads them in.  That way, they will be found when we try
1119      * to create links below.
1120      */
1121     
1122     autoCmd = Tcl_FindCommand(interp, "auto_import",
1123       (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
1124  
1125     if (autoCmd != NULL) {
1126   Tcl_Obj *objv[2];
1127  
1128   objv[0] = Tcl_NewStringObj("auto_import", -1);
1129   Tcl_IncrRefCount(objv[0]);
1130   objv[1] = Tcl_NewStringObj(pattern, -1);
1131   Tcl_IncrRefCount(objv[1]);
1132  
1133   cmdPtr = (Command *) autoCmd;
1134   result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
1135     2, objv);
1136  
1137   Tcl_DecrRefCount(objv[0]);
1138   Tcl_DecrRefCount(objv[1]);
1139  
1140   if (result != TCL_OK) {
1141       return TCL_ERROR;
1142   }
1143   Tcl_ResetResult(interp);
1144     }
1145 
1146     /*
1147      * From the pattern, find the namespace from which we are importing
1148      * and get the simple pattern (no namespace qualifiers or ::'s) at
1149      * the end.
1150      */
1151 
1152     if (strlen(pattern) == 0) {
1153   Tcl_SetStringObj(Tcl_GetObjResult(interp),
1154           "empty import pattern", -1);
1155         return TCL_ERROR;
1156     }
1157     TclGetNamespaceForQualName(interp, pattern, nsPtr,
1158       /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
1159       &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
1160 
1161     if (importNsPtr == NULL) {
1162   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1163     "unknown namespace in import pattern \"",
1164     pattern, "\"", (char *) NULL);
1165         return TCL_ERROR;
1166     }
1167     if (importNsPtr == nsPtr) {
1168   if (pattern == simplePattern) {
1169       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1170         "no namespace specified in import pattern \"", pattern,
1171         "\"", (char *) NULL);
1172   } else {
1173       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1174         "import pattern \"", pattern,
1175         "\" tries to import from namespace \"",
1176         importNsPtr->name, "\" into itself", (char *) NULL);
1177   }
1178         return TCL_ERROR;
1179     }
1180 
1181     /*
1182      * Scan through the command table in the source namespace and look for
1183      * exported commands that match the string pattern. Create an "imported
1184      * command" in the current namespace for each imported command; these
1185      * commands redirect their invocations to the "real" command.
1186      */
1187 
1188     for (hPtr = Tcl_FirstHashEntry(&importNsPtr->cmdTable, &search);
1189       (hPtr != NULL);
1190       hPtr = Tcl_NextHashEntry(&search)) {
1191         cmdName = Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr);
1192         if (Tcl_StringMatch(cmdName, simplePattern)) {
1193       /*
1194        * The command cmdName in the source namespace matches the
1195        * pattern. Check whether it was exported. If it wasn't,
1196        * we ignore it.
1197        */
1198       Tcl_HashEntry *found;
1199 
1200       wasExported = 0;
1201       for (i = 0;  i < importNsPtr->numExportPatterns;  i++) {
1202     if (Tcl_StringMatch(cmdName,
1203       importNsPtr->exportArrayPtr[i])) {
1204         wasExported = 1;
1205         break;
1206     }
1207       }
1208       if (!wasExported) {
1209     continue;
1210             }
1211 
1212       /*
1213        * Unless there is a name clash, create an imported command
1214        * in the current namespace that refers to cmdPtr.
1215        */
1216 
1217       found = Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName);
1218       if ((found == NULL) || allowOverwrite) {
1219     /*
1220      * Create the imported command and its client data.
1221      * To create the new command in the current namespace, 
1222      * generate a fully qualified name for it.
1223      */
1224 
1225     Tcl_DString ds;
1226 
1227     Tcl_DStringInit(&ds);
1228     Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
1229     if (nsPtr != iPtr->globalNsPtr) {
1230         Tcl_DStringAppend(&ds, "::", 2);
1231     }
1232     Tcl_DStringAppend(&ds, cmdName, -1);
1233 
1234     /*
1235      * Check whether creating the new imported command in the
1236      * current namespace would create a cycle of imported
1237      * command references.
1238      */
1239 
1240     cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
1241     if ((found != NULL)
1242       && cmdPtr->deleteProc == DeleteImportedCmd) {
1243 
1244         Command *overwrite = (Command *) Tcl_GetHashValue(found);
1245         Command *link = cmdPtr;
1246         while (link->deleteProc == DeleteImportedCmd) {
1247       ImportedCmdData *dataPtr;
1248            
1249       dataPtr = (ImportedCmdData *) link->objClientData;
1250       link = dataPtr->realCmdPtr;
1251       if (overwrite == link) {
1252           Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1253             "import pattern \"", pattern,
1254             "\" would create a loop containing ",
1255             "command \"", Tcl_DStringValue(&ds),
1256             "\"", (char *) NULL);
1257           Tcl_DStringFree(&ds);
1258           return TCL_ERROR;
1259       }
1260         }
1261     }
1262 
1263     dataPtr = (ImportedCmdData *)
1264             ckalloc(sizeof(ImportedCmdData));
1265                 importedCmd = Tcl_CreateObjCommand(interp, 
1266                         Tcl_DStringValue(&ds), InvokeImportedCmd,
1267                         (ClientData) dataPtr, DeleteImportedCmd);
1268     dataPtr->realCmdPtr = cmdPtr;
1269     dataPtr->selfPtr = (Command *) importedCmd;
1270     dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
1271     Tcl_DStringFree(&ds);
1272 
1273     /*
1274      * Create an ImportRef structure describing this new import
1275      * command and add it to the import ref list in the "real"
1276      * command.
1277      */
1278 
1279                 refPtr = (ImportRef *) ckalloc(sizeof(ImportRef));
1280                 refPtr->importedCmdPtr = (Command *) importedCmd;
1281                 refPtr->nextPtr = cmdPtr->importRefPtr;
1282                 cmdPtr->importRefPtr = refPtr;
1283             } else {
1284     Command *overwrite = (Command *) Tcl_GetHashValue(found);
1285     if (overwrite->deleteProc == DeleteImportedCmd) {
1286         ImportedCmdData *dataPtr =
1287           (ImportedCmdData *) overwrite->objClientData;
1288         if (dataPtr->realCmdPtr
1289           == (Command *) Tcl_GetHashValue(hPtr)) {
1290       /* Repeated import of same command -- acceptable */
1291       return TCL_OK;
1292         }
1293     }
1294     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1295             "can't import command \"", cmdName,
1296       "\": already exists", (char *) NULL);
1297                 return TCL_ERROR;
1298             }
1299         }
1300     }
1301     return TCL_OK;
1302 }
int Tcl_NamespaceObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv)

Definition at line 2504 of file tclNamesp.c.
References CONST, NamespaceChildrenCmd(), NamespaceCodeCmd(), NamespaceCurrentCmd(), NamespaceDeleteCmd(), NamespaceEvalCmd(), NamespaceExistsCmd(), NamespaceExportCmd(), NamespaceForgetCmd(), NamespaceImportCmd(), NamespaceInscopeCmd(), NamespaceOriginCmd(), NamespaceParentCmd(), NamespaceQualifiersCmd(), NamespaceTailCmd(), NamespaceWhichCmd(), NULL, TCL_ERROR, Tcl_GetIndexFromObj(), TCL_OK, and Tcl_WrongNumArgs().2509 {
2510     static CONST char *subCmds[] = {
2511   "children", "code", "current", "delete",
2512   "eval", "exists", "export", "forget", "import",
2513   "inscope", "origin", "parent", "qualifiers",
2514   "tail", "which", (char *) NULL
2515     };
2516     enum NSSubCmdIdx {
2517   NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx,
2518   NSEvalIdx, NSExistsIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
2519   NSInscopeIdx, NSOriginIdx, NSParentIdx, NSQualifiersIdx,
2520   NSTailIdx, NSWhichIdx
2521     };
2522     int index, result;
2523 
2524     if (objc < 2) {
2525         Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
2526         return TCL_ERROR;
2527     }
2528 
2529     /*
2530      * Return an index reflecting the particular subcommand.
2531      */
2532 
2533     result = Tcl_GetIndexFromObj((Tcl_Interp *) interp, objv[1], subCmds,
2534       "option", /*flags*/ 0, (int *) &index);
2535     if (result != TCL_OK) {
2536   return result;
2537     }
2538     
2539     switch (index) {
2540         case NSChildrenIdx:
2541       result = NamespaceChildrenCmd(clientData, interp, objc, objv);
2542             break;
2543         case NSCodeIdx:
2544       result = NamespaceCodeCmd(clientData, interp, objc, objv);
2545             break;
2546         case NSCurrentIdx:
2547       result = NamespaceCurrentCmd(clientData, interp, objc, objv);
2548             break;
2549         case NSDeleteIdx:
2550       result = NamespaceDeleteCmd(clientData, interp, objc, objv);
2551             break;
2552         case NSEvalIdx:
2553       result = NamespaceEvalCmd(clientData, interp, objc, objv);
2554             break;
2555         case NSExistsIdx:
2556       result = NamespaceExistsCmd(clientData, interp, objc, objv);
2557             break;
2558         case NSExportIdx:
2559       result = NamespaceExportCmd(clientData, interp, objc, objv);
2560             break;
2561         case NSForgetIdx:
2562       result = NamespaceForgetCmd(clientData, interp, objc, objv);
2563             break;
2564         case NSImportIdx:
2565       result = NamespaceImportCmd(clientData, interp, objc, objv);
2566             break;
2567         case NSInscopeIdx:
2568       result = NamespaceInscopeCmd(clientData, interp, objc, objv);
2569             break;
2570         case NSOriginIdx:
2571       result = NamespaceOriginCmd(clientData, interp, objc, objv);
2572             break;
2573         case NSParentIdx:
2574       result = NamespaceParentCmd(clientData, interp, objc, objv);
2575             break;
2576         case NSQualifiersIdx:
2577       result = NamespaceQualifiersCmd(clientData, interp, objc, objv);
2578             break;
2579         case NSTailIdx:
2580       result = NamespaceTailCmd(clientData, interp, objc, objv);
2581             break;
2582         case NSWhichIdx:
2583       result = NamespaceWhichCmd(clientData, interp, objc, objv);
2584             break;
2585     }
2586     return result;
2587 }
void Tcl_PopCallFrame (Tcl_Interp* interp)

Definition at line 349 of file tclNamesp.c.
References Namespace::activationCount, CallFrame::callerPtr, CallFrame::callerVarPtr, ckfree, Namespace::flags, Interp::framePtr, NS_DYING, CallFrame::nsPtr, NULL, CallFrame::numCompiledLocals, Tcl_DeleteNamespace(), TclDeleteCompiledLocalVars(), TclDeleteVars(), Interp::varFramePtr, and CallFrame::varTablePtr.
Referenced by NamespaceEvalCmd(), NamespaceInscopeCmd(), TclGetNamespaceForQualName(), and TestgetvarfullnameCmd().351 {
352     register Interp *iPtr = (Interp *) interp;
353     register CallFrame *framePtr = iPtr->framePtr;
354     Namespace *nsPtr;
355 
356     /*
357      * It's important to remove the call frame from the interpreter's stack
358      * of call frames before deleting local variables, so that traces
359      * invoked by the variable deletion don't see the partially-deleted
360      * frame.
361      */
362 
363     iPtr->framePtr = framePtr->callerPtr;
364     iPtr->varFramePtr = framePtr->callerVarPtr;
365 
366     if (framePtr->varTablePtr != NULL) {
367         TclDeleteVars(iPtr, framePtr->varTablePtr);
368         ckfree((char *) framePtr->varTablePtr);
369         framePtr->varTablePtr = NULL;
370     }
371     if (framePtr->numCompiledLocals > 0) {
372         TclDeleteCompiledLocalVars(iPtr, framePtr);
373     }
374 
375     /*
376      * Decrement the namespace's count of active call frames. If the
377      * namespace is "dying" and there are no more active call frames,
378      * call Tcl_DeleteNamespace to destroy it.
379      */
380 
381     nsPtr = framePtr->nsPtr;
382     nsPtr->activationCount--;
383     if ((nsPtr->flags & NS_DYING)
384       && (nsPtr->activationCount == 0)) {
385         Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
386     }
387     framePtr->nsPtr = NULL;
388 }
int Tcl_PushCallFrame (Tcl_Interp * interp, Tcl_CallFrame * callFramePtr, Tcl_Namespace * namespacePtr, int isProcCallFrame)

Definition at line 260 of file tclNamesp.c.
References Namespace::activationCount, CallFrame::callerPtr, CallFrame::callerVarPtr, CallFrame::compiledLocals, Namespace::flags, Interp::framePtr, CallFrame::isProcCallFrame, CallFrame::level, NS_DEAD, CallFrame::nsPtr, NULL, CallFrame::numCompiledLocals, CallFrame::objc, CallFrame::objv, panic, CallFrame::procPtr, Tcl_GetCurrentNamespace(), TCL_OK, Interp::varFramePtr, and CallFrame::varTablePtr.
Referenced by NamespaceEvalCmd(), NamespaceInscopeCmd(), TclGetNamespaceForQualName(), TclObjInterpProc(), and TestgetvarfullnameCmd().286 {
287     Interp *iPtr = (Interp *) interp;
288     register CallFrame *framePtr = (CallFrame *) callFramePtr;
289     register Namespace *nsPtr;
290 
291     if (namespacePtr == NULL) {
292   nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
293     } else {
294         nsPtr = (Namespace *) namespacePtr;
295         if (nsPtr->flags & NS_DEAD) {
296       panic("Trying to push call frame for dead namespace");
297       /*NOTREACHED*/
298         }
299     }
300 
301     nsPtr->activationCount++;
302     framePtr->nsPtr = nsPtr;
303     framePtr->isProcCallFrame = isProcCallFrame;
304     framePtr->objc = 0;
305     framePtr->objv = NULL;
306     framePtr->callerPtr = iPtr->framePtr;
307     framePtr->callerVarPtr = iPtr->varFramePtr;
308     if (iPtr->varFramePtr != NULL) {
309         framePtr->level = (iPtr->varFramePtr->level + 1);
310     } else {
311         framePtr->level = 1;
312     }
313     framePtr->procPtr = NULL;      /* no called procedure */
314     framePtr->varTablePtr = NULL;  /* and no local variables */
315     framePtr->numCompiledLocals = 0;
316     framePtr->compiledLocals = NULL;
317 
318     /*
319      * Push the new call frame onto the interpreter's stack of procedure
320      * call frames making it the current frame.
321      */
322 
323     iPtr->framePtr = framePtr;
324     iPtr->varFramePtr = framePtr;
325     return TCL_OK;
326 }
int TclGetNamespaceForQualName (Tcl_Interp * interp, CONST char * qualName, Namespace * cxtNsPtr, int flags, Namespace ** nsPtrPtr, Namespace ** altNsPtrPtr, Namespace ** actualCxtPtrPtr, CONST char ** simpleNamePtr)

Definition at line 1640 of file tclNamesp.c.
References Namespace::childTable, CONST, CREATE_NS_IF_UNKNOWN, FIND_ONLY_NS, Interp::globalNsPtr, CallFrame::nsPtr, NULL, panic, Tcl_CreateNamespace(), Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringSetLength(), Tcl_DStringValue, Tcl_FindHashEntry, Tcl_GetHashValue, TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, TCL_OK, Tcl_PopCallFrame(), Tcl_PushCallFrame(), Interp::varFramePtr, and void().
Referenced by InfoCommandsCmd(), InfoProcsCmd(), InfoVarsCmd(), SetNsNameFromAny(), Tcl_CreateCommand(), Tcl_CreateNamespace(), Tcl_CreateObjCommand(), Tcl_Export(), Tcl_FindCommand(), Tcl_FindNamespace(), Tcl_FindNamespaceVar(), Tcl_ForgetImport(), Tcl_Import(), Tcl_ProcObjCmd(), TclLookupSimpleVar(), and TclRenameCommand().1650                                                     : an OR'd
1651           * combination of TCL_GLOBAL_ONLY,
1652           * TCL_NAMESPACE_ONLY,
1653           * CREATE_NS_IF_UNKNOWN, and
1654           * FIND_ONLY_NS. */
1655     Namespace **nsPtrPtr;  /* Address where procedure stores a pointer
1656           * to containing namespace if qualName is
1657           * found starting from *cxtNsPtr or, if
1658           * TCL_GLOBAL_ONLY is set, if qualName is
1659           * found in the global :: namespace. NULL
1660           * is stored otherwise. */
1661     Namespace **altNsPtrPtr;   /* Address where procedure stores a pointer
1662           * to containing namespace if qualName is
1663           * found starting from the global ::
1664           * namespace. NULL is stored if qualName
1665           * isn't found starting from :: or if the
1666           * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
1667           * CREATE_NS_IF_UNKNOWN, FIND_ONLY_NS flag
1668           * is set. */
1669     Namespace **actualCxtPtrPtr; /* Address where procedure stores a pointer
1670           * to the actual namespace from which the
1671           * search started. This is either cxtNsPtr,
1672           * the :: namespace if TCL_GLOBAL_ONLY was
1673           * specified, or the current namespace if
1674           * cxtNsPtr was NULL. */
1675     CONST char **simpleNamePtr;  /* Address where procedure stores the
1676           * simple name at end of the qualName, or
1677           * NULL if qualName is "::" or the flag
1678           * FIND_ONLY_NS was specified. */
1679 {
1680     Interp *iPtr = (Interp *) interp;
1681     Namespace *nsPtr = cxtNsPtr;
1682     Namespace *altNsPtr;
1683     Namespace *globalNsPtr = iPtr->globalNsPtr;
1684     CONST char *start, *end;
1685     CONST char *nsName;
1686     Tcl_HashEntry *entryPtr;
1687     Tcl_DString buffer;
1688     int len;
1689 
1690     /*
1691      * Determine the context namespace nsPtr in which to start the primary
1692      * search.  If the qualName name starts with a "::" or TCL_GLOBAL_ONLY
1693      * was specified, search from the global namespace. Otherwise, use the
1694      * namespace given in cxtNsPtr, or if that is NULL, use the current
1695      * namespace context. Note that we always treat two or more
1696      * adjacent ":"s as a namespace separator.
1697      */
1698 
1699     if (flags & TCL_GLOBAL_ONLY) {
1700   nsPtr = globalNsPtr;
1701     } else if (nsPtr == NULL) {
1702   if (iPtr->varFramePtr != NULL) {
1703       nsPtr = iPtr->varFramePtr->nsPtr;
1704   } else {
1705       nsPtr = iPtr->globalNsPtr;
1706   }
1707     }
1708 
1709     start = qualName;   /* pts to start of qualifying namespace */
1710     if ((*qualName == ':') && (*(qualName+1) == ':')) {
1711   start = qualName+2; /* skip over the initial :: */
1712   while (*start == ':') {
1713             start++;    /* skip over a subsequent : */
1714   }
1715         nsPtr = globalNsPtr;
1716         if (*start == '\0') { /* qualName is just two or more ":"s */
1717             *nsPtrPtr        = globalNsPtr;
1718             *altNsPtrPtr     = NULL;
1719       *actualCxtPtrPtr = globalNsPtr;
1720             *simpleNamePtr   = start; /* points to empty string */
1721             return TCL_OK;
1722         }
1723     }
1724     *actualCxtPtrPtr = nsPtr;
1725 
1726     /*
1727      * Start an alternate search path starting with the global namespace.
1728      * However, if the starting context is the global namespace, or if the
1729      * flag is set to search only the namespace *cxtNsPtr, ignore the
1730      * alternate search path.
1731      */
1732 
1733     altNsPtr = globalNsPtr;
1734     if ((nsPtr == globalNsPtr)
1735       || (flags & (TCL_NAMESPACE_ONLY | FIND_ONLY_NS))) {
1736         altNsPtr = NULL;
1737     }
1738 
1739     /*
1740      * Loop to resolve each namespace qualifier in qualName.
1741      */
1742 
1743     Tcl_DStringInit(&buffer);
1744     end = start;
1745     while (*start != '\0') {
1746         /*
1747          * Find the next namespace qualifier (i.e., a name ending in "::")
1748    * or the end of the qualified name  (i.e., a name ending in "\0").
1749    * Set len to the number of characters, starting from start,
1750    * in the name; set end to point after the "::"s or at the "\0".
1751          */
1752 
1753   len = 0;
1754         for (end = start;  *end != '\0';  end++) {
1755       if ((*end == ':') && (*(end+1) == ':')) {
1756     end += 2; /* skip over the initial :: */
1757     while (*end == ':') {
1758         end++;  /* skip over the subsequent : */
1759     }
1760     break;    /* exit for loop; end is after ::'s */
1761       }
1762             len++;
1763   }
1764 
1765   if ((*end == '\0')
1766           && !((end-start >= 2) && (*(end-1) == ':') && (*(end-2) == ':'))) {
1767       /*
1768        * qualName ended with a simple name at start. If FIND_ONLY_NS
1769        * was specified, look this up as a namespace. Otherwise,
1770        * start is the name of a cmd or var and we are done.
1771        */
1772       
1773       if (flags & FIND_ONLY_NS) {
1774     nsName = start;
1775       } else {
1776     *nsPtrPtr      = nsPtr;
1777     *altNsPtrPtr   = altNsPtr;
1778     *simpleNamePtr = start;
1779     Tcl_DStringFree(&buffer);
1780     return TCL_OK;
1781       }
1782   } else {
1783       /*
1784        * start points to the beginning of a namespace qualifier ending
1785        * in "::". end points to the start of a name in that namespace
1786        * that might be empty. Copy the namespace qualifier to a
1787        * buffer so it can be null terminated. We can't modify the
1788        * incoming qualName since it may be a string constant.
1789        */
1790 
1791       Tcl_DStringSetLength(&buffer, 0);
1792             Tcl_DStringAppend(&buffer, start, len);
1793             nsName = Tcl_DStringValue(&buffer);
1794         }
1795 
1796         /*
1797    * Look up the namespace qualifier nsName in the current namespace
1798          * context. If it isn't found but CREATE_NS_IF_UNKNOWN is set,
1799          * create that qualifying namespace. This is needed for procedures
1800          * like Tcl_CreateCommand that cannot fail.
1801    */
1802 
1803         if (nsPtr != NULL) {
1804             entryPtr = Tcl_FindHashEntry(&nsPtr->childTable, nsName);
1805             if (entryPtr != NULL) {
1806                 nsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
1807             } else if (flags & CREATE_NS_IF_UNKNOWN) {
1808     Tcl_CallFrame frame;
1809     
1810     (void) Tcl_PushCallFrame(interp, &frame,
1811             (Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0);
1812 
1813                 nsPtr = (Namespace *) Tcl_CreateNamespace(interp, nsName,
1814             (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL);
1815                 Tcl_PopCallFrame(interp);
1816 
1817                 if (nsPtr == NULL) {
1818                     panic("Could not create namespace '%s'", nsName);
1819                 }
1820             } else {    /* namespace not found and wasn't created */
1821                 nsPtr = NULL;
1822             }
1823         }
1824 
1825         /*
1826          * Look up the namespace qualifier in the alternate search path too.
1827          */
1828 
1829         if (altNsPtr != NULL) {
1830             entryPtr = Tcl_FindHashEntry(&altNsPtr->childTable, nsName);
1831             if (entryPtr != NULL) {
1832                 altNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
1833             } else {
1834                 altNsPtr = NULL;
1835             }
1836         }
1837 
1838         /*
1839          * If both search paths have failed, return NULL results.
1840          */
1841 
1842         if ((nsPtr == NULL) && (altNsPtr == NULL)) {
1843             *nsPtrPtr      = NULL;
1844             *altNsPtrPtr   = NULL;
1845             *simpleNamePtr = NULL;
1846             Tcl_DStringFree(&buffer);
1847             return TCL_OK;
1848         }
1849 
1850   start = end;
1851     }
1852 
1853     /*
1854      * We ignore trailing "::"s in a namespace name, but in a command or
1855      * variable name, trailing "::"s refer to the cmd or var named {}.
1856      */
1857 
1858     if ((flags & FIND_ONLY_NS)
1859       || ((end > start ) && (*(end-1) != ':'))) {
1860   *simpleNamePtr = NULL; /* found namespace name */
1861     } else {
1862   *simpleNamePtr = end;  /* found cmd/var: points to empty string */
1863     }
1864 
1865     /*
1866      * As a special case, if we are looking for a namespace and qualName
1867      * is "" and the current active namespace (nsPtr) is not the global
1868      * namespace, return NULL (no namespace was found). This is because
1869      * namespaces can not have empty names except for the global namespace.
1870      */
1871 
1872     if ((flags & FIND_ONLY_NS) && (*qualName == '\0')
1873       && (nsPtr != globalNsPtr)) {
1874   nsPtr = NULL;
1875     }
1876 
1877     *nsPtrPtr    = nsPtr;
1878     *altNsPtrPtr = altNsPtr;
1879     Tcl_DStringFree(&buffer);
1880     return TCL_OK;
1881 }
Tcl_Command TclGetOriginalCommand (Tcl_Command command)

Definition at line 1454 of file tclNamesp.c.
References DeleteImportedCmd(), Command::deleteProc, NULL, Command::objClientData, and ImportedCmdData::realCmdPtr.
Referenced by InfoProcsCmd(), NamespaceOriginCmd(), Tcl_ForgetImport(), TclFindProc(), and TclIsProc().1457 {
1458     register Command *cmdPtr = (Command *) command;
1459     ImportedCmdData *dataPtr;
1460 
1461     if (cmdPtr->deleteProc != DeleteImportedCmd) {
1462   return (Tcl_Command) NULL;
1463     }
1464     
1465     while (cmdPtr->deleteProc == DeleteImportedCmd) {
1466   dataPtr = (ImportedCmdData *) cmdPtr->objClientData;
1467   cmdPtr = dataPtr->realCmdPtr;
1468     }
1469     return (Tcl_Command) cmdPtr;
1470 }
void TclInitNamespaceSubsystem ()

Definition at line 175 of file tclNamesp.c.
Referenced by TclInitSubsystems().176 {
177     /*
178      * Does nothing for now.
179      */
180 }
void TclResetShadowedCmdRefs (Tcl_Interp * interp, Command * newCmdPtr)

Definition at line 2234 of file tclNamesp.c.
References Namespace::childTable, ckalloc, ckfree, Namespace::cmdRefEpoch, Namespace::cmdTable, Command::hPtr, Namespace::name, Command::nsPtr, NULL, NUM_TRAIL_ELEMS, Namespace::parentPtr, Namespace::resolverEpoch, size_t(), Tcl_HashEntry::tablePtr, Tcl_FindHashEntry, Tcl_GetGlobalNamespace(), Tcl_GetHashKey, and Tcl_GetHashValue.
Referenced by Tcl_CreateCommand(), Tcl_CreateObjCommand(), and TclRenameCommand().2237 {
2238     char *cmdName;
2239     Tcl_HashEntry *hPtr;
2240     register Namespace *nsPtr;
2241     Namespace *trailNsPtr, *shadowNsPtr;
2242     Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
2243     int found, i;
2244 
2245     /*
2246      * This procedure generates an array used to hold the trail list. This
2247      * starts out with stack-allocated space but uses dynamically-allocated
2248      * storage if needed.
2249      */
2250 
2251     Namespace *(trailStorage[NUM_TRAIL_ELEMS]);
2252     Namespace **trailPtr = trailStorage;
2253     int trailFront = -1;
2254     int trailSize = NUM_TRAIL_ELEMS;
2255 
2256     /*
2257      * Start at the namespace containing the new command, and work up
2258      * through the list of parents. Stop just before the global namespace,
2259      * since the global namespace can't "shadow" its own entries.
2260      *
2261      * The namespace "trail" list we build consists of the names of each
2262      * namespace that encloses the new command, in order from outermost to
2263      * innermost: for example, "a" then "b". Each iteration of this loop
2264      * eventually extends the trail upwards by one namespace, nsPtr. We use
2265      * this trail list to see if nsPtr (e.g. "a" in 2. above) could have
2266      * now-invalid cached command references. This will happen if nsPtr
2267      * (e.g. "a") contains a sequence of child namespaces (e.g. "b")
2268      * such that there is a identically-named sequence of child namespaces
2269      * starting from :: (e.g. "::b") whose tail namespace contains a command
2270      * also named cmdName.
2271      */
2272 
2273     cmdName = Tcl_GetHashKey(newCmdPtr->hPtr->tablePtr, newCmdPtr->hPtr);
2274     for (nsPtr = newCmdPtr->nsPtr;
2275       (nsPtr != NULL) && (nsPtr != globalNsPtr);
2276             nsPtr = nsPtr->parentPtr) {
2277         /*
2278    * Find the maximal sequence of child namespaces contained in nsPtr
2279    * such that there is a identically-named sequence of child
2280    * namespaces starting from ::. shadowNsPtr will be the tail of this
2281    * sequence, or the deepest namespace under :: that might contain a
2282    * command now shadowed by cmdName. We check below if shadowNsPtr
2283    * actually contains a command cmdName.
2284    */
2285 
2286         found = 1;
2287         shadowNsPtr = globalNsPtr;
2288 
2289         for (i = trailFront;  i >= 0;  i--) {
2290             trailNsPtr = trailPtr[i];
2291             hPtr = Tcl_FindHashEntry(&shadowNsPtr->childTable,
2292         trailNsPtr->name);
2293             if (hPtr != NULL) {
2294                 shadowNsPtr = (Namespace *) Tcl_GetHashValue(hPtr);
2295             } else {
2296                 found = 0;
2297                 break;
2298             }
2299         }
2300 
2301         /*
2302    * If shadowNsPtr contains a command named cmdName, we invalidate
2303          * all of the command refs cached in nsPtr. As a boundary case,
2304    * shadowNsPtr is initially :: and we check for case 1. above.
2305    */
2306 
2307         if (found) {
2308             hPtr = Tcl_FindHashEntry(&shadowNsPtr->cmdTable, cmdName);
2309             if (hPtr != NULL) {
2310                 nsPtr->cmdRefEpoch++;
2311 
2312     /* 
2313      * If the shadowed command was compiled to bytecodes, we
2314      * invalidate all the bytecodes in nsPtr, to force a new
2315      * compilation. We use the resolverEpoch to signal the need
2316      * for a fresh compilation of every bytecode.
2317      */
2318 
2319     if ((((Command *) Tcl_GetHashValue(hPtr))->compileProc) != NULL) {
2320         nsPtr->resolverEpoch++;
2321     }
2322             }
2323         }
2324 
2325         /*
2326    * Insert nsPtr at the front of the trail list: i.e., at the end
2327    * of the trailPtr array.
2328    */
2329 
2330   trailFront++;
2331   if (trailFront == trailSize) {
2332       size_t currBytes = trailSize * sizeof(Namespace *);
2333       int newSize = 2*trailSize;
2334       size_t newBytes = newSize * sizeof(Namespace *);
2335       Namespace **newPtr =
2336         (Namespace **) ckalloc((unsigned) newBytes);
2337       
2338       memcpy((VOID *) newPtr, (VOID *) trailPtr, currBytes);
2339       if (trailPtr != trailStorage) {
2340     ckfree((char *) trailPtr);
2341       }
2342       trailPtr = newPtr;
2343       trailSize = newSize;
2344   }
2345   trailPtr[trailFront] = nsPtr;
2346     }
2347 
2348     /*
2349      * Free any allocated storage.
2350      */
2351     
2352     if (trailPtr != trailStorage) {
2353   ckfree((char *) trailPtr);
2354     }
2355 }
void TclTeardownNamespace (Namespace * nsPtr)

Definition at line 682 of file tclNamesp.c.
References ckfree, NULL, Tcl_DecrRefCount, Tcl_DeleteCommandFromToken(), Tcl_DeleteHashEntry(), Tcl_DeleteHashTable(), Tcl_DeleteNamespace(), Tcl_FindHashEntry, Tcl_FirstHashEntry(), Tcl_GetGlobalNamespace(), Tcl_GetHashValue, Tcl_GetVar2Ex(), TCL_GLOBAL_ONLY, Tcl_IncrRefCount, Tcl_InitHashTable(), Tcl_SetVar2Ex(), TCL_STRING_KEYS, and TclDeleteNamespaceVars().
Referenced by DeleteInterpProc(), and Tcl_DeleteNamespace().685 {
686     Interp *iPtr = (Interp *) nsPtr->interp;
687     register Tcl_HashEntry *entryPtr;
688     Tcl_HashSearch search;
689     Tcl_Namespace *childNsPtr;
690     Tcl_Command cmd;
691     Namespace *globalNsPtr =
692       (Namespace *) Tcl_GetGlobalNamespace((Tcl_Interp *) iPtr);
693     int i;
694 
695     /*
696      * Start by destroying the namespace's variable table,
697      * since variables might trigger traces.
698      */
699 
700     if (nsPtr == globalNsPtr) {
701   /*
702    * This is the global namespace.  Tearing it down will destroy the
703    * ::errorInfo and ::errorCode variables.  We save and restore them
704    * in case there are any errors in progress, so the error details
705    * they contain will not be lost.  See test namespace-8.5
706    */
707     
708   Tcl_Obj *errorInfo = Tcl_GetVar2Ex(nsPtr->interp, "errorInfo",
709     NULL, TCL_GLOBAL_ONLY);
710   Tcl_Obj *errorCode = Tcl_GetVar2Ex(nsPtr->interp, "errorCode",
711     NULL, TCL_GLOBAL_ONLY);
712 
713   if (errorInfo) {
714       Tcl_IncrRefCount(errorInfo);
715   }
716   if (errorCode) {
717       Tcl_IncrRefCount(errorCode);
718   }
719 
720         TclDeleteNamespaceVars(nsPtr);
721         Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
722 
723   if (errorInfo) {
724       Tcl_SetVar2Ex(nsPtr->interp, "errorInfo", NULL,
725         errorInfo, TCL_GLOBAL_ONLY);
726       Tcl_DecrRefCount(errorInfo);
727   }
728   if (errorCode) {
729       Tcl_SetVar2Ex(nsPtr->interp, "errorCode", NULL,
730         errorCode, TCL_GLOBAL_ONLY);
731       Tcl_DecrRefCount(errorCode);
732   }
733     } else {
734   /*
735    * Variable table should be cleared but not freed! TclDeleteVars
736    * frees it, so we reinitialize it afterwards.
737    */
738     
739         TclDeleteNamespaceVars(nsPtr);
740         Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
741     }
742 
743     /*
744      * Delete all commands in this namespace. Be careful when traversing the
745      * hash table: when each command is deleted, it removes itself from the
746      * command table.
747      */
748 
749     for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
750             entryPtr != NULL;
751             entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {
752         cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
753         Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd);
754     }
755     Tcl_DeleteHashTable(&nsPtr->cmdTable);
756     Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
757 
758     /*
759      * Remove the namespace from its parent's child hashtable.
760      */
761 
762     if (nsPtr->parentPtr != NULL) {
763         entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
764           nsPtr->name);
765         if (entryPtr != NULL) {
766             Tcl_DeleteHashEntry(entryPtr);
767         }
768     }
769     nsPtr->parentPtr = NULL;
770 
771     /*
772      * Delete all the child namespaces.
773      *
774      * BE CAREFUL: When each child is deleted, it will divorce
775      *    itself from its parent. You can't traverse a hash table
776      *    properly if its elements are being deleted. We use only
777      *    the Tcl_FirstHashEntry function to be safe.
778      */
779 
780     for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
781             entryPtr != NULL;
782             entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
783         childNsPtr = (Tcl_Namespace *) Tcl_GetHashValue(entryPtr);
784         Tcl_DeleteNamespace(childNsPtr);
785     }
786 
787     /*
788      * Free the namespace's export pattern array.
789      */
790 
791     if (nsPtr->exportArrayPtr != NULL) {
792   for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
793       ckfree(nsPtr->exportArrayPtr[i]);
794   }
795         ckfree((char *) nsPtr->exportArrayPtr);
796   nsPtr->exportArrayPtr = NULL;
797   nsPtr->numExportPatterns = 0;
798   nsPtr->maxExportPatterns = 0;
799     }
800 
801     /*
802      * Free any client data associated with the namespace.
803      */
804 
805     if (nsPtr->deleteProc != NULL) {
806         (*nsPtr->deleteProc)(nsPtr->clientData);
807     }
808     nsPtr->deleteProc = NULL;
809     nsPtr->clientData = NULL;
810 
811     /*
812      * Reset the namespace's id field to ensure that this namespace won't
813      * be interpreted as valid by, e.g., the cache validation code for
814      * cached command references in Tcl_GetCommandFromObj.
815      */
816 
817     nsPtr->nsId = 0;
818 }
static void UpdateStringOfNsName (Tcl_Obj * objPtr) [static]

Definition at line 3971 of file tclNamesp.c.
References ckalloc, NS_DEAD, NULL, ResolvedNsName, and tclEmptyStringRep.3973 {
3974     ResolvedNsName *resNamePtr =
3975         (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
3976     register Namespace *nsPtr;
3977     char *name = "";
3978     int length;
3979 
3980     if ((resNamePtr != NULL)
3981       && (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) {
3982         nsPtr = resNamePtr->nsPtr;
3983         if (nsPtr->flags & NS_DEAD) {
3984             nsPtr = NULL;
3985         }
3986         if (nsPtr != NULL) {
3987             name = nsPtr->fullName;
3988         }
3989     }
3990 
3991     /*
3992      * The following sets the string rep to an empty string on the heap
3993      * if the internal rep is NULL.
3994      */
3995 
3996     length = strlen(name);
3997     if (length == 0) {
3998   objPtr->bytes = tclEmptyStringRep;
3999     } else {
4000   objPtr->bytes = (char *) ckalloc((unsigned) (length + 1));
4001   memcpy((VOID *) objPtr->bytes, (VOID *) name, (unsigned) length);
4002   objPtr->bytes[length] = '\0';
4003     }
4004     objPtr->length = length;
4005 }

Variable Documentation
long numNsCreated = 0 [static]

Definition at line 48 of file tclNamesp.c.
Referenced by Tcl_CreateNamespace().ResolvedNsName

Definition at line 74 of file tclNamesp.c.
Referenced by DupNsNameInternalRep(), FreeNsNameInternalRep(), GetNamespaceFromObj(), SetNsNameFromAny(), and UpdateStringOfNsName().Tcl_ObjType tclNsNameType
Initial value: {
    "nsName",     
    FreeNsNameInternalRep,  
    DupNsNameInternalRep, 
    UpdateStringOfNsName, 
    SetNsNameFromAny    
}
Definition at line 149 of file tclNamesp.c.
Referenced by DupNsNameInternalRep(), GetNamespaceFromObj(), SetNsNameFromAny(), and TclInitObjSubsystem().

generic/tclNotify.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Classes
struct EventSource
struct ThreadSpecificData
Functions
TCL_DECLARE_MUTEX (listLock)
void TclFinalizeNotifier ()
void Tcl_SetNotifier (Tcl_NotifierProcs *notifierProcPtr)
void Tcl_CreateEventSource (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData)
void Tcl_DeleteEventSource (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData)
void Tcl_QueueEvent (Tcl_Event *evPtr, Tcl_QueuePosition position)
void Tcl_ThreadQueueEvent (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position)
static void QueueEvent (ThreadSpecificData *tsdPtr, Tcl_Event *evPtr, Tcl_QueuePosition position)
void Tcl_DeleteEvents (Tcl_EventDeleteProc *proc, ClientData clientData)
int Tcl_ServiceEvent (int flags)
int Tcl_GetServiceMode ()
int Tcl_SetServiceMode (int mode)
void Tcl_SetMaxBlockTime (Tcl_Time *timePtr)
int Tcl_DoOneEvent (int flags)
int Tcl_ServiceAll ()
void Tcl_ThreadAlert (Tcl_ThreadId threadId)
Variables
TclStubs tclStubs
static Tcl_ThreadDataKey dataKey
static ThreadSpecificData * firstNotifierPtr

Function Documentation
static void QueueEvent (ThreadSpecificData * tsdPtr, Tcl_Event* evPtr, Tcl_QueuePosition position) [static]

Definition at line 438 of file tclNotify.c.
References Tcl_Event::nextPtr, NULL, Tcl_MutexLock, Tcl_MutexUnlock, TCL_QUEUE_HEAD, TCL_QUEUE_MARK, and TCL_QUEUE_TAIL.
Referenced by Tcl_QueueEvent(), and Tcl_ThreadQueueEvent().449 {
450     Tcl_MutexLock(&(tsdPtr->queueMutex));
451     if (position == TCL_QUEUE_TAIL) {
452   /*
453    * Append the event on the end of the queue.
454    */
455 
456   evPtr->nextPtr = NULL;
457   if (tsdPtr->firstEventPtr == NULL) {
458       tsdPtr->firstEventPtr = evPtr;
459   } else {
460       tsdPtr->lastEventPtr->nextPtr = evPtr;
461   }
462   tsdPtr->lastEventPtr = evPtr;
463     } else if (position == TCL_QUEUE_HEAD) {
464   /*
465    * Push the event on the head of the queue.
466    */
467 
468   evPtr->nextPtr = tsdPtr->firstEventPtr;
469   if (tsdPtr->firstEventPtr == NULL) {
470       tsdPtr->lastEventPtr = evPtr;
471   }     
472   tsdPtr->firstEventPtr = evPtr;
473     } else if (position == TCL_QUEUE_MARK) {
474   /*
475    * Insert the event after the current marker event and advance
476    * the marker to the new event.
477    */
478 
479   if (tsdPtr->markerEventPtr == NULL) {
480       evPtr->nextPtr = tsdPtr->firstEventPtr;
481       tsdPtr->firstEventPtr = evPtr;
482   } else {
483       evPtr->nextPtr = tsdPtr->markerEventPtr->nextPtr;
484       tsdPtr->markerEventPtr->nextPtr = evPtr;
485   }
486   tsdPtr->markerEventPtr = evPtr;
487   if (evPtr->nextPtr == NULL) {
488       tsdPtr->lastEventPtr = evPtr;
489   }
490     }
491     Tcl_MutexUnlock(&(tsdPtr->queueMutex));
492 }
void Tcl_CreateEventSource (Tcl_EventSetupProc * setupProc, Tcl_EventCheckProc * checkProc, ClientData clientData)

Definition at line 267 of file tclNotify.c.
References EventSource::checkProc, ckalloc, EventSource::clientData, dataKey, ThreadSpecificData::firstEventSourcePtr, EventSource::nextPtr, EventSource::setupProc, and TCL_TSD_INIT.
Referenced by ConsoleInit(), FileInit(), InitSockets(), InitTimer(), PipeInit(), and SerialInit().274 {
275     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
276     EventSource *sourcePtr = (EventSource *) ckalloc(sizeof(EventSource));
277 
278     sourcePtr->setupProc = setupProc;
279     sourcePtr->checkProc = checkProc;
280     sourcePtr->clientData = clientData;
281     sourcePtr->nextPtr = tsdPtr->firstEventSourcePtr;
282     tsdPtr->firstEventSourcePtr = sourcePtr;
283 }
TCL_DECLARE_MUTEX (listLock)

Definition at line 87 of file tclNotify.c.
References ThreadSpecificData::clientData, dataKey, firstNotifierPtr, ThreadSpecificData::initialized, ThreadSpecificData::nextPtr, Tcl_GetCurrentThread(), Tcl_MutexLock, Tcl_MutexUnlock, TCL_TSD_INIT, tclStubs, and ThreadSpecificData::threadId.104           :
105  *  None.
106  *
107  * Side effects:
108  *  Adds the current thread to the global list of notifiers.
109  *
110  *----------------------------------------------------------------------
111  */
112 
113 void
114 TclInitNotifier()
115 {
116     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
117 
118     Tcl_MutexLock(&listLock);
119 
120     tsdPtr->threadId = Tcl_GetCurrentThread();
121     tsdPtr->clientData = tclStubs.tcl_InitNotifier();
122     tsdPtr->initialized = 1;
123     tsdPtr->nextPtr = firstNotifierPtr;
124     firstNotifierPtr = tsdPtr;
125 
126     Tcl_MutexUnlock(&listLock);
127 }

void Tcl_DeleteEvents (Tcl_EventDeleteProc * proc, ClientData clientData)

Definition at line 514 of file tclNotify.c.
References ckfree, dataKey, ThreadSpecificData::firstEventPtr, ThreadSpecificData::lastEventPtr, ThreadSpecificData::markerEventPtr, Tcl_Event::nextPtr, NULL, ThreadSpecificData::queueMutex, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by TesteventObjCmd().517 {
518     Tcl_Event *evPtr, *prevPtr, *hold;
519     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
520 
521     Tcl_MutexLock(&(tsdPtr->queueMutex));
522     for (prevPtr = (Tcl_Event *) NULL, evPtr = tsdPtr->firstEventPtr;
523              evPtr != (Tcl_Event *) NULL;
524              ) {
525         if ((*proc) (evPtr, clientData) == 1) {
526             if (tsdPtr->firstEventPtr == evPtr) {
527                 tsdPtr->firstEventPtr = evPtr->nextPtr;
528             } else {
529                 prevPtr->nextPtr = evPtr->nextPtr;
530             }
531             if (evPtr->nextPtr == (Tcl_Event *) NULL) {
532                 tsdPtr->lastEventPtr = prevPtr;
533             }
534             if (tsdPtr->markerEventPtr == evPtr) {
535                 tsdPtr->markerEventPtr = prevPtr;
536             }
537             hold = evPtr;
538             evPtr = evPtr->nextPtr;
539             ckfree((char *) hold);
540         } else {
541             prevPtr = evPtr;
542             evPtr = evPtr->nextPtr;
543         }
544     }
545     Tcl_MutexUnlock(&(tsdPtr->queueMutex));
546 }
void Tcl_DeleteEventSource (Tcl_EventSetupProc * setupProc, Tcl_EventCheckProc * checkProc, ClientData clientData)

Definition at line 305 of file tclNotify.c.
References EventSource::checkProc, ckfree, EventSource::clientData, dataKey, ThreadSpecificData::firstEventSourcePtr, EventSource::nextPtr, NULL, EventSource::setupProc, and TCL_TSD_INIT.
Referenced by ConsoleExitHandler(), FileChannelExitHandler(), SerialExitHandler(), TclpFinalizePipes(), TclpFinalizeSockets(), and TimerExitProc().312 {
313     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
314     EventSource *sourcePtr, *prevPtr;
315 
316     for (sourcePtr = tsdPtr->firstEventSourcePtr, prevPtr = NULL;
317       sourcePtr != NULL;
318       prevPtr = sourcePtr, sourcePtr = sourcePtr->nextPtr) {
319   if ((sourcePtr->setupProc != setupProc)
320     || (sourcePtr->checkProc != checkProc)
321     || (sourcePtr->clientData != clientData)) {
322       continue;
323   }
324   if (prevPtr == NULL) {
325       tsdPtr->firstEventSourcePtr = sourcePtr->nextPtr;
326   } else {
327       prevPtr->nextPtr = sourcePtr->nextPtr;
328   }
329   ckfree((char *) sourcePtr);
330   return;
331     }
332 }
int Tcl_DoOneEvent (int flags)

Definition at line 820 of file tclNotify.c.
References ThreadSpecificData::blockTime, ThreadSpecificData::blockTimeSet, EventSource::checkProc, EventSource::clientData, dataKey, ThreadSpecificData::firstEventSourcePtr, ThreadSpecificData::inTraversal, EventSource::nextPtr, NULL, Tcl_Time::sec, ThreadSpecificData::serviceMode, EventSource::setupProc, TCL_ALL_EVENTS, Tcl_AsyncInvoke(), Tcl_AsyncReady(), TCL_DONT_WAIT, TCL_IDLE_EVENTS, TCL_SERVICE_NONE, Tcl_ServiceEvent(), TCL_TSD_INIT, Tcl_WaitForEvent(), TclServiceIdle(), Tcl_Time::usec, and void().
Referenced by MainLoop(), Tcl_UpdateObjCmd(), Tcl_VwaitObjCmd(), TclOSAActiveProc(), and TestfilehandlerCmd().821                                                 :  may be any
822          * combination of TCL_DONT_WAIT,
823          * TCL_WINDOW_EVENTS, TCL_FILE_EVENTS,
824          * TCL_TIMER_EVENTS, TCL_IDLE_EVENTS, or
825          * others defined by event sources. */
826 {
827     int result = 0, oldMode;
828     EventSource *sourcePtr;
829     Tcl_Time *timePtr;
830     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
831 
832     /*
833      * The first thing we do is to service any asynchronous event
834      * handlers.
835      */
836     
837     if (Tcl_AsyncReady()) {
838   (void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0);
839   return 1;
840     }
841 
842     /*
843      * No event flags is equivalent to TCL_ALL_EVENTS.
844      */
845     
846     if ((flags & TCL_ALL_EVENTS) == 0) {
847   flags |= TCL_ALL_EVENTS;
848     }
849 
850     /*
851      * Set the service mode to none so notifier event routines won't
852      * try to service events recursively.
853      */
854 
855     oldMode = tsdPtr->serviceMode;
856     tsdPtr->serviceMode = TCL_SERVICE_NONE;
857 
858     /*
859      * The core of this procedure is an infinite loop, even though
860      * we only service one event.  The reason for this is that we
861      * may be processing events that don't do anything inside of Tcl.
862      */
863 
864     while (1) {
865 
866   /*
867    * If idle events are the only things to service, skip the
868    * main part of the loop and go directly to handle idle
869    * events (i.e. don't wait even if TCL_DONT_WAIT isn't set).
870    */
871 
872   if ((flags & TCL_ALL_EVENTS) == TCL_IDLE_EVENTS) {
873       flags = TCL_IDLE_EVENTS|TCL_DONT_WAIT;
874       goto idleEvents;
875   }
876 
877   /*
878    * Ask Tcl to service a queued event, if there are any.
879    */
880 
881   if (Tcl_ServiceEvent(flags)) {
882       result = 1;
883       break;
884   }
885 
886   /*
887    * If TCL_DONT_WAIT is set, be sure to poll rather than
888    * blocking, otherwise reset the block time to infinity.
889    */
890 
891   if (flags & TCL_DONT_WAIT) {
892       tsdPtr->blockTime.sec = 0;
893       tsdPtr->blockTime.usec = 0;
894       tsdPtr->blockTimeSet = 1;
895   } else {
896       tsdPtr->blockTimeSet = 0;
897   }
898 
899   /*
900    * Set up all the event sources for new events.  This will
901    * cause the block time to be updated if necessary.
902    */
903 
904   tsdPtr->inTraversal = 1;
905   for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
906        sourcePtr = sourcePtr->nextPtr) {
907       if (sourcePtr->setupProc) {
908     (sourcePtr->setupProc)(sourcePtr->clientData, flags);
909       }
910   }
911   tsdPtr->inTraversal = 0;
912 
913   if ((flags & TCL_DONT_WAIT) || tsdPtr->blockTimeSet) {
914       timePtr = &tsdPtr->blockTime;
915   } else {
916       timePtr = NULL;
917   }
918 
919   /*
920    * Wait for a new event or a timeout.  If Tcl_WaitForEvent
921    * returns -1, we should abort Tcl_DoOneEvent.
922    */
923 
924   result = Tcl_WaitForEvent(timePtr);
925   if (result < 0) {
926       result = 0;
927       break;
928   }
929 
930   /*
931    * Check all the event sources for new events.
932    */
933 
934   for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
935        sourcePtr = sourcePtr->nextPtr) {
936       if (sourcePtr->checkProc) {
937     (sourcePtr->checkProc)(sourcePtr->clientData, flags);
938       }
939   }
940 
941   /*
942    * Check for events queued by the notifier or event sources.
943    */
944 
945   if (Tcl_ServiceEvent(flags)) {
946       result = 1;
947       break;
948   }
949 
950   /*
951    * We've tried everything at this point, but nobody we know
952    * about had anything to do.  Check for idle events.  If none,
953    * either quit or go back to the top and try again.
954    */
955 
956   idleEvents:
957   if (flags & TCL_IDLE_EVENTS) {
958       if (TclServiceIdle()) {
959     result = 1;
960     break;
961       }
962   }
963   if (flags & TCL_DONT_WAIT) {
964       break;
965   }
966 
967   /*
968    * If Tcl_WaitForEvent has returned 1,
969    * indicating that one system event has been dispatched
970    * (and thus that some Tcl code might have been indirectly executed),
971    * we break out of the loop.
972    * We do this to give VwaitCmd for instance a chance to check 
973    * if that system event had the side effect of changing the 
974    * variable (so the vwait can return and unwind properly).
975    *
976    * NB: We will process idle events if any first, because
977    *     otherwise we might never do the idle events if the notifier
978    *     always gets system events.
979    */
980 
981   if (result) {
982       break;
983   }
984 
985     }
986 
987     tsdPtr->serviceMode = oldMode;
988     return result;
989 }
int Tcl_GetServiceMode ()

Definition at line 709 of file tclNotify.c.
References dataKey, ThreadSpecificData::serviceMode, and TCL_TSD_INIT.710 {
711     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
712 
713     return tsdPtr->serviceMode;
714 }
void Tcl_QueueEvent (Tcl_Event* evPtr, Tcl_QueuePosition position)

Definition at line 352 of file tclNotify.c.
References dataKey, QueueEvent(), and TCL_TSD_INIT.
Referenced by ConsoleCheckProc(), FileCheckProc(), FileProc(), PipeCheckProc(), SerialCheckProc(), SocketCheckProc(), Tcl_WaitForEvent(), TesteventObjCmd(), and TimerCheckProc().361 {
362     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
363     QueueEvent(tsdPtr, evPtr, position);
364 }
int Tcl_ServiceAll ()

Definition at line 1013 of file tclNotify.c.
References ThreadSpecificData::blockTime, ThreadSpecificData::blockTimeSet, EventSource::checkProc, EventSource::clientData, dataKey, ThreadSpecificData::firstEventSourcePtr, ThreadSpecificData::inTraversal, EventSource::nextPtr, NULL, ThreadSpecificData::serviceMode, EventSource::setupProc, TCL_ALL_EVENTS, Tcl_AsyncInvoke(), Tcl_AsyncReady(), TCL_SERVICE_ALL, TCL_SERVICE_NONE, Tcl_ServiceEvent(), Tcl_SetTimer(), TCL_TSD_INIT, TclServiceIdle(), and void().
Referenced by FileProc(), NotifierProc(), and TimerProc().1014 {
1015     int result = 0;
1016     EventSource *sourcePtr;
1017     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1018 
1019     if (tsdPtr->serviceMode == TCL_SERVICE_NONE) {
1020   return result;
1021     }
1022 
1023     /*
1024      * We need to turn off event servicing like we to in Tcl_DoOneEvent,
1025      * to avoid recursive calls.
1026      */
1027     
1028     tsdPtr->serviceMode = TCL_SERVICE_NONE;
1029 
1030     /*
1031      * Check async handlers first.
1032      */
1033 
1034     if (Tcl_AsyncReady()) {
1035   (void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0);
1036     }
1037 
1038     /*
1039      * Make a single pass through all event sources, queued events,
1040      * and idle handlers.  Note that we wait to update the notifier
1041      * timer until the end so we can avoid multiple changes.
1042      */
1043 
1044     tsdPtr->inTraversal = 1;
1045     tsdPtr->blockTimeSet = 0;
1046 
1047     for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
1048    sourcePtr = sourcePtr->nextPtr) {
1049   if (sourcePtr->setupProc) {
1050       (sourcePtr->setupProc)(sourcePtr->clientData, TCL_ALL_EVENTS);
1051   }
1052     }
1053     for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
1054    sourcePtr = sourcePtr->nextPtr) {
1055   if (sourcePtr->checkProc) {
1056       (sourcePtr->checkProc)(sourcePtr->clientData, TCL_ALL_EVENTS);
1057   }
1058     }
1059 
1060     while (Tcl_ServiceEvent(0)) {
1061   result = 1;
1062     }
1063     if (TclServiceIdle()) {
1064   result = 1;
1065     }
1066 
1067     if (!tsdPtr->blockTimeSet) {
1068   Tcl_SetTimer(NULL);
1069     } else {
1070   Tcl_SetTimer(&tsdPtr->blockTime);
1071     }
1072     tsdPtr->inTraversal = 0;
1073     tsdPtr->serviceMode = TCL_SERVICE_ALL;
1074     return result;
1075 }
int Tcl_ServiceEvent (int flags)

Definition at line 570 of file tclNotify.c.
References ckfree, dataKey, ThreadSpecificData::firstEventPtr, ThreadSpecificData::lastEventPtr, ThreadSpecificData::markerEventPtr, Tcl_Event::nextPtr, NULL, Tcl_Event::proc, ThreadSpecificData::queueMutex, TCL_ALL_EVENTS, Tcl_AsyncInvoke(), Tcl_AsyncReady(), Tcl_MutexLock, Tcl_MutexUnlock, TCL_TSD_INIT, and void().
Referenced by Tcl_DoOneEvent(), and Tcl_ServiceAll().577 {
578     Tcl_Event *evPtr, *prevPtr;
579     Tcl_EventProc *proc;
580     int result;
581     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
582 
583     /*
584      * Asynchronous event handlers are considered to be the highest
585      * priority events, and so must be invoked before we process events
586      * on the event queue.
587      */
588     
589     if (Tcl_AsyncReady()) {
590   (void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0);
591   return 1;
592     }
593 
594     /*
595      * No event flags is equivalent to TCL_ALL_EVENTS.
596      */
597     
598     if ((flags & TCL_ALL_EVENTS) == 0) {
599   flags |= TCL_ALL_EVENTS;
600     }
601 
602     /*
603      * Loop through all the events in the queue until we find one
604      * that can actually be handled.
605      */
606 
607     Tcl_MutexLock(&(tsdPtr->queueMutex));
608     for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL;
609    evPtr = evPtr->nextPtr) {
610   /*
611    * Call the handler for the event.  If it actually handles the
612    * event then free the storage for the event.  There are two
613    * tricky things here, both stemming from the fact that the event
614    * code may be re-entered while servicing the event:
615    *
616    * 1. Set the "proc" field to NULL.  This is a signal to ourselves
617    *    that we shouldn't reexecute the handler if the event loop
618    *    is re-entered.
619    * 2. When freeing the event, must search the queue again from the
620    *    front to find it.  This is because the event queue could
621    *    change almost arbitrarily while handling the event, so we
622    *    can't depend on pointers found now still being valid when
623    *    the handler returns.
624    */
625 
626   proc = evPtr->proc;
627   if (proc == NULL) {
628       continue;
629   }
630   evPtr->proc = NULL;
631 
632   /*
633    * Release the lock before calling the event procedure.  This
634    * allows other threads to post events if we enter a recursive
635    * event loop in this thread.  Note that we are making the assumption
636    * that if the proc returns 0, the event is still in the list.
637    */
638 
639   Tcl_MutexUnlock(&(tsdPtr->queueMutex));
640   result = (*proc)(evPtr, flags);
641   Tcl_MutexLock(&(tsdPtr->queueMutex));
642 
643   if (result) {
644       /*
645        * The event was processed, so remove it from the queue.
646        */
647 
648       if (tsdPtr->firstEventPtr == evPtr) {
649     tsdPtr->firstEventPtr = evPtr->nextPtr;
650     if (evPtr->nextPtr == NULL) {
651         tsdPtr->lastEventPtr = NULL;
652     }
653     if (tsdPtr->markerEventPtr == evPtr) {
654         tsdPtr->markerEventPtr = NULL;
655     }
656       } else {
657     for (prevPtr = tsdPtr->firstEventPtr;
658          prevPtr && prevPtr->nextPtr != evPtr;
659          prevPtr = prevPtr->nextPtr) {
660         /* Empty loop body. */
661     }
662     if (prevPtr) {
663         prevPtr->nextPtr = evPtr->nextPtr;
664         if (evPtr->nextPtr == NULL) {
665       tsdPtr->lastEventPtr = prevPtr;
666         }
667         if (tsdPtr->markerEventPtr == evPtr) {
668       tsdPtr->markerEventPtr = prevPtr;
669         }
670     } else {
671         evPtr = NULL;
672     }
673       }
674       if (evPtr) {
675     ckfree((char *) evPtr);
676       }
677       Tcl_MutexUnlock(&(tsdPtr->queueMutex));
678       return 1;
679   } else {
680       /*
681        * The event wasn't actually handled, so we have to restore
682        * the proc field to allow the event to be attempted again.
683        */
684 
685       evPtr->proc = proc;
686   }
687     }
688     Tcl_MutexUnlock(&(tsdPtr->queueMutex));
689     return 0;
690 }
void Tcl_SetMaxBlockTime (Tcl_Time * timePtr)

Definition at line 768 of file tclNotify.c.
References ThreadSpecificData::blockTime, ThreadSpecificData::blockTimeSet, dataKey, ThreadSpecificData::inTraversal, NULL, Tcl_Time::sec, Tcl_SetTimer(), TCL_TSD_INIT, and Tcl_Time::usec.
Referenced by CommonWatch(), ConsoleSetupProc(), ConsoleWatchProc(), FileSetupProc(), FileWatchProc(), PipeSetupProc(), PipeWatchProc(), SerialBlockTime(), SocketEventProc(), SocketSetupProc(), Tcl_DoWhenIdle(), TclServiceIdle(), TcpOutputProc(), TcpWatchProc(), and TimerSetupProc().772 {
773     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
774 
775     if (!tsdPtr->blockTimeSet || (timePtr->sec < tsdPtr->blockTime.sec)
776       || ((timePtr->sec == tsdPtr->blockTime.sec)
777       && (timePtr->usec < tsdPtr->blockTime.usec))) {
778   tsdPtr->blockTime = *timePtr;
779   tsdPtr->blockTimeSet = 1;
780     }
781 
782     /*
783      * If we are called outside an event source traversal, set the
784      * timeout immediately.
785      */
786 
787     if (!tsdPtr->inTraversal) {
788   if (tsdPtr->blockTimeSet) {
789       Tcl_SetTimer(&tsdPtr->blockTime);
790   } else {
791       Tcl_SetTimer(NULL);
792   }
793     }
794 }
void Tcl_SetNotifier (Tcl_NotifierProcs * notifierProcPtr)

Definition at line 215 of file tclNotify.c.
References tclStubs.
Referenced by InitNotifier().217 {
218 #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
219     tclStubs.tcl_CreateFileHandler = notifierProcPtr->createFileHandlerProc;
220     tclStubs.tcl_DeleteFileHandler = notifierProcPtr->deleteFileHandlerProc;
221 #endif
222     tclStubs.tcl_SetTimer = notifierProcPtr->setTimerProc;
223     tclStubs.tcl_WaitForEvent = notifierProcPtr->waitForEventProc;
224     tclStubs.tcl_InitNotifier = notifierProcPtr->initNotifierProc;
225     tclStubs.tcl_FinalizeNotifier = notifierProcPtr->finalizeNotifierProc;
226     tclStubs.tcl_AlertNotifier = notifierProcPtr->alertNotifierProc;
227     tclStubs.tcl_ServiceModeHook = notifierProcPtr->serviceModeHookProc;
228 }
int Tcl_SetServiceMode (int mode)

Definition at line 733 of file tclNotify.c.
References dataKey, ThreadSpecificData::serviceMode, TCL_TSD_INIT, and tclStubs.
Referenced by TesteventloopCmd(), and WaitForSocketEvent().734                                      : TCL_SERVICE_ALL or
735          * TCL_SERVICE_NONE */
736 {
737     int oldMode;
738     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
739 
740     oldMode = tsdPtr->serviceMode;
741     tsdPtr->serviceMode = mode;
742     if (tclStubs.tcl_ServiceModeHook) {
743   tclStubs.tcl_ServiceModeHook(mode);
744     }
745     return oldMode;
746 }
void Tcl_ThreadAlert (Tcl_ThreadId threadId)

Definition at line 1095 of file tclNotify.c.
References ThreadSpecificData::clientData, firstNotifierPtr, ThreadSpecificData::nextPtr, Tcl_MutexLock, tclStubs, and ThreadSpecificData::threadId.
Referenced by ConsoleReaderThread(), ConsoleWriterThread(), PipeReaderThread(), PipeWriterThread(), SerialWriterThread(), SocketProc(), and Tcl_AsyncMark().1097 {
1098     ThreadSpecificData *tsdPtr;
1099 
1100     /*
1101      * Find the notifier associated with the specified thread.
1102      * Note that we need to hold the listLock while calling
1103      * Tcl_AlertNotifier to avoid a race condition where
1104      * the specified thread might destroy its notifier.
1105      */
1106 
1107     Tcl_MutexLock(&listLock);
1108     for (tsdPtr = firstNotifierPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
1109   if (tsdPtr->threadId == threadId) {
1110       if (tclStubs.tcl_AlertNotifier) {
1111     tclStubs.tcl_AlertNotifier(tsdPtr->clientData);
1112       }
1113       break;
1114   }
1115     }
1116     Tcl_MutexUnlock(&listLock);
1117 }
void Tcl_ThreadQueueEvent (Tcl_ThreadId threadId, Tcl_Event* evPtr, Tcl_QueuePosition position)

Definition at line 383 of file tclNotify.c.
References firstNotifierPtr, ThreadSpecificData::nextPtr, QueueEvent(), Tcl_MutexLock, Tcl_MutexUnlock, and ThreadSpecificData::threadId.393 {
394     ThreadSpecificData *tsdPtr;
395 
396     /*
397      * Find the notifier associated with the specified thread.
398      */
399 
400     Tcl_MutexLock(&listLock);
401     for (tsdPtr = firstNotifierPtr; tsdPtr && tsdPtr->threadId != threadId;
402        tsdPtr = tsdPtr->nextPtr) {
403   /* Empty loop body. */
404     }
405 
406     /*
407      * Queue the event if there was a notifier associated with the thread.
408      */
409 
410     if (tsdPtr) {
411   QueueEvent(tsdPtr, evPtr, position);
412     }
413     Tcl_MutexUnlock(&listLock);
414 }
void TclFinalizeNotifier ()

Definition at line 156 of file tclNotify.c.
References ckfree, ThreadSpecificData::clientData, dataKey, ThreadSpecificData::firstEventPtr, firstNotifierPtr, ThreadSpecificData::initialized, ThreadSpecificData::lastEventPtr, ThreadSpecificData::nextPtr, Tcl_Event::nextPtr, NULL, ThreadSpecificData::queueMutex, Tcl_MutexFinalize, Tcl_MutexLock, Tcl_MutexUnlock, TCL_TSD_INIT, and tclStubs.
Referenced by Tcl_FinalizeThread().157 {
158     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
159     ThreadSpecificData **prevPtrPtr;
160     Tcl_Event *evPtr, *hold;
161 
162     if (!tsdPtr->initialized) {
163         return; /* Notifier not initialized for the current thread */
164     }
165 
166     Tcl_MutexLock(&(tsdPtr->queueMutex));
167     for (evPtr = tsdPtr->firstEventPtr; evPtr != (Tcl_Event *) NULL; ) {
168   hold = evPtr;
169   evPtr = evPtr->nextPtr;
170   ckfree((char *) hold);
171     }
172     tsdPtr->firstEventPtr = NULL;
173     tsdPtr->lastEventPtr = NULL;
174     Tcl_MutexUnlock(&(tsdPtr->queueMutex));
175 
176     Tcl_MutexLock(&listLock);
177 
178     if (tclStubs.tcl_FinalizeNotifier) {
179   tclStubs.tcl_FinalizeNotifier(tsdPtr->clientData);
180     }
181     Tcl_MutexFinalize(&(tsdPtr->queueMutex));
182     for (prevPtrPtr = &firstNotifierPtr; *prevPtrPtr != NULL;
183    prevPtrPtr = &((*prevPtrPtr)->nextPtr)) {
184   if (*prevPtrPtr == tsdPtr) {
185       *prevPtrPtr = tsdPtr->nextPtr;
186       break;
187   }
188     }
189     tsdPtr->initialized = 0;
190 
191     Tcl_MutexUnlock(&listLock);
192 }

Variable Documentation
Tcl_ThreadDataKey dataKey [static]

Definition at line 78 of file tclNotify.c.ThreadSpecificData* firstNotifierPtr [static]

Definition at line 86 of file tclNotify.c.
Referenced by TCL_DECLARE_MUTEX(), Tcl_ThreadAlert(), Tcl_ThreadQueueEvent(), and TclFinalizeNotifier().TclStubs tclStubs

Definition at line 411 of file tclStubInit.c.

generic/tclObj.c File Reference
#include "tclInt.h"
#include "tclCompile.h"
#include "tclPort.h"
Classes
struct ResolvedCmdName
Defines
#define OBJS_TO_ALLOC_EACH_TIME  100
Functions
TCL_DECLARE_MUTEX (tableMutex)
void TclInitObjSubsystem ()
void TclFinalizeObjects ()
void Tcl_RegisterObjType (Tcl_ObjType *typePtr)
int Tcl_AppendAllObjTypes (Tcl_Interp *interp, Tcl_Obj *objPtr)
Tcl_ObjType * Tcl_GetObjType (CONST char *typeName)
int Tcl_ConvertToType (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_ObjType *typePtr)
Tcl_Obj * Tcl_NewObj ()
Tcl_Obj * Tcl_DbNewObj (CONST char *file, int line)
void TclAllocateFreeObjects ()
void TclFreeObj (Tcl_Obj *objPtr)
Tcl_Obj * Tcl_DuplicateObj (Tcl_Obj *objPtr)
char * Tcl_GetString (Tcl_Obj *objPtr)
char * Tcl_GetStringFromObj (Tcl_Obj *objPtr, int *lengthPtr)
void Tcl_InvalidateStringRep (Tcl_Obj *objPtr)
Tcl_Obj * Tcl_NewBooleanObj (int boolValue)
Tcl_Obj * Tcl_DbNewBooleanObj (int boolValue, CONST char *file, int line)
void Tcl_SetBooleanObj (Tcl_Obj *objPtr, int boolValue)
int Tcl_GetBooleanFromObj (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr)
static int SetBooleanFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr)
static void UpdateStringOfBoolean (Tcl_Obj *objPtr)
Tcl_Obj * Tcl_NewDoubleObj (double dblValue)
Tcl_Obj * Tcl_DbNewDoubleObj (double dblValue, CONST char *file, int line)
void Tcl_SetDoubleObj (Tcl_Obj *objPtr, double dblValue)
int Tcl_GetDoubleFromObj (Tcl_Interp *interp, Tcl_Obj *objPtr, double *dblPtr)
static int SetDoubleFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr)
static void UpdateStringOfDouble (Tcl_Obj *objPtr)
Tcl_Obj * Tcl_NewIntObj (int intValue)
void Tcl_SetIntObj (Tcl_Obj *objPtr, int intValue)
int Tcl_GetIntFromObj (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr)
static int SetIntFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr)
static int SetIntOrWideFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr)
static void UpdateStringOfInt (Tcl_Obj *objPtr)
Tcl_Obj * Tcl_NewLongObj (long longValue)
Tcl_Obj * Tcl_DbNewLongObj (long longValue, CONST char *file, int line)
void Tcl_SetLongObj (Tcl_Obj *objPtr, long longValue)
int Tcl_GetLongFromObj (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr)
static int SetWideIntFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr)
static void UpdateStringOfWideInt (Tcl_Obj *objPtr)
Tcl_Obj * Tcl_NewWideIntObj (Tcl_WideInt wideValue)
Tcl_Obj * Tcl_DbNewWideIntObj (Tcl_WideInt wideValue, CONST char *file, int line)
void Tcl_SetWideIntObj (Tcl_Obj *objPtr, Tcl_WideInt wideValue)
int Tcl_GetWideIntFromObj (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *wideIntPtr)
void Tcl_DbIncrRefCount (Tcl_Obj *objPtr, CONST char *file, int line)
void Tcl_DbDecrRefCount (Tcl_Obj *objPtr, CONST char *file, int line)
int Tcl_DbIsShared (Tcl_Obj *objPtr, CONST char *file, int line)
void Tcl_InitObjHashTable (Tcl_HashTable *tablePtr)
static Tcl_HashEntry * AllocObjEntry (Tcl_HashTable *tablePtr, VOID *keyPtr)
static int CompareObjKeys (VOID *keyPtr, Tcl_HashEntry *hPtr)
static void FreeObjEntry (Tcl_HashEntry *hPtr)
static unsigned int HashObjKey (Tcl_HashTable *tablePtr, VOID *keyPtr)
Tcl_Command Tcl_GetCommandFromObj (Tcl_Interp *interp, Tcl_Obj *objPtr)
void TclSetCmdNameObj (Tcl_Interp *interp, Tcl_Obj *objPtr, Command *cmdPtr)
static void FreeCmdNameInternalRep (Tcl_Obj *objPtr)
static void DupCmdNameInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
static int SetCmdNameFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr)
Variables
static Tcl_HashTable typeTable
static int typeTableInitialized = 0
Tcl_ObjType tclDoubleType
Tcl_ObjType tclIntType
Tcl_ObjType tclWideIntType
Tcl_HashKeyType tclObjHashKeyType
static Tcl_ObjType tclCmdNameType

Define Documentation
#define OBJS_TO_ALLOC_EACH_TIME  100

Definition at line 606 of file tclObj.c.
Referenced by TclAllocateFreeObjects().
Function Documentation
static Tcl_HashEntry* AllocObjEntry (Tcl_HashTable * tablePtr, VOID * keyPtr) [static]

Definition at line 2774 of file tclObj.c.
References ckalloc, Tcl_HashEntry::key, Tcl_HashEntry::oneWordValue, and Tcl_IncrRefCount.2777 {
2778     Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
2779     Tcl_HashEntry *hPtr;
2780 
2781     hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)));
2782     hPtr->key.oneWordValue = (char *) objPtr;
2783     Tcl_IncrRefCount (objPtr);
2784 
2785     return hPtr;
2786 }
static int CompareObjKeys (VOID * keyPtr, Tcl_HashEntry * hPtr) [static]

Definition at line 2806 of file tclObj.c.
References CONST, Tcl_HashEntry::key, Tcl_Obj::length, Tcl_HashEntry::oneWordValue, and TclGetString.2809 {
2810     Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr;
2811     Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
2812     register CONST char *p1, *p2;
2813     register int l1, l2;
2814 
2815     /*
2816      * If the object pointers are the same then they match.
2817      */
2818     if (objPtr1 == objPtr2) {
2819   return 1;
2820     }
2821 
2822     /*
2823      * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being
2824      * in a register.
2825      */
2826     p1 = TclGetString(objPtr1);
2827     l1 = objPtr1->length;
2828     p2 = TclGetString(objPtr2);
2829     l2 = objPtr2->length;
2830     
2831     /*
2832      * Only compare if the string representations are of the same length.
2833      */
2834     if (l1 == l2) {
2835   for (;; p1++, p2++, l1--) {
2836       if (*p1 != *p2) {
2837     break;
2838       }
2839       if (l1 == 0) {
2840     return 1;
2841       }
2842   }
2843     }
2844 
2845     return 0;
2846 }
static void DupCmdNameInternalRep (Tcl_Obj * srcPtr, Tcl_Obj * copyPtr) [static]

Definition at line 3174 of file tclObj.c.
References ResolvedCmdName::refCount, tclCmdNameType, and VOID.3177 {
3178     register ResolvedCmdName *resPtr =
3179         (ResolvedCmdName *) srcPtr->internalRep.twoPtrValue.ptr1;
3180 
3181     copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
3182     copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
3183     if (resPtr != NULL) {
3184         resPtr->refCount++;
3185     }
3186     copyPtr->typePtr = &tclCmdNameType;
3187 }
static void FreeCmdNameInternalRep (Tcl_Obj * objPtr) [static]

Definition at line 3125 of file tclObj.c.
References ckfree, ResolvedCmdName::cmdPtr, ResolvedCmdName::refCount, and TclCleanupCommand().3128 {
3129     register ResolvedCmdName *resPtr =
3130   (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
3131 
3132     if (resPtr != NULL) {
3133   /*
3134    * Decrement the reference count of the ResolvedCmdName structure.
3135    * If there are no more uses, free the ResolvedCmdName structure.
3136    */
3137     
3138         resPtr->refCount--;
3139         if (resPtr->refCount == 0) {
3140             /*
3141        * Now free the cached command, unless it is still in its
3142              * hash table or if there are other references to it
3143              * from other cmdName objects.
3144        */
3145       
3146             Command *cmdPtr = resPtr->cmdPtr;
3147             TclCleanupCommand(cmdPtr);
3148             ckfree((char *) resPtr);
3149         }
3150     }
3151 }
static void FreeObjEntry (Tcl_HashEntry * hPtr) [static]

Definition at line 2865 of file tclObj.c.
References ckfree, and Tcl_DecrRefCount.2867 {
2868     Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;
2869 
2870     Tcl_DecrRefCount (objPtr);
2871     ckfree ((char *) hPtr);
2872 }
static unsigned int HashObjKey (Tcl_HashTable * tablePtr, VOID * keyPtr) [static]

Definition at line 2893 of file tclObj.c.
References CONST, Tcl_Obj::length, and TclGetString.2896 {
2897     Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
2898     CONST char *string = TclGetString(objPtr);
2899     int length = objPtr->length;
2900     unsigned int result;
2901     int i;
2902 
2903     /*
2904      * I tried a zillion different hash functions and asked many other
2905      * people for advice.  Many people had their own favorite functions,
2906      * all different, but no-one had much idea why they were good ones.
2907      * I chose the one below (multiply by 9 and add new character)
2908      * because of the following reasons:
2909      *
2910      * 1. Multiplying by 10 is perfect for keys that are decimal strings,
2911      *    and multiplying by 9 is just about as good.
2912      * 2. Times-9 is (shift-left-3) plus (old).  This means that each
2913      *    character's bits hang around in the low-order bits of the
2914      *    hash value for ever, plus they spread fairly rapidly up to
2915      *    the high-order bits to fill out the hash value.  This seems
2916      *    works well both for decimal and non-decimal strings.
2917      */
2918 
2919     result = 0;
2920     for (i=0 ; i<length ; i++) {
2921   result += (result<<3) + string[i];
2922     }
2923     return result;
2924 }
static int SetBooleanFromAny (Tcl_Interp * interp, Tcl_Obj * objPtr) [static]

Definition at line 1085 of file tclObj.c.
References Tcl_ObjType::freeIntRepProc, size_t(), strtod(), strtol(), strtoll(), Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), Tcl_GetStringFromObj(), Tcl_LongAsWide, TCL_OK, Tcl_ResetResult(), Tcl_UniCharIsUpper(), Tcl_UniCharToLower(), tclDoubleType, tclIntType, tclWideIntType, and UCHAR.
Referenced by Tcl_GetBooleanFromObj().1088 {
1089     Tcl_ObjType *oldTypePtr = objPtr->typePtr;
1090     char *string, *end;
1091     register char c;
1092     char lowerCase[10];
1093     int newBool, length;
1094     register int i;
1095 
1096     /*
1097      * Get the string representation. Make it up-to-date if necessary.
1098      */
1099     
1100     string = Tcl_GetStringFromObj(objPtr, &length);
1101 
1102     /*
1103      * Use the obvious shortcuts for numerical values; if objPtr is not
1104      * of numerical type, parse its string rep.
1105      */
1106   
1107     if (objPtr->typePtr == &tclIntType) {
1108   newBool = (objPtr->internalRep.longValue != 0);
1109     } else if (objPtr->typePtr == &tclDoubleType) {
1110   newBool = (objPtr->internalRep.doubleValue != 0.0);
1111     } else if (objPtr->typePtr == &tclWideIntType) {
1112   newBool = (objPtr->internalRep.wideValue != 0);
1113     } else {
1114   /*
1115    * Copy the string converting its characters to lower case.
1116    */
1117   
1118   for (i = 0;  (i < 9) && (i < length);  i++) {
1119       c = string[i];
1120       /*
1121        * Weed out international characters so we can safely operate
1122        * on single bytes.
1123        */
1124       
1125       if (c & 0x80) {
1126     goto badBoolean;
1127       }
1128       if (Tcl_UniCharIsUpper(UCHAR(c))) {
1129     c = (char) Tcl_UniCharToLower(UCHAR(c));
1130       }
1131       lowerCase[i] = c;
1132   }
1133   lowerCase[i] = 0;
1134   
1135   /*
1136    * Parse the string as a boolean. We use an implementation here that
1137    * doesn't report errors in interp if interp is NULL.
1138    */
1139   
1140   c = lowerCase[0];
1141   if ((c == '0') && (lowerCase[1] == '\0')) {
1142       newBool = 0;
1143   } else if ((c == '1') && (lowerCase[1] == '\0')) {
1144       newBool = 1;
1145   } else if ((c == 'y') && (strncmp(lowerCase, "yes", (size_t) length) == 0)) {
1146       newBool = 1;
1147   } else if ((c == 'n') && (strncmp(lowerCase, "no", (size_t) length) == 0)) {
1148       newBool = 0;
1149   } else if ((c == 't') && (strncmp(lowerCase, "true", (size_t) length) == 0)) {
1150       newBool = 1;
1151   } else if ((c == 'f') && (strncmp(lowerCase, "false", (size_t) length) == 0)) {
1152       newBool = 0;
1153   } else if ((c == 'o') && (length >= 2)) {
1154       if (strncmp(lowerCase, "on", (size_t) length) == 0) {
1155     newBool = 1;
1156       } else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
1157     newBool = 0;
1158       } else {
1159     goto badBoolean;
1160       }
1161   } else {
1162       double dbl;
1163       /*
1164        * Boolean values can be extracted from ints or doubles.  Note
1165        * that we don't use strtoul or strtoull here because we don't
1166        * care about what the value is, just whether it is equal to
1167        * zero or not.
1168        */
1169 #ifdef TCL_WIDE_INT_IS_LONG
1170       newBool = strtol(string, &end, 0);
1171       if (end != string) {
1172     /*
1173      * Make sure the string has no garbage after the end of
1174      * the int.
1175      */
1176     while ((end < (string+length))
1177            && isspace(UCHAR(*end))) { /* INTL: ISO only */
1178         end++;
1179     }
1180     if (end == (string+length)) {
1181         newBool = (newBool != 0);
1182         goto goodBoolean;
1183     }
1184       }
1185 #else /* !TCL_WIDE_INT_IS_LONG */
1186       Tcl_WideInt wide = strtoll(string, &end, 0);
1187       if (end != string) {
1188     /*
1189      * Make sure the string has no garbage after the end of
1190      * the wide int.
1191      */
1192     while ((end < (string+length))
1193            && isspace(UCHAR(*end))) { /* INTL: ISO only */
1194         end++;
1195     }
1196     if (end == (string+length)) {
1197         newBool = (wide != Tcl_LongAsWide(0));
1198         goto goodBoolean;
1199     }
1200       }
1201 #endif /* TCL_WIDE_INT_IS_LONG */
1202       /*
1203        * Still might be a string containing the characters representing an
1204        * int or double that wasn't handled above. This would be a string
1205        * like "27" or "1.0" that is non-zero and not "1". Such a string
1206        * would result in the boolean value true. We try converting to
1207        * double. If that succeeds and the resulting double is non-zero, we
1208        * have a "true". Note that numbers can't have embedded NULLs.
1209        */
1210       
1211       dbl = strtod(string, &end);
1212       if (end == string) {
1213     goto badBoolean;
1214       }
1215       
1216       /*
1217        * Make sure the string has no garbage after the end of the double.
1218        */
1219       
1220       while ((end < (string+length))
1221        && isspace(UCHAR(*end))) { /* INTL: ISO only */
1222     end++;
1223       }
1224       if (end != (string+length)) {
1225     goto badBoolean;
1226       }
1227       newBool = (dbl != 0.0);
1228   }
1229     }
1230 
1231     /*
1232      * Free the old internalRep before setting the new one. We do this as
1233      * late as possible to allow the conversion code, in particular
1234      * Tcl_GetStringFromObj, to use that old internalRep.
1235      */
1236 
1237     goodBoolean:
1238     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
1239   oldTypePtr->freeIntRepProc(objPtr);
1240     }
1241 
1242     objPtr->internalRep.longValue = newBool;
1243     objPtr->typePtr = &tclBooleanType;
1244     return TCL_OK;
1245 
1246     badBoolean:
1247     if (interp != NULL) {
1248   /*
1249    * Must copy string before resetting the result in case a caller
1250    * is trying to convert the interpreter's result to a boolean.
1251    */
1252   
1253   char buf[100];
1254   sprintf(buf, "expected boolean value but got \"%.50s\"", string);
1255   Tcl_ResetResult(interp);
1256   Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
1257     }
1258     return TCL_ERROR;
1259 }
static int SetCmdNameFromAny (Tcl_Interp * interp, Tcl_Obj * objPtr) [static]

Definition at line 3211 of file tclObj.c.
References ckalloc, Command::cmdEpoch, ResolvedCmdName::cmdEpoch, ResolvedCmdName::cmdPtr, Namespace::cmdRefEpoch, Interp::globalNsPtr, Namespace::nsId, CallFrame::nsPtr, NULL, ResolvedCmdName::refCount, Command::refCount, ResolvedCmdName::refNsCmdEpoch, ResolvedCmdName::refNsId, ResolvedCmdName::refNsPtr, Tcl_FindCommand(), Tcl_GetString(), TCL_OK, tclCmdNameType, Interp::varFramePtr, and VOID.3214 {
3215     Interp *iPtr = (Interp *) interp;
3216     char *name;
3217     Tcl_Command cmd;
3218     register Command *cmdPtr;
3219     Namespace *currNsPtr;
3220     register ResolvedCmdName *resPtr;
3221 
3222     /*
3223      * Get "objPtr"s string representation. Make it up-to-date if necessary.
3224      */
3225 
3226     name = objPtr->bytes;
3227     if (name == NULL) {
3228   name = Tcl_GetString(objPtr);
3229     }
3230 
3231     /*
3232      * Find the Command structure, if any, that describes the command called
3233      * "name". Build a ResolvedCmdName that holds a cached pointer to this
3234      * Command, and bump the reference count in the referenced Command
3235      * structure. A Command structure will not be deleted as long as it is
3236      * referenced from a CmdName object.
3237      */
3238 
3239     cmd = Tcl_FindCommand(interp, name, (Tcl_Namespace *) NULL,
3240       /*flags*/ 0);
3241     cmdPtr = (Command *) cmd;
3242     if (cmdPtr != NULL) {
3243   /*
3244    * Get the current namespace.
3245    */
3246   
3247   if (iPtr->varFramePtr != NULL) {
3248       currNsPtr = iPtr->varFramePtr->nsPtr;
3249   } else {
3250       currNsPtr = iPtr->globalNsPtr;
3251   }
3252   
3253   cmdPtr->refCount++;
3254         resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
3255         resPtr->cmdPtr        = cmdPtr;
3256         resPtr->refNsPtr      = currNsPtr;
3257         resPtr->refNsId       = currNsPtr->nsId;
3258         resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
3259         resPtr->cmdEpoch      = cmdPtr->cmdEpoch;
3260         resPtr->refCount      = 1;
3261     } else {
3262   resPtr = NULL;  /* no command named "name" was found */
3263     }
3264 
3265     /*
3266      * Free the old internalRep before setting the new one. We do this as
3267      * late as possible to allow the conversion code, in particular
3268      * GetStringFromObj, to use that old internalRep. If no Command
3269      * structure was found, leave NULL as the cached value.
3270      */
3271 
3272     if ((objPtr->typePtr != NULL)
3273       && (objPtr->typePtr->freeIntRepProc != NULL)) {
3274   objPtr->typePtr->freeIntRepProc(objPtr);
3275     }
3276     
3277     objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
3278     objPtr->internalRep.twoPtrValue.ptr2 = NULL;
3279     objPtr->typePtr = &tclCmdNameType;
3280     return TCL_OK;
3281 }
static int SetDoubleFromAny (Tcl_Interp * interp, Tcl_Obj * objPtr) [static]

Definition at line 1501 of file tclObj.c.
References errno, Tcl_ObjType::freeIntRepProc, strtod(), Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), Tcl_GetStringFromObj(), TCL_OK, Tcl_ResetResult(), tclDoubleType, TclExprFloatError(), and UCHAR.
Referenced by Tcl_GetDoubleFromObj().1504 {
1505     Tcl_ObjType *oldTypePtr = objPtr->typePtr;
1506     char *string, *end;
1507     double newDouble;
1508     int length;
1509 
1510     /*
1511      * Get the string representation. Make it up-to-date if necessary.
1512      */
1513 
1514     string = Tcl_GetStringFromObj(objPtr, &length);
1515 
1516     /*
1517      * Now parse "objPtr"s string as an double. Numbers can't have embedded
1518      * NULLs. We use an implementation here that doesn't report errors in
1519      * interp if interp is NULL.
1520      */
1521 
1522     errno = 0;
1523     newDouble = strtod(string, &end);
1524     if (end == string) {
1525   badDouble:
1526   if (interp != NULL) {
1527       /*
1528        * Must copy string before resetting the result in case a caller
1529        * is trying to convert the interpreter's result to an int.
1530        */
1531       
1532       char buf[100];
1533       sprintf(buf, "expected floating-point number but got \"%.50s\"",
1534               string);
1535       Tcl_ResetResult(interp);
1536       Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
1537   }
1538   return TCL_ERROR;
1539     }
1540     if (errno != 0) {
1541   if (interp != NULL) {
1542       TclExprFloatError(interp, newDouble);
1543   }
1544   return TCL_ERROR;
1545     }
1546 
1547     /*
1548      * Make sure that the string has no garbage after the end of the double.
1549      */
1550     
1551     while ((end < (string+length))
1552       && isspace(UCHAR(*end))) { /* INTL: ISO space. */
1553   end++;
1554     }
1555     if (end != (string+length)) {
1556   goto badDouble;
1557     }
1558     
1559     /*
1560      * The conversion to double succeeded. Free the old internalRep before
1561      * setting the new one. We do this as late as possible to allow the
1562      * conversion code, in particular Tcl_GetStringFromObj, to use that old
1563      * internalRep.
1564      */
1565     
1566     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
1567   oldTypePtr->freeIntRepProc(objPtr);
1568     }
1569 
1570     objPtr->internalRep.doubleValue = newDouble;
1571     objPtr->typePtr = &tclDoubleType;
1572     return TCL_OK;
1573 }
static int SetIntFromAny (Tcl_Interp * interp, Tcl_Obj * objPtr) [static]

Definition at line 1797 of file tclObj.c.
References SetIntOrWideFromAny(), Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), TCL_OK, Tcl_ResetResult(), tclIntType, and Tcl_Obj::typePtr.
Referenced by SetWideIntFromAny().1801 {
1802     int result;
1803 
1804     result = SetIntOrWideFromAny( interp, objPtr );
1805     if ( result != TCL_OK ) {
1806   return result;
1807     }
1808     if ( objPtr->typePtr != &tclIntType ) {
1809   if ( interp != NULL ) {
1810       char *s = "integer value too large to represent";
1811       Tcl_ResetResult(interp);
1812       Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
1813       Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
1814   }
1815   return TCL_ERROR;
1816     }
1817     return TCL_OK;
1818 }
static int SetIntOrWideFromAny (Tcl_Interp * interp, Tcl_Obj * objPtr) [static]

Definition at line 1841 of file tclObj.c.
References ERANGE, errno, Tcl_ObjType::freeIntRepProc, LONG_MAX, strtoul(), Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), Tcl_GetStringFromObj(), TCL_OK, Tcl_ResetResult(), TclCheckBadOctal(), tclIntType, tclWideIntType, and UCHAR.
Referenced by SetIntFromAny(), Tcl_GetIntFromObj(), and Tcl_GetLongFromObj().1844 {
1845     Tcl_ObjType *oldTypePtr = objPtr->typePtr;
1846     char *string, *end;
1847     int length;
1848     register char *p;
1849     unsigned long newLong;
1850     int isNegative = 0;
1851     int isWide = 0;
1852 
1853     /*
1854      * Get the string representation. Make it up-to-date if necessary.
1855      */
1856 
1857     p = string = Tcl_GetStringFromObj(objPtr, &length);
1858 
1859     /*
1860      * Now parse "objPtr"s string as an int. We use an implementation here
1861      * that doesn't report errors in interp if interp is NULL. Note: use
1862      * strtoul instead of strtol for integer conversions to allow full-size
1863      * unsigned numbers, but don't depend on strtoul to handle sign
1864      * characters; it won't in some implementations.
1865      */
1866 
1867     errno = 0;
1868     for ( ;  isspace(UCHAR(*p));  p++) { /* INTL: ISO space. */
1869   /* Empty loop body. */
1870     }
1871     if (*p == '-') {
1872   p++;
1873   isNegative = 1;
1874     } else if (*p == '+') {
1875   p++;
1876     }
1877     if (!isdigit(UCHAR(*p))) {
1878   badInteger:
1879   if (interp != NULL) {
1880       /*
1881        * Must copy string before resetting the result in case a caller
1882        * is trying to convert the interpreter's result to an int.
1883        */
1884       
1885       char buf[100];
1886       sprintf(buf, "expected integer but got \"%.50s\"", string);
1887       Tcl_ResetResult(interp);
1888       Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
1889       TclCheckBadOctal(interp, string);
1890   }
1891   return TCL_ERROR;
1892     }
1893     newLong = strtoul(p, &end, 0);
1894     if (end == p) {
1895   goto badInteger;
1896     }
1897     if (errno == ERANGE) {
1898   if (interp != NULL) {
1899       char *s = "integer value too large to represent";
1900       Tcl_ResetResult(interp);
1901       Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
1902       Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
1903   }
1904   return TCL_ERROR;
1905     }
1906 
1907     /*
1908      * Make sure that the string has no garbage after the end of the int.
1909      */
1910     
1911     while ((end < (string+length))
1912       && isspace(UCHAR(*end))) { /* INTL: ISO space. */
1913   end++;
1914     }
1915     if (end != (string+length)) {
1916   goto badInteger;
1917     }
1918 
1919     /*
1920      * If the resulting integer will exceed the range of a long,
1921      * put it into a wide instead.  (Tcl Bug #868489)
1922      */
1923 
1924 #ifndef TCL_WIDE_INT_IS_LONG
1925     if ((isNegative && newLong > (unsigned long) (LONG_MAX) + 1)
1926       || (!isNegative && newLong > LONG_MAX)) {
1927   isWide = 1;
1928     }
1929 #endif
1930 
1931     /*
1932      * The conversion to int succeeded. Free the old internalRep before
1933      * setting the new one. We do this as late as possible to allow the
1934      * conversion code, in particular Tcl_GetStringFromObj, to use that old
1935      * internalRep.
1936      */
1937 
1938     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
1939   oldTypePtr->freeIntRepProc(objPtr);
1940     }
1941 
1942     if (isWide) {
1943   objPtr->internalRep.wideValue =
1944     (isNegative ? -(Tcl_WideInt)newLong : (Tcl_WideInt)newLong);
1945   objPtr->typePtr = &tclWideIntType;
1946     } else {
1947   objPtr->internalRep.longValue =
1948     (isNegative ? -(long)newLong : (long)newLong);
1949   objPtr->typePtr = &tclIntType;
1950     }
1951     return TCL_OK;
1952 }
static int SetWideIntFromAny (Tcl_Interp * interp, Tcl_Obj * objPtr) [static]

Definition at line 2241 of file tclObj.c.
References ERANGE, errno, Tcl_ObjType::freeIntRepProc, SetIntFromAny(), strtoull(), Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), Tcl_GetStringFromObj(), TCL_OK, Tcl_ResetResult(), TclCheckBadOctal(), tclWideIntType, and UCHAR.
Referenced by Tcl_GetWideIntFromObj().2244 {
2245 #ifndef TCL_WIDE_INT_IS_LONG
2246     Tcl_ObjType *oldTypePtr = objPtr->typePtr;
2247     char *string, *end;
2248     int length;
2249     register char *p;
2250     Tcl_WideInt newWide;
2251 
2252     /*
2253      * Get the string representation. Make it up-to-date if necessary.
2254      */
2255 
2256     p = string = Tcl_GetStringFromObj(objPtr, &length);
2257 
2258     /*
2259      * Now parse "objPtr"s string as an int. We use an implementation here
2260      * that doesn't report errors in interp if interp is NULL. Note: use
2261      * strtoull instead of strtoll for integer conversions to allow full-size
2262      * unsigned numbers, but don't depend on strtoull to handle sign
2263      * characters; it won't in some implementations.
2264      */
2265 
2266     errno = 0;
2267 #ifdef TCL_STRTOUL_SIGN_CHECK
2268     for ( ;  isspace(UCHAR(*p));  p++) { /* INTL: ISO space. */
2269   /* Empty loop body. */
2270     }
2271     if (*p == '-') {
2272   p++;
2273   newWide = -((Tcl_WideInt)strtoull(p, &end, 0));
2274     } else if (*p == '+') {
2275   p++;
2276   newWide = strtoull(p, &end, 0);
2277     } else
2278 #else
2279   newWide = strtoull(p, &end, 0);
2280 #endif
2281     if (end == p) {
2282   badInteger:
2283   if (interp != NULL) {
2284       /*
2285        * Must copy string before resetting the result in case a caller
2286        * is trying to convert the interpreter's result to an int.
2287        */
2288       
2289       char buf[100];
2290       sprintf(buf, "expected integer but got \"%.50s\"", string);
2291       Tcl_ResetResult(interp);
2292       Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
2293       TclCheckBadOctal(interp, string);
2294   }
2295   return TCL_ERROR;
2296     }
2297     if (errno == ERANGE) {
2298   if (interp != NULL) {
2299       char *s = "integer value too large to represent";
2300       Tcl_ResetResult(interp);
2301       Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
2302       Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
2303   }
2304   return TCL_ERROR;
2305     }
2306 
2307     /*
2308      * Make sure that the string has no garbage after the end of the int.
2309      */
2310     
2311     while ((end < (string+length))
2312       && isspace(UCHAR(*end))) { /* INTL: ISO space. */
2313   end++;
2314     }
2315     if (end != (string+length)) {
2316   goto badInteger;
2317     }
2318 
2319     /*
2320      * The conversion to int succeeded. Free the old internalRep before
2321      * setting the new one. We do this as late as possible to allow the
2322      * conversion code, in particular Tcl_GetStringFromObj, to use that old
2323      * internalRep.
2324      */
2325 
2326     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
2327   oldTypePtr->freeIntRepProc(objPtr);
2328     }
2329     
2330     objPtr->internalRep.wideValue = newWide;
2331 #else 
2332     if (TCL_ERROR == SetIntFromAny(interp, objPtr)) {
2333   return TCL_ERROR;
2334     }
2335 #endif
2336     objPtr->typePtr = &tclWideIntType;
2337     return TCL_OK;
2338 }
int Tcl_AppendAllObjTypes (Tcl_Interp * interp, Tcl_Obj * objPtr)

Definition at line 367 of file tclObj.c.
References TCL_ERROR, Tcl_FirstHashEntry(), Tcl_GetHashKey, Tcl_ListObjAppendElement(), Tcl_ListObjGetElements(), Tcl_MutexLock, Tcl_MutexUnlock, Tcl_NewStringObj(), Tcl_NextHashEntry(), TCL_OK, and typeTable.
Referenced by TestobjCmd().372 {
373     register Tcl_HashEntry *hPtr;
374     Tcl_HashSearch search;
375     int objc;
376     Tcl_Obj **objv;
377 
378     /*
379      * Get the test for a valid list out of the way first.
380      */
381 
382     if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
383   return TCL_ERROR;
384     }
385 
386     /*
387      * Type names are NUL-terminated, not counted strings.
388      * This code relies on that.
389      */
390 
391     Tcl_MutexLock(&tableMutex);
392     for (hPtr = Tcl_FirstHashEntry(&typeTable, &search);
393       hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
394   Tcl_ListObjAppendElement(NULL, objPtr,
395           Tcl_NewStringObj(Tcl_GetHashKey(&typeTable, hPtr), -1));
396     }
397     Tcl_MutexUnlock(&tableMutex);
398     return TCL_OK;
399 }
int Tcl_ConvertToType (Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_ObjType * typePtr)

Definition at line 456 of file tclObj.c.
References Tcl_ObjType::setFromAnyProc, TCL_OK, and Tcl_Obj::typePtr.
Referenced by ParsePrimaryExpr(), ParseSearchId(), Tcl_FSConvertToPathType(), Tcl_FSGetNormalizedPath(), and TestobjCmd().460 {
461     if (objPtr->typePtr == typePtr) {
462   return TCL_OK;
463     }
464 
465     /*
466      * Use the target type's Tcl_SetFromAnyProc to set "objPtr"s internal
467      * form as appropriate for the target type. This frees the old internal
468      * representation.
469      */
470 
471     return typePtr->setFromAnyProc(interp, objPtr);
472 }
void Tcl_DbDecrRefCount (Tcl_Obj * objPtr, CONST char * file, int line)

Definition at line 2660 of file tclObj.c.
References panic, and TclFreeObj().2667 {
2668 #ifdef TCL_MEM_DEBUG
2669     if (objPtr->refCount == 0x61616161) {
2670   fprintf(stderr, "file = %s, line = %d\n", file, line);
2671   fflush(stderr);
2672   panic("Trying to decrement refCount of previously disposed object.");
2673     }
2674 #endif
2675     if (--(objPtr)->refCount <= 0) {
2676   TclFreeObj(objPtr);
2677     }
2678 }
void Tcl_DbIncrRefCount (Tcl_Obj * objPtr, CONST char * file, int line)

Definition at line 2620 of file tclObj.c.
References panic.2627 {
2628 #ifdef TCL_MEM_DEBUG
2629     if (objPtr->refCount == 0x61616161) {
2630   fprintf(stderr, "file = %s, line = %d\n", file, line);
2631   fflush(stderr);
2632   panic("Trying to increment refCount of previously disposed object.");
2633     }
2634 #endif
2635     ++(objPtr)->refCount;
2636 }
int Tcl_DbIsShared (Tcl_Obj * objPtr, CONST char * file, int line)

Definition at line 2702 of file tclObj.c.
References panic, Tcl_MutexLock, and Tcl_MutexUnlock.2708 {
2709 #ifdef TCL_MEM_DEBUG
2710     if (objPtr->refCount == 0x61616161) {
2711   fprintf(stderr, "file = %s, line = %d\n", file, line);
2712   fflush(stderr);
2713   panic("Trying to check whether previously disposed object is shared.");
2714     }
2715 #endif
2716 #ifdef TCL_COMPILE_STATS
2717     Tcl_MutexLock(&tclObjMutex);
2718     if ((objPtr)->refCount <= 1) {
2719   tclObjsShared[1]++;
2720     } else if ((objPtr)->refCount < TCL_MAX_SHARED_OBJ_STATS) {
2721   tclObjsShared[(objPtr)->refCount]++;
2722     } else {
2723   tclObjsShared[0]++;
2724     }
2725     Tcl_MutexUnlock(&tclObjMutex);
2726 #endif
2727     return ((objPtr)->refCount > 1);
2728 }
Tcl_Obj* Tcl_DbNewBooleanObj (int boolValue, CONST char * file, int line)

Definition at line 974 of file tclObj.c.
References Tcl_NewBooleanObj().980 {
981     return Tcl_NewBooleanObj(boolValue);
982 }
Tcl_Obj* Tcl_DbNewDoubleObj (double dblValue, CONST char * file, int line)

Definition at line 1390 of file tclObj.c.
References Tcl_NewDoubleObj().1396 {
1397     return Tcl_NewDoubleObj(dblValue);
1398 }
Tcl_Obj* Tcl_DbNewLongObj (long longValue, CONST char * file, int line)

Definition at line 2103 of file tclObj.c.
References Tcl_NewLongObj().2110 {
2111     return Tcl_NewLongObj(longValue);
2112 }
Tcl_Obj* Tcl_DbNewObj (CONST char * file, int line)

Definition at line 575 of file tclObj.c.
References Tcl_NewObj().580 {
581     return Tcl_NewObj();
582 }
Tcl_Obj* Tcl_DbNewWideIntObj (Tcl_WideInt wideValue, CONST char * file, int line)

Definition at line 2495 of file tclObj.c.
References Tcl_NewWideIntObj().2503 {
2504     return Tcl_NewWideIntObj(wideValue);
2505 }
TCL_DECLARE_MUTEX (tableMutex)

Definition at line 27 of file tclObj.c.
References tclBooleanType, tclEmptyString, and tclEmptyStringRep.54                                                        :
55  */
56 
57 static int    SetBooleanFromAny _ANSI_ARGS_((Tcl_Interp *interp,
58           Tcl_Obj *objPtr));
59 static int    SetDoubleFromAny _ANSI_ARGS_((Tcl_Interp *interp,
60           Tcl_Obj *objPtr));
61 static int    SetIntFromAny _ANSI_ARGS_((Tcl_Interp *interp,
62           Tcl_Obj *objPtr));
63 static int    SetIntOrWideFromAny _ANSI_ARGS_((Tcl_Interp* interp,
64                Tcl_Obj *objPtr));
65 static void   UpdateStringOfBoolean _ANSI_ARGS_((Tcl_Obj *objPtr));
66 static void   UpdateStringOfDouble _ANSI_ARGS_((Tcl_Obj *objPtr));
67 static void   UpdateStringOfInt _ANSI_ARGS_((Tcl_Obj *objPtr));
68 static int    SetWideIntFromAny _ANSI_ARGS_((Tcl_Interp *interp,
69           Tcl_Obj *objPtr));
70 
71 #ifndef TCL_WIDE_INT_IS_LONG
72 static void   UpdateStringOfWideInt _ANSI_ARGS_((Tcl_Obj *objPtr));
73 #endif
74 
75 /*
76  * Prototypes for the array hash key methods.
77  */
78 
79 static Tcl_HashEntry *  AllocObjEntry _ANSI_ARGS_((
80           Tcl_HashTable *tablePtr, VOID *keyPtr));
81 static int    CompareObjKeys _ANSI_ARGS_((
82           VOID *keyPtr, Tcl_HashEntry *hPtr));
83 static void   FreeObjEntry _ANSI_ARGS_((
84           Tcl_HashEntry *hPtr));
85 static unsigned int HashObjKey _ANSI_ARGS_((
86           Tcl_HashTable *tablePtr,
87           VOID *keyPtr));
88 
89 /*
90  * Prototypes for the CommandName object type.
91  */
92 
93 static void   DupCmdNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
94           Tcl_Obj *copyPtr));
95 static void   FreeCmdNameInternalRep _ANSI_ARGS_((
96               Tcl_Obj *objPtr));
97 static int    SetCmdNameFromAny _ANSI_ARGS_((Tcl_Interp *interp,
98           Tcl_Obj *objPtr));
99 
100 
101 /*
102  * The structures below defines the Tcl object types defined in this file by
103  * means of procedures that can be invoked by generic object code. See also
104  * tclStringObj.c, tclListObj.c, tclByteCode.c for other type manager
105  * implementations.
106  */
107 
108 Tcl_ObjType tclBooleanType = {
109     "boolean",        /* name */
110     (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
111     (Tcl_DupInternalRepProc *) NULL,  /* dupIntRepProc */
112     UpdateStringOfBoolean,    /* updateStringProc */
113     SetBooleanFromAny     /* setFromAnyProc */
114 };

Tcl_Obj* Tcl_DuplicateObj (Tcl_Obj * objPtr)

Definition at line 736 of file tclObj.c.
References Tcl_Obj::bytes, Tcl_ObjType::dupIntRepProc, Tcl_Obj::internalRep, TclInitStringRep, TclNewObj, and Tcl_Obj::typePtr.
Referenced by CopyData(), ExecuteCallback(), FsAddMountsToGlobResult(), ProcCompileProc(), StdinProc(), Tcl_FSGetNormalizedPath(), Tcl_FSJoinPath(), Tcl_LappendObjCmd(), Tcl_LinsertObjCmd(), Tcl_LreplaceObjCmd(), Tcl_LsearchObjCmd(), Tcl_LsortObjCmd(), Tcl_Main(), Tcl_RegsubObjCmd(), Tcl_StringObjCmd(), TclFSCwdPointerEquals(), TclGlob(), TclHideLiteral(), TclLsetFlat(), TclLsetList(), TclPtrIncrVar(), TclPtrSetVar(), TestobjCmd(), TestReportInFilesystem(), TeststringobjCmd(), and UpdateStringOfFsPath().738 {
739     register Tcl_ObjType *typePtr = objPtr->typePtr;
740     register Tcl_Obj *dupPtr;
741 
742     TclNewObj(dupPtr);
743 
744     if (objPtr->bytes == NULL) {
745   dupPtr->bytes = NULL;
746     } else if (objPtr->bytes != tclEmptyStringRep) {
747   TclInitStringRep(dupPtr, objPtr->bytes, objPtr->length);
748     }
749     
750     if (typePtr != NULL) {
751   if (typePtr->dupIntRepProc == NULL) {
752       dupPtr->internalRep = objPtr->internalRep;
753       dupPtr->typePtr = typePtr;
754   } else {
755       (*typePtr->dupIntRepProc)(objPtr, dupPtr);
756   }
757     }
758     return dupPtr;
759 }
int Tcl_GetBooleanFromObj (Tcl_Interp * interp, Tcl_Obj * objPtr, int * boolPtr)

Definition at line 1045 of file tclObj.c.
References SetBooleanFromAny(), and TCL_OK.
Referenced by LinkTraceProc(), SetFileFinderAttributes(), SetFileReadOnly(), SetWinFileAttributes(), TCL_DECLARE_MUTEX(), Tcl_ExprBoolean(), Tcl_ExprBooleanObj(), TclCompileWhileCmd(), TclExecuteByteCode(), TestbooleanobjCmd(), TesteventProc(), TestFilesystemObjCmd(), TestindexobjCmd(), TestsaveresultCmd(), and TestSimpleFilesystemObjCmd().1049 {
1050     register int result;
1051 
1052     if (objPtr->typePtr == &tclBooleanType) {
1053   result = TCL_OK;
1054     } else {
1055   result = SetBooleanFromAny(interp, objPtr);
1056     }
1057 
1058     if (result == TCL_OK) {
1059   *boolPtr = (int) objPtr->internalRep.longValue;
1060     }
1061     return result;
1062 }
Tcl_Command Tcl_GetCommandFromObj (Tcl_Interp * interp, Tcl_Obj * objPtr)

Definition at line 2946 of file tclObj.c.
References ResolvedCmdName::cmdEpoch, Command::cmdEpoch, ResolvedCmdName::cmdPtr, Namespace::cmdRefEpoch, Interp::globalNsPtr, Namespace::nsId, CallFrame::nsPtr, ResolvedCmdName::refNsCmdEpoch, ResolvedCmdName::refNsId, ResolvedCmdName::refNsPtr, Tcl_ObjType::setFromAnyProc, Tcl_GetString(), TCL_OK, tclCmdNameType, and Interp::varFramePtr.
Referenced by NamespaceOriginCmd(), NamespaceWhichCmd(), TclEvalObjvInternal(), and TclExecuteByteCode().2954 {
2955     Interp *iPtr = (Interp *) interp;
2956     register ResolvedCmdName *resPtr;
2957     register Command *cmdPtr;
2958     Namespace *currNsPtr;
2959     int result;
2960     CallFrame *savedFramePtr;
2961     char *name;
2962 
2963     /*
2964      * If the variable name is fully qualified, do as if the lookup were
2965      * done from the global namespace; this helps avoid repeated lookups 
2966      * of fully qualified names. It costs close to nothing, and may be very
2967      * helpful for OO applications which pass along a command name ("this"),
2968      * [Patch 456668]
2969      */
2970 
2971     savedFramePtr = iPtr->varFramePtr;
2972     name = Tcl_GetString(objPtr);
2973     if ((*name++ == ':') && (*name == ':')) {
2974   iPtr->varFramePtr = NULL;
2975     }
2976 
2977     /*
2978      * Get the internal representation, converting to a command type if
2979      * needed. The internal representation is a ResolvedCmdName that points
2980      * to the actual command.
2981      */
2982     
2983     if (objPtr->typePtr != &tclCmdNameType) {
2984         result = tclCmdNameType.setFromAnyProc(interp, objPtr);
2985         if (result != TCL_OK) {
2986       iPtr->varFramePtr = savedFramePtr;
2987             return (Tcl_Command) NULL;
2988         }
2989     }
2990     resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
2991 
2992     /*
2993      * Get the current namespace.
2994      */
2995     
2996     if (iPtr->varFramePtr != NULL) {
2997   currNsPtr = iPtr->varFramePtr->nsPtr;
2998     } else {
2999   currNsPtr = iPtr->globalNsPtr;
3000     }
3001 
3002     /*
3003      * Check the context namespace and the namespace epoch of the resolved
3004      * symbol to make sure that it is fresh. If not, then force another
3005      * conversion to the command type, to discard the old rep and create a
3006      * new one. Note that we verify that the namespace id of the context
3007      * namespace is the same as the one we cached; this insures that the
3008      * namespace wasn't deleted and a new one created at the same address
3009      * with the same command epoch.
3010      */
3011     
3012     cmdPtr = NULL;
3013     if ((resPtr != NULL)
3014       && (resPtr->refNsPtr == currNsPtr)
3015       && (resPtr->refNsId == currNsPtr->nsId)
3016       && (resPtr->refNsCmdEpoch == currNsPtr->cmdRefEpoch)) {
3017         cmdPtr = resPtr->cmdPtr;
3018         if (cmdPtr->cmdEpoch != resPtr->cmdEpoch) {
3019             cmdPtr = NULL;
3020         }
3021     }
3022 
3023     if (cmdPtr == NULL) {
3024         result = tclCmdNameType.setFromAnyProc(interp, objPtr);
3025         if (result != TCL_OK) {
3026       iPtr->varFramePtr = savedFramePtr;
3027             return (Tcl_Command) NULL;
3028         }
3029         resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
3030         if (resPtr != NULL) {
3031             cmdPtr = resPtr->cmdPtr;
3032         }
3033     }
3034     iPtr->varFramePtr = savedFramePtr;
3035     return (Tcl_Command) cmdPtr;
3036 }
int Tcl_GetDoubleFromObj (Tcl_Interp * interp, Tcl_Obj * objPtr, double * dblPtr)

Definition at line 1461 of file tclObj.c.
References SetDoubleFromAny(), TCL_OK, and tclDoubleType.
Referenced by FormatNumber(), LinkTraceProc(), SortCompare(), Tcl_ExprDoubleObj(), Tcl_FormatObjCmd(), Tcl_LsearchObjCmd(), TclExecuteByteCode(), TestconvertobjCmd(), TestdoubleobjCmd(), and VerifyExprObjType().1465 {
1466     register int result;
1467     
1468     if (objPtr->typePtr == &tclDoubleType) {
1469   *dblPtr = objPtr->internalRep.doubleValue;
1470   return TCL_OK;
1471     }
1472 
1473     result = SetDoubleFromAny(interp, objPtr);
1474     if (result == TCL_OK) {
1475   *dblPtr = objPtr->internalRep.doubleValue;
1476     }
1477     return result;
1478 }
int Tcl_GetIntFromObj (Tcl_Interp * interp, Tcl_Obj * objPtr, int * intPtr)

Definition at line 1734 of file tclObj.c.
References LLONG_MAX, SetIntOrWideFromAny(), TCL_ERROR, Tcl_LongAsWide, Tcl_NewStringObj(), TCL_OK, Tcl_SetObjResult(), tclIntType, and tclWideIntType.
Referenced by BroadcastValue(), ExecuteCallback(), GetTimesCmd(), InfoLevelCmd(), LinkTraceProc(), Pkgb_SubObjCmd(), Pkgc_SubObjCmd(), Pkgd_SubObjCmd(), SetValue(), SlaveRecursionLimit(), SortCompare(), Tcl_AfterObjCmd(), Tcl_BeepObjCmd(), Tcl_DdeObjCmd(), Tcl_ExitObjCmd(), Tcl_FcopyObjCmd(), Tcl_FormatObjCmd(), Tcl_LsearchObjCmd(), Tcl_OpenObjCmd(), Tcl_ReadObjCmd(), Tcl_RegexpObjCmd(), Tcl_RegsubObjCmd(), Tcl_ReturnObjCmd(), Tcl_StringObjCmd(), Tcl_TimeObjCmd(), TclCompileIncrCmd(), TclGetIntForIndex(), TestevalobjvObjCmd(), TestexprparserObjCmd(), TestGetIndexFromObjStructObjCmd(), TestindexobjCmd(), TestintobjCmd(), TestparserObjCmd(), TestparsevarnameObjCmd(), TeststringobjCmd(), TestwincpuidCmd(), TestwinsleepCmd(), and TestWrongNumArgsObjCmd().1738 {
1739     int result;
1740     Tcl_WideInt w = 0;
1741 
1742     /*
1743      * If the object isn't already an integer of any width, try to
1744      * convert it to one.
1745      */
1746 
1747     if (objPtr->typePtr != &tclIntType && objPtr->typePtr != &tclWideIntType) {
1748   result = SetIntOrWideFromAny(interp, objPtr);
1749   if (result != TCL_OK) {
1750       return result;
1751   }
1752     }
1753 
1754     /*
1755      * Object should now be either int or wide. Get its value.
1756      */
1757 
1758 #ifndef TCL_WIDE_INT_IS_LONG
1759     if (objPtr->typePtr == &tclWideIntType) {
1760   w = objPtr->internalRep.wideValue;
1761     } else
1762 #endif
1763     {
1764   w = Tcl_LongAsWide(objPtr->internalRep.longValue);
1765     }
1766 
1767     if ((LLONG_MAX > UINT_MAX)
1768       && ((w > UINT_MAX) || (w < -(Tcl_WideInt)UINT_MAX))) {
1769   if (interp != NULL) {
1770       Tcl_SetObjResult(interp, Tcl_NewStringObj(
1771     "integer value too large to represent as non-long integer",
1772     -1));
1773   }
1774   return TCL_ERROR;
1775     }
1776     *intPtr = (int)w;
1777     return TCL_OK;
1778 }
int Tcl_GetLongFromObj (Tcl_Interp * interp, Tcl_Obj * objPtr, long * longPtr)

Definition at line 2176 of file tclObj.c.
References SetIntOrWideFromAny(), Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), TCL_OK, Tcl_ResetResult(), Tcl_WideAsLong, tclIntType, and tclWideIntType.
Referenced by ExprSrandFunc(), FormatNumber(), SetGroupAttribute(), SetOwnerAttribute(), SetPermissionsAttribute(), SortCompare(), Tcl_ExprLongObj(), Tcl_FileObjCmd(), Tcl_FormatObjCmd(), Tcl_IncrObjCmd(), Tcl_MacSourceObjCmd(), Tcl_ResourceObjCmd(), and TestintobjCmd().2180 {
2181     register int result;
2182     
2183     if (objPtr->typePtr != &tclIntType && objPtr->typePtr != &tclWideIntType) {
2184   result = SetIntOrWideFromAny(interp, objPtr);
2185   if (result != TCL_OK) {
2186       return result;
2187   }
2188     }
2189 
2190 #ifndef TCL_WIDE_INT_IS_LONG
2191     if (objPtr->typePtr == &tclWideIntType) {
2192   /*
2193    * If the object is already a wide integer, don't convert it.
2194    * This code allows for any integer in the range -ULONG_MAX to
2195    * ULONG_MAX to be converted to a long, ignoring overflow.
2196    * The rule preserves existing semantics for conversion of
2197    * integers on input, but avoids inadvertent demotion of
2198    * wide integers to 32-bit ones in the internal rep.
2199    */
2200 
2201   Tcl_WideInt w = objPtr->internalRep.wideValue;
2202   if (w >= -(Tcl_WideInt)(ULONG_MAX) && w <= (Tcl_WideInt)(ULONG_MAX)) {
2203       *longPtr = Tcl_WideAsLong(w);
2204       return TCL_OK;
2205   } else {
2206       if (interp != NULL) {
2207     Tcl_ResetResult(interp);
2208     Tcl_AppendToObj(Tcl_GetObjResult(interp),
2209       "integer value too large to represent", -1);
2210       }
2211       return TCL_ERROR;
2212   }
2213     }
2214 #endif
2215 
2216     *longPtr = objPtr->internalRep.longValue;
2217     return TCL_OK;
2218 }
Tcl_ObjType* Tcl_GetObjType (CONST char * typeName)

Definition at line 420 of file tclObj.c.
References Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_MutexLock, Tcl_MutexUnlock, and typeTable.
Referenced by TestobjCmd().422 {
423     register Tcl_HashEntry *hPtr;
424     Tcl_ObjType *typePtr = NULL;
425 
426     Tcl_MutexLock(&tableMutex);
427     hPtr = Tcl_FindHashEntry(&typeTable, typeName);
428     if (hPtr != (Tcl_HashEntry *) NULL) {
429         typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr);
430     }
431     Tcl_MutexUnlock(&tableMutex);
432     return typePtr;
433 }
char* Tcl_GetString (Tcl_Obj * objPtr)

Definition at line 783 of file tclObj.c.
References panic.
Referenced by AliasCreate(), AliasDelete(), AliasDescribe(), AsyncHandlerProc(), CallVarTraces(), CannotSetAttribute(), ComparePkgVersions(), ConvertFileNameFormat(), CopyRenameOneFile(), DeleteValue(), DoReadChars(), FileBasename(), FileCopyRename(), FileForceOption(), FindLibraries(), GetAfterEvent(), GetFileFinderAttributes(), GetFileReadOnly(), GetGroupAttribute(), GetInterp(), GetKeyNames(), GetNamespaceFromObj(), GetOwnerAttribute(), GetPermissionsAttribute(), GetStatBuf(), GetType(), GetValue(), GetValueNames(), InfoArgsCmd(), InfoBodyCmd(), InfoCommandsCmd(), InfoDefaultCmd(), InfoExistsCmd(), InfoFunctionsCmd(), InfoGlobalsCmd(), InfoLevelCmd(), InfoLoadedCmd(), InfoLocalsCmd(), InfoProcsCmd(), InfoVarsCmd(), LinkTraceProc(), LoadEncodingFile(), LoadTableEncoding(), NamespaceChildrenCmd(), NamespaceDeleteCmd(), NamespaceExportCmd(), NamespaceForgetCmd(), NamespaceImportCmd(), NamespaceInscopeCmd(), NamespaceOriginCmd(), NamespaceParentCmd(), NamespaceQualifiersCmd(), NamespaceTailCmd(), NamespaceWhichCmd(), ObjTraceProc(), ParseSearchId(), SetArraySearchObj(), SetCmdNameFromAny(), SetFileFinderAttributes(), SetFileReadOnly(), SetFsPathFromAny(), SetGroupAttribute(), SetNsNameFromAny(), SetOwnerAttribute(), SetPermissionsAttribute(), SetValue(), SimpleCopy(), SimplePathInFilesystem(), SlaveCreate(), SlaveExpose(), SlaveHide(), SlaveObjCmd(), SortCompare(), StatError(), StringTraceProc(), Tcl_AfterObjCmd(), Tcl_ArrayObjCmd(), Tcl_BeepObjCmd(), Tcl_BinaryObjCmd(), Tcl_CaseObjCmd(), Tcl_CdObjCmd(), Tcl_CloseObjCmd(), Tcl_DdeObjCmd(), Tcl_EofObjCmd(), Tcl_EvalObjv(), Tcl_EvalTokensStandard(), Tcl_ExecObjCmd(), Tcl_FblockedObjCmd(), Tcl_FconfigureObjCmd(), Tcl_FcopyObjCmd(), Tcl_FileEventObjCmd(), Tcl_FileObjCmd(), Tcl_FlushObjCmd(), Tcl_ForeachObjCmd(), Tcl_FSAccess(), Tcl_FSEvalFile(), Tcl_FSGetNormalizedPath(), Tcl_FSJoinPath(), Tcl_FSLoadFile(), Tcl_FSOpenFileChannel(), Tcl_FSSplitPath(), Tcl_FSStat(), Tcl_GetAlias(), Tcl_GetAliasObj(), Tcl_GetCommandFromObj(), Tcl_GetCwd(), Tcl_GetRange(), Tcl_GetsObjCmd(), Tcl_GlobObjCmd(), Tcl_IfObjCmd(), Tcl_InterpObjCmd(), Tcl_LoadObjCmd(), Tcl_LreplaceObjCmd(), Tcl_LsearchObjCmd(), Tcl_LsObjCmd(), Tcl_MacBGNotifyObjCmd(), Tcl_MacSourceObjCmd(), Tcl_ObjGetVar2(), Tcl_ObjSetVar2(), Tcl_OpenObjCmd(), Tcl_PackageObjCmd(), Tcl_PidObjCmd(), Tcl_PkgRequireEx(), Tcl_ProcObjCmd(), Tcl_PutsObjCmd(), Tcl_ReadObjCmd(), Tcl_RegexpObjCmd(), Tcl_RegExpRange(), Tcl_RegsubObjCmd(), Tcl_RenameObjCmd(), Tcl_ResourceObjCmd(), Tcl_ReturnObjCmd(), Tcl_ScanObjCmd(), Tcl_SeekObjCmd(), Tcl_SocketObjCmd(), Tcl_StringObjCmd(), Tcl_SwitchObjCmd(), Tcl_TellObjCmd(), Tcl_TraceObjCmd(), Tcl_TranslateFileName(), Tcl_VwaitObjCmd(), Tcl_WrongNumArgs(), TclCompileStringCmd(), TclDeleteNamespaceVars(), TclDeleteVars(), TclDoGlob(), TclEvalObjvInternal(), TclExecuteByteCode(), TclFileAttrsCmd(), TclFileDeleteCmd(), TclFileDirname(), TclFileMakeDirsCmd(), TclFindEncodings(), TclFSMakePathRelative(), TclGetEncodingFromObj(), TclGetIntForIndex(), TclGetStartupScriptFileName(), TclGlob(), TclInvokeStringCommand(), TclObjInvoke(), TclpDlopen(), TclpFilesystemPathType(), TclpGetNativePathType(), TclpMatchInDirectory(), TclpNativeJoinPath(), TclpNativeSplitPath(), TclpObjCopyDirectory(), TclpObjNormalizePath(), TclpObjRemoveDirectory(), TclpObjStat(), TclpOpenFileChannel(), TclPreventAliasLoop(), TclRenameCommand(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), TestbooleanobjCmd(), TestcmdtokenCmd(), TestconvertobjCmd(), TestdoubleobjCmd(), TestencodingObjCmd(), TestfileCmd(), TestfilelinkCmd(), TestgetvarfullnameCmd(), TestindexobjCmd(), TestintobjCmd(), TestlinkCmd(), TestlocaleCmd(), TestNumUtfCharsCmd(), TestobjCmd(), TestparsevarObjCmd(), TestregexpObjCmd(), TestReport(), TestsaveresultCmd(), TeststringobjCmd(), TestvolumetypeCmd(), TraceExecutionProc(), and TryToLoad().786 {
787     if (objPtr->bytes != NULL) {
788   return objPtr->bytes;
789     }
790 
791     if (objPtr->typePtr->updateStringProc == NULL) {
792   panic("UpdateStringProc should not be invoked for type %s",
793     objPtr->typePtr->name);
794     }
795     (*objPtr->typePtr->updateStringProc)(objPtr);
796     return objPtr->bytes;
797 }
char* Tcl_GetStringFromObj (Tcl_Obj * objPtr, int * lengthPtr)

Definition at line 823 of file tclObj.c.
References panic.
Referenced by AfterProc(), BroadcastValue(), CloseLibraryResource(), ConvertFileNameFormat(), CopyData(), DdeServerProc(), DeleteKey(), DeleteValue(), DoReadChars(), FsUpdateCwd(), GetPathType(), GetRsrcRefFromObj(), GetType(), GetValue(), GetWinFileAttributes(), HandleBgErrors(), IllegalExprOperandType(), LinkTraceProc(), NamespaceCodeCmd(), NamespaceEvalCmd(), NativeCreateNativeRep(), NativePathInFilesystem(), OpenKey(), Pkga_EqObjCmd(), ProcBodyTestProcObjCmd(), RebuildLiteralTable(), SetBooleanFromAny(), SetByteArrayFromAny(), SetDoubleFromAny(), SetEndOffsetFromAny(), SetFsPathFromAny(), SetGroupAttribute(), SetIntOrWideFromAny(), SetListFromAny(), SetOSTypeFromAny(), SetOwnerAttribute(), SetValue(), SetWideIntFromAny(), StdinProc(), Tcl_AfterObjCmd(), Tcl_AppendObjToObj(), Tcl_BackgroundError(), Tcl_BeepObjCmd(), Tcl_BinaryObjCmd(), Tcl_CloseObjCmd(), Tcl_DdeObjCmd(), TCL_DECLARE_MUTEX(), Tcl_EncodingObjCmd(), Tcl_ErrorObjCmd(), Tcl_EvalObjEx(), Tcl_ExecObjCmd(), Tcl_ExprObj(), Tcl_ExprObjCmd(), Tcl_FileObjCmd(), Tcl_FormatObjCmd(), Tcl_FSChdir(), Tcl_FSEqualPaths(), Tcl_FSEvalFile(), Tcl_FSGetNormalizedPath(), Tcl_FSGetTranslatedStringPath(), Tcl_FSJoinPath(), Tcl_FSMatchInDirectory(), Tcl_FSRemoveDirectory(), Tcl_GetEncodingNames(), Tcl_GetRegExpFromObj(), Tcl_Gets(), Tcl_GetsObj(), Tcl_GlobObjCmd(), Tcl_JoinObjCmd(), Tcl_JoinPath(), Tcl_LsearchObjCmd(), Tcl_LsObjCmd(), Tcl_MacSourceObjCmd(), Tcl_Main(), Tcl_PackageObjCmd(), Tcl_PidObjCmd(), Tcl_PutsObjCmd(), Tcl_ReadObjCmd(), Tcl_ResourceObjCmd(), Tcl_ReturnObjCmd(), Tcl_ScanObjCmd(), Tcl_SplitObjCmd(), Tcl_SplitPath(), Tcl_StringObjCmd(), Tcl_SubstObj(), Tcl_TraceObjCmd(), Tcl_WriteObj(), TclArraySet(), TclCompEvalObj(), TclCreateProc(), TclExecuteByteCode(), TclFSMakePathRelative(), TclFSNormalizeAbsolutePath(), TclGlob(), TclHideLiteral(), TclLookupLiteralEntry(), TclMacRegisterResourceFork(), TclMacUnRegisterResourceFork(), TclObjCommandComplete(), TclObjInterpProc(), TclObjInvoke(), TclObjLookupVar(), TclpCreateProcess(), TclpGetNativePathType(), TclpMatchInDirectory(), TclpNativeJoinPath(), TclpObjNormalizePath(), TclPrintObject(), TclpSetInitialEncodings(), TclpSetVariables(), TclReleaseLiteral(), TclSetByteCodeFromAny(), TclSetLibraryPath(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), TestencodingObjCmd(), TestevalexObjCmd(), TesteventDeleteProc(), TestexprparserObjCmd(), TestNumUtfCharsCmd(), TestparserObjCmd(), TestparsevarnameObjCmd(), TestregexpObjCmd(), TeststringobjCmd(), TestWrongNumArgsObjCmd(), TraceExecutionProc(), UpdateParsedVarName(), UpdateStringOfFsPath(), UpdateStringOfList(), and VerifyExprObjType().829 {
830     if (objPtr->bytes == NULL) {
831   if (objPtr->typePtr->updateStringProc == NULL) {
832       panic("UpdateStringProc should not be invoked for type %s",
833         objPtr->typePtr->name);
834   }
835   (*objPtr->typePtr->updateStringProc)(objPtr);
836     }
837 
838     if (lengthPtr != NULL) {
839   *lengthPtr = objPtr->length;
840     }
841     return objPtr->bytes;
842 }
int Tcl_GetWideIntFromObj (Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_WideInt * wideIntPtr)

Definition at line 2569 of file tclObj.c.
References SetWideIntFromAny(), Tcl_LongAsWide, TCL_OK, tclIntType, and tclWideIntType.
Referenced by ExprSrandFunc(), FormatNumber(), GetLexeme(), LinkTraceProc(), TCL_DECLARE_MUTEX(), Tcl_FormatObjCmd(), Tcl_IncrObjCmd(), Tcl_SeekObjCmd(), TclPtrIncrVar(), and TestlinkCmd().2573 {
2574     register int result;
2575 
2576     if (objPtr->typePtr == &tclWideIntType) {
2577     gotWide:
2578   *wideIntPtr = objPtr->internalRep.wideValue;
2579   return TCL_OK;
2580     }
2581     if (objPtr->typePtr == &tclIntType) {
2582   /*
2583    * This cast is safe; all valid ints/longs are wides.
2584    */
2585 
2586   objPtr->internalRep.wideValue =
2587     Tcl_LongAsWide(objPtr->internalRep.longValue);
2588   objPtr->typePtr = &tclWideIntType;
2589   goto gotWide;
2590     }
2591     result = SetWideIntFromAny(interp, objPtr);
2592     if (result == TCL_OK) {
2593   *wideIntPtr = objPtr->internalRep.wideValue;
2594     }
2595     return result;
2596 }
void Tcl_InitObjHashTable (Tcl_HashTable * tablePtr)

Definition at line 2749 of file tclObj.c.
References TCL_CUSTOM_PTR_KEYS, Tcl_InitCustomHashTable(), and tclObjHashKeyType.2752 {
2753     Tcl_InitCustomHashTable(tablePtr, TCL_CUSTOM_PTR_KEYS,
2754       &tclObjHashKeyType);
2755 }
void Tcl_InvalidateStringRep (Tcl_Obj * objPtr)

Definition at line 863 of file tclObj.c.
References ckfree.
Referenced by AppendUnicodeToUnicodeRep(), Tcl_AttemptSetObjLength(), Tcl_LappendObjCmd(), Tcl_ListObjAppendElement(), Tcl_ListObjReplace(), Tcl_NewListObj(), Tcl_NewUnicodeObj(), Tcl_SetBooleanObj(), Tcl_SetByteArrayLength(), Tcl_SetByteArrayObj(), Tcl_SetDoubleObj(), Tcl_SetIntObj(), Tcl_SetListObj(), Tcl_SetLongObj(), Tcl_SetObjLength(), Tcl_SetOSTypeObj(), Tcl_SetStringObj(), Tcl_SetUnicodeObj(), Tcl_SetWideIntObj(), TclExecuteByteCode(), TclFreeObj(), TclLsetFlat(), TclLsetList(), TclpSetInitialEncodings(), and TestobjCmd().866 {
867     if (objPtr->bytes != NULL) {
868   if (objPtr->bytes != tclEmptyStringRep) {
869       ckfree((char *) objPtr->bytes);
870   }
871   objPtr->bytes = NULL;
872     }
873 }
Tcl_Obj* Tcl_NewBooleanObj (int boolValue)

Definition at line 911 of file tclObj.c.
References Tcl_Obj::bytes, Tcl_Obj::internalRep, Tcl_Obj::longValue, TclNewObj, and Tcl_Obj::typePtr.
Referenced by GetFileFinderAttributes(), GetFileReadOnly(), GetWinFileAttributes(), ObjValue(), Tcl_DbNewBooleanObj(), and TestbooleanobjCmd().913 {
914     register Tcl_Obj *objPtr;
915 
916     TclNewObj(objPtr);
917     objPtr->bytes = NULL;
918     
919     objPtr->internalRep.longValue = (boolValue? 1 : 0);
920     objPtr->typePtr = &tclBooleanType;
921     return objPtr;
922 }
Tcl_Obj* Tcl_NewDoubleObj (double dblValue)

Definition at line 1327 of file tclObj.c.
References Tcl_Obj::bytes, Tcl_Obj::doubleValue, Tcl_Obj::internalRep, tclDoubleType, TclNewObj, and Tcl_Obj::typePtr.
Referenced by ExprAbsFunc(), ExprBinaryFunc(), ExprDoubleFunc(), ExprRandFunc(), ExprUnaryFunc(), ObjValue(), ScanNumber(), Tcl_DbNewDoubleObj(), Tcl_ScanObjCmd(), Tcl_TimeObjCmd(), TclExecuteByteCode(), and TestdoubleobjCmd().1329 {
1330     register Tcl_Obj *objPtr;
1331 
1332     TclNewObj(objPtr);
1333     objPtr->bytes = NULL;
1334     
1335     objPtr->internalRep.doubleValue = dblValue;
1336     objPtr->typePtr = &tclDoubleType;
1337     return objPtr;
1338 }
Tcl_Obj* Tcl_NewIntObj (int intValue)

Definition at line 1655 of file tclObj.c.
References Tcl_Obj::bytes, Tcl_Obj::internalRep, Tcl_Obj::longValue, tclIntType, TclNewObj, and Tcl_Obj::typePtr.
Referenced by CopyData(), ExecuteRemoteObject(), GetGroupAttribute(), GetOwnerAttribute(), ObjValue(), Pkga_EqObjCmd(), Pkgb_SubObjCmd(), Pkgc_SubObjCmd(), Pkgd_SubObjCmd(), PrintParse(), SlaveRecursionLimit(), StoreStatData(), Tcl_LsearchObjCmd(), Tcl_Main(), Tcl_PackageObjCmd(), Tcl_ResourceObjCmd(), Tcl_ScanObjCmd(), Tcl_StringObjCmd(), Tcl_TimeObjCmd(), TclExecuteByteCode(), TestintobjCmd(), TestNumUtfCharsCmd(), TestwinclockCmd(), TestwincpuidCmd(), and TraceExecutionProc().1657 {
1658     register Tcl_Obj *objPtr;
1659 
1660     TclNewObj(objPtr);
1661     objPtr->bytes = NULL;
1662     
1663     objPtr->internalRep.longValue = (long)intValue;
1664     objPtr->typePtr = &tclIntType;
1665     return objPtr;
1666 }
Tcl_Obj* Tcl_NewLongObj (long longValue)

Definition at line 2031 of file tclObj.c.
References Tcl_Obj::bytes, Tcl_Obj::internalRep, Tcl_Obj::longValue, tclIntType, TclNewObj, and Tcl_Obj::typePtr.
Referenced by BroadcastValue(), ExprAbsFunc(), ExprIntFunc(), ExprRoundFunc(), ScanNumber(), StoreStatData(), Tcl_DbNewLongObj(), Tcl_ExprObj(), Tcl_PidObjCmd(), Tcl_RegexpObjCmd(), Tcl_ScanObjCmd(), TclExecuteByteCode(), TestintobjCmd(), TestmainthreadCmd(), and TestregexpObjCmd().2034 {
2035     register Tcl_Obj *objPtr;
2036 
2037     TclNewObj(objPtr);
2038     objPtr->bytes = NULL;
2039     
2040     objPtr->internalRep.longValue = longValue;
2041     objPtr->typePtr = &tclIntType;
2042     return objPtr;
2043 }
Tcl_Obj* Tcl_NewObj ()

Definition at line 512 of file tclObj.c.
References TclNewObj.
Referenced by BroadcastValue(), BuildResourceForkList(), CopyData(), FileBasename(), FsListMounts(), GetTimesCmd(), InfoCommandsCmd(), InfoDefaultCmd(), InfoProcsCmd(), InfoVarsCmd(), LoadTableEncoding(), OpenLibraryResource(), ResourceInit(), SplitMacPath(), SplitUnixPath(), SplitWinPath(), StdinProc(), StoreStatData(), Tcl_ArrayObjCmd(), Tcl_BinaryObjCmd(), Tcl_CreateInterp(), Tcl_DbNewObj(), Tcl_DdeObjCmd(), Tcl_ExecObjCmd(), Tcl_ForeachObjCmd(), Tcl_FormatObjCmd(), Tcl_FSEvalFile(), Tcl_FSJoinPath(), Tcl_FSListVolumes(), Tcl_FSSplitPath(), Tcl_Gets(), Tcl_GetsObjCmd(), Tcl_Init(), Tcl_JoinPath(), Tcl_LappendObjCmd(), Tcl_ListMathFuncs(), Tcl_LsearchObjCmd(), Tcl_LsortObjCmd(), Tcl_Main(), Tcl_NewOSTypeObj(), Tcl_ReadObjCmd(), Tcl_RegexpObjCmd(), Tcl_SaveResult(), Tcl_ScanObjCmd(), Tcl_StringObjCmd(), Tcl_TraceObjCmd(), TclCleanupChildren(), TclDeleteNamespaceVars(), TclDeleteVars(), TclLindexFlat(), TclLindexList(), TclNewFSPathObj(), TclpInitLibraryPath(), TclpObjListVolumes(), TclRenameCommand(), TestcmdtokenCmd(), TestobjCmd(), TestregexpObjCmd(), TestsetobjerrorcodeCmd(), TeststringobjCmd(), and TestwinclockCmd().513 {
514     register Tcl_Obj *objPtr;
515 
516     /*
517      * Use the macro defined in tclInt.h - it will use the
518      * correct allocator.
519      */
520 
521     TclNewObj(objPtr);
522     return objPtr;
523 }
Tcl_Obj* Tcl_NewWideIntObj (Tcl_WideInt wideValue)

Definition at line 2421 of file tclObj.c.
References Tcl_Obj::bytes, Tcl_Obj::internalRep, TclNewObj, tclWideIntType, Tcl_Obj::typePtr, and Tcl_Obj::wideValue.
Referenced by ExprAbsFunc(), ExprRoundFunc(), ExprWideFunc(), ObjValue(), ScanNumber(), StoreStatData(), Tcl_DbNewWideIntObj(), Tcl_ScanObjCmd(), TclExecuteByteCode(), TestlinkCmd(), and TestwinclockCmd().2424 {
2425     register Tcl_Obj *objPtr;
2426 
2427     TclNewObj(objPtr);
2428     objPtr->bytes = NULL;
2429     
2430     objPtr->internalRep.wideValue = wideValue;
2431     objPtr->typePtr = &tclWideIntType;
2432     return objPtr;
2433 }
void Tcl_RegisterObjType (Tcl_ObjType * typePtr)

Definition at line 329 of file tclObj.c.
References Tcl_CreateHashEntry, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_SetHashValue, and typeTable.
Referenced by Tcl_GetOSTypeFromObj(), Tcl_NewOSTypeObj(), Tcl_SetOSTypeObj(), and TclInitObjSubsystem().333 {
334     int new;
335     Tcl_MutexLock(&tableMutex);
336     Tcl_SetHashValue(
337       Tcl_CreateHashEntry(&typeTable, typePtr->name, &new), typePtr);
338     Tcl_MutexUnlock(&tableMutex);
339 }
void Tcl_SetBooleanObj (Tcl_Obj * objPtr, int boolValue)

Definition at line 1004 of file tclObj.c.
References Tcl_ObjType::freeIntRepProc, panic, Tcl_InvalidateStringRep(), and Tcl_IsShared.
Referenced by CheckAccess(), NamespaceExistsCmd(), Tcl_EofObjCmd(), Tcl_FblockedObjCmd(), Tcl_FileObjCmd(), Tcl_StringObjCmd(), and TestbooleanobjCmd().1007 {
1008     register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
1009 
1010     if (Tcl_IsShared(objPtr)) {
1011   panic("Tcl_SetBooleanObj called with shared object");
1012     }
1013     
1014     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
1015   oldTypePtr->freeIntRepProc(objPtr);
1016     }
1017     
1018     objPtr->internalRep.longValue = (boolValue? 1 : 0);
1019     objPtr->typePtr = &tclBooleanType;
1020     Tcl_InvalidateStringRep(objPtr);
1021 }
void Tcl_SetDoubleObj (Tcl_Obj * objPtr, double dblValue)

Definition at line 1420 of file tclObj.c.
References Tcl_ObjType::freeIntRepProc, panic, Tcl_InvalidateStringRep(), Tcl_IsShared, and tclDoubleType.
Referenced by TclExecuteByteCode(), and TestdoubleobjCmd().1423 {
1424     register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
1425 
1426     if (Tcl_IsShared(objPtr)) {
1427   panic("Tcl_SetDoubleObj called with shared object");
1428     }
1429 
1430     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
1431   oldTypePtr->freeIntRepProc(objPtr);
1432     }
1433     
1434     objPtr->internalRep.doubleValue = dblValue;
1435     objPtr->typePtr = &tclDoubleType;
1436     Tcl_InvalidateStringRep(objPtr);
1437 }
void Tcl_SetIntObj (Tcl_Obj * objPtr, int intValue)

Definition at line 1688 of file tclObj.c.
References Tcl_ObjType::freeIntRepProc, panic, Tcl_InvalidateStringRep(), Tcl_IsShared, and tclIntType.
Referenced by CopyData(), GetType(), GetValue(), InfoCmdCountCmd(), InfoCompleteCmd(), InfoDefaultCmd(), InfoExistsCmd(), InfoLevelCmd(), SlaveObjCmd(), Tcl_ArrayObjCmd(), Tcl_CatchObjCmd(), Tcl_GetsObjCmd(), Tcl_InterpObjCmd(), Tcl_LlengthObjCmd(), Tcl_LsearchObjCmd(), Tcl_PackageObjCmd(), Tcl_RegexpObjCmd(), Tcl_RegsubObjCmd(), Tcl_StringObjCmd(), TclExecuteByteCode(), TclPtrIncrVar(), TestindexobjCmd(), TestintobjCmd(), TestregexpObjCmd(), and TeststringobjCmd().1691 {
1692     register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
1693 
1694     if (Tcl_IsShared(objPtr)) {
1695   panic("Tcl_SetIntObj called with shared object");
1696     }
1697     
1698     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
1699   oldTypePtr->freeIntRepProc(objPtr);
1700     }
1701     
1702     objPtr->internalRep.longValue = (long) intValue;
1703     objPtr->typePtr = &tclIntType;
1704     Tcl_InvalidateStringRep(objPtr);
1705 }
void Tcl_SetLongObj (Tcl_Obj * objPtr, long longValue)

Definition at line 2134 of file tclObj.c.
References Tcl_ObjType::freeIntRepProc, panic, Tcl_InvalidateStringRep(), Tcl_IsShared, and tclIntType.
Referenced by Tcl_BinaryObjCmd(), TCL_DECLARE_MUTEX(), Tcl_FileObjCmd(), Tcl_PidObjCmd(), TclExecuteByteCode(), TclPtrIncrVar(), and TestintobjCmd().2138 {
2139     register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
2140 
2141     if (Tcl_IsShared(objPtr)) {
2142   panic("Tcl_SetLongObj called with shared object");
2143     }
2144 
2145     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
2146   oldTypePtr->freeIntRepProc(objPtr);
2147     }
2148     
2149     objPtr->internalRep.longValue = longValue;
2150     objPtr->typePtr = &tclIntType;
2151     Tcl_InvalidateStringRep(objPtr);
2152 }
void Tcl_SetWideIntObj (Tcl_Obj * objPtr, Tcl_WideInt wideValue)

Definition at line 2527 of file tclObj.c.
References Tcl_ObjType::freeIntRepProc, panic, Tcl_InvalidateStringRep(), Tcl_IsShared, and tclWideIntType.
Referenced by TCL_DECLARE_MUTEX(), Tcl_FileObjCmd(), Tcl_TellObjCmd(), TclExecuteByteCode(), and TclPtrIncrVar().2531 {
2532     register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
2533 
2534     if (Tcl_IsShared(objPtr)) {
2535   panic("Tcl_SetWideIntObj called with shared object");
2536     }
2537 
2538     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
2539   oldTypePtr->freeIntRepProc(objPtr);
2540     }
2541     
2542     objPtr->internalRep.wideValue = wideValue;
2543     objPtr->typePtr = &tclWideIntType;
2544     Tcl_InvalidateStringRep(objPtr);
2545 }
void TclAllocateFreeObjects ()

Definition at line 609 of file tclObj.c.
References ckalloc, Tcl_Obj::internalRep, OBJS_TO_ALLOC_EACH_TIME, Tcl_Obj::otherValuePtr, size_t(), tclFreeObjList, and VOID.610 {
611     size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj));
612     char *basePtr;
613     register Tcl_Obj *prevPtr, *objPtr;
614     register int i;
615 
616     /*
617      * This has been noted by Purify to be a potential leak.  The problem is
618      * that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated
619      * Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of
620      * actually freeing the memory.  TclFinalizeObjects() does not ckfree()
621      * this memory, but leaves it to Tcl's memory subsystem finalziation to
622      * release it.  Purify apparently can't figure that out, and fires a
623      * false alarm.
624      */
625 
626     basePtr = (char *) ckalloc(bytesToAlloc);
627     memset(basePtr, 0, bytesToAlloc);
628 
629     prevPtr = NULL;
630     objPtr = (Tcl_Obj *) basePtr;
631     for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
632   objPtr->internalRep.otherValuePtr = (VOID *) prevPtr;
633   prevPtr = objPtr;
634   objPtr++;
635     }
636     tclFreeObjList = prevPtr;
637 }
void TclFinalizeObjects ()

Definition at line 290 of file tclObj.c.
References Tcl_DeleteHashTable(), Tcl_MutexLock, Tcl_MutexUnlock, tclFreeObjList, typeTable, and typeTableInitialized.
Referenced by Tcl_Finalize().291 {
292     Tcl_MutexLock(&tableMutex);
293     if (typeTableInitialized) {
294         Tcl_DeleteHashTable(&typeTable);
295         typeTableInitialized = 0;
296     }
297     Tcl_MutexUnlock(&tableMutex);
298 
299     /* 
300      * All we do here is reset the head pointer of the linked list of
301      * free Tcl_Obj's to NULL;  the memory finalization will take care
302      * of releasing memory for us.
303      */
304     Tcl_MutexLock(&tclObjMutex);
305     tclFreeObjList = NULL;
306     Tcl_MutexUnlock(&tclObjMutex);
307 }
void TclFreeObj (Tcl_Obj * objPtr)

Definition at line 666 of file tclObj.c.
References ckfree, Tcl_ObjType::freeIntRepProc, panic, Tcl_InvalidateStringRep(), Tcl_MutexLock, Tcl_MutexUnlock, tclFreeObjList, and VOID.
Referenced by Tcl_DbDecrRefCount().668 {
669     register Tcl_ObjType *typePtr = objPtr->typePtr;
670     
671 #ifdef TCL_MEM_DEBUG
672     if ((objPtr)->refCount < -1) {
673   panic("Reference count for %lx was negative", objPtr);
674     }
675 #endif /* TCL_MEM_DEBUG */
676 
677     if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
678   typePtr->freeIntRepProc(objPtr);
679     }
680     Tcl_InvalidateStringRep(objPtr);
681 
682     /*
683      * If debugging Tcl's memory usage, deallocate the object using ckfree.
684      * Otherwise, deallocate it by adding it onto the list of free
685      * Tcl_Obj structs we maintain.
686      */
687 
688 #if defined(TCL_MEM_DEBUG) || defined(PURIFY)
689     Tcl_MutexLock(&tclObjMutex);
690     ckfree((char *) objPtr);
691     Tcl_MutexUnlock(&tclObjMutex);
692 #elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) 
693     TclThreadFreeObj(objPtr); 
694 #else 
695     Tcl_MutexLock(&tclObjMutex);
696     objPtr->internalRep.otherValuePtr = (VOID *) tclFreeObjList;
697     tclFreeObjList = objPtr;
698     Tcl_MutexUnlock(&tclObjMutex);
699 #endif /* TCL_MEM_DEBUG */
700 
701 #ifdef TCL_COMPILE_STATS
702     tclObjsFreed++;
703 #endif /* TCL_COMPILE_STATS */
704 }
void TclInitObjSubsystem ()

Definition at line 236 of file tclObj.c.
References Tcl_InitHashTable(), Tcl_MutexLock, Tcl_MutexUnlock, Tcl_RegisterObjType(), TCL_STRING_KEYS, tclArraySearchType, tclByteArrayType, tclByteCodeType, tclCmdNameType, tclDoubleType, tclEndOffsetType, tclIndexType, tclIntType, tclListType, tclNsNameType, tclProcBodyType, tclStringType, tclWideIntType, typeTable, and typeTableInitialized.
Referenced by TclInitSubsystems().237 {
238     Tcl_MutexLock(&tableMutex);
239     typeTableInitialized = 1;
240     Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
241     Tcl_MutexUnlock(&tableMutex);
242 
243     Tcl_RegisterObjType(&tclBooleanType);
244     Tcl_RegisterObjType(&tclByteArrayType);
245     Tcl_RegisterObjType(&tclDoubleType);
246     Tcl_RegisterObjType(&tclEndOffsetType);
247     Tcl_RegisterObjType(&tclIntType);
248     Tcl_RegisterObjType(&tclWideIntType);
249     Tcl_RegisterObjType(&tclStringType);
250     Tcl_RegisterObjType(&tclListType);
251     Tcl_RegisterObjType(&tclByteCodeType);
252     Tcl_RegisterObjType(&tclProcBodyType);
253     Tcl_RegisterObjType(&tclArraySearchType);
254     Tcl_RegisterObjType(&tclIndexType);
255     Tcl_RegisterObjType(&tclNsNameType);
256     Tcl_RegisterObjType(&tclCmdNameType);
257 
258 #ifdef TCL_COMPILE_STATS
259     Tcl_MutexLock(&tclObjMutex);
260     tclObjsAlloced = 0;
261     tclObjsFreed = 0;
262     {
263   int i;
264   for (i = 0;  i < TCL_MAX_SHARED_OBJ_STATS;  i++) {
265       tclObjsShared[i] = 0;
266   }
267     }
268     Tcl_MutexUnlock(&tclObjMutex);
269 #endif
270 }
void TclSetCmdNameObj (Tcl_Interp * interp, Tcl_Obj * objPtr, Command * cmdPtr)

Definition at line 3059 of file tclObj.c.
References ckalloc, Command::cmdEpoch, ResolvedCmdName::cmdEpoch, ResolvedCmdName::cmdPtr, Namespace::cmdRefEpoch, Tcl_ObjType::freeIntRepProc, Interp::globalNsPtr, Namespace::nsId, CallFrame::nsPtr, ResolvedCmdName::refCount, Command::refCount, ResolvedCmdName::refNsCmdEpoch, ResolvedCmdName::refNsId, ResolvedCmdName::refNsPtr, tclCmdNameType, Interp::varFramePtr, and VOID.
Referenced by TclCompileScript().3066 {
3067     Interp *iPtr = (Interp *) interp;
3068     register ResolvedCmdName *resPtr;
3069     Tcl_ObjType *oldTypePtr = objPtr->typePtr;
3070     register Namespace *currNsPtr;
3071 
3072     if (oldTypePtr == &tclCmdNameType) {
3073   return;
3074     }
3075     
3076     /*
3077      * Get the current namespace.
3078      */
3079     
3080     if (iPtr->varFramePtr != NULL) {
3081   currNsPtr = iPtr->varFramePtr->nsPtr;
3082     } else {
3083   currNsPtr = iPtr->globalNsPtr;
3084     }
3085     
3086     cmdPtr->refCount++;
3087     resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
3088     resPtr->cmdPtr = cmdPtr;
3089     resPtr->refNsPtr = currNsPtr;
3090     resPtr->refNsId  = currNsPtr->nsId;
3091     resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
3092     resPtr->cmdEpoch = cmdPtr->cmdEpoch;
3093     resPtr->refCount = 1;
3094     
3095     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
3096   oldTypePtr->freeIntRepProc(objPtr);
3097     }
3098     objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
3099     objPtr->internalRep.twoPtrValue.ptr2 = NULL;
3100     objPtr->typePtr = &tclCmdNameType;
3101 }
static void UpdateStringOfBoolean (Tcl_Obj * objPtr) [static]

Definition at line 1281 of file tclObj.c.
References ckalloc.1283 {
1284     char *s = ckalloc((unsigned) 2);
1285     
1286     s[0] = (char) (objPtr->internalRep.longValue? '1' : '0');
1287     s[1] = '\0';
1288     objPtr->bytes = s;
1289     objPtr->length = 1;
1290 }
static void UpdateStringOfDouble (Tcl_Obj * objPtr) [static]

Definition at line 1597 of file tclObj.c.
References ckalloc, TCL_DOUBLE_SPACE, and Tcl_PrintDouble().1599 {
1600     char buffer[TCL_DOUBLE_SPACE];
1601     register int len;
1602     
1603     Tcl_PrintDouble((Tcl_Interp *) NULL, objPtr->internalRep.doubleValue,
1604       buffer);
1605     len = strlen(buffer);
1606     
1607     objPtr->bytes = (char *) ckalloc((unsigned) len + 1);
1608     strcpy(objPtr->bytes, buffer);
1609     objPtr->length = len;
1610 }
static void UpdateStringOfInt (Tcl_Obj * objPtr) [static]

Definition at line 1974 of file tclObj.c.
References ckalloc, TCL_INTEGER_SPACE, and TclFormatInt().1976 {
1977     char buffer[TCL_INTEGER_SPACE];
1978     register int len;
1979     
1980     len = TclFormatInt(buffer, objPtr->internalRep.longValue);
1981     
1982     objPtr->bytes = ckalloc((unsigned) len + 1);
1983     strcpy(objPtr->bytes, buffer);
1984     objPtr->length = len;
1985 }
static void UpdateStringOfWideInt (Tcl_Obj * objPtr) [static]

Definition at line 2361 of file tclObj.c.
References ckalloc, TCL_INTEGER_SPACE, and TCL_LL_MODIFIER.2363 {
2364     char buffer[TCL_INTEGER_SPACE+2];
2365     register unsigned len;
2366     register Tcl_WideInt wideVal = objPtr->internalRep.wideValue;
2367 
2368     /*
2369      * Note that sprintf will generate a compiler warning under
2370      * Mingw claiming %I64 is an unknown format specifier.
2371      * Just ignore this warning. We can't use %L as the format
2372      * specifier since that gets printed as a 32 bit value.
2373      */
2374     sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal);
2375     len = strlen(buffer);
2376     objPtr->bytes = ckalloc((unsigned) len + 1);
2377     memcpy(objPtr->bytes, buffer, len + 1);
2378     objPtr->length = len;
2379 }

Variable Documentation
Tcl_ObjType tclCmdNameType [static]
Initial value: {
    "cmdName",        
    FreeCmdNameInternalRep,   
    DupCmdNameInternalRep,    
    (Tcl_UpdateStringProc *) NULL,  
    SetCmdNameFromAny     
}
Definition at line 171 of file tclObj.c.
Referenced by DupCmdNameInternalRep(), SetCmdNameFromAny(), Tcl_GetCommandFromObj(), TclInitObjSubsystem(), and TclSetCmdNameObj().Tcl_ObjType tclDoubleType
Initial value: {
    "double",       
    (Tcl_FreeInternalRepProc *) NULL,   
    (Tcl_DupInternalRepProc *) NULL,  
    UpdateStringOfDouble,   
    SetDoubleFromAny      
}
Definition at line 116 of file tclObj.c.
Referenced by SetBooleanFromAny(), SetDoubleFromAny(), Tcl_ExprBoolean(), Tcl_ExprBooleanObj(), Tcl_ExprDouble(), Tcl_ExprDoubleObj(), Tcl_ExprLong(), Tcl_ExprLongObj(), Tcl_ExprString(), Tcl_GetDoubleFromObj(), Tcl_NewDoubleObj(), Tcl_SetDoubleObj(), Tcl_StringObjCmd(), TclExecuteByteCode(), and TclInitObjSubsystem().Tcl_ObjType tclIntType
Initial value: {
    "int",        
    (Tcl_FreeInternalRepProc *) NULL,   
    (Tcl_DupInternalRepProc *) NULL,  
    UpdateStringOfInt,      
    SetIntFromAny     
}
Definition at line 124 of file tclObj.c.
Referenced by ExprAbsFunc(), ExprCallMathFunc(), ExprIntFunc(), ExprRoundFunc(), ExprWideFunc(), SetBooleanFromAny(), SetIntFromAny(), SetIntOrWideFromAny(), Tcl_AfterObjCmd(), Tcl_ExprBoolean(), Tcl_ExprBooleanObj(), Tcl_ExprDouble(), Tcl_ExprDoubleObj(), Tcl_ExprLong(), Tcl_ExprLongObj(), Tcl_ExprString(), Tcl_GetIntFromObj(), Tcl_GetLongFromObj(), Tcl_GetWideIntFromObj(), Tcl_IncrObjCmd(), Tcl_NewIntObj(), Tcl_NewLongObj(), Tcl_SetIntObj(), Tcl_SetLongObj(), Tcl_StringObjCmd(), TclExecuteByteCode(), TclInitObjSubsystem(), TclPtrIncrVar(), and TclRegisterLiteral().Tcl_HashKeyType tclObjHashKeyType
Initial value: {
    TCL_HASH_KEY_TYPE_VERSION,    
    0,          
    HashObjKey,       
    CompareObjKeys,     
    AllocObjEntry,      
    FreeObjEntry      
}
Definition at line 147 of file tclObj.c.
Referenced by Tcl_InitObjHashTable().Tcl_ObjType tclWideIntType
Initial value: {
    "wideInt",        
    (Tcl_FreeInternalRepProc *) NULL,   
    (Tcl_DupInternalRepProc *) NULL,  

 
    UpdateStringOfWideInt,    

    SetWideIntFromAny     
}
Definition at line 132 of file tclObj.c.
Referenced by ExprAbsFunc(), ExprIntFunc(), ExprRoundFunc(), ExprWideFunc(), SetBooleanFromAny(), SetIntOrWideFromAny(), SetWideIntFromAny(), Tcl_ExprBoolean(), Tcl_ExprDouble(), Tcl_ExprLong(), Tcl_GetIntFromObj(), Tcl_GetLongFromObj(), Tcl_GetWideIntFromObj(), Tcl_IncrObjCmd(), Tcl_NewWideIntObj(), Tcl_SetWideIntObj(), TclExecuteByteCode(), TclInitObjSubsystem(), and TclPtrIncrVar().Tcl_HashTable typeTable [static]

Definition at line 25 of file tclObj.c.
Referenced by Tcl_AppendAllObjTypes(), Tcl_GetObjType(), Tcl_RegisterObjType(), TclFinalizeObjects(), and TclInitObjSubsystem().int typeTableInitialized = 0 [static]

Definition at line 26 of file tclObj.c.
Referenced by TclFinalizeObjects(), and TclInitObjSubsystem().

generic/tclPanic.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Functions
void Tcl_SetPanicProc (Tcl_PanicProc *proc)
void Tcl_PanicVA (CONST char *format, va_list argList)
void Tcl_Panic TCL_VARARGS_DEF (CONST char *, arg1)
Variables
static Tcl_PanicProc * panicProc = NULL
static Tcl_PanicProc *CONST platformPanicProc = TclpPanic

Function Documentation
void Tcl_PanicVA (CONST char * format, va_list argList)

Definition at line 77 of file tclPanic.c.
References NULL, panicProc, platformPanicProc, and void().
Referenced by TCL_VARARGS_DEF().81 {
82     char *arg1, *arg2, *arg3, *arg4;  /* Additional arguments (variable in
83            * number) to pass to fprintf. */
84     char *arg5, *arg6, *arg7, *arg8;
85 
86     arg1 = va_arg(argList, char *);
87     arg2 = va_arg(argList, char *);
88     arg3 = va_arg(argList, char *);
89     arg4 = va_arg(argList, char *);
90     arg5 = va_arg(argList, char *);
91     arg6 = va_arg(argList, char *);
92     arg7 = va_arg(argList, char *);
93     arg8 = va_arg(argList, char *);
94     
95     if (panicProc != NULL) {
96   (void) (*panicProc)(format, arg1, arg2, arg3, arg4,
97     arg5, arg6, arg7, arg8);
98     } else if (platformPanicProc != NULL) {
99   (void) (*platformPanicProc)(format, arg1, arg2, arg3, arg4,
100     arg5, arg6, arg7, arg8);
101     } else {
102   (void) fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6,
103     arg7, arg8);
104   (void) fprintf(stderr, "\n");
105   (void) fflush(stderr);
106   abort();
107     }
108 }
void Tcl_SetPanicProc (Tcl_PanicProc * proc)

Definition at line 54 of file tclPanic.c.
References panicProc.
Referenced by Tcl_Finalize().56 {
57     panicProc = proc;
58 }
void Tcl_Panic TCL_VARARGS_DEF (CONST char *, arg1)

Definition at line 128 of file tclPanic.c.
References CONST, format, Tcl_PanicVA(), and TCL_VARARGS_START.129 {
130     va_list argList;
131     CONST char *format;
132 
133     format = TCL_VARARGS_START(CONST char *,arg1,argList);
134     Tcl_PanicVA(format, argList);
135     va_end (argList);
136 }

Variable Documentation
Tcl_PanicProc* panicProc = NULL [static]

Definition at line 26 of file tclPanic.c.
Referenced by Tcl_PanicVA(), and Tcl_SetPanicProc().Tcl_PanicProc* CONST platformPanicProc = TclpPanic [static]

Definition at line 34 of file tclPanic.c.
Referenced by Tcl_PanicVA().

generic/tclParse.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Defines
#define TYPE_NORMAL  0
#define TYPE_SPACE  0x1
#define TYPE_COMMAND_END  0x2
#define TYPE_SUBS  0x4
#define TYPE_QUOTE  0x8
#define TYPE_CLOSE_PAREN  0x10
#define TYPE_CLOSE_BRACK  0x20
#define TYPE_BRACE  0x40
#define CHAR_TYPE(c)  (charTypeTable+128)[(int)(c)]
Functions
static int CommandComplete _ANSI_ARGS_ ((CONST char *script, int numBytes))
static int ParseComment _ANSI_ARGS_ ((CONST char *src, int numBytes, Tcl_Parse *parsePtr))
static int ParseTokens _ANSI_ARGS_ ((CONST char *src, int numBytes, int mask, Tcl_Parse *parsePtr))
int Tcl_ParseCommand (Tcl_Interp *interp, CONST char *string, int numBytes, int nested, Tcl_Parse *parsePtr)
int TclParseWhiteSpace (CONST char *src, int numBytes, Tcl_Parse *parsePtr, char *typePtr)
int TclParseHex (CONST char *src, int numBytes, Tcl_UniChar *resultPtr)
int TclParseBackslash (CONST char *src, int numBytes, int *readPtr, char *dst)
static int ParseComment (CONST char *src, int numBytes, Tcl_Parse *parsePtr)
static int ParseTokens (CONST char *src, int numBytes, int mask, Tcl_Parse *parsePtr)
void Tcl_FreeParse (Tcl_Parse *parsePtr)
void TclExpandTokenArray (Tcl_Parse *parsePtr)
int Tcl_ParseVarName (Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr, int append)
CONST char * Tcl_ParseVar (Tcl_Interp *interp, CONST char *string, CONST char **termPtr)
int Tcl_ParseBraces (Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr, int append, CONST char **termPtr)
int Tcl_ParseQuotedString (Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr, int append, CONST char **termPtr)
static int CommandComplete (CONST char *script, int numBytes)
int Tcl_CommandComplete (CONST char *script)
int TclObjCommandComplete (Tcl_Obj *objPtr)
int TclIsLocalScalar (CONST char *src, int len)
Variables
static CONST char charTypeTable []

Define Documentation
#define CHAR_TYPE(c)  (charTypeTable+128)[(int)(c)]

Definition at line 58 of file tclParse.c.
Referenced by ParseTokens(), Tcl_ParseBraces(), TclIsLocalScalar(), and TclParseWhiteSpace().#define TYPE_BRACE  0x40

Definition at line 56 of file tclParse.c.#define TYPE_CLOSE_BRACK  0x20

Definition at line 55 of file tclParse.c.
Referenced by Tcl_ParseCommand().#define TYPE_CLOSE_PAREN  0x10

Definition at line 54 of file tclParse.c.
Referenced by Tcl_ParseVarName().#define TYPE_COMMAND_END  0x2

Definition at line 51 of file tclParse.c.
Referenced by Tcl_ParseCommand(), and TclIsLocalScalar().#define TYPE_NORMAL  0

Definition at line 49 of file tclParse.c.
Referenced by Tcl_ParseBraces(), TclIsLocalScalar(), and TclParseWhiteSpace().#define TYPE_QUOTE  0x8

Definition at line 53 of file tclParse.c.
Referenced by Tcl_ParseQuotedString().#define TYPE_SPACE  0x1

Definition at line 50 of file tclParse.c.
Referenced by ParseTokens(), Tcl_ParseCommand(), and TclParseWhiteSpace().#define TYPE_SUBS  0x4

Definition at line 52 of file tclParse.c.
Referenced by ParseTokens(), and TclParseWhiteSpace().
Function Documentation
static int ParseTokens _ANSI_ARGS_ ((CONST char *src, int numBytes, int mask, Tcl_Parse *parsePtr)) [static]
static int ParseComment _ANSI_ARGS_ ((CONST char *src, int numBytes, Tcl_Parse *parsePtr)) [static]
static int CommandComplete _ANSI_ARGS_ ((CONST char *script, int numBytes)) [static]
static int CommandComplete (CONST char * script, int numBytes) [static]

Definition at line 1652 of file tclParse.c.
References CONST, NULL, parse(), Tcl_FreeParse(), TCL_OK, and Tcl_ParseCommand().
Referenced by Tcl_CommandComplete(), and TclObjCommandComplete().1655 {
1656     Tcl_Parse parse;
1657     CONST char *p, *end;
1658     int result;
1659 
1660     p = script;
1661     end = p + numBytes;
1662     while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse)
1663       == TCL_OK) {
1664   p = parse.commandStart + parse.commandSize;
1665   if (p >= end) {
1666       break;
1667   }
1668   Tcl_FreeParse(&parse);
1669     }
1670     if (parse.incomplete) {
1671   result = 0;
1672     } else {
1673   result = 1;
1674     }
1675     Tcl_FreeParse(&parse);
1676     return result;
1677 }
static int ParseComment (CONST char * src, int numBytes, Tcl_Parse * parsePtr) [static]

Definition at line 712 of file tclParse.c.
References Tcl_Parse::commentSize, Tcl_Parse::commentStart, CONST, NULL, TclParseBackslash(), and TclParseWhiteSpace().
Referenced by Tcl_ParseCommand().718 {
719     register CONST char *p = src;
720     while (numBytes) {
721   char type;
722   int scanned;
723   do {
724       scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type);
725       p += scanned; numBytes -= scanned;
726   } while (numBytes && (*p == '\n') && (p++,numBytes--));
727   if ((numBytes == 0) || (*p != '#')) {
728       break;
729   }
730   if (parsePtr->commentStart == NULL) {
731       parsePtr->commentStart = p;
732   }
733   while (numBytes) {
734       if (*p == '\\') {
735     scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type);
736     if (scanned) {
737         p += scanned; numBytes -= scanned;
738     } else {
739         /*
740          * General backslash substitution in comments isn't
741          * part of the formal spec, but test parse-15.47
742          * and history indicate that it has been the de facto
743          * rule.  Don't change it now.
744          */
745         TclParseBackslash(p, numBytes, &scanned, NULL);
746         p += scanned; numBytes -= scanned;
747     }
748       } else {
749     p++; numBytes--;
750     if (p[-1] == '\n') {
751         break;
752     }
753       }
754   }
755   parsePtr->commentSize = p - parsePtr->commentStart;
756     }
757     return (p - src);
758 }
static int ParseTokens (CONST char * src, int numBytes, int mask, Tcl_Parse * parsePtr) [static]

Definition at line 788 of file tclParse.c.
References CHAR_TYPE, ckfree, Tcl_Parse::commandSize, Tcl_Parse::commandStart, Tcl_Parse::end, Tcl_Parse::errorType, Tcl_Parse::incomplete, Tcl_Parse::interp, NULL, Tcl_Token::numComponents, Tcl_Parse::numTokens, panic, Tcl_Token::size, Tcl_Token::start, Tcl_Parse::staticTokens, TCL_ERROR, TCL_OK, TCL_PARSE_MISSING_BRACKET, Tcl_ParseCommand(), Tcl_ParseVarName(), Tcl_SetResult(), TCL_STATIC, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, TCL_TOKEN_TEXT, TclExpandTokenArray(), TclParseBackslash(), Tcl_Parse::term, Tcl_Parse::tokenPtr, Tcl_Parse::tokensAvailable, Tcl_Token::type, TYPE_SPACE, and TYPE_SUBS.
Referenced by Tcl_ParseCommand(), Tcl_ParseQuotedString(), and Tcl_ParseVarName().798 {
799     char type; 
800     int originalTokens, varToken;
801     Tcl_Token *tokenPtr;
802     Tcl_Parse nested;
803 
804     /*
805      * Each iteration through the following loop adds one token of
806      * type TCL_TOKEN_TEXT, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, or
807      * TCL_TOKEN_VARIABLE to parsePtr.  For TCL_TOKEN_VARIABLE tokens,
808      * additional tokens are added for the parsed variable name.
809      */
810 
811     originalTokens = parsePtr->numTokens;
812     while (numBytes && !((type = CHAR_TYPE(*src)) & mask)) {
813   if (parsePtr->numTokens == parsePtr->tokensAvailable) {
814       TclExpandTokenArray(parsePtr);
815   }
816   tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
817   tokenPtr->start = src;
818   tokenPtr->numComponents = 0;
819 
820   if ((type & TYPE_SUBS) == 0) {
821       /*
822        * This is a simple range of characters.  Scan to find the end
823        * of the range.
824        */
825 
826       while ((++src, --numBytes) 
827         && !(CHAR_TYPE(*src) & (mask | TYPE_SUBS))) {
828     /* empty loop */
829       }
830       tokenPtr->type = TCL_TOKEN_TEXT;
831       tokenPtr->size = src - tokenPtr->start;
832       parsePtr->numTokens++;
833   } else if (*src == '$') {
834       /*
835        * This is a variable reference.  Call Tcl_ParseVarName to do
836        * all the dirty work of parsing the name.
837        */
838 
839       varToken = parsePtr->numTokens;
840       if (Tcl_ParseVarName(parsePtr->interp, src, numBytes,
841         parsePtr, 1) != TCL_OK) {
842     return TCL_ERROR;
843       }
844       src += parsePtr->tokenPtr[varToken].size;
845       numBytes -= parsePtr->tokenPtr[varToken].size;
846   } else if (*src == '[') {
847       /*
848        * Command substitution.  Call Tcl_ParseCommand recursively
849        * (and repeatedly) to parse the nested command(s), then
850        * throw away the parse information.
851        */
852 
853       src++; numBytes--;
854       while (1) {
855     if (Tcl_ParseCommand(parsePtr->interp, src,
856       numBytes, 1, &nested) != TCL_OK) {
857         parsePtr->errorType = nested.errorType;
858         parsePtr->term = nested.term;
859         parsePtr->incomplete = nested.incomplete;
860         return TCL_ERROR;
861     }
862     src = nested.commandStart + nested.commandSize;
863     numBytes = parsePtr->end - src;
864 
865     /*
866      * This is equivalent to Tcl_FreeParse(&nested), but
867      * presumably inlined here for sake of runtime optimization
868      */
869 
870     if (nested.tokenPtr != nested.staticTokens) {
871         ckfree((char *) nested.tokenPtr);
872     }
873 
874     /*
875      * Check for the closing ']' that ends the command
876      * substitution.  It must have been the last character of
877      * the parsed command.
878      */
879 
880     if ((nested.term < parsePtr->end) && (*nested.term == ']')
881       && !nested.incomplete) {
882         break;
883     }
884     if (numBytes == 0) {
885         if (parsePtr->interp != NULL) {
886       Tcl_SetResult(parsePtr->interp,
887           "missing close-bracket", TCL_STATIC);
888         }
889         parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
890         parsePtr->term = tokenPtr->start;
891         parsePtr->incomplete = 1;
892         return TCL_ERROR;
893     }
894       }
895       tokenPtr->type = TCL_TOKEN_COMMAND;
896       tokenPtr->size = src - tokenPtr->start;
897       parsePtr->numTokens++;
898   } else if (*src == '\\') {
899       /*
900        * Backslash substitution.
901        */
902       TclParseBackslash(src, numBytes, &tokenPtr->size, NULL);
903 
904       if (tokenPtr->size == 1) {
905     /* Just a backslash, due to end of string */
906     tokenPtr->type = TCL_TOKEN_TEXT;
907     parsePtr->numTokens++;
908     src++; numBytes--;
909     continue;
910       }
911 
912       if (src[1] == '\n') {
913     if (numBytes == 2) {
914         parsePtr->incomplete = 1;
915     }
916 
917     /*
918      * Note: backslash-newline is special in that it is
919      * treated the same as a space character would be.  This
920      * means that it could terminate the token.
921      */
922 
923     if (mask & TYPE_SPACE) {
924         if (parsePtr->numTokens == originalTokens) {
925       goto finishToken;
926         }
927         break;
928     }
929       }
930 
931       tokenPtr->type = TCL_TOKEN_BS;
932       parsePtr->numTokens++;
933       src += tokenPtr->size;
934       numBytes -= tokenPtr->size;
935   } else if (*src == 0) {
936       tokenPtr->type = TCL_TOKEN_TEXT;
937       tokenPtr->size = 1;
938       parsePtr->numTokens++;
939       src++; numBytes--;
940   } else {
941       panic("ParseTokens encountered unknown character");
942   }
943     }
944     if (parsePtr->numTokens == originalTokens) {
945   /*
946    * There was nothing in this range of text.  Add an empty token
947    * for the empty range, so that there is always at least one
948    * token added.
949    */
950   if (parsePtr->numTokens == parsePtr->tokensAvailable) {
951       TclExpandTokenArray(parsePtr);
952   }
953   tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
954   tokenPtr->start = src;
955   tokenPtr->numComponents = 0;
956 
957   finishToken:
958   tokenPtr->type = TCL_TOKEN_TEXT;
959   tokenPtr->size = 0;
960   parsePtr->numTokens++;
961     }
962     parsePtr->term = src;
963     return TCL_OK;
964 }
int Tcl_CommandComplete (CONST char * script)

Definition at line 1700 of file tclParse.c.
References CommandComplete().1702 {
1703     return CommandComplete(script, (int) strlen(script));
1704 }
void Tcl_FreeParse (Tcl_Parse * parsePtr)

Definition at line 985 of file tclParse.c.
References ckfree.
Referenced by CommandComplete(), Tcl_EvalEx(), Tcl_ParseBraces(), Tcl_ParseCommand(), Tcl_ParseQuotedString(), Tcl_ParseVarName(), TclCompileExpr(), TclCompileScript(), TestexprparserObjCmd(), TestparserObjCmd(), and TestparsevarnameObjCmd().988 {
989     if (parsePtr->tokenPtr != parsePtr->staticTokens) {
990   ckfree((char *) parsePtr->tokenPtr);
991   parsePtr->tokenPtr = parsePtr->staticTokens;
992     }
993 }
int Tcl_ParseBraces (Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append, CONST char ** termPtr)

Definition at line 1359 of file tclParse.c.
References CHAR_TYPE, CONST, NULL, NUM_STATIC_TOKENS, Tcl_Token::numComponents, Tcl_Token::size, Tcl_Token::start, TCL_ERROR, Tcl_FreeParse(), TCL_OK, TCL_PARSE_MISSING_BRACE, TCL_PARSE_SUCCESS, Tcl_SetResult(), TCL_STATIC, TCL_TOKEN_BS, TCL_TOKEN_TEXT, TclExpandTokenArray(), TclParseBackslash(), Tcl_Token::type, TYPE_NORMAL, and UCHAR.
Referenced by ParsePrimaryExpr(), and Tcl_ParseCommand().1364                                         {'. */
1365     register int numBytes;  /* Total number of bytes in string. If < 0,
1366          * the string consists of all bytes up to
1367          * the first null character. */
1368     register Tcl_Parse *parsePtr;
1369             /* Structure to fill in with information
1370          * about the string. */
1371     int append;     /* Non-zero means append tokens to existing
1372          * information in parsePtr; zero means
1373          * ignore existing tokens in parsePtr and
1374          * reinitialize it. */
1375     CONST char **termPtr; /* If non-NULL, points to word in which to
1376          * store a pointer to the character just
1377          * after the terminating '}' if the parse
1378          * was successful. */
1379 
1380 {
1381     Tcl_Token *tokenPtr;
1382     register CONST char *src;
1383     int startIndex, level, length;
1384 
1385     if ((numBytes == 0) || (string == NULL)) {
1386   return TCL_ERROR;
1387     }
1388     if (numBytes < 0) {
1389   numBytes = strlen(string);
1390     }
1391 
1392     if (!append) {
1393   parsePtr->numWords = 0;
1394   parsePtr->tokenPtr = parsePtr->staticTokens;
1395   parsePtr->numTokens = 0;
1396   parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
1397   parsePtr->string = string;
1398   parsePtr->end = (string + numBytes);
1399   parsePtr->interp = interp;
1400   parsePtr->errorType = TCL_PARSE_SUCCESS;
1401     }
1402 
1403     src = string;
1404     startIndex = parsePtr->numTokens;
1405 
1406     if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1407   TclExpandTokenArray(parsePtr);
1408     }
1409     tokenPtr = &parsePtr->tokenPtr[startIndex];
1410     tokenPtr->type = TCL_TOKEN_TEXT;
1411     tokenPtr->start = src+1;
1412     tokenPtr->numComponents = 0;
1413     level = 1;
1414     while (1) {
1415   while (++src, --numBytes) {
1416       if (CHAR_TYPE(*src) != TYPE_NORMAL) {
1417     break;
1418       }
1419   }
1420   if (numBytes == 0) {
1421       register int openBrace = 0;
1422 
1423       parsePtr->errorType = TCL_PARSE_MISSING_BRACE;
1424       parsePtr->term = string;
1425       parsePtr->incomplete = 1;
1426       if (interp == NULL) {
1427     /*
1428      * Skip straight to the exit code since we have no
1429      * interpreter to put error message in.
1430      */
1431     goto error;
1432       }
1433 
1434       Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
1435 
1436       /*
1437        *  Guess if the problem is due to comments by searching
1438        *  the source string for a possible open brace within the
1439        *  context of a comment.  Since we aren't performing a
1440        *  full Tcl parse, just look for an open brace preceded
1441        *  by a '<whitespace>#' on the same line.
1442        */
1443 
1444       for (; src > string; src--) {
1445     switch (*src) {
1446         case '{':
1447       openBrace = 1;
1448       break;
1449         case '\n':
1450       openBrace = 0;
1451       break;
1452         case '#' :
1453       if (openBrace && (isspace(UCHAR(src[-1])))) {
1454           Tcl_AppendResult(interp,
1455             ": possible unbalanced brace in comment",
1456             (char *) NULL);
1457           goto error;
1458       }
1459       break;
1460     }
1461       }
1462 
1463       error:
1464       Tcl_FreeParse(parsePtr);
1465       return TCL_ERROR;
1466   }
1467   switch (*src) {
1468       case '{':
1469     level++;
1470     break;
1471       case '}':
1472     if (--level == 0) {
1473 
1474         /*
1475          * Decide if we need to finish emitting a
1476          * partially-finished token.  There are 3 cases:
1477          *     {abc \newline xyz} or {xyz}
1478          *    - finish emitting "xyz" token
1479          *     {abc \newline}
1480          *    - don't emit token after \newline
1481          *     {} - finish emitting zero-sized token
1482          *
1483          * The last case ensures that there is a token
1484          * (even if empty) that describes the braced string.
1485          */
1486     
1487         if ((src != tokenPtr->start)
1488           || (parsePtr->numTokens == startIndex)) {
1489       tokenPtr->size = (src - tokenPtr->start);
1490       parsePtr->numTokens++;
1491         }
1492         if (termPtr != NULL) {
1493       *termPtr = src+1;
1494         }
1495         return TCL_OK;
1496     }
1497     break;
1498       case '\\':
1499     TclParseBackslash(src, numBytes, &length, NULL);
1500     if ((length > 1) && (src[1] == '\n')) {
1501         /*
1502          * A backslash-newline sequence must be collapsed, even
1503          * inside braces, so we have to split the word into
1504          * multiple tokens so that the backslash-newline can be
1505          * represented explicitly.
1506          */
1507     
1508         if (numBytes == 2) {
1509       parsePtr->incomplete = 1;
1510         }
1511         tokenPtr->size = (src - tokenPtr->start);
1512         if (tokenPtr->size != 0) {
1513       parsePtr->numTokens++;
1514         }
1515         if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) {
1516       TclExpandTokenArray(parsePtr);
1517         }
1518         tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1519         tokenPtr->type = TCL_TOKEN_BS;
1520         tokenPtr->start = src;
1521         tokenPtr->size = length;
1522         tokenPtr->numComponents = 0;
1523         parsePtr->numTokens++;
1524     
1525         src += length - 1;
1526         numBytes -= length - 1;
1527         tokenPtr++;
1528         tokenPtr->type = TCL_TOKEN_TEXT;
1529         tokenPtr->start = src + 1;
1530         tokenPtr->numComponents = 0;
1531     } else {
1532         src += length - 1;
1533         numBytes -= length - 1;
1534     }
1535     break;
1536   }
1537     }
1538 }
int Tcl_ParseCommand (Tcl_Interp * interp, CONST char * string, int numBytes, int nested, Tcl_Parse * parsePtr)

Definition at line 211 of file tclParse.c.
References CONST, NULL, NUM_STATIC_TOKENS, Tcl_Token::numComponents, ParseComment(), ParseTokens(), Tcl_Token::size, Tcl_Token::start, TCL_ERROR, Tcl_FreeParse(), TCL_OK, TCL_PARSE_BRACE_EXTRA, TCL_PARSE_QUOTE_EXTRA, TCL_PARSE_SUCCESS, Tcl_ParseBraces(), Tcl_ParseQuotedString(), Tcl_SetResult(), TCL_STATIC, TCL_TOKEN_SIMPLE_WORD, TCL_TOKEN_TEXT, TCL_TOKEN_WORD, TclExpandTokenArray(), TclParseWhiteSpace(), Tcl_Token::type, TYPE_CLOSE_BRACK, TYPE_COMMAND_END, and TYPE_SPACE.
Referenced by CommandComplete(), ParsePrimaryExpr(), ParseTokens(), Tcl_EvalEx(), TclCompileScript(), and TestparserObjCmd().220                                                               :
221          * close bracket should be considered
222          * a command terminator. If zero, then close
223          * bracket has no special meaning. */
224     register Tcl_Parse *parsePtr;
225             /* Structure to fill in with information
226          * about the parsed command; any previous
227          * information in the structure is
228          * ignored. */
229 {
230     register CONST char *src; /* Points to current character
231          * in the command. */
232     char type;      /* Result returned by CHAR_TYPE(*src). */
233     Tcl_Token *tokenPtr;  /* Pointer to token being filled in. */
234     int wordIndex;    /* Index of word token for current word. */
235     int terminators;    /* CHAR_TYPE bits that indicate the end
236          * of a command. */
237     CONST char *termPtr;  /* Set by Tcl_ParseBraces/QuotedString to
238          * point to char after terminating one. */
239     int scanned;
240     
241     if ((string == NULL) && (numBytes!=0)) {
242   if (interp != NULL) {
243       Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC);
244   }
245   return TCL_ERROR;
246     }
247     if (numBytes < 0) {
248   numBytes = strlen(string);
249     }
250     parsePtr->commentStart = NULL;
251     parsePtr->commentSize = 0;
252     parsePtr->commandStart = NULL;
253     parsePtr->commandSize = 0;
254     parsePtr->numWords = 0;
255     parsePtr->tokenPtr = parsePtr->staticTokens;
256     parsePtr->numTokens = 0;
257     parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
258     parsePtr->string = string;
259     parsePtr->end = string + numBytes;
260     parsePtr->term = parsePtr->end;
261     parsePtr->interp = interp;
262     parsePtr->incomplete = 0;
263     parsePtr->errorType = TCL_PARSE_SUCCESS;
264     if (nested != 0) {
265   terminators = TYPE_COMMAND_END | TYPE_CLOSE_BRACK;
266     } else {
267   terminators = TYPE_COMMAND_END;
268     }
269 
270     /*
271      * Parse any leading space and comments before the first word of the
272      * command.
273      */
274 
275     scanned = ParseComment(string, numBytes, parsePtr);
276     src = (string + scanned); numBytes -= scanned;
277     if (numBytes == 0) {
278   if (nested) {
279       parsePtr->incomplete = nested;
280   }
281     }
282 
283     /*
284      * The following loop parses the words of the command, one word
285      * in each iteration through the loop.
286      */
287 
288     parsePtr->commandStart = src;
289     while (1) {
290   /*
291    * Create the token for the word.
292    */
293 
294   if (parsePtr->numTokens == parsePtr->tokensAvailable) {
295       TclExpandTokenArray(parsePtr);
296   }
297   wordIndex = parsePtr->numTokens;
298   tokenPtr = &parsePtr->tokenPtr[wordIndex];
299   tokenPtr->type = TCL_TOKEN_WORD;
300 
301   /*
302    * Skip white space before the word. Also skip a backslash-newline
303    * sequence: it should be treated just like white space.
304    */
305 
306   scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
307   src += scanned; numBytes -= scanned;
308   if (numBytes == 0) {
309       parsePtr->term = src;
310       break;
311   }
312   if ((type & terminators) != 0) {
313       parsePtr->term = src;
314       src++;
315       break;
316   }
317   tokenPtr->start = src;
318   parsePtr->numTokens++;
319   parsePtr->numWords++;
320 
321   /*
322    * At this point the word can have one of three forms: something
323    * enclosed in quotes, something enclosed in braces, or an
324    * unquoted word (anything else).
325    */
326 
327   if (*src == '"') {
328       if (Tcl_ParseQuotedString(interp, src, numBytes,
329         parsePtr, 1, &termPtr) != TCL_OK) {
330     goto error;
331       }
332       src = termPtr; numBytes = parsePtr->end - src;
333   } else if (*src == '{') {
334       if (Tcl_ParseBraces(interp, src, numBytes,
335         parsePtr, 1, &termPtr) != TCL_OK) {
336     goto error;
337       }
338       src = termPtr; numBytes = parsePtr->end - src;
339   } else {
340       /*
341        * This is an unquoted word.  Call ParseTokens and let it do
342        * all of the work.
343        */
344 
345       if (ParseTokens(src, numBytes, TYPE_SPACE|terminators,
346         parsePtr) != TCL_OK) {
347     goto error;
348       }
349       src = parsePtr->term; numBytes = parsePtr->end - src;
350   }
351 
352   /*
353    * Finish filling in the token for the word and check for the
354    * special case of a word consisting of a single range of
355    * literal text.
356    */
357 
358   tokenPtr = &parsePtr->tokenPtr[wordIndex];
359   tokenPtr->size = src - tokenPtr->start;
360   tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1);
361   if ((tokenPtr->numComponents == 1)
362     && (tokenPtr[1].type == TCL_TOKEN_TEXT)) {
363       tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
364   }
365 
366   /*
367    * Do two additional checks: (a) make sure we're really at the
368    * end of a word (there might have been garbage left after a
369    * quoted or braced word), and (b) check for the end of the
370    * command.
371    */
372 
373   scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
374   if (scanned) {
375       src += scanned; numBytes -= scanned;
376       continue;
377   }
378 
379   if (numBytes == 0) {
380       parsePtr->term = src;
381       break;
382   }
383   if ((type & terminators) != 0) {
384       parsePtr->term = src;
385       src++; 
386       break;
387   }
388   if (src[-1] == '"') { 
389       if (interp != NULL) {
390     Tcl_SetResult(interp, "extra characters after close-quote",
391       TCL_STATIC);
392       }
393       parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA;
394   } else {
395       if (interp != NULL) {
396     Tcl_SetResult(interp, "extra characters after close-brace",
397       TCL_STATIC);
398       }
399       parsePtr->errorType = TCL_PARSE_BRACE_EXTRA;
400   }
401   parsePtr->term = src;
402   goto error;
403     }
404 
405     parsePtr->commandSize = src - parsePtr->commandStart;
406     return TCL_OK;
407 
408     error:
409     Tcl_FreeParse(parsePtr);
410     if (parsePtr->commandStart == NULL) {
411   parsePtr->commandStart = string;
412     }
413     parsePtr->commandSize = parsePtr->end - parsePtr->commandStart;
414     return TCL_ERROR;
415 }

int Tcl_ParseQuotedString (Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append, CONST char ** termPtr)

Definition at line 1570 of file tclParse.c.
References NULL, NUM_STATIC_TOKENS, ParseTokens(), TCL_ERROR, Tcl_FreeParse(), TCL_OK, TCL_PARSE_MISSING_QUOTE, TCL_PARSE_SUCCESS, Tcl_SetResult(), TCL_STATIC, and TYPE_QUOTE.
Referenced by ParsePrimaryExpr(), and Tcl_ParseCommand().1590 {
1591     if ((numBytes == 0) || (string == NULL)) {
1592   return TCL_ERROR;
1593     }
1594     if (numBytes < 0) {
1595   numBytes = strlen(string);
1596     }
1597 
1598     if (!append) {
1599   parsePtr->numWords = 0;
1600   parsePtr->tokenPtr = parsePtr->staticTokens;
1601   parsePtr->numTokens = 0;
1602   parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
1603   parsePtr->string = string;
1604   parsePtr->end = (string + numBytes);
1605   parsePtr->interp = interp;
1606   parsePtr->errorType = TCL_PARSE_SUCCESS;
1607     }
1608     
1609     if (ParseTokens(string+1, numBytes-1, TYPE_QUOTE, parsePtr) != TCL_OK) {
1610   goto error;
1611     }
1612     if (*parsePtr->term != '"') {
1613   if (interp != NULL) {
1614       Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC);
1615   }
1616   parsePtr->errorType = TCL_PARSE_MISSING_QUOTE;
1617   parsePtr->term = string;
1618   parsePtr->incomplete = 1;
1619   goto error;
1620     }
1621     if (termPtr != NULL) {
1622   *termPtr = (parsePtr->term + 1);
1623     }
1624     return TCL_OK;
1625 
1626     error:
1627     Tcl_FreeParse(parsePtr);
1628     return TCL_ERROR;
1629 }
CONST char* Tcl_ParseVar (Tcl_Interp * interp, CONST char * string, CONST char ** termPtr)

Definition at line 1277 of file tclParse.c.
References NULL, parse(), Tcl_EvalTokensStandard(), Tcl_GetObjResult(), Tcl_IncrRefCount, Tcl_IsShared, TCL_OK, Tcl_ParseVarName(), Tcl_ResetResult(), and TclGetString.
Referenced by TestparsevarObjCmd().1285 {
1286     Tcl_Parse parse;
1287     register Tcl_Obj *objPtr;
1288     int code;
1289 
1290     if (Tcl_ParseVarName(interp, string, -1, &parse, 0) != TCL_OK) {
1291   return NULL;
1292     }
1293 
1294     if (termPtr != NULL) {
1295   *termPtr = string + parse.tokenPtr->size;
1296     }
1297     if (parse.numTokens == 1) {
1298   /*
1299    * There isn't a variable name after all: the $ is just a $.
1300    */
1301 
1302   return "$";
1303     }
1304 
1305     code = Tcl_EvalTokensStandard(interp, parse.tokenPtr, parse.numTokens);
1306     if (code != TCL_OK) {
1307   return NULL;
1308     }
1309     objPtr = Tcl_GetObjResult(interp);
1310 
1311     /*
1312      * At this point we should have an object containing the value of
1313      * a variable.  Just return the string from that object.
1314      *
1315      * This should have returned the object for the user to manage, but
1316      * instead we have some weak reference to the string value in the
1317      * object, which is why we make sure the object exists after resetting
1318      * the result.  This isn't ideal, but it's the best we can do with the
1319      * current documented interface. -- hobbs
1320      */
1321 
1322     if (!Tcl_IsShared(objPtr)) {
1323   Tcl_IncrRefCount(objPtr);
1324     }
1325     Tcl_ResetResult(interp);
1326     return TclGetString(objPtr);
1327 }
int Tcl_ParseVarName (Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append)

Definition at line 1063 of file tclParse.c.
References CONST, Tcl_Parse::end, Tcl_Parse::errorType, Tcl_Parse::incomplete, Tcl_Parse::interp, NULL, NUM_STATIC_TOKENS, Tcl_Token::numComponents, Tcl_Parse::numTokens, Tcl_Parse::numWords, ParseTokens(), Tcl_Token::size, size_t(), Tcl_Token::start, Tcl_Parse::staticTokens, Tcl_Parse::string, TCL_ERROR, Tcl_FreeParse(), TCL_OK, TCL_PARSE_MISSING_PAREN, TCL_PARSE_MISSING_VAR_BRACE, TCL_PARSE_SUCCESS, Tcl_SetResult(), TCL_STATIC, TCL_TOKEN_TEXT, TCL_TOKEN_VARIABLE, TCL_UTF_MAX, Tcl_UtfCharComplete(), Tcl_UtfToUniChar(), TclExpandTokenArray(), Tcl_Parse::term, Tcl_Parse::tokenPtr, Tcl_Parse::tokensAvailable, Tcl_Token::type, TYPE_CLOSE_PAREN, and UCHAR.
Referenced by ParsePrimaryExpr(), ParseTokens(), Tcl_ParseVar(), Tcl_SubstObj(), and TestparsevarnameObjCmd().1078 {
1079     Tcl_Token *tokenPtr;
1080     register CONST char *src;
1081     unsigned char c;
1082     int varIndex, offset;
1083     Tcl_UniChar ch;
1084     unsigned array;
1085 
1086     if ((numBytes == 0) || (string == NULL)) {
1087   return TCL_ERROR;
1088     }
1089     if (numBytes < 0) {
1090   numBytes = strlen(string);
1091     }
1092 
1093     if (!append) {
1094   parsePtr->numWords = 0;
1095   parsePtr->tokenPtr = parsePtr->staticTokens;
1096   parsePtr->numTokens = 0;
1097   parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
1098   parsePtr->string = string;
1099   parsePtr->end = (string + numBytes);
1100   parsePtr->interp = interp;
1101   parsePtr->errorType = TCL_PARSE_SUCCESS;
1102   parsePtr->incomplete = 0;
1103     }
1104 
1105     /*
1106      * Generate one token for the variable, an additional token for the
1107      * name, plus any number of additional tokens for the index, if
1108      * there is one.
1109      */
1110 
1111     src = string;
1112     if ((parsePtr->numTokens + 2) > parsePtr->tokensAvailable) {
1113   TclExpandTokenArray(parsePtr);
1114     }
1115     tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1116     tokenPtr->type = TCL_TOKEN_VARIABLE;
1117     tokenPtr->start = src;
1118     varIndex = parsePtr->numTokens;
1119     parsePtr->numTokens++;
1120     tokenPtr++;
1121     src++; numBytes--;
1122     if (numBytes == 0) {
1123   goto justADollarSign;
1124     }
1125     tokenPtr->type = TCL_TOKEN_TEXT;
1126     tokenPtr->start = src;
1127     tokenPtr->numComponents = 0;
1128 
1129     /*
1130      * The name of the variable can have three forms:
1131      * 1. The $ sign is followed by an open curly brace.  Then 
1132      *    the variable name is everything up to the next close
1133      *    curly brace, and the variable is a scalar variable.
1134      * 2. The $ sign is not followed by an open curly brace.  Then
1135      *    the variable name is everything up to the next
1136      *    character that isn't a letter, digit, or underscore.
1137      *    :: sequences are also considered part of the variable
1138      *    name, in order to support namespaces. If the following
1139      *    character is an open parenthesis, then the information
1140      *    between parentheses is the array element name.
1141      * 3. The $ sign is followed by something that isn't a letter,
1142      *    digit, or underscore:  in this case, there is no variable
1143      *    name and the token is just "$".
1144      */
1145 
1146     if (*src == '{') {
1147   src++; numBytes--;
1148   tokenPtr->type = TCL_TOKEN_TEXT;
1149   tokenPtr->start = src;
1150   tokenPtr->numComponents = 0;
1151 
1152   while (numBytes && (*src != '}')) {
1153       numBytes--; src++;
1154   }
1155   if (numBytes == 0) {
1156       if (interp != NULL) {
1157     Tcl_SetResult(interp, "missing close-brace for variable name",
1158       TCL_STATIC);
1159       }
1160       parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
1161       parsePtr->term = tokenPtr->start-1;
1162       parsePtr->incomplete = 1;
1163       goto error;
1164   }
1165   tokenPtr->size = src - tokenPtr->start;
1166   tokenPtr[-1].size = src - tokenPtr[-1].start;
1167   parsePtr->numTokens++;
1168   src++;
1169     } else {
1170   tokenPtr->type = TCL_TOKEN_TEXT;
1171   tokenPtr->start = src;
1172   tokenPtr->numComponents = 0;
1173   while (numBytes) {
1174       if (Tcl_UtfCharComplete(src, numBytes)) {
1175           offset = Tcl_UtfToUniChar(src, &ch);
1176       } else {
1177     char utfBytes[TCL_UTF_MAX];
1178     memcpy(utfBytes, src, (size_t) numBytes);
1179     utfBytes[numBytes] = '\0';
1180           offset = Tcl_UtfToUniChar(utfBytes, &ch);
1181       }
1182       c = UCHAR(ch);
1183       if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */
1184     src += offset;  numBytes -= offset;
1185     continue;
1186       }
1187       if ((c == ':') && (numBytes != 1) && (src[1] == ':')) {
1188     src += 2; numBytes -= 2;
1189     while (numBytes && (*src == ':')) {
1190         src++; numBytes--; 
1191     }
1192     continue;
1193       }
1194       break;
1195   }
1196 
1197   /*
1198    * Support for empty array names here.
1199    */
1200   array = (numBytes && (*src == '('));
1201   tokenPtr->size = src - tokenPtr->start;
1202   if ((tokenPtr->size == 0) && !array) {
1203       goto justADollarSign;
1204   }
1205   parsePtr->numTokens++;
1206   if (array) {
1207       /*
1208        * This is a reference to an array element.  Call
1209        * ParseTokens recursively to parse the element name,
1210        * since it could contain any number of substitutions.
1211        */
1212 
1213       if (ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN, parsePtr)
1214         != TCL_OK) {
1215     goto error;
1216       }
1217       if ((parsePtr->term == (src + numBytes)) 
1218         || (*parsePtr->term != ')')) { 
1219     if (parsePtr->interp != NULL) {
1220         Tcl_SetResult(parsePtr->interp, "missing )",
1221           TCL_STATIC);
1222     }
1223     parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
1224     parsePtr->term = src;
1225     parsePtr->incomplete = 1;
1226     goto error;
1227       }
1228       src = parsePtr->term + 1;
1229   }
1230     }
1231     tokenPtr = &parsePtr->tokenPtr[varIndex];
1232     tokenPtr->size = src - tokenPtr->start;
1233     tokenPtr->numComponents = parsePtr->numTokens - (varIndex + 1);
1234     return TCL_OK;
1235 
1236     /*
1237      * The dollar sign isn't followed by a variable name.
1238      * replace the TCL_TOKEN_VARIABLE token with a
1239      * TCL_TOKEN_TEXT token for the dollar sign.
1240      */
1241 
1242     justADollarSign:
1243     tokenPtr = &parsePtr->tokenPtr[varIndex];
1244     tokenPtr->type = TCL_TOKEN_TEXT;
1245     tokenPtr->size = 1;
1246     tokenPtr->numComponents = 0;
1247     return TCL_OK;
1248 
1249     error:
1250     Tcl_FreeParse(parsePtr);
1251     return TCL_ERROR;
1252 }
void TclExpandTokenArray (Tcl_Parse * parsePtr)

Definition at line 1015 of file tclParse.c.
References ckalloc, ckfree, size_t(), and VOID.
Referenced by ParseCondExpr(), ParsePrimaryExpr(), ParseTokens(), PrependSubExprTokens(), Tcl_ParseBraces(), Tcl_ParseCommand(), and Tcl_ParseVarName().1018 {
1019     int newCount;
1020     Tcl_Token *newPtr;
1021 
1022     newCount = parsePtr->tokensAvailable*2;
1023     newPtr = (Tcl_Token *) ckalloc((unsigned) (newCount * sizeof(Tcl_Token)));
1024     memcpy((VOID *) newPtr, (VOID *) parsePtr->tokenPtr,
1025       (size_t) (parsePtr->tokensAvailable * sizeof(Tcl_Token)));
1026     if (parsePtr->tokenPtr != parsePtr->staticTokens) {
1027   ckfree((char *) parsePtr->tokenPtr);
1028     }
1029     parsePtr->tokenPtr = newPtr;
1030     parsePtr->tokensAvailable = newCount;
1031 }
int TclIsLocalScalar (CONST char * src, int len)

Definition at line 1754 of file tclParse.c.
References CHAR_TYPE, CONST, TYPE_COMMAND_END, and TYPE_NORMAL.
Referenced by TclCompileCatchCmd(), and TclCompileForeachCmd().1757 {
1758     CONST char *p;
1759     CONST char *lastChar = src + (len - 1);
1760 
1761     for (p = src; p <= lastChar; p++) {
1762   if ((CHAR_TYPE(*p) != TYPE_NORMAL) &&
1763     (CHAR_TYPE(*p) != TYPE_COMMAND_END)) {
1764       /*
1765        * TCL_COMMAND_END is returned for the last character
1766        * of the string.  By this point we know it isn't
1767        * an array or namespace reference.
1768        */
1769 
1770       return 0;
1771   }
1772   if  (*p == '(') {
1773       if (*lastChar == ')') { /* we have an array element */
1774     return 0;
1775       }
1776   } else if (*p == ':') {
1777       if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
1778     return 0;
1779       }
1780   }
1781     }
1782   
1783     return 1;
1784 }
int TclObjCommandComplete (Tcl_Obj * objPtr)

Definition at line 1725 of file tclParse.c.
References CommandComplete(), CONST, and Tcl_GetStringFromObj().
Referenced by InfoCompleteCmd(), StdinProc(), and Tcl_Main().1728 {
1729     CONST char *script;
1730     int length;
1731 
1732     script = Tcl_GetStringFromObj(objPtr, &length);
1733     return CommandComplete(script, length);
1734 }
int TclParseBackslash (CONST char * src, int numBytes, int * readPtr, char * dst)

Definition at line 555 of file tclParse.c.
References CONST, NULL, size_t(), Tcl_UniCharToUtf(), TCL_UTF_MAX, Tcl_UtfCharComplete(), Tcl_UtfToUniChar(), TclParseHex(), and UCHAR.
Referenced by ParseComment(), ParseTokens(), Tcl_ParseBraces(), and Tcl_UtfBackslash().565 {
566     register CONST char *p = src+1;
567     Tcl_UniChar result;
568     int count;
569     char buf[TCL_UTF_MAX];
570 
571     if (numBytes == 0) {
572   if (readPtr != NULL) {
573       *readPtr = 0;
574   }
575   return 0;
576     }
577 
578     if (dst == NULL) {
579         dst = buf;
580     }
581 
582     if (numBytes == 1) {
583   /* Can only scan the backslash.  Return it. */
584   result = '\\';
585   count = 1;
586   goto done;
587     }
588 
589     count = 2;
590     switch (*p) {
591         /*
592          * Note: in the conversions below, use absolute values (e.g.,
593          * 0xa) rather than symbolic values (e.g. \n) that get converted
594          * by the compiler.  It's possible that compilers on some
595          * platforms will do the symbolic conversions differently, which
596          * could result in non-portable Tcl scripts.
597          */
598 
599         case 'a':
600             result = 0x7;
601             break;
602         case 'b':
603             result = 0x8;
604             break;
605         case 'f':
606             result = 0xc;
607             break;
608         case 'n':
609             result = 0xa;
610             break;
611         case 'r':
612             result = 0xd;
613             break;
614         case 't':
615             result = 0x9;
616             break;
617         case 'v':
618             result = 0xb;
619             break;
620         case 'x':
621       count += TclParseHex(p+1, numBytes-1, &result);
622       if (count == 2) {
623     /* No hexadigits -> This is just "x". */
624     result = 'x';
625       } else {
626     /* Keep only the last byte (2 hex digits) */
627     result = (unsigned char) result;
628       }
629             break;
630         case 'u':
631       count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-1, &result);
632       if (count == 2) {
633     /* No hexadigits -> This is just "u". */
634     result = 'u';
635       }
636             break;
637         case '\n':
638             count--;
639             do {
640                 p++; count++;
641             } while ((count < numBytes) && ((*p == ' ') || (*p == '\t')));
642             result = ' ';
643             break;
644         case 0:
645             result = '\\';
646             count = 1;
647             break;
648         default:
649             /*
650              * Check for an octal number \oo?o?
651              */
652             if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */
653                 result = (unsigned char)(*p - '0');
654                 p++;
655                 if ((numBytes == 2) || !isdigit(UCHAR(*p)) /* INTL: digit */
656       || (UCHAR(*p) >= '8')) { 
657                     break;
658                 }
659                 count = 3;
660                 result = (unsigned char)((result << 3) + (*p - '0'));
661                 p++;
662                 if ((numBytes == 3) || !isdigit(UCHAR(*p)) /* INTL: digit */
663       || (UCHAR(*p) >= '8')) {
664                     break;
665                 }
666                 count = 4;
667                 result = (unsigned char)((result << 3) + (*p - '0'));
668                 break;
669             }
670             /*
671              * We have to convert here in case the user has put a
672              * backslash in front of a multi-byte utf-8 character.
673              * While this means nothing special, we shouldn't break up
674              * a correct utf-8 character. [Bug #217987] test subst-3.2
675              */
676       if (Tcl_UtfCharComplete(p, numBytes - 1)) {
677           count = Tcl_UtfToUniChar(p, &result) + 1; /* +1 for '\' */
678       } else {
679     char utfBytes[TCL_UTF_MAX];
680     memcpy(utfBytes, p, (size_t) (numBytes - 1));
681     utfBytes[numBytes - 1] = '\0';
682           count = Tcl_UtfToUniChar(utfBytes, &result) + 1;
683       }
684             break;
685     }
686 
687     done:
688     if (readPtr != NULL) {
689         *readPtr = count;
690     }
691     return Tcl_UniCharToUtf((int) result, dst);
692 }
int TclParseHex (CONST char * src, int numBytes, Tcl_UniChar * resultPtr)

Definition at line 500 of file tclParse.c.
References CONST, and UCHAR.
Referenced by TclParseBackslash(), and TclParseInteger().507 {
508     Tcl_UniChar result = 0;
509     register CONST char *p = src;
510 
511     while (numBytes--) {
512   unsigned char digit = UCHAR(*p);
513 
514   if (!isxdigit(digit))
515       break;
516 
517   ++p;
518   result <<= 4;
519 
520   if (digit >= 'a') {
521       result |= (10 + digit - 'a');
522   } else if (digit >= 'A') {
523       result |= (10 + digit - 'A');
524   } else {
525       result |= (digit - '0');
526   }
527     }
528 
529     *resultPtr = result;
530     return (p - src);
531 }
int TclParseWhiteSpace (CONST char * src, int numBytes, Tcl_Parse * parsePtr, char * typePtr)

Definition at line 437 of file tclParse.c.
References CHAR_TYPE, CONST, Tcl_Parse::incomplete, TYPE_NORMAL, TYPE_SPACE, and TYPE_SUBS.
Referenced by GetLexeme(), ParseComment(), and Tcl_ParseCommand().446 {
447     register char type = TYPE_NORMAL;
448     register CONST char *p = src;
449 
450     while (1) {
451   while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) {
452       numBytes--; p++;
453   }
454   if (numBytes && (type & TYPE_SUBS)) {
455       if (*p != '\\') {
456     break;
457       }
458       if (--numBytes == 0) {
459     break;
460       }
461       if (p[1] != '\n') {
462     break;
463       }
464       p+=2;
465       if (--numBytes == 0) {
466     parsePtr->incomplete = 1;
467     break;
468       }
469       continue;
470   }
471   break;
472     }
473     *typePtr = type;
474     return (p - src);
475 }

Variable Documentation
CONST char charTypeTable[] [static]

Definition at line 60 of file tclParse.c.

generic/tclParseExpr.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Classes
struct ParseInfo
Defines
#define LITERAL  0
#define FUNC_NAME  1
#define OPEN_BRACKET  2
#define OPEN_BRACE  3
#define OPEN_PAREN  4
#define CLOSE_PAREN  5
#define DOLLAR  6
#define QUOTE  7
#define COMMA  8
#define END  9
#define UNKNOWN  10
#define UNKNOWN_CHAR  11
#define MULT  12
#define DIVIDE  13
#define MOD  14
#define PLUS  15
#define MINUS  16
#define LEFT_SHIFT  17
#define RIGHT_SHIFT  18
#define LESS  19
#define GREATER  20
#define LEQ  21
#define GEQ  22
#define EQUAL  23
#define NEQ  24
#define BIT_AND  25
#define BIT_XOR  26
#define BIT_OR  27
#define AND  28
#define OR  29
#define QUESTY  30
#define COLON  31
#define NOT  32
#define BIT_NOT  33
#define STREQ  34
#define STRNEQ  35
#define HERE(production, level)
Functions
static int GetLexeme _ANSI_ARGS_ ((ParseInfo *infoPtr))
static void LogSyntaxError _ANSI_ARGS_ ((ParseInfo *infoPtr, CONST char *extraInfo))
static int ParseMaxDoubleLength _ANSI_ARGS_ ((CONST char *string, CONST char *end))
static void PrependSubExprTokens _ANSI_ARGS_ ((CONST char *op, int opBytes, CONST char *src, int srcBytes, int firstIndex, ParseInfo *infoPtr))
int Tcl_ParseExpr (Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr)
static int ParseCondExpr (ParseInfo *infoPtr)
static int ParseLorExpr (ParseInfo *infoPtr)
static int ParseLandExpr (ParseInfo *infoPtr)
static int ParseBitOrExpr (ParseInfo *infoPtr)
static int ParseBitXorExpr (ParseInfo *infoPtr)
static int ParseBitAndExpr (ParseInfo *infoPtr)
static int ParseEqualityExpr (ParseInfo *infoPtr)
static int ParseRelationalExpr (ParseInfo *infoPtr)
static int ParseShiftExpr (ParseInfo *infoPtr)
static int ParseAddExpr (ParseInfo *infoPtr)
static int ParseMultiplyExpr (ParseInfo *infoPtr)
static int ParseUnaryExpr (ParseInfo *infoPtr)
static int ParsePrimaryExpr (ParseInfo *infoPtr)
static int GetLexeme (ParseInfo *infoPtr)
int TclParseInteger (CONST char *string, int numBytes)
static int ParseMaxDoubleLength (CONST char *string, CONST char *end)
static void PrependSubExprTokens (CONST char *op, int opBytes, CONST char *src, int srcBytes, int firstIndex, ParseInfo *infoPtr)
static void LogSyntaxError (ParseInfo *infoPtr, CONST char *extraInfo)
Variables
static char * lexemeStrings []

Define Documentation
#define AND  28

Definition at line 112 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParseLandExpr().#define BIT_AND  25

Definition at line 109 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParseBitAndExpr().#define BIT_NOT  33

Definition at line 123 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParseUnaryExpr().#define BIT_OR  27

Definition at line 111 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParseBitOrExpr().#define BIT_XOR  26

Definition at line 110 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParseBitXorExpr().#define CLOSE_PAREN  5

Definition at line 84 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParsePrimaryExpr().#define COLON  31

Definition at line 115 of file tclParseExpr.c.
Referenced by GetLexeme(), ParseCondExpr(), and ParsePrimaryExpr().#define COMMA  8

Definition at line 87 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParsePrimaryExpr().#define DIVIDE  13

Definition at line 97 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParseMultiplyExpr().#define DOLLAR  6

Definition at line 85 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParsePrimaryExpr().#define END  9

Definition at line 88 of file tclParseExpr.c.#define EQUAL  23

Definition at line 107 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParseEqualityExpr().#define FUNC_NAME  1

Definition at line 80 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParsePrimaryExpr().#define GEQ  22

Definition at line 106 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParseRelationalExpr().#define GREATER  20

Definition at line 104 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParseRelationalExpr().#define HERE(production, level)

Definition at line 185 of file tclParseExpr.c.
Referenced by ParseAddExpr(), ParseBitAndExpr(), ParseBitOrExpr(), ParseBitXorExpr(), ParseCondExpr(), ParseEqualityExpr(), ParseLandExpr(), ParseLorExpr(), ParseMultiplyExpr(), ParsePrimaryExpr(), ParseRelationalExpr(), ParseShiftExpr(), and ParseUnaryExpr().#define LEFT_SHIFT  17

Definition at line 101 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParseShiftExpr().#define LEQ  21

Definition at line 105 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParseRelationalExpr().#define LESS  19

Definition at line 103 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParseRelationalExpr().#define LITERAL  0

Definition at line 79 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParsePrimaryExpr().#define MINUS  16

Definition at line 100 of file tclParseExpr.c.
Referenced by GetLexeme(), ParseAddExpr(), and ParseUnaryExpr().#define MOD  14

Definition at line 98 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParseMultiplyExpr().#define MULT  12

Definition at line 96 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParseMultiplyExpr().#define NEQ  24

Definition at line 108 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParseEqualityExpr().#define NOT  32

Definition at line 122 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParseUnaryExpr().#define OPEN_BRACE  3

Definition at line 82 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParsePrimaryExpr().#define OPEN_BRACKET  2

Definition at line 81 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParsePrimaryExpr().#define OPEN_PAREN  4

Definition at line 83 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParsePrimaryExpr().#define OR  29

Definition at line 113 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParseLorExpr().#define PLUS  15

Definition at line 99 of file tclParseExpr.c.
Referenced by GetLexeme(), ParseAddExpr(), and ParseUnaryExpr().#define QUESTY  30

Definition at line 114 of file tclParseExpr.c.
Referenced by GetLexeme(), ParseCondExpr(), and ParsePrimaryExpr().#define QUOTE  7

Definition at line 86 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParsePrimaryExpr().#define RIGHT_SHIFT  18

Definition at line 102 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParseShiftExpr().#define STREQ  34

Definition at line 129 of file tclParseExpr.c.
Referenced by GetLexeme(), ParseEqualityExpr(), and ParsePrimaryExpr().#define STRNEQ  35

Definition at line 130 of file tclParseExpr.c.
Referenced by GetLexeme(), ParseEqualityExpr(), and ParsePrimaryExpr().#define UNKNOWN  10

Definition at line 89 of file tclParseExpr.c.
Referenced by GetLexeme(), ParsePrimaryExpr(), and Tcl_ParseExpr().#define UNKNOWN_CHAR  11

Definition at line 90 of file tclParseExpr.c.
Referenced by GetLexeme(), and ParsePrimaryExpr().
Function Documentation
static void PrependSubExprTokens _ANSI_ARGS_ ((CONST char *op, int opBytes, CONST char *src, int srcBytes, int firstIndex, ParseInfo *infoPtr)) [static]
static int ParseMaxDoubleLength _ANSI_ARGS_ ((CONST char *string, CONST char *end)) [static]
static void LogSyntaxError _ANSI_ARGS_ ((ParseInfo *infoPtr, CONST char *extraInfo)) [static]
static int GetLexeme _ANSI_ARGS_ ((ParseInfo *infoPtr)) [static]
static int GetLexeme (ParseInfo * infoPtr) [static]

Definition at line 1549 of file tclParseExpr.c.
References AND, BIT_AND, BIT_NOT, BIT_OR, BIT_XOR, CLOSE_PAREN, COLON, COMMA, CONST, DIVIDE, DOLLAR, END, Tcl_Parse::end, EQUAL, errno, Tcl_Parse::errorType, FUNC_NAME, GEQ, GREATER, Tcl_Parse::interp, LEFT_SHIFT, LEQ, LESS, LITERAL, MINUS, MOD, MULT, NEQ, NOT, NULL, OPEN_BRACE, OPEN_BRACKET, OPEN_PAREN, OR, ParseMaxDoubleLength(), PLUS, QUESTY, QUOTE, RIGHT_SHIFT, size_t(), STREQ, STRNEQ, strtod(), Tcl_DecrRefCount, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), TCL_ERROR, Tcl_GetWideIntFromObj(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_OK, TCL_PARSE_BAD_NUMBER, TCL_UTF_MAX, Tcl_UtfCharComplete(), Tcl_UtfToUniChar(), TclExprFloatError(), TclParseInteger(), TclParseWhiteSpace(), Tcl_Parse::term, UCHAR, UNKNOWN, and UNKNOWN_CHAR.
Referenced by ParseAddExpr(), ParseBitAndExpr(), ParseBitOrExpr(), ParseBitXorExpr(), ParseCondExpr(), ParseEqualityExpr(), ParseLandExpr(), ParseLorExpr(), ParseMultiplyExpr(), ParsePrimaryExpr(), ParseRelationalExpr(), ParseShiftExpr(), ParseUnaryExpr(), and Tcl_ParseExpr().1552 {
1553     register CONST char *src; /* Points to current source char. */
1554     char c;
1555     int offset, length, numBytes;
1556     Tcl_Parse *parsePtr = infoPtr->parsePtr;
1557     Tcl_Interp *interp = parsePtr->interp;
1558     Tcl_UniChar ch;
1559 
1560     /*
1561      * Record where the previous lexeme ended. Since we always read one
1562      * lexeme ahead during parsing, this helps us know the source length of
1563      * subexpression tokens.
1564      */
1565 
1566     infoPtr->prevEnd = infoPtr->next;
1567 
1568     /*
1569      * Scan over leading white space at the start of a lexeme. 
1570      */
1571 
1572     src = infoPtr->next;
1573     numBytes = parsePtr->end - src;
1574     do {
1575   char type;
1576   int scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
1577   src += scanned; numBytes -= scanned;
1578     } while  (numBytes && (*src == '\n') && (src++,numBytes--));
1579     parsePtr->term = src;
1580     if (numBytes == 0) {
1581   infoPtr->lexeme = END;
1582   infoPtr->next = src;
1583   return TCL_OK;
1584     }
1585 
1586     /*
1587      * Try to parse the lexeme first as an integer or floating-point
1588      * number. Don't check for a number if the first character c is
1589      * "+" or "-". If we did, we might treat a binary operator as unary
1590      * by mistake, which would eventually cause a syntax error.
1591      */
1592 
1593     c = *src;
1594     if ((c != '+') && (c != '-')) {
1595   CONST char *end = infoPtr->lastChar;
1596   if ((length = TclParseInteger(src, (end - src)))) {
1597       /*
1598        * First length bytes look like an integer.  Verify by
1599        * attempting the conversion to the largest integer we have.
1600        */
1601       int code;
1602       Tcl_WideInt wide;
1603       Tcl_Obj *value = Tcl_NewStringObj(src, length);
1604 
1605       Tcl_IncrRefCount(value);
1606       code = Tcl_GetWideIntFromObj(interp, value, &wide);
1607       Tcl_DecrRefCount(value);
1608       if (code == TCL_ERROR) {
1609     parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
1610     return TCL_ERROR;
1611       }
1612             infoPtr->lexeme = LITERAL;
1613       infoPtr->start = src;
1614       infoPtr->size = length;
1615             infoPtr->next = (src + length);
1616       parsePtr->term = infoPtr->next;
1617             return TCL_OK;
1618   } else if ((length = ParseMaxDoubleLength(src, end))) {
1619       /*
1620        * There are length characters that could be a double.
1621        * Let strtod() tells us for sure.  Need a writable copy
1622        * so we can set an terminating NULL to keep strtod from
1623        * scanning too far.
1624        */
1625       char *startPtr, *termPtr;
1626       double doubleValue;
1627       Tcl_DString toParse;
1628 
1629       errno = 0;
1630       Tcl_DStringInit(&toParse);
1631       startPtr = Tcl_DStringAppend(&toParse, src, length);
1632       doubleValue = strtod(startPtr, &termPtr);
1633       Tcl_DStringFree(&toParse);
1634       if (termPtr != startPtr) {
1635     if (errno != 0) {
1636         if (interp != NULL) {
1637       TclExprFloatError(interp, doubleValue);
1638         }
1639         parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
1640         return TCL_ERROR;
1641     }
1642     
1643     /*
1644                  * startPtr was the start of a valid double, copied
1645      * from src.
1646                  */
1647     
1648     infoPtr->lexeme = LITERAL;
1649     infoPtr->start = src;
1650     if ((termPtr - startPtr) > length) {
1651         infoPtr->size = length;
1652     } else {
1653         infoPtr->size = (termPtr - startPtr);
1654     }
1655     infoPtr->next = src + infoPtr->size;
1656     parsePtr->term = infoPtr->next;
1657     return TCL_OK;
1658       }
1659   }
1660     }
1661 
1662     /*
1663      * Not an integer or double literal. Initialize the lexeme's fields
1664      * assuming the common case of a single character lexeme.
1665      */
1666 
1667     infoPtr->start = src;
1668     infoPtr->size = 1;
1669     infoPtr->next = src+1;
1670     parsePtr->term = infoPtr->next;
1671     
1672     switch (*src) {
1673   case '[':
1674       infoPtr->lexeme = OPEN_BRACKET;
1675       return TCL_OK;
1676 
1677         case '{':
1678       infoPtr->lexeme = OPEN_BRACE;
1679       return TCL_OK;
1680 
1681   case '(':
1682       infoPtr->lexeme = OPEN_PAREN;
1683       return TCL_OK;
1684 
1685   case ')':
1686       infoPtr->lexeme = CLOSE_PAREN;
1687       return TCL_OK;
1688 
1689   case '$':
1690       infoPtr->lexeme = DOLLAR;
1691       return TCL_OK;
1692 
1693   case '\"':
1694       infoPtr->lexeme = QUOTE;
1695       return TCL_OK;
1696 
1697   case ',':
1698       infoPtr->lexeme = COMMA;
1699       return TCL_OK;
1700 
1701   case '*':
1702       infoPtr->lexeme = MULT;
1703       return TCL_OK;
1704 
1705   case '/':
1706       infoPtr->lexeme = DIVIDE;
1707       return TCL_OK;
1708 
1709   case '%':
1710       infoPtr->lexeme = MOD;
1711       return TCL_OK;
1712 
1713   case '+':
1714       infoPtr->lexeme = PLUS;
1715       return TCL_OK;
1716 
1717   case '-':
1718       infoPtr->lexeme = MINUS;
1719       return TCL_OK;
1720 
1721   case '?':
1722       infoPtr->lexeme = QUESTY;
1723       return TCL_OK;
1724 
1725   case ':':
1726       infoPtr->lexeme = COLON;
1727       return TCL_OK;
1728 
1729   case '<':
1730       infoPtr->lexeme = LESS;
1731       if ((infoPtr->lastChar - src) > 1) {
1732     switch (src[1]) {
1733         case '<':
1734       infoPtr->lexeme = LEFT_SHIFT;
1735       infoPtr->size = 2;
1736       infoPtr->next = src+2;
1737       break;
1738         case '=':
1739       infoPtr->lexeme = LEQ;
1740       infoPtr->size = 2;
1741       infoPtr->next = src+2;
1742       break;
1743     }
1744       }
1745       parsePtr->term = infoPtr->next;
1746       return TCL_OK;
1747 
1748   case '>':
1749       infoPtr->lexeme = GREATER;
1750       if ((infoPtr->lastChar - src) > 1) {
1751     switch (src[1]) {
1752         case '>':
1753       infoPtr->lexeme = RIGHT_SHIFT;
1754       infoPtr->size = 2;
1755       infoPtr->next = src+2;
1756       break;
1757         case '=':
1758       infoPtr->lexeme = GEQ;
1759       infoPtr->size = 2;
1760       infoPtr->next = src+2;
1761       break;
1762     }
1763       }
1764       parsePtr->term = infoPtr->next;
1765       return TCL_OK;
1766 
1767   case '=':
1768       infoPtr->lexeme = UNKNOWN;
1769       if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {
1770     infoPtr->lexeme = EQUAL;
1771     infoPtr->size = 2;
1772     infoPtr->next = src+2;
1773       }
1774       parsePtr->term = infoPtr->next;
1775       return TCL_OK;
1776 
1777   case '!':
1778       infoPtr->lexeme = NOT;
1779       if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {
1780     infoPtr->lexeme = NEQ;
1781     infoPtr->size = 2;
1782     infoPtr->next = src+2;
1783       }
1784       parsePtr->term = infoPtr->next;
1785       return TCL_OK;
1786 
1787   case '&':
1788       infoPtr->lexeme = BIT_AND;
1789       if ((src[1] == '&') && ((infoPtr->lastChar - src) > 1)) {
1790     infoPtr->lexeme = AND;
1791     infoPtr->size = 2;
1792     infoPtr->next = src+2;
1793       }
1794       parsePtr->term = infoPtr->next;
1795       return TCL_OK;
1796 
1797   case '^':
1798       infoPtr->lexeme = BIT_XOR;
1799       return TCL_OK;
1800 
1801   case '|':
1802       infoPtr->lexeme = BIT_OR;
1803       if ((src[1] == '|') && ((infoPtr->lastChar - src) > 1)) {
1804     infoPtr->lexeme = OR;
1805     infoPtr->size = 2;
1806     infoPtr->next = src+2;
1807       }
1808       parsePtr->term = infoPtr->next;
1809       return TCL_OK;
1810 
1811   case '~':
1812       infoPtr->lexeme = BIT_NOT;
1813       return TCL_OK;
1814 
1815   case 'e':
1816       if ((src[1] == 'q') && ((infoPtr->lastChar - src) > 1)) {
1817     infoPtr->lexeme = STREQ;
1818     infoPtr->size = 2;
1819     infoPtr->next = src+2;
1820     parsePtr->term = infoPtr->next;
1821     return TCL_OK;
1822       } else {
1823     goto checkFuncName;
1824       }
1825 
1826   case 'n':
1827       if ((src[1] == 'e') && ((infoPtr->lastChar - src) > 1)) {
1828     infoPtr->lexeme = STRNEQ;
1829     infoPtr->size = 2;
1830     infoPtr->next = src+2;
1831     parsePtr->term = infoPtr->next;
1832     return TCL_OK;
1833       } else {
1834     goto checkFuncName;
1835       }
1836 
1837   default:
1838   checkFuncName:
1839       length = (infoPtr->lastChar - src);
1840       if (Tcl_UtfCharComplete(src, length)) {
1841     offset = Tcl_UtfToUniChar(src, &ch);
1842       } else {
1843     char utfBytes[TCL_UTF_MAX];
1844     memcpy(utfBytes, src, (size_t) length);
1845     utfBytes[length] = '\0';
1846     offset = Tcl_UtfToUniChar(utfBytes, &ch);
1847       }
1848       c = UCHAR(ch);
1849       if (isalpha(UCHAR(c))) {  /* INTL: ISO only. */
1850     infoPtr->lexeme = FUNC_NAME;
1851     while (isalnum(UCHAR(c)) || (c == '_')) { /* INTL: ISO only. */
1852         src += offset; length -= offset;
1853         if (Tcl_UtfCharComplete(src, length)) {
1854       offset = Tcl_UtfToUniChar(src, &ch);
1855         } else {
1856       char utfBytes[TCL_UTF_MAX];
1857       memcpy(utfBytes, src, (size_t) length);
1858       utfBytes[length] = '\0';
1859       offset = Tcl_UtfToUniChar(utfBytes, &ch);
1860         }
1861         c = UCHAR(ch);
1862     }
1863     infoPtr->size = (src - infoPtr->start);
1864     infoPtr->next = src;
1865     parsePtr->term = infoPtr->next;
1866     return TCL_OK;
1867       }
1868       infoPtr->lexeme = UNKNOWN_CHAR;
1869       return TCL_OK;
1870     }
1871 }
static void LogSyntaxError (ParseInfo * infoPtr, CONST char * extraInfo) [static]

Definition at line 2058 of file tclParseExpr.c.
References NULL, Tcl_GetObjResult(), TCL_PARSE_SYNTAX, and Tcl_ResetResult().2063 {
2064     int numBytes = (infoPtr->lastChar - infoPtr->originalExpr);
2065     char buffer[100];
2066 
2067     if (numBytes > 60) {
2068   sprintf(buffer, "syntax error in expression \"%.60s...\"",
2069     infoPtr->originalExpr);
2070     } else {
2071   sprintf(buffer, "syntax error in expression \"%.*s\"",
2072     numBytes, infoPtr->originalExpr);
2073     }
2074     Tcl_ResetResult(infoPtr->parsePtr->interp);
2075     Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->parsePtr->interp),
2076       buffer, ": ", extraInfo, (char *) NULL);
2077     infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX;
2078     infoPtr->parsePtr->term = infoPtr->start;
2079 }
static int ParseAddExpr (ParseInfo * infoPtr) [static]

Definition at line 933 of file tclParseExpr.c.
References CONST, GetLexeme(), HERE, MINUS, Tcl_Parse::numTokens, ParseMultiplyExpr(), PLUS, PrependSubExprTokens(), and TCL_OK.
Referenced by ParseShiftExpr().936 {
937     Tcl_Parse *parsePtr = infoPtr->parsePtr;
938     int firstIndex, lexeme, code;
939     CONST char *srcStart, *operator;
940 
941     HERE("addExpr", 10);
942     srcStart = infoPtr->start;
943     firstIndex = parsePtr->numTokens;
944     
945     code = ParseMultiplyExpr(infoPtr);
946     if (code != TCL_OK) {
947   return code;
948     }
949 
950     lexeme = infoPtr->lexeme;
951     while ((lexeme == PLUS) || (lexeme == MINUS)) {
952   operator = infoPtr->start;
953   code = GetLexeme(infoPtr); /* skip over + or - */
954   if (code != TCL_OK) {
955       return code;
956   }
957   code = ParseMultiplyExpr(infoPtr);
958   if (code != TCL_OK) {
959       return code;
960   }
961 
962   /*
963    * Generate tokens for the subexpression and '+' or '-' operator.
964    */
965 
966   PrependSubExprTokens(operator, 1, srcStart,
967           (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
968   lexeme = infoPtr->lexeme;
969     }
970     return TCL_OK;
971 }
static int ParseBitAndExpr (ParseInfo * infoPtr) [static]

Definition at line 678 of file tclParseExpr.c.
References BIT_AND, CONST, GetLexeme(), HERE, Tcl_Parse::numTokens, ParseEqualityExpr(), PrependSubExprTokens(), and TCL_OK.
Referenced by ParseBitXorExpr().681 {
682     Tcl_Parse *parsePtr = infoPtr->parsePtr;
683     int firstIndex, code;
684     CONST char *srcStart, *operator;
685 
686     HERE("bitAndExpr", 6);
687     srcStart = infoPtr->start;
688     firstIndex = parsePtr->numTokens;
689     
690     code = ParseEqualityExpr(infoPtr);
691     if (code != TCL_OK) {
692   return code;
693     }
694     
695     while (infoPtr->lexeme == BIT_AND) {
696   operator = infoPtr->start;
697   code = GetLexeme(infoPtr); /* skip over the '&' */
698   if (code != TCL_OK) {
699       return code;
700   }
701   code = ParseEqualityExpr(infoPtr);
702   if (code != TCL_OK) {
703       return code;
704   }
705   
706   /*
707    * Generate tokens for the BITAND subexpression and '&' operator.
708    */
709 
710   PrependSubExprTokens(operator, 1, srcStart,
711           (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
712     }
713     return TCL_OK;
714 }
static int ParseBitOrExpr (ParseInfo * infoPtr) [static]

Definition at line 556 of file tclParseExpr.c.
References BIT_OR, CONST, GetLexeme(), HERE, Tcl_Parse::numTokens, ParseBitXorExpr(), PrependSubExprTokens(), and TCL_OK.
Referenced by ParseLandExpr().559 {
560     Tcl_Parse *parsePtr = infoPtr->parsePtr;
561     int firstIndex, code;
562     CONST char *srcStart, *operator;
563 
564     HERE("bitOrExpr", 4);
565     srcStart = infoPtr->start;
566     firstIndex = parsePtr->numTokens;
567     
568     code = ParseBitXorExpr(infoPtr);
569     if (code != TCL_OK) {
570   return code;
571     }
572     
573     while (infoPtr->lexeme == BIT_OR) {
574   operator = infoPtr->start;
575   code = GetLexeme(infoPtr); /* skip over the '|' */
576   if (code != TCL_OK) {
577       return code;
578   }
579 
580   code = ParseBitXorExpr(infoPtr);
581   if (code != TCL_OK) {
582       return code;
583   }
584   
585   /*
586    * Generate tokens for the BITOR subexpression and the '|' operator.
587    */
588 
589   PrependSubExprTokens(operator, 1, srcStart,
590           (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
591     }
592     return TCL_OK;
593 }
static int ParseBitXorExpr (ParseInfo * infoPtr) [static]

Definition at line 617 of file tclParseExpr.c.
References BIT_XOR, CONST, GetLexeme(), HERE, Tcl_Parse::numTokens, ParseBitAndExpr(), PrependSubExprTokens(), and TCL_OK.
Referenced by ParseBitOrExpr().620 {
621     Tcl_Parse *parsePtr = infoPtr->parsePtr;
622     int firstIndex, code;
623     CONST char *srcStart, *operator;
624 
625     HERE("bitXorExpr", 5);
626     srcStart = infoPtr->start;
627     firstIndex = parsePtr->numTokens;
628     
629     code = ParseBitAndExpr(infoPtr);
630     if (code != TCL_OK) {
631   return code;
632     }
633     
634     while (infoPtr->lexeme == BIT_XOR) {
635   operator = infoPtr->start;
636   code = GetLexeme(infoPtr); /* skip over the '^' */
637   if (code != TCL_OK) {
638       return code;
639   }
640 
641   code = ParseBitAndExpr(infoPtr);
642   if (code != TCL_OK) {
643       return code;
644   }
645   
646   /*
647    * Generate tokens for the XOR subexpression and the '^' operator.
648    */
649 
650   PrependSubExprTokens(operator, 1, srcStart,
651           (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
652     }
653     return TCL_OK;
654 }
static int ParseCondExpr (ParseInfo * infoPtr) [static]

Definition at line 322 of file tclParseExpr.c.
References COLON, CONST, GetLexeme(), HERE, LogSyntaxError(), Tcl_Token::numComponents, Tcl_Parse::numTokens, ParseLorExpr(), QUESTY, Tcl_Token::size, size_t(), TCL_ERROR, TCL_OK, TCL_TOKEN_OPERATOR, TCL_TOKEN_SUB_EXPR, TclExpandTokenArray(), Tcl_Parse::tokenPtr, Tcl_Parse::tokensAvailable, and VOID.
Referenced by ParsePrimaryExpr(), and Tcl_ParseExpr().325 {
326     Tcl_Parse *parsePtr = infoPtr->parsePtr;
327     Tcl_Token *tokenPtr, *firstTokenPtr, *condTokenPtr;
328     int firstIndex, numToMove, code;
329     CONST char *srcStart;
330     
331     HERE("condExpr", 1);
332     srcStart = infoPtr->start;
333     firstIndex = parsePtr->numTokens;
334     
335     code = ParseLorExpr(infoPtr);
336     if (code != TCL_OK) {
337   return code;
338     }
339     
340     if (infoPtr->lexeme == QUESTY) {
341   /*
342    * Emit two tokens: one TCL_TOKEN_SUB_EXPR token for the entire
343    * conditional expression, and a TCL_TOKEN_OPERATOR token for 
344    * the "?" operator. Note that these two tokens must be inserted
345    * before the LOR operand tokens generated above.
346    */
347 
348   if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {
349       TclExpandTokenArray(parsePtr);
350   }
351   firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
352   tokenPtr = (firstTokenPtr + 2);
353   numToMove = (parsePtr->numTokens - firstIndex);
354   memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
355           (size_t) (numToMove * sizeof(Tcl_Token)));
356   parsePtr->numTokens += 2;
357   
358   tokenPtr = firstTokenPtr;
359   tokenPtr->type = TCL_TOKEN_SUB_EXPR;
360   tokenPtr->start = srcStart;
361   
362   tokenPtr++;
363   tokenPtr->type = TCL_TOKEN_OPERATOR;
364   tokenPtr->start = infoPtr->start;
365   tokenPtr->size = 1;
366   tokenPtr->numComponents = 0;
367     
368   /*
369    * Skip over the '?'.
370    */
371   
372   code = GetLexeme(infoPtr); 
373   if (code != TCL_OK) {
374       return code;
375   }
376 
377   /*
378    * Parse the "then" expression.
379    */
380 
381   code = ParseCondExpr(infoPtr);
382   if (code != TCL_OK) {
383       return code;
384   }
385   if (infoPtr->lexeme != COLON) {
386       LogSyntaxError(infoPtr, "missing colon from ternary conditional");
387       return TCL_ERROR;
388   }
389   code = GetLexeme(infoPtr); /* skip over the ':' */
390   if (code != TCL_OK) {
391       return code;
392   }
393 
394   /*
395    * Parse the "else" expression.
396    */
397 
398   code = ParseCondExpr(infoPtr);
399   if (code != TCL_OK) {
400       return code;
401   }
402 
403   /*
404    * Now set the size-related fields in the '?' subexpression token.
405    */
406 
407   condTokenPtr = &parsePtr->tokenPtr[firstIndex];
408   condTokenPtr->size = (infoPtr->prevEnd - srcStart);
409   condTokenPtr->numComponents = parsePtr->numTokens - (firstIndex+1);
410     }
411     return TCL_OK;
412 }
static int ParseEqualityExpr (ParseInfo * infoPtr) [static]

Definition at line 739 of file tclParseExpr.c.
References CONST, EQUAL, GetLexeme(), HERE, NEQ, Tcl_Parse::numTokens, ParseRelationalExpr(), PrependSubExprTokens(), STREQ, STRNEQ, and TCL_OK.
Referenced by ParseBitAndExpr().742 {
743     Tcl_Parse *parsePtr = infoPtr->parsePtr;
744     int firstIndex, lexeme, code;
745     CONST char *srcStart, *operator;
746 
747     HERE("equalityExpr", 7);
748     srcStart = infoPtr->start;
749     firstIndex = parsePtr->numTokens;
750     
751     code = ParseRelationalExpr(infoPtr);
752     if (code != TCL_OK) {
753   return code;
754     }
755 
756     lexeme = infoPtr->lexeme;
757     while ((lexeme == EQUAL) || (lexeme == NEQ)
758       || (lexeme == STREQ) || (lexeme == STRNEQ)) {
759   operator = infoPtr->start;
760   code = GetLexeme(infoPtr); /* skip over ==, !=, 'eq' or 'ne'  */
761   if (code != TCL_OK) {
762       return code;
763   }
764   code = ParseRelationalExpr(infoPtr);
765   if (code != TCL_OK) {
766       return code;
767   }
768 
769   /*
770    * Generate tokens for the subexpression and '==', '!=', 'eq' or 'ne'
771    * operator.
772    */
773 
774   PrependSubExprTokens(operator, 2, srcStart,
775           (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
776   lexeme = infoPtr->lexeme;
777     }
778     return TCL_OK;
779 }
static int ParseLandExpr (ParseInfo * infoPtr) [static]

Definition at line 496 of file tclParseExpr.c.
References AND, CONST, GetLexeme(), HERE, Tcl_Parse::numTokens, ParseBitOrExpr(), PrependSubExprTokens(), and TCL_OK.
Referenced by ParseLorExpr().499 {
500     Tcl_Parse *parsePtr = infoPtr->parsePtr;
501     int firstIndex, code;
502     CONST char *srcStart, *operator;
503 
504     HERE("landExpr", 3);
505     srcStart = infoPtr->start;
506     firstIndex = parsePtr->numTokens;
507     
508     code = ParseBitOrExpr(infoPtr);
509     if (code != TCL_OK) {
510   return code;
511     }
512 
513     while (infoPtr->lexeme == AND) {
514   operator = infoPtr->start;
515   code = GetLexeme(infoPtr); /* skip over the '&&' */
516   if (code != TCL_OK) {
517       return code;
518   }
519   code = ParseBitOrExpr(infoPtr);
520   if (code != TCL_OK) {
521       return code;
522   }
523 
524   /*
525    * Generate tokens for the LAND subexpression and the '&&' operator.
526    */
527 
528   PrependSubExprTokens(operator, 2, srcStart,
529           (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
530     }
531     return TCL_OK;
532 }
static int ParseLorExpr (ParseInfo * infoPtr) [static]

Definition at line 436 of file tclParseExpr.c.
References CONST, GetLexeme(), HERE, Tcl_Parse::numTokens, OR, ParseLandExpr(), PrependSubExprTokens(), and TCL_OK.
Referenced by ParseCondExpr().439 {
440     Tcl_Parse *parsePtr = infoPtr->parsePtr;
441     int firstIndex, code;
442     CONST char *srcStart, *operator;
443     
444     HERE("lorExpr", 2);
445     srcStart = infoPtr->start;
446     firstIndex = parsePtr->numTokens;
447     
448     code = ParseLandExpr(infoPtr);
449     if (code != TCL_OK) {
450   return code;
451     }
452 
453     while (infoPtr->lexeme == OR) {
454   operator = infoPtr->start;
455   code = GetLexeme(infoPtr); /* skip over the '||' */
456   if (code != TCL_OK) {
457       return code;
458   }
459   code = ParseLandExpr(infoPtr);
460   if (code != TCL_OK) {
461       return code;
462   }
463 
464   /*
465    * Generate tokens for the LOR subexpression and the '||' operator.
466    */
467 
468   PrependSubExprTokens(operator, 2, srcStart,
469           (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
470     }
471     return TCL_OK;
472 }
static int ParseMaxDoubleLength (CONST char * string, CONST char * end) [static]

Definition at line 1952 of file tclParseExpr.c.
References CONST.
Referenced by GetLexeme().1956 {
1957     CONST char *p = string;
1958     while (p < end) {
1959   switch (*p) {
1960       case '0': case '1': case '2': case '3': case '4': case '5':
1961       case '6': case '7': case '8': case '9': case 'A': case 'B':
1962       case 'C': case 'D': case 'E': case 'F': case 'I': case 'N':
1963       case 'P': case 'X': case 'a': case 'b': case 'c': case 'd':
1964       case 'e': case 'f': case 'i': case 'n': case 'p': case 'x':
1965       case '.': case '+': case '-':
1966     p++;
1967     break;
1968       default:
1969     goto done;
1970   }
1971     }
1972     done:
1973     return (p - string);
1974 }
static int ParseMultiplyExpr (ParseInfo * infoPtr) [static]

Definition at line 995 of file tclParseExpr.c.
References CONST, DIVIDE, GetLexeme(), HERE, MOD, MULT, Tcl_Parse::numTokens, ParseUnaryExpr(), PrependSubExprTokens(), and TCL_OK.
Referenced by ParseAddExpr().998 {
999     Tcl_Parse *parsePtr = infoPtr->parsePtr;
1000     int firstIndex, lexeme, code;
1001     CONST char *srcStart, *operator;
1002 
1003     HERE("multiplyExpr", 11);
1004     srcStart = infoPtr->start;
1005     firstIndex = parsePtr->numTokens;
1006     
1007     code = ParseUnaryExpr(infoPtr);
1008     if (code != TCL_OK) {
1009   return code;
1010     }
1011 
1012     lexeme = infoPtr->lexeme;
1013     while ((lexeme == MULT) || (lexeme == DIVIDE) || (lexeme == MOD)) {
1014   operator = infoPtr->start;
1015   code = GetLexeme(infoPtr); /* skip over * or / or % */
1016   if (code != TCL_OK) {
1017       return code;
1018   }
1019   code = ParseUnaryExpr(infoPtr);
1020   if (code != TCL_OK) {
1021       return code;
1022   }
1023 
1024   /*
1025    * Generate tokens for the subexpression and * or / or % operator.
1026    */
1027 
1028   PrependSubExprTokens(operator, 1, srcStart,
1029           (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
1030   lexeme = infoPtr->lexeme;
1031     }
1032     return TCL_OK;
1033 }
static int ParsePrimaryExpr (ParseInfo * infoPtr) [static]

Definition at line 1120 of file tclParseExpr.c.
References ckfree, CLOSE_PAREN, COLON, COMMA, Tcl_Parse::commandSize, Tcl_Parse::commandStart, CONST, DOLLAR, END, Tcl_Parse::end, Tcl_Parse::errorType, FUNC_NAME, GetLexeme(), HERE, Tcl_Parse::incomplete, Tcl_Parse::interp, lexemeStrings, LITERAL, LogSyntaxError(), Interp::mathFuncTable, NULL, Tcl_Token::numComponents, Tcl_Parse::numTokens, OPEN_BRACE, OPEN_BRACKET, OPEN_PAREN, ParseCondExpr(), QUESTY, QUOTE, ParseInfo::size, Tcl_Token::size, size_t(), ParseInfo::start, Tcl_Token::start, Tcl_Parse::staticTokens, STREQ, STRNEQ, Tcl_ConvertToType(), Tcl_DecrRefCount, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), TCL_ERROR, Tcl_FindHashEntry, Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_OK, TCL_PARSE_MISSING_BRACKET, Tcl_ParseBraces(), Tcl_ParseCommand(), Tcl_ParseQuotedString(), Tcl_ParseVarName(), Tcl_SetResult(), TCL_STATIC, TCL_TOKEN_COMMAND, TCL_TOKEN_OPERATOR, TCL_TOKEN_SUB_EXPR, TCL_TOKEN_TEXT, TCL_TOKEN_WORD, tclBooleanType, TclExpandTokenArray(), Tcl_Parse::term, Tcl_Parse::tokenPtr, Tcl_Parse::tokensAvailable, Tcl_Token::type, UNKNOWN, UNKNOWN_CHAR, and VOID.
Referenced by ParseUnaryExpr().1123 {
1124     Tcl_Parse *parsePtr = infoPtr->parsePtr;
1125     Tcl_Interp *interp = parsePtr->interp;
1126     Tcl_Token *tokenPtr, *exprTokenPtr;
1127     Tcl_Parse nested;
1128     CONST char *dollarPtr, *stringStart, *termPtr, *src;
1129     int lexeme, exprIndex, firstIndex, numToMove, code;
1130 
1131     /*
1132      * We simply recurse on parenthesized subexpressions.
1133      */
1134 
1135     HERE("primaryExpr", 13);
1136     lexeme = infoPtr->lexeme;
1137     if (lexeme == OPEN_PAREN) {
1138   code = GetLexeme(infoPtr); /* skip over the '(' */
1139   if (code != TCL_OK) {
1140       return code;
1141   }
1142   code = ParseCondExpr(infoPtr);
1143   if (code != TCL_OK) {
1144       return code;
1145   }
1146   if (infoPtr->lexeme != CLOSE_PAREN) {
1147       LogSyntaxError(infoPtr, "looking for close parenthesis");
1148       return TCL_ERROR;
1149   }
1150   code = GetLexeme(infoPtr); /* skip over the ')' */
1151   if (code != TCL_OK) {
1152       return code;
1153   }
1154   return TCL_OK;
1155     }
1156 
1157     /*
1158      * Start a TCL_TOKEN_SUB_EXPR token for the primary.
1159      */
1160 
1161     if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1162   TclExpandTokenArray(parsePtr);
1163     }
1164     exprIndex = parsePtr->numTokens;
1165     exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1166     exprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
1167     exprTokenPtr->start = infoPtr->start;
1168     parsePtr->numTokens++;
1169 
1170     /*
1171      * Process the primary then finish setting the fields of the
1172      * TCL_TOKEN_SUB_EXPR token. Note that we can't use the pointer now
1173      * stored in "exprTokenPtr" in the code below since the token array
1174      * might be reallocated.
1175      */
1176 
1177     firstIndex = parsePtr->numTokens;
1178     switch (lexeme) {
1179     case LITERAL:
1180   /*
1181    * Int or double number.
1182    */
1183   
1184   tokenizeLiteral:
1185   if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1186       TclExpandTokenArray(parsePtr);
1187   }
1188   tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1189   tokenPtr->type = TCL_TOKEN_TEXT;
1190   tokenPtr->start = infoPtr->start;
1191   tokenPtr->size = infoPtr->size;
1192   tokenPtr->numComponents = 0;
1193   parsePtr->numTokens++;
1194 
1195   exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1196   exprTokenPtr->size = infoPtr->size;
1197   exprTokenPtr->numComponents = 1;
1198   break;
1199 
1200     case DOLLAR:
1201   /*
1202    * $var variable reference.
1203    */
1204   
1205   dollarPtr = (infoPtr->next - 1);
1206   code = Tcl_ParseVarName(interp, dollarPtr,
1207           (infoPtr->lastChar - dollarPtr), parsePtr, 1);
1208   if (code != TCL_OK) {
1209       return code;
1210   }
1211   infoPtr->next = dollarPtr + parsePtr->tokenPtr[firstIndex].size;
1212 
1213   exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1214   exprTokenPtr->size = parsePtr->tokenPtr[firstIndex].size;
1215   exprTokenPtr->numComponents =
1216           (parsePtr->tokenPtr[firstIndex].numComponents + 1);
1217   break;
1218   
1219     case QUOTE:
1220   /*
1221    * '"' string '"'
1222    */
1223   
1224   stringStart = infoPtr->next;
1225   code = Tcl_ParseQuotedString(interp, infoPtr->start,
1226           (infoPtr->lastChar - stringStart), parsePtr, 1, &termPtr);
1227   if (code != TCL_OK) {
1228       return code;
1229   }
1230   infoPtr->next = termPtr;
1231 
1232   exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1233   exprTokenPtr->size = (termPtr - exprTokenPtr->start);
1234   exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
1235 
1236   /*
1237    * If parsing the quoted string resulted in more than one token,
1238    * insert a TCL_TOKEN_WORD token before them. This indicates that
1239    * the quoted string represents a concatenation of multiple tokens.
1240    */
1241 
1242   if (exprTokenPtr->numComponents > 1) {
1243       if (parsePtr->numTokens >= parsePtr->tokensAvailable) {
1244     TclExpandTokenArray(parsePtr);
1245       }
1246       tokenPtr = &parsePtr->tokenPtr[firstIndex];
1247       numToMove = (parsePtr->numTokens - firstIndex);
1248       memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
1249               (size_t) (numToMove * sizeof(Tcl_Token)));
1250       parsePtr->numTokens++;
1251 
1252       exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1253       exprTokenPtr->numComponents++;
1254 
1255       tokenPtr->type = TCL_TOKEN_WORD;
1256       tokenPtr->start = exprTokenPtr->start;
1257       tokenPtr->size = exprTokenPtr->size;
1258       tokenPtr->numComponents = (exprTokenPtr->numComponents - 1);
1259   }
1260   break;
1261   
1262     case OPEN_BRACKET:
1263   /*
1264    * '[' command {command} ']'
1265    */
1266 
1267   if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1268       TclExpandTokenArray(parsePtr);
1269   }
1270   tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1271   tokenPtr->type = TCL_TOKEN_COMMAND;
1272   tokenPtr->start = infoPtr->start;
1273   tokenPtr->numComponents = 0;
1274   parsePtr->numTokens++;
1275 
1276   /*
1277    * Call Tcl_ParseCommand repeatedly to parse the nested command(s)
1278    * to find their end, then throw away that parse information.
1279    */
1280   
1281   src = infoPtr->next;
1282   while (1) {
1283       if (Tcl_ParseCommand(interp, src, (parsePtr->end - src), 1,
1284         &nested) != TCL_OK) {
1285     parsePtr->term = nested.term;
1286     parsePtr->errorType = nested.errorType;
1287     parsePtr->incomplete = nested.incomplete;
1288     return TCL_ERROR;
1289       }
1290       src = (nested.commandStart + nested.commandSize);
1291 
1292       /*
1293        * This is equivalent to Tcl_FreeParse(&nested), but
1294        * presumably inlined here for sake of runtime optimization
1295        */
1296 
1297       if (nested.tokenPtr != nested.staticTokens) {
1298     ckfree((char *) nested.tokenPtr);
1299       }
1300 
1301       /*
1302        * Check for the closing ']' that ends the command substitution.
1303        * It must have been the last character of the parsed command.
1304        */
1305 
1306       if ((nested.term < parsePtr->end) && (*nested.term == ']') 
1307         && !nested.incomplete) {
1308     break;
1309       }
1310       if (src == parsePtr->end) {
1311     if (parsePtr->interp != NULL) {
1312         Tcl_SetResult(interp, "missing close-bracket",
1313           TCL_STATIC);
1314     }
1315     parsePtr->term = tokenPtr->start;
1316     parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
1317     parsePtr->incomplete = 1;
1318     return TCL_ERROR;
1319       }
1320   }
1321   tokenPtr->size = (src - tokenPtr->start);
1322   infoPtr->next = src;
1323 
1324   exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1325   exprTokenPtr->size = (src - tokenPtr->start);
1326   exprTokenPtr->numComponents = 1;
1327   break;
1328 
1329     case OPEN_BRACE:
1330   /*
1331    * '{' string '}'
1332    */
1333 
1334   code = Tcl_ParseBraces(interp, infoPtr->start,
1335           (infoPtr->lastChar - infoPtr->start), parsePtr, 1,
1336     &termPtr);
1337   if (code != TCL_OK) {
1338       return code;
1339   }
1340   infoPtr->next = termPtr;
1341 
1342   exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1343   exprTokenPtr->size = (termPtr - infoPtr->start);
1344   exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
1345 
1346   /*
1347    * If parsing the braced string resulted in more than one token,
1348    * insert a TCL_TOKEN_WORD token before them. This indicates that
1349    * the braced string represents a concatenation of multiple tokens.
1350    */
1351 
1352   if (exprTokenPtr->numComponents > 1) {
1353       if (parsePtr->numTokens >= parsePtr->tokensAvailable) {
1354     TclExpandTokenArray(parsePtr);
1355       }
1356       tokenPtr = &parsePtr->tokenPtr[firstIndex];
1357       numToMove = (parsePtr->numTokens - firstIndex);
1358       memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
1359               (size_t) (numToMove * sizeof(Tcl_Token)));
1360       parsePtr->numTokens++;
1361 
1362       exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1363       exprTokenPtr->numComponents++;
1364       
1365       tokenPtr->type = TCL_TOKEN_WORD;
1366       tokenPtr->start = exprTokenPtr->start;
1367       tokenPtr->size = exprTokenPtr->size;
1368       tokenPtr->numComponents = exprTokenPtr->numComponents-1;
1369   }
1370   break;
1371   
1372     case STREQ:
1373     case STRNEQ:
1374     case FUNC_NAME: {
1375   /*
1376    * math_func '(' expr {',' expr} ')'
1377    */
1378 
1379   ParseInfo savedInfo = *infoPtr;
1380   
1381   code = GetLexeme(infoPtr); /* skip over function name */
1382   if (code != TCL_OK) {
1383       return code;
1384   }
1385   if (infoPtr->lexeme != OPEN_PAREN) {
1386       int code;
1387       Tcl_DString functionName;
1388       Tcl_HashEntry *hPtr;
1389       Interp *iPtr = (Interp *) infoPtr->parsePtr->interp;
1390       Tcl_Obj *objPtr = Tcl_NewStringObj(savedInfo.start, savedInfo.size);
1391 
1392       /* Check for boolean literals (true, false, yes, no, on, off) */
1393       Tcl_IncrRefCount(objPtr);
1394       code = Tcl_ConvertToType(NULL, objPtr, &tclBooleanType);
1395       Tcl_DecrRefCount(objPtr);
1396       if (code == TCL_OK) {
1397     *infoPtr = savedInfo;
1398     goto tokenizeLiteral;
1399       }
1400 
1401       /*
1402        * Guess what kind of error we have by trying to tell
1403        * whether we have a function or variable name here.
1404        * Alas, this makes the parser more tightly bound with the
1405        * rest of the interpreter, but that is the only way to
1406        * give a sensible message here.  Still, it is not too
1407        * serious as this is only done when generating an error.
1408        */
1409 
1410       /*
1411        * Look up the name as a function name.  We need a writable
1412        * copy (DString) so we can terminate it with a NULL for
1413        * the benefit of Tcl_FindHashEntry which operates on
1414        * NULL-terminated string keys.
1415        */
1416       Tcl_DStringInit(&functionName);
1417       hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, 
1418         Tcl_DStringAppend(&functionName,
1419       savedInfo.start, savedInfo.size));
1420       Tcl_DStringFree(&functionName);
1421 
1422       /*
1423        * Assume that we have an attempted variable reference
1424        * unless we've got a function name, as the set of
1425        * potential function names is typically much smaller.
1426        */
1427       if (hPtr != NULL) {
1428     LogSyntaxError(infoPtr,
1429       "expected parenthesis enclosing function arguments");
1430       } else {
1431     LogSyntaxError(infoPtr,
1432       "variable references require preceding $");
1433       }
1434       return TCL_ERROR;
1435   }
1436 
1437   if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1438       TclExpandTokenArray(parsePtr);
1439   }
1440   tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1441   tokenPtr->type = TCL_TOKEN_OPERATOR;
1442   tokenPtr->start = savedInfo.start;
1443   tokenPtr->size = savedInfo.size;
1444   tokenPtr->numComponents = 0;
1445   parsePtr->numTokens++;
1446   
1447   code = GetLexeme(infoPtr); /* skip over '(' */
1448   if (code != TCL_OK) {
1449       return code;
1450   }
1451 
1452   while (infoPtr->lexeme != CLOSE_PAREN) {
1453       code = ParseCondExpr(infoPtr);
1454       if (code != TCL_OK) {
1455     return code;
1456       }
1457       
1458       if (infoPtr->lexeme == COMMA) {
1459     code = GetLexeme(infoPtr); /* skip over , */
1460     if (code != TCL_OK) {
1461         return code;
1462     }
1463       } else if (infoPtr->lexeme != CLOSE_PAREN) {
1464     LogSyntaxError(infoPtr,
1465       "missing close parenthesis at end of function call");
1466     return TCL_ERROR;
1467       }
1468   }
1469 
1470   exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1471   exprTokenPtr->size = (infoPtr->next - exprTokenPtr->start);
1472   exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
1473   break;
1474     }
1475 
1476     case COMMA:
1477   LogSyntaxError(infoPtr,
1478     "commas can only separate function arguments");
1479   return TCL_ERROR;
1480     case END:
1481   LogSyntaxError(infoPtr, "premature end of expression");
1482   return TCL_ERROR;
1483     case UNKNOWN:
1484   LogSyntaxError(infoPtr, "single equality character not legal in expressions");
1485   return TCL_ERROR;
1486     case UNKNOWN_CHAR:
1487   LogSyntaxError(infoPtr, "character not legal in expressions");
1488   return TCL_ERROR;
1489     case QUESTY:
1490   LogSyntaxError(infoPtr, "unexpected ternary 'then' separator");
1491   return TCL_ERROR;
1492     case COLON:
1493   LogSyntaxError(infoPtr, "unexpected ternary 'else' separator");
1494   return TCL_ERROR;
1495     case CLOSE_PAREN:
1496   LogSyntaxError(infoPtr, "unexpected close parenthesis");
1497   return TCL_ERROR;
1498 
1499     default: {
1500   char buf[64];
1501 
1502   sprintf(buf, "unexpected operator %s", lexemeStrings[lexeme]);
1503   LogSyntaxError(infoPtr, buf);
1504   return TCL_ERROR;
1505   }
1506     }
1507 
1508     /*
1509      * Advance to the next lexeme before returning.
1510      */
1511     
1512     code = GetLexeme(infoPtr);
1513     if (code != TCL_OK) {
1514   return code;
1515     }
1516     parsePtr->term = infoPtr->next;
1517     return TCL_OK;
1518 }
static int ParseRelationalExpr (ParseInfo * infoPtr) [static]

Definition at line 803 of file tclParseExpr.c.
References CONST, GEQ, GetLexeme(), GREATER, HERE, LEQ, LESS, Tcl_Parse::numTokens, ParseShiftExpr(), PrependSubExprTokens(), and TCL_OK.
Referenced by ParseEqualityExpr().806 {
807     Tcl_Parse *parsePtr = infoPtr->parsePtr;
808     int firstIndex, lexeme, operatorSize, code;
809     CONST char *srcStart, *operator;
810 
811     HERE("relationalExpr", 8);
812     srcStart = infoPtr->start;
813     firstIndex = parsePtr->numTokens;
814     
815     code = ParseShiftExpr(infoPtr);
816     if (code != TCL_OK) {
817   return code;
818     }
819 
820     lexeme = infoPtr->lexeme;
821     while ((lexeme == LESS) || (lexeme == GREATER) || (lexeme == LEQ)
822             || (lexeme == GEQ)) {
823   operator = infoPtr->start;
824   if ((lexeme == LEQ) || (lexeme == GEQ)) {
825       operatorSize = 2;
826   } else {
827       operatorSize = 1;
828   }
829   code = GetLexeme(infoPtr); /* skip over the operator */
830   if (code != TCL_OK) {
831       return code;
832   }
833   code = ParseShiftExpr(infoPtr);
834   if (code != TCL_OK) {
835       return code;
836   }
837 
838   /*
839    * Generate tokens for the subexpression and the operator.
840    */
841 
842   PrependSubExprTokens(operator, operatorSize, srcStart,
843           (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
844   lexeme = infoPtr->lexeme;
845     }
846     return TCL_OK;
847 }
static int ParseShiftExpr (ParseInfo * infoPtr) [static]

Definition at line 871 of file tclParseExpr.c.
References CONST, GetLexeme(), HERE, LEFT_SHIFT, Tcl_Parse::numTokens, ParseAddExpr(), PrependSubExprTokens(), RIGHT_SHIFT, and TCL_OK.
Referenced by ParseRelationalExpr().874 {
875     Tcl_Parse *parsePtr = infoPtr->parsePtr;
876     int firstIndex, lexeme, code;
877     CONST char *srcStart, *operator;
878 
879     HERE("shiftExpr", 9);
880     srcStart = infoPtr->start;
881     firstIndex = parsePtr->numTokens;
882     
883     code = ParseAddExpr(infoPtr);
884     if (code != TCL_OK) {
885   return code;
886     }
887 
888     lexeme = infoPtr->lexeme;
889     while ((lexeme == LEFT_SHIFT) || (lexeme == RIGHT_SHIFT)) {
890   operator = infoPtr->start;
891   code = GetLexeme(infoPtr); /* skip over << or >> */
892   if (code != TCL_OK) {
893       return code;
894   }
895   code = ParseAddExpr(infoPtr);
896   if (code != TCL_OK) {
897       return code;
898   }
899 
900   /*
901    * Generate tokens for the subexpression and '<<' or '>>' operator.
902    */
903 
904   PrependSubExprTokens(operator, 2, srcStart,
905           (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
906   lexeme = infoPtr->lexeme;
907     }
908     return TCL_OK;
909 }
static int ParseUnaryExpr (ParseInfo * infoPtr) [static]

Definition at line 1057 of file tclParseExpr.c.
References BIT_NOT, CONST, GetLexeme(), HERE, MINUS, NOT, Tcl_Parse::numTokens, ParsePrimaryExpr(), PLUS, PrependSubExprTokens(), and TCL_OK.
Referenced by ParseMultiplyExpr().1060 {
1061     Tcl_Parse *parsePtr = infoPtr->parsePtr;
1062     int firstIndex, lexeme, code;
1063     CONST char *srcStart, *operator;
1064 
1065     HERE("unaryExpr", 12);
1066     srcStart = infoPtr->start;
1067     firstIndex = parsePtr->numTokens;
1068     
1069     lexeme = infoPtr->lexeme;
1070     if ((lexeme == PLUS) || (lexeme == MINUS) || (lexeme == BIT_NOT)
1071             || (lexeme == NOT)) {
1072   operator = infoPtr->start;
1073   code = GetLexeme(infoPtr); /* skip over the unary operator */
1074   if (code != TCL_OK) {
1075       return code;
1076   }
1077   code = ParseUnaryExpr(infoPtr);
1078   if (code != TCL_OK) {
1079       return code;
1080   }
1081 
1082   /*
1083    * Generate tokens for the subexpression and the operator.
1084    */
1085 
1086   PrependSubExprTokens(operator, 1, srcStart,
1087           (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
1088     } else {      /* must be a primaryExpr */
1089   code = ParsePrimaryExpr(infoPtr);
1090   if (code != TCL_OK) {
1091       return code;
1092   }
1093     }
1094     return TCL_OK;
1095 }
static void PrependSubExprTokens (CONST char * op, int opBytes, CONST char * src, int srcBytes, int firstIndex, ParseInfo * infoPtr) [static]

Definition at line 1997 of file tclParseExpr.c.
References Tcl_Parse::numTokens, ParseInfo::parsePtr, size_t(), TCL_TOKEN_OPERATOR, TCL_TOKEN_SUB_EXPR, TclExpandTokenArray(), Tcl_Parse::tokenPtr, Tcl_Parse::tokensAvailable, and VOID.
Referenced by ParseAddExpr(), ParseBitAndExpr(), ParseBitOrExpr(), ParseBitXorExpr(), ParseEqualityExpr(), ParseLandExpr(), ParseLorExpr(), ParseMultiplyExpr(), ParseRelationalExpr(), ParseShiftExpr(), and ParseUnaryExpr().2009 {
2010     Tcl_Parse *parsePtr = infoPtr->parsePtr;
2011     Tcl_Token *tokenPtr, *firstTokenPtr;
2012     int numToMove;
2013 
2014     if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {
2015   TclExpandTokenArray(parsePtr);
2016     }
2017     firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
2018     tokenPtr = (firstTokenPtr + 2);
2019     numToMove = (parsePtr->numTokens - firstIndex);
2020     memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
2021             (size_t) (numToMove * sizeof(Tcl_Token)));
2022     parsePtr->numTokens += 2;
2023     
2024     tokenPtr = firstTokenPtr;
2025     tokenPtr->type = TCL_TOKEN_SUB_EXPR;
2026     tokenPtr->start = src;
2027     tokenPtr->size = srcBytes;
2028     tokenPtr->numComponents = parsePtr->numTokens - (firstIndex + 1);
2029     
2030     tokenPtr++;
2031     tokenPtr->type = TCL_TOKEN_OPERATOR;
2032     tokenPtr->start = op;
2033     tokenPtr->size = opBytes;
2034     tokenPtr->numComponents = 0;
2035 }
int Tcl_ParseExpr (Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr)

Definition at line 217 of file tclParseExpr.c.
References ckfree, Tcl_Parse::commandSize, Tcl_Parse::commandStart, Tcl_Parse::commentSize, Tcl_Parse::commentStart, END, Tcl_Parse::end, GetLexeme(), Tcl_Parse::incomplete, Tcl_Parse::interp, ParseInfo::lastChar, ParseInfo::lexeme, LogSyntaxError(), ParseInfo::next, NULL, NUM_STATIC_TOKENS, Tcl_Parse::numTokens, Tcl_Parse::numWords, ParseInfo::originalExpr, ParseCondExpr(), ParseInfo::parsePtr, ParseInfo::prevEnd, ParseInfo::size, ParseInfo::start, Tcl_Parse::staticTokens, Tcl_Parse::string, TCL_ERROR, TCL_OK, Tcl_Parse::term, Tcl_Parse::tokenPtr, Tcl_Parse::tokensAvailable, and UNKNOWN.
Referenced by TclCompileExpr(), and TestexprparserObjCmd().227 {
228     ParseInfo info;
229     int code;
230 
231     if (numBytes < 0) {
232   numBytes = (string? strlen(string) : 0);
233     }
234 #ifdef TCL_COMPILE_DEBUG
235     if (traceParseExpr) {
236   fprintf(stderr, "Tcl_ParseExpr: string=\"%.*s\"\n",
237           numBytes, string);
238     }
239 #endif /* TCL_COMPILE_DEBUG */
240     
241     parsePtr->commentStart = NULL;
242     parsePtr->commentSize = 0;
243     parsePtr->commandStart = NULL;
244     parsePtr->commandSize = 0;
245     parsePtr->numWords = 0;
246     parsePtr->tokenPtr = parsePtr->staticTokens;
247     parsePtr->numTokens = 0;
248     parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
249     parsePtr->string = string;
250     parsePtr->end = (string + numBytes);
251     parsePtr->interp = interp;
252     parsePtr->term = string;
253     parsePtr->incomplete = 0;
254 
255     /*
256      * Initialize the ParseInfo structure that holds state while parsing
257      * the expression.
258      */
259 
260     info.parsePtr = parsePtr;
261     info.lexeme = UNKNOWN;
262     info.start = NULL;
263     info.size = 0;
264     info.next = string;
265     info.prevEnd = string;
266     info.originalExpr = string;
267     info.lastChar = (string + numBytes); /* just after last char of expr */
268 
269     /*
270      * Get the first lexeme then parse the expression.
271      */
272 
273     code = GetLexeme(&info);
274     if (code != TCL_OK) {
275   goto error;
276     }
277     code = ParseCondExpr(&info);
278     if (code != TCL_OK) {
279   goto error;
280     }
281     if (info.lexeme != END) {
282   LogSyntaxError(&info, "extra tokens at end of expression");
283   goto error;
284     }
285     return TCL_OK;
286     
287     error:
288     if (parsePtr->tokenPtr != parsePtr->staticTokens) {
289   ckfree((char *) parsePtr->tokenPtr);
290     }
291     return TCL_ERROR;
292 }
int TclParseInteger (CONST char * string, int numBytes)

Definition at line 1894 of file tclParseExpr.c.
References CONST, TclParseHex(), and UCHAR.
Referenced by GetLexeme(), and TclLooksLikeInt().1897 {
1898     register CONST char *p = string;
1899 
1900     /* Take care of introductory "0x" */
1901     if ((numBytes > 1) && (p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) {
1902   int scanned;
1903   Tcl_UniChar ch;
1904   p+=2; numBytes -= 2;
1905   scanned = TclParseHex(p, numBytes, &ch);
1906   if (scanned) {
1907       return scanned + 2;
1908   }
1909 
1910   /* Recognize the 0 as valid integer, but x is left behind */
1911   return 1;
1912     }
1913     while (numBytes && isdigit(UCHAR(*p))) {  /* INTL: digit */
1914   numBytes--; p++;
1915     }
1916     if (numBytes == 0) {
1917         return (p - string);
1918     }
1919     if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
1920         return (p - string);
1921     }
1922     return 0;
1923 }

Variable Documentation
char* lexemeStrings[] [static]
Initial value: {
    "LITERAL", "FUNCNAME",
    "[", "{", "(", ")", "$", "\"", ",", "END", "UNKNOWN", "UNKNOWN_CHAR",
    "*", "/", "%", "+", "-",
    "<<", ">>", "<", ">", "<=", ">=", "==", "!=",
    "&", "^", "|", "&&", "||", "?", ":",
    "!", "~", "eq", "ne",
}
Definition at line 137 of file tclParseExpr.c.
Referenced by ParsePrimaryExpr().

generic/tclPipe.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Classes
struct Detached
Functions
TCL_DECLARE_MUTEX (pipeMutex)
void Tcl_DetachPids (int numPids, Tcl_Pid *pidPtr)
void Tcl_ReapDetachedProcs ()
int TclCleanupChildren (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan)
int TclCreatePipeline (Tcl_Interp *interp, int argc, CONST char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr)
Tcl_Channel Tcl_OpenCommandChannel (Tcl_Interp *interp, int argc, CONST char **argv, int flags)
Variables
static Detached * detList = NULL

Function Documentation
TCL_DECLARE_MUTEX (pipeMutex)

Definition at line 35 of file tclPipe.c.
References CONST, NULL, Tcl_DStringFree(), Tcl_Flush(), Tcl_GetChannel(), Tcl_GetChannelName(), Tcl_PosixError(), TCL_READABLE, Tcl_TranslateFileName(), TCL_WRITABLE, TclpMakeFile(), and TclpOpenFile().38                                                          :
39  */
40 
41 static TclFile  FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
42               CONST char *spec, int atOk, CONST char *arg, 
43         CONST char *nextArg, int flags, int *skipPtr,
44         int *closePtr, int *releasePtr));
45 
46 /*
47  *----------------------------------------------------------------------
48  *
49  * FileForRedirect --
50  *
51  *  This procedure does much of the work of parsing redirection
52  *  operators.  It handles "@" if specified and allowed, and a file
53  *  name, and opens the file if necessary.
54  *
55  * Results:
56  *  The return value is the descriptor number for the file.  If an
57  *  error occurs then NULL is returned and an error message is left
58  *  in the interp's result.  Several arguments are side-effected; see
59  *  the argument list below for details.
60  *
61  * Side effects:
62  *  None.
63  *
64  *----------------------------------------------------------------------
65  */
66 
67 static TclFile
68 FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
69   releasePtr)
70     Tcl_Interp *interp;   /* Intepreter to use for error reporting. */
71     CONST char *spec;   /* Points to character just after
72          * redirection character. */
73     int atOK;     /* Non-zero means that '@' notation can be 
74          * used to specify a channel, zero means that
75          * it isn't. */
76     CONST char *arg;    /* Pointer to entire argument containing 
77          * spec:  used for error reporting. */
78     CONST char *nextArg;  /* Next argument in argc/argv array, if needed 
79          * for file name or channel name.  May be 
80          * NULL. */
81     int flags;      /* Flags to use for opening file or to 
82          * specify mode for channel. */
83     int *skipPtr;   /* Filled with 1 if redirection target was
84          * in spec, 2 if it was in nextArg. */
85     int *closePtr;    /* Filled with one if the caller should 
86          * close the file when done with it, zero
87          * otherwise. */
88     int *releasePtr;
89 {
90     int writing = (flags & O_WRONLY);
91     Tcl_Channel chan;
92     TclFile file;
93 
94     *skipPtr = 1;
95     if ((atOK != 0)  && (*spec == '@')) {
96   spec++;
97   if (*spec == '\0') {
98       spec = nextArg;
99       if (spec == NULL) {
100     goto badLastArg;
101       }
102       *skipPtr = 2;
103   }
104         chan = Tcl_GetChannel(interp, spec, NULL);
105         if (chan == (Tcl_Channel) NULL) {
106             return NULL;
107         }
108   file = TclpMakeFile(chan, writing ? TCL_WRITABLE : TCL_READABLE);
109         if (file == NULL) {
110       Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan),
111         "\" wasn't opened for ",
112         ((writing) ? "writing" : "reading"), (char *) NULL);
113             return NULL;
114         }
115   *releasePtr = 1;
116   if (writing) {
117 
118       /*
119        * Be sure to flush output to the file, so that anything
120        * written by the child appears after stuff we've already
121        * written.
122        */
123 
124             Tcl_Flush(chan);
125   }
126     } else {
127   CONST char *name;
128   Tcl_DString nameString;
129 
130   if (*spec == '\0') {
131       spec = nextArg;
132       if (spec == NULL) {
133     goto badLastArg;
134       }
135       *skipPtr = 2;
136   }
137   name = Tcl_TranslateFileName(interp, spec, &nameString);
138   if (name == NULL) {
139       return NULL;
140   }
141   file = TclpOpenFile(name, flags);
142   Tcl_DStringFree(&nameString);
143   if (file == NULL) {
144       Tcl_AppendResult(interp, "couldn't ",
145         ((writing) ? "write" : "read"), " file \"", spec, "\": ",
146         Tcl_PosixError(interp), (char *) NULL);
147       return NULL;
148   }
149         *closePtr = 1;
150     }
151     return file;
152 
153     badLastArg:
154     Tcl_AppendResult(interp, "can't specify \"", arg,
155       "\" as last word in command", (char *) NULL);
156     return NULL;
157 }

void Tcl_DetachPids (int numPids, Tcl_Pid * pidPtr)

Definition at line 179 of file tclPipe.c.
References ckalloc, detList, Detached::nextPtr, Detached::pid, Tcl_MutexLock, and Tcl_MutexUnlock.
Referenced by PipeClose2Proc(), PipeCloseProc(), Tcl_OpenCommandChannel(), TclCreatePipeline(), and TclGetAndDetachPids().180                                                :  gives size
181          * of array pointed to by pidPtr. */
182     Tcl_Pid *pidPtr;    /* Array of pids to detach. */
183 {
184     register Detached *detPtr;
185     int i;
186 
187     Tcl_MutexLock(&pipeMutex);
188     for (i = 0; i < numPids; i++) {
189   detPtr = (Detached *) ckalloc(sizeof(Detached));
190   detPtr->pid = pidPtr[i];
191   detPtr->nextPtr = detList;
192   detList = detPtr;
193     }
194     Tcl_MutexUnlock(&pipeMutex);
195 
196 }
Tcl_Channel Tcl_OpenCommandChannel (Tcl_Interp * interp, int argc, CONST char ** argv, int flags)

Definition at line 1046 of file tclPipe.c.
References ckfree, NULL, Tcl_DetachPids(), TCL_ENFORCE_MODE, TCL_STDERR, TCL_STDIN, TCL_STDOUT, TclCreatePipeline(), TclpCloseFile(), and TclpCreateCommandChannel().
Referenced by Tcl_ExecObjCmd(), and Tcl_OpenObjCmd().1053 {
1054     TclFile *inPipePtr, *outPipePtr, *errFilePtr;
1055     TclFile inPipe, outPipe, errFile;
1056     int numPids;
1057     Tcl_Pid *pidPtr;
1058     Tcl_Channel channel;
1059 
1060     inPipe = outPipe = errFile = NULL;
1061 
1062     inPipePtr = (flags & TCL_STDIN) ? &inPipe : NULL;
1063     outPipePtr = (flags & TCL_STDOUT) ? &outPipe : NULL;
1064     errFilePtr = (flags & TCL_STDERR) ? &errFile : NULL;
1065     
1066     numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr,
1067             outPipePtr, errFilePtr);
1068 
1069     if (numPids < 0) {
1070   goto error;
1071     }
1072 
1073     /*
1074      * Verify that the pipes that were created satisfy the
1075      * readable/writable constraints. 
1076      */
1077 
1078     if (flags & TCL_ENFORCE_MODE) {
1079   if ((flags & TCL_STDOUT) && (outPipe == NULL)) {
1080       Tcl_AppendResult(interp, "can't read output from command:",
1081         " standard output was redirected", (char *) NULL);
1082       goto error;
1083   }
1084   if ((flags & TCL_STDIN) && (inPipe == NULL)) {
1085       Tcl_AppendResult(interp, "can't write input to command:",
1086         " standard input was redirected", (char *) NULL);
1087       goto error;
1088   }
1089     }
1090     
1091     channel = TclpCreateCommandChannel(outPipe, inPipe, errFile,
1092       numPids, pidPtr);
1093 
1094     if (channel == (Tcl_Channel) NULL) {
1095         Tcl_AppendResult(interp, "pipe for command could not be created",
1096                 (char *) NULL);
1097   goto error;
1098     }
1099     return channel;
1100 
1101 error:
1102     if (numPids > 0) {
1103   Tcl_DetachPids(numPids, pidPtr);
1104   ckfree((char *) pidPtr);
1105     }
1106     if (inPipe != NULL) {
1107   TclpCloseFile(inPipe);
1108     }
1109     if (outPipe != NULL) {
1110   TclpCloseFile(outPipe);
1111     }
1112     if (errFile != NULL) {
1113   TclpCloseFile(errFile);
1114     }
1115     return NULL;
1116 }
void Tcl_ReapDetachedProcs ()

Definition at line 219 of file tclPipe.c.
References ckfree, detList, ECHILD, errno, Detached::nextPtr, NULL, Detached::pid, status, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_WaitPid(), and WNOHANG.
Referenced by PipeClose2Proc(), PipeCloseProc(), and TclCreatePipeline().220 {
221     register Detached *detPtr;
222     Detached *nextPtr, *prevPtr;
223     int status;
224     Tcl_Pid pid;
225 
226     Tcl_MutexLock(&pipeMutex);
227     for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {
228   pid = Tcl_WaitPid(detPtr->pid, &status, WNOHANG);
229   if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) {
230       prevPtr = detPtr;
231       detPtr = detPtr->nextPtr;
232       continue;
233   }
234   nextPtr = detPtr->nextPtr;
235   if (prevPtr == NULL) {
236       detList = detPtr->nextPtr;
237   } else {
238       prevPtr->nextPtr = detPtr->nextPtr;
239   }
240   ckfree((char *) detPtr);
241   detPtr = nextPtr;
242     }
243     Tcl_MutexUnlock(&pipeMutex);
244 }
int TclCleanupChildren (Tcl_Interp * interp, int numPids, Tcl_Pid * pidPtr, Tcl_Channel errorChan)

Definition at line 269 of file tclPipe.c.
References CONST, ECHILD, errno, NULL, Detached::pid, SEEK_SET, Tcl_Close(), Tcl_DecrRefCount, TCL_ERROR, TCL_INTEGER_SPACE, Tcl_NewObj(), TCL_OK, Tcl_PosixError(), Tcl_ReadChars(), Tcl_ResetResult(), Tcl_Seek(), Tcl_SetObjResult(), Tcl_SignalId(), Tcl_SignalMsg(), Tcl_WaitPid(), TclFormatInt(), TclpGetPid, WAIT_STATUS_TYPE, WEXITSTATUS, WIFEXITED, WIFSIGNALED, WIFSTOPPED, WSTOPSIG, and WTERMSIG.
Referenced by PipeClose2Proc(), and PipeCloseProc().276 {
277     int result = TCL_OK;
278     int i, abnormalExit, anyErrorInfo;
279     Tcl_Pid pid;
280     WAIT_STATUS_TYPE waitStatus;
281     CONST char *msg;
282     unsigned long resolvedPid;
283 
284     abnormalExit = 0;
285     for (i = 0; i < numPids; i++) {
286   /*
287    * We need to get the resolved pid before we wait on it as
288    * the windows implimentation of Tcl_WaitPid deletes the
289    * information such that any following calls to TclpGetPid
290    * fail.
291    */
292   resolvedPid = TclpGetPid(pidPtr[i]);
293         pid = Tcl_WaitPid(pidPtr[i], (int *) &waitStatus, 0);
294   if (pid == (Tcl_Pid) -1) {
295       result = TCL_ERROR;
296             if (interp != (Tcl_Interp *) NULL) {
297                 msg = Tcl_PosixError(interp);
298                 if (errno == ECHILD) {
299         /*
300                      * This changeup in message suggested by Mark Diekhans
301                      * to remind people that ECHILD errors can occur on
302                      * some systems if SIGCHLD isn't in its default state.
303                      */
304 
305                     msg =
306                         "child process lost (is SIGCHLD ignored or trapped?)";
307                 }
308                 Tcl_AppendResult(interp, "error waiting for process to exit: ",
309                         msg, (char *) NULL);
310             }
311       continue;
312   }
313 
314   /*
315    * Create error messages for unusual process exits.  An
316    * extra newline gets appended to each error message, but
317    * it gets removed below (in the same fashion that an
318    * extra newline in the command's output is removed).
319    */
320 
321   if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {
322       char msg1[TCL_INTEGER_SPACE], msg2[TCL_INTEGER_SPACE];
323 
324       result = TCL_ERROR;
325       TclFormatInt(msg1, (long) resolvedPid);
326       if (WIFEXITED(waitStatus)) {
327                 if (interp != (Tcl_Interp *) NULL) {
328         TclFormatInt(msg2, WEXITSTATUS(waitStatus));
329                     Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2,
330                             (char *) NULL);
331                 }
332     abnormalExit = 1;
333       } else if (WIFSIGNALED(waitStatus)) {
334                 if (interp != (Tcl_Interp *) NULL) {
335                     CONST char *p;
336                     
337                     p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus)));
338                     Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
339                             Tcl_SignalId((int) (WTERMSIG(waitStatus))), p,
340                             (char *) NULL);
341                     Tcl_AppendResult(interp, "child killed: ", p, "\n",
342                             (char *) NULL);
343                 }
344       } else if (WIFSTOPPED(waitStatus)) {
345                 if (interp != (Tcl_Interp *) NULL) {
346                     CONST char *p;
347 
348                     p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus)));
349                     Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
350                             Tcl_SignalId((int) (WSTOPSIG(waitStatus))),
351                             p, (char *) NULL);
352                     Tcl_AppendResult(interp, "child suspended: ", p, "\n",
353                             (char *) NULL);
354                 }
355       } else {
356                 if (interp != (Tcl_Interp *) NULL) {
357                     Tcl_AppendResult(interp,
358                             "child wait status didn't make sense\n",
359                             (char *) NULL);
360                 }
361       }
362   }
363     }
364 
365     /*
366      * Read the standard error file.  If there's anything there,
367      * then return an error and add the file's contents to the result
368      * string.
369      */
370 
371     anyErrorInfo = 0;
372     if (errorChan != NULL) {
373 
374   /*
375    * Make sure we start at the beginning of the file.
376    */
377 
378         if (interp != NULL) {
379       int count;
380       Tcl_Obj *objPtr;
381       
382       Tcl_Seek(errorChan, (Tcl_WideInt)0, SEEK_SET);
383       objPtr = Tcl_NewObj();
384       count = Tcl_ReadChars(errorChan, objPtr, -1, 0);
385       if (count < 0) {
386     result = TCL_ERROR;
387     Tcl_DecrRefCount(objPtr);
388     Tcl_ResetResult(interp);
389     Tcl_AppendResult(interp, "error reading stderr output file: ",
390       Tcl_PosixError(interp), NULL);
391       } else if (count > 0) {
392     anyErrorInfo = 1;
393     Tcl_SetObjResult(interp, objPtr);
394     result = TCL_ERROR;
395       } else {
396     Tcl_DecrRefCount(objPtr);
397       }
398   }
399   Tcl_Close(NULL, errorChan);
400     }
401 
402     /*
403      * If a child exited abnormally but didn't output any error information
404      * at all, generate an error message here.
405      */
406 
407     if ((abnormalExit != 0) && (anyErrorInfo == 0) && (interp != NULL)) {
408   Tcl_AppendResult(interp, "child process exited abnormally",
409     (char *) NULL);
410     }
411     return result;
412 }
int TclCreatePipeline (Tcl_Interp * interp, int argc, CONST char ** argv, Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr, TclFile * outPipePtr, TclFile * errFilePtr)

Definition at line 446 of file tclPipe.c.
References ckalloc, ckfree, cleanup(), CONST, NULL, Detached::pid, skip(), Tcl_DetachPids(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, Tcl_GetStdChannel(), TCL_OK, Tcl_PosixError(), TCL_READABLE, Tcl_ReapDetachedProcs(), Tcl_SetResult(), TCL_STATIC, TCL_STDERR, TCL_STDIN, TCL_STDOUT, Tcl_TranslateFileName(), TCL_WRITABLE, TclpCloseFile(), TclpCreatePipe(), TclpCreateProcess(), TclpCreateTempFile(), TclpMakeFile(), and TclpReleaseFile.
Referenced by Tcl_OpenCommandChannel().480 {
481     Tcl_Pid *pidPtr = NULL; /* Points to malloc-ed array holding all
482          * the pids of child processes. */
483     int numPids;    /* Actual number of processes that exist
484          * at *pidPtr right now. */
485     int cmdCount;   /* Count of number of distinct commands
486          * found in argc/argv. */
487     CONST char *inputLiteral = NULL;  /* If non-null, then this points to a
488          * string containing input data (specified
489          * via <<) to be piped to the first process
490          * in the pipeline. */
491     TclFile inputFile = NULL; /* If != NULL, gives file to use as input for
492          * first process in pipeline (specified via <
493          * or <@). */
494     int inputClose = 0;   /* If non-zero, then inputFile should be 
495              * closed when cleaning up. */
496     int inputRelease = 0;
497     TclFile outputFile = NULL;  /* Writable file for output from last command
498          * in pipeline (could be file or pipe).  NULL
499          * means use stdout. */
500     int outputClose = 0;  /* If non-zero, then outputFile should be 
501              * closed when cleaning up. */
502     int outputRelease = 0;
503     TclFile errorFile = NULL; /* Writable file for error output from all
504          * commands in pipeline.  NULL means use
505          * stderr. */
506     int errorClose = 0;   /* If non-zero, then errorFile should be 
507              * closed when cleaning up. */
508     int errorRelease = 0;
509     CONST char *p;
510     CONST char *nextArg;
511     int skip, lastBar, lastArg, i, j, atOK, flags, needCmd, errorToOutput = 0;
512     Tcl_DString execBuffer;
513     TclFile pipeIn;
514     TclFile curInFile, curOutFile, curErrFile;
515     Tcl_Channel channel;
516 
517     if (inPipePtr != NULL) {
518   *inPipePtr = NULL;
519     }
520     if (outPipePtr != NULL) {
521   *outPipePtr = NULL;
522     }
523     if (errFilePtr != NULL) {
524   *errFilePtr = NULL;
525     }
526 
527     Tcl_DStringInit(&execBuffer);
528     
529     pipeIn = NULL;
530     curInFile = NULL;
531     curOutFile = NULL;
532     numPids = 0;
533 
534     /*
535      * First, scan through all the arguments to figure out the structure
536      * of the pipeline.  Process all of the input and output redirection
537      * arguments and remove them from the argument list in the pipeline.
538      * Count the number of distinct processes (it's the number of "|"
539      * arguments plus one) but don't remove the "|" arguments because 
540      * they'll be used in the second pass to seperate the individual 
541      * child processes.  Cannot start the child processes in this pass 
542      * because the redirection symbols may appear anywhere in the 
543      * command line -- e.g., the '<' that specifies the input to the 
544      * entire pipe may appear at the very end of the argument list.
545      */
546 
547     lastBar = -1;
548     cmdCount = 1;
549     needCmd = 1;
550     for (i = 0; i < argc; i++) {
551   errorToOutput = 0;
552   skip = 0;
553   p = argv[i];
554   switch (*p++) {
555   case '|':
556       if (*p == '&') {
557     p++;
558       }
559       if (*p == '\0') {
560     if ((i == (lastBar + 1)) || (i == (argc - 1))) {
561         Tcl_SetResult(interp,
562           "illegal use of | or |& in command",
563           TCL_STATIC);
564         goto error;
565     }
566       }
567       lastBar = i;
568       cmdCount++;
569       needCmd = 1;
570       break;
571 
572   case '<':
573       if (inputClose != 0) {
574     inputClose = 0;
575     TclpCloseFile(inputFile);
576       }
577       if (inputRelease != 0) {
578     inputRelease = 0;
579     TclpReleaseFile(inputFile);
580       }
581       if (*p == '<') {
582     inputFile = NULL;
583     inputLiteral = p + 1;
584     skip = 1;
585     if (*inputLiteral == '\0') {
586         inputLiteral = ((i + 1) == argc) ? NULL : argv[i + 1];
587         if (inputLiteral == NULL) {
588       Tcl_AppendResult(interp, "can't specify \"", argv[i],
589         "\" as last word in command", (char *) NULL);
590       goto error;
591         }
592         skip = 2;
593     }
594       } else {
595     nextArg = ((i + 1) == argc) ? NULL : argv[i + 1];
596     inputLiteral = NULL;
597     inputFile = FileForRedirect(interp, p, 1, argv[i], 
598       nextArg, O_RDONLY, &skip, &inputClose, &inputRelease);
599     if (inputFile == NULL) {
600         goto error;
601     }
602       }
603       break;
604 
605   case '>':
606       atOK = 1;
607       flags = O_WRONLY | O_CREAT | O_TRUNC;
608       if (*p == '>') {
609     p++;
610     atOK = 0;
611 
612     /*
613      * Note that the O_APPEND flag only has an effect on POSIX
614      * platforms. On Windows, we just have to carry on regardless.
615      */
616 
617     flags = O_WRONLY | O_CREAT | O_APPEND;
618       }
619       if (*p == '&') {
620     if (errorClose != 0) {
621         errorClose = 0;
622         TclpCloseFile(errorFile);
623     }
624     errorToOutput = 1;
625     p++;
626       }
627 
628       /*
629        * Close the old output file, but only if the error file is
630        * not also using it.
631        */
632 
633       if (outputClose != 0) {
634     outputClose = 0;
635     if (errorFile == outputFile) {
636         errorClose = 1;
637     } else {
638         TclpCloseFile(outputFile);
639     }
640       }
641       if (outputRelease != 0) {
642     outputRelease = 0;
643     if (errorFile == outputFile) {
644         errorRelease = 1;
645     } else {
646         TclpReleaseFile(outputFile);
647     }
648       }
649       nextArg = ((i + 1) == argc) ? NULL : argv[i + 1];
650       outputFile = FileForRedirect(interp, p, atOK, argv[i], 
651         nextArg, flags, &skip, &outputClose, &outputRelease);
652       if (outputFile == NULL) {
653     goto error;
654       }
655       if (errorToOutput) {
656     if (errorClose != 0) {
657         errorClose = 0;
658         TclpCloseFile(errorFile);
659     }
660     if (errorRelease != 0) {
661         errorRelease = 0;
662         TclpReleaseFile(errorFile);
663     }
664     errorFile = outputFile;
665       }
666       break;
667 
668   case '2':
669       if (*p != '>') {
670     break;
671       }
672       p++;
673       atOK = 1;
674       flags = O_WRONLY | O_CREAT | O_TRUNC;
675       if (*p == '>') {
676     p++;
677     atOK = 0;
678     flags = O_WRONLY | O_CREAT;
679       }
680       if (errorClose != 0) {
681     errorClose = 0;
682     TclpCloseFile(errorFile);
683       }
684       if (errorRelease != 0) {
685     errorRelease = 0;
686     TclpReleaseFile(errorFile);
687       }
688       if (atOK && p[0] == '@' && p[1] == '1' && p[2] == '\0') {
689     /*
690      * Special case handling of 2>@1 to redirect stderr to the
691      * exec/open output pipe as well.  This is meant for the end
692      * of the command string, otherwise use |& between commands.
693      */
694     if (i != argc - 1) {
695         Tcl_AppendResult(interp, "must specify \"", argv[i],
696           "\" as last word in command", (char *) NULL);
697         goto error;
698     }
699     errorFile = outputFile;
700     errorToOutput = 2;
701     skip = 1;
702       } else {
703     nextArg = ((i + 1) == argc) ? NULL : argv[i + 1];
704     errorFile = FileForRedirect(interp, p, atOK, argv[i], 
705       nextArg, flags, &skip, &errorClose, &errorRelease);
706     if (errorFile == NULL) {
707         goto error;
708     }
709       }
710       break;
711 
712   default:
713     /* Got a command word, not a redirection */
714     needCmd = 0;
715     break;
716   }
717 
718   if (skip != 0) {
719       for (j = i + skip; j < argc; j++) {
720     argv[j - skip] = argv[j];
721       }
722       argc -= skip;
723       i -= 1;
724   }
725     }
726 
727     if (needCmd) {
728         /* We had a bar followed only by redirections. */
729 
730         Tcl_SetResult(interp,
731           "illegal use of | or |& in command",
732           TCL_STATIC);
733   goto error;
734     }
735 
736     if (inputFile == NULL) {
737   if (inputLiteral != NULL) {
738       /*
739        * The input for the first process is immediate data coming from
740        * Tcl.  Create a temporary file for it and put the data into the
741        * file.
742        */
743       inputFile = TclpCreateTempFile(inputLiteral);
744       if (inputFile == NULL) {
745     Tcl_AppendResult(interp,
746       "couldn't create input file for command: ",
747       Tcl_PosixError(interp), (char *) NULL);
748     goto error;
749       }
750       inputClose = 1;
751   } else if (inPipePtr != NULL) {
752       /*
753        * The input for the first process in the pipeline is to
754        * come from a pipe that can be written from by the caller.
755        */
756 
757       if (TclpCreatePipe(&inputFile, inPipePtr) == 0) {
758     Tcl_AppendResult(interp, 
759       "couldn't create input pipe for command: ",
760       Tcl_PosixError(interp), (char *) NULL);
761     goto error;
762       }
763       inputClose = 1;
764   } else {
765       /*
766        * The input for the first process comes from stdin.
767        */
768 
769       channel = Tcl_GetStdChannel(TCL_STDIN);
770       if (channel != NULL) {
771     inputFile = TclpMakeFile(channel, TCL_READABLE);
772     if (inputFile != NULL) {
773         inputRelease = 1;
774     }
775       }
776   }
777     }
778 
779     if (outputFile == NULL) {
780   if (outPipePtr != NULL) {
781       /*
782        * Output from the last process in the pipeline is to go to a
783        * pipe that can be read by the caller.
784        */
785 
786       if (TclpCreatePipe(outPipePtr, &outputFile) == 0) {
787     Tcl_AppendResult(interp, 
788       "couldn't create output pipe for command: ",
789       Tcl_PosixError(interp), (char *) NULL);
790     goto error;
791       }
792       outputClose = 1;
793   } else {
794       /*
795        * The output for the last process goes to stdout.
796        */
797 
798       channel = Tcl_GetStdChannel(TCL_STDOUT);
799       if (channel) {
800     outputFile = TclpMakeFile(channel, TCL_WRITABLE);
801     if (outputFile != NULL) {
802         outputRelease = 1;
803     }
804       }
805   }
806     }
807 
808     if (errorFile == NULL) {
809   if (errorToOutput == 2) {
810       /*
811        * Handle 2>@1 special case at end of cmd line
812        */
813       errorFile = outputFile;
814   } else if (errFilePtr != NULL) {
815       /*
816        * Set up the standard error output sink for the pipeline, if
817        * requested.  Use a temporary file which is opened, then deleted.
818        * Could potentially just use pipe, but if it filled up it could
819        * cause the pipeline to deadlock:  we'd be waiting for processes
820        * to complete before reading stderr, and processes couldn't 
821        * complete because stderr was backed up.
822        */
823 
824       errorFile = TclpCreateTempFile(NULL);
825       if (errorFile == NULL) {
826     Tcl_AppendResult(interp,
827       "couldn't create error file for command: ",
828       Tcl_PosixError(interp), (char *) NULL);
829     goto error;
830       }
831       *errFilePtr = errorFile;
832   } else {
833       /*
834        * Errors from the pipeline go to stderr.
835        */
836 
837       channel = Tcl_GetStdChannel(TCL_STDERR);
838       if (channel) {
839     errorFile = TclpMakeFile(channel, TCL_WRITABLE);
840     if (errorFile != NULL) {
841         errorRelease = 1;
842     }
843       }
844   }
845     }
846   
847     /*
848      * Scan through the argc array, creating a process for each
849      * group of arguments between the "|" characters.
850      */
851 
852     Tcl_ReapDetachedProcs();
853     pidPtr = (Tcl_Pid *) ckalloc((unsigned) (cmdCount * sizeof(Tcl_Pid)));
854 
855     curInFile = inputFile;
856 
857     for (i = 0; i < argc; i = lastArg + 1) { 
858   int result, joinThisError;
859   Tcl_Pid pid;
860   CONST char *oldName;
861 
862   /*
863    * Convert the program name into native form. 
864    */
865 
866   if (Tcl_TranslateFileName(interp, argv[i], &execBuffer) == NULL) {
867       goto error;
868   }
869 
870   /*
871    * Find the end of the current segment of the pipeline.
872    */
873 
874   joinThisError = 0;
875   for (lastArg = i; lastArg < argc; lastArg++) {
876       if (argv[lastArg][0] == '|') { 
877     if (argv[lastArg][1] == '\0') { 
878         break;
879     }
880     if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == '\0')) {
881         joinThisError = 1;
882         break;
883     }
884       }
885   }
886 
887   /*
888    * If this is the last segment, use the specified outputFile.
889    * Otherwise create an intermediate pipe.  pipeIn will become the
890    * curInFile for the next segment of the pipe.
891    */
892 
893   if (lastArg == argc) {
894       curOutFile = outputFile;
895   } else {
896       argv[lastArg] = NULL;
897       if (TclpCreatePipe(&pipeIn, &curOutFile) == 0) {
898     Tcl_AppendResult(interp, "couldn't create pipe: ",
899       Tcl_PosixError(interp), (char *) NULL);
900     goto error;
901       }
902   }
903 
904   if (joinThisError != 0) {
905       curErrFile = curOutFile;
906   } else {
907       curErrFile = errorFile;
908   }
909 
910   /*
911    * Restore argv[i], since a caller wouldn't expect the contents of
912    * argv to be modified.
913    */
914    
915   oldName = argv[i];
916   argv[i] = Tcl_DStringValue(&execBuffer);
917   result = TclpCreateProcess(interp, lastArg - i, argv + i,
918     curInFile, curOutFile, curErrFile, &pid);
919   argv[i] = oldName;
920   if (result != TCL_OK) {
921       goto error;
922   }
923   Tcl_DStringFree(&execBuffer);
924 
925   pidPtr[numPids] = pid;
926   numPids++;
927 
928   /*
929    * Close off our copies of file descriptors that were set up for
930    * this child, then set up the input for the next child.
931    */
932 
933   if ((curInFile != NULL) && (curInFile != inputFile)) {
934       TclpCloseFile(curInFile);
935   }
936   curInFile = pipeIn;
937   pipeIn = NULL;
938 
939   if ((curOutFile != NULL) && (curOutFile != outputFile)) {
940       TclpCloseFile(curOutFile);
941   }
942   curOutFile = NULL;
943     }
944 
945     *pidArrayPtr = pidPtr;
946 
947     /*
948      * All done.  Cleanup open files lying around and then return.
949      */
950 
951 cleanup:
952     Tcl_DStringFree(&execBuffer);
953 
954     if (inputClose) {
955   TclpCloseFile(inputFile);
956     } else if (inputRelease) {
957   TclpReleaseFile(inputFile);
958     }
959     if (outputClose) {
960   TclpCloseFile(outputFile);
961     } else if (outputRelease) {
962   TclpReleaseFile(outputFile);
963     }
964     if (errorClose) {
965   TclpCloseFile(errorFile);
966     } else if (errorRelease) {
967   TclpReleaseFile(errorFile);
968     }
969     return numPids;
970 
971     /*
972      * An error occurred.  There could have been extra files open, such
973      * as pipes between children.  Clean them all up.  Detach any child
974      * processes that have been created.
975      */
976 
977 error:
978     if (pipeIn != NULL) {
979   TclpCloseFile(pipeIn);
980     }
981     if ((curOutFile != NULL) && (curOutFile != outputFile)) {
982   TclpCloseFile(curOutFile);
983     }
984     if ((curInFile != NULL) && (curInFile != inputFile)) {
985   TclpCloseFile(curInFile);
986     }
987     if ((inPipePtr != NULL) && (*inPipePtr != NULL)) {
988   TclpCloseFile(*inPipePtr);
989   *inPipePtr = NULL;
990     }
991     if ((outPipePtr != NULL) && (*outPipePtr != NULL)) {
992   TclpCloseFile(*outPipePtr);
993   *outPipePtr = NULL;
994     }
995     if ((errFilePtr != NULL) && (*errFilePtr != NULL)) {
996   TclpCloseFile(*errFilePtr);
997   *errFilePtr = NULL;
998     }
999     if (pidPtr != NULL) {
1000   for (i = 0; i < numPids; i++) {
1001       if (pidPtr[i] != (Tcl_Pid) -1) {
1002     Tcl_DetachPids(1, &pidPtr[i]);
1003       }
1004   }
1005   ckfree((char *) pidPtr);
1006     }
1007     numPids = -1;
1008     goto cleanup;
1009 }

Variable Documentation
Detached* detList = NULL [static]

Definition at line 34 of file tclPipe.c.
Referenced by Tcl_DetachPids(), and Tcl_ReapDetachedProcs().

generic/tclPkg.c File Reference
#include "tclInt.h"
Classes
struct PkgAvail
struct Package
Functions
static int CheckVersion _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string))
static int ComparePkgVersions _ANSI_ARGS_ ((CONST char *v1, CONST char *v2, int *satPtr))
static Package *FindPackage _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name))
int Tcl_PkgProvide (Tcl_Interp *interp, CONST char *name, CONST char *version)
int Tcl_PkgProvideEx (Tcl_Interp *interp, CONST char *name, CONST char *version, ClientData clientData)
int Tcl_PkgRequireProc (Tcl_Interp *interp, CONST char *name, int reqc, reqv, ClientData *clientDataPtr)
CONST char * Tcl_PkgRequire (Tcl_Interp *interp, CONST char *name, CONST char *version, int exact)
CONST char * Tcl_PkgRequireEx (Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr)
CONST char * Tcl_PkgPresent (Tcl_Interp *interp, CONST char *name, CONST char *version, int exact)
CONST char * Tcl_PkgPresentEx (Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr)
int Tcl_PackageObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static Package * FindPackage (Tcl_Interp *interp, CONST char *name)
void TclFreePackageInfo (Interp *iPtr)
static int CheckVersion (Tcl_Interp *interp, CONST char *string)
static int ComparePkgVersions (CONST char *v1, CONST char *v2, int *satPtr)

Function Documentation
static Package* FindPackage _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *name)) [static]
static int ComparePkgVersions _ANSI_ARGS_ ((CONST char *v1, CONST char *v2, int *satPtr)) [static]
static int CheckVersion _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *string)) [static]
static int CheckVersion (Tcl_Interp * interp, CONST char * string) [static]

Definition at line 1743 of file tclPkg.c.
References CONST, Tcl_Alloc(), TCL_ERROR, Tcl_Free(), TCL_OK, and UCHAR.
Referenced by Tcl_PackageObjCmd().1755                                 : Version is (un)stable. */
1756 #endif
1757 {
1758     CONST char *p = string;
1759     char prevChar;
1760 #ifdef TCL_TIP268
1761     int hasunstable = 0;
1762     /* 4* assuming that each char is a separator (a,b become ' -x ').
1763      * 4+ to have spce for an additional -2 at the end
1764      */
1765     char* ibuf = Tcl_Alloc (4+4*strlen(string));
1766     char* ip   = ibuf;
1767 
1768     /* Basic rules
1769      * (1) First character has to be a digit.
1770      * (2) All other characters have to be a digit or '.'
1771      * (3) Two '.'s may not follow each other.
1772 
1773      * TIP 268, Modified rules
1774      * (1) s.a.
1775      * (2) All other characters have to be a digit, 'a', 'b', or '.'
1776      * (3) s.a.
1777      * (4) Only one of 'a' or 'b' may occur.
1778      * (5) Neither 'a', nor 'b' may occur before or after a '.'
1779      */
1780 
1781 #endif
1782     if (!isdigit(UCHAR(*p))) {  /* INTL: digit */
1783   goto error;
1784     }
1785 #ifdef TCL_TIP268
1786     *ip++ = *p;
1787 #endif
1788     for (prevChar = *p, p++; *p != 0; p++) {
1789 #ifndef TCL_TIP268
1790   if (!isdigit(UCHAR(*p)) &&
1791     ((*p != '.') || (prevChar == '.'))) { /* INTL: digit */
1792 #else
1793   if (
1794       (!isdigit(UCHAR(*p))) &&
1795       (((*p != '.') && (*p != 'a') && (*p != 'b')) ||
1796        ((hasunstable && ((*p == 'a') || (*p == 'b'))) ||
1797         (((prevChar == 'a') || (prevChar == 'b') || (prevChar == '.')) && (*p       == '.')) ||
1798         (((*p       == 'a') || (*p       == 'b') || (*p       == '.')) && (prevChar == '.'))))
1799       ) {
1800       /* INTL: digit */
1801 #endif
1802       goto error;
1803   }
1804 #ifdef TCL_TIP268
1805   if ((*p == 'a') || (*p == 'b')) { hasunstable = 1 ; }
1806 
1807   /* Translation to the internal rep. Regular version chars are copied
1808    * as is. The separators are translated to numerics. The new separator
1809    * for all parts is space. */
1810 
1811   if      (*p == '.') { *ip++ = ' ';              *ip++ = '0'; *ip++ = ' '; }
1812   else if (*p == 'a') { *ip++ = ' '; *ip++ = '-'; *ip++ = '2'; *ip++ = ' '; }
1813   else if (*p == 'b') { *ip++ = ' '; *ip++ = '-'; *ip++ = '1'; *ip++ = ' '; }
1814   else                { *ip++ = *p; }
1815 #endif
1816   prevChar = *p;
1817     }
1818 #ifndef TCL_TIP268
1819     if (prevChar != '.') {
1820 #else
1821     if ((prevChar != '.') && (prevChar != 'a') && (prevChar != 'b')) {
1822   *ip = '\0';
1823   if (internal != NULL) {
1824       *internal = ibuf;
1825   } else {
1826       Tcl_Free (ibuf);
1827   }
1828   if (stable != NULL) {
1829       *stable = !hasunstable;
1830   }
1831 #endif
1832   return TCL_OK;
1833     }
1834 
1835  error:
1836 #ifdef TCL_TIP268
1837     Tcl_Free (ibuf);
1838 #endif
1839     Tcl_AppendResult(interp, "expected version number but got \"",
1840       string, "\"", (char *) NULL);
1841     return TCL_ERROR;
1842 }
static int ComparePkgVersions (CONST char * v1, CONST char * v2, int * satPtr) [static]

Definition at line 1866 of file tclPkg.c.
References ckfree, CONST, dstring, Tcl_DecrRefCount, Tcl_DStringAppend(), TCL_ERROR, Tcl_Free(), Tcl_GetString(), Tcl_NewStringObj(), TCL_OK, Tcl_SplitList(), and TclGetString.
Referenced by Tcl_PackageObjCmd(), Tcl_PkgPresentEx(), and Tcl_PkgProvideEx().1872                             :  v1 is greater than
1873          * or equal to v2 and both version numbers
1874          * have the same major number. */
1875 #else
1876 CompareVersions(v1, v2, isMajorPtr)
1877      CONST char *v1;  /* Versions strings, of form 2.1.3 (any number */
1878      CONST char *v2;  /* of version numbers). */
1879      int *isMajorPtr;   /* If non-null, the word pointed to is filled
1880        * in with a 0/1 value. 1 means that the difference
1881        * occured in the first element. */
1882 #endif
1883 {
1884     int thisIsMajor, n1, n2;
1885 #ifdef TCL_TIP268
1886     int res, flip;
1887 #endif
1888 
1889     /*
1890      * Each iteration of the following loop processes one number from each
1891      * string, terminated by a " " (space). If those numbers don't match then the
1892      * comparison is over; otherwise, we loop back for the next number.
1893      *
1894      * TIP 268.
1895      * This is identical the function 'ComparePkgVersion', but using the new
1896      * space separator as used by the internal rep of version numbers. The
1897      * special separators 'a' and 'b' have already been dealt with in
1898      * 'CheckVersionAndConvert', they were translated into numbers as
1899      * well. This keeps the comparison sane. Otherwise we would have to
1900      * compare numerics, the separators, and also deal with the special case
1901      * of end-of-string compared to separators. The semi-list rep we get here
1902      * is much easier to handle, as it is still regular.
1903      */
1904 
1905     thisIsMajor = 1;
1906     while (1) {
1907   /*
1908    * Parse one decimal number from the front of each string.
1909    */
1910 
1911   n1 = n2 = 0;
1912 #ifndef TCL_TIP268
1913   while ((*v1 != 0) && (*v1 != '.')) {
1914 #else
1915   flip = 0;
1916   while ((*v1 != 0) && (*v1 != ' ')) {
1917       if (*v1 == '-') {flip = 1 ; v1++ ; continue;}
1918 #endif
1919       n1 = 10*n1 + (*v1 - '0');
1920       v1++;
1921   }
1922 #ifndef TCL_TIP268
1923   while ((*v2 != 0) && (*v2 != '.')) {
1924 #else
1925   if (flip) n1 = -n1;
1926   flip = 0;
1927   while ((*v2 != 0) && (*v2 != ' ')) {
1928       if (*v2 == '-') {flip = 1; v2++ ; continue;}
1929 #endif
1930       n2 = 10*n2 + (*v2 - '0');
1931       v2++;
1932   }
1933 #ifdef TCL_TIP268
1934   if (flip) n2 = -n2;
1935 #endif
1936 
1937   /*
1938    * Compare and go on to the next version number if the current numbers
1939    * match.
1940    */
1941 
1942   if (n1 != n2) {
1943       break;
1944   }
1945   if (*v1 != 0) {
1946       v1++;
1947   } else if (*v2 == 0) {
1948       break;
1949   }
1950   if (*v2 != 0) {
1951       v2++;
1952   }
1953   thisIsMajor = 0;
1954     }
1955 #ifndef TCL_TIP268
1956     if (satPtr != NULL) {
1957   *satPtr = (n1 == n2) || ((n1 > n2) && !thisIsMajor);
1958     }
1959 #endif
1960     if (n1 > n2) {
1961 #ifndef TCL_TIP268
1962   return 1;
1963 #else
1964   res = 1;
1965 #endif
1966     } else if (n1 == n2) {
1967 #ifndef TCL_TIP268
1968   return 0;
1969 #else
1970   res = 0;
1971 #endif
1972     } else {
1973 #ifndef TCL_TIP268
1974   return -1;
1975 #else
1976   res = -1;
1977     }
1978 
1979     if (isMajorPtr != NULL) {
1980   *isMajorPtr = thisIsMajor;
1981     }
1982 
1983     return res;
1984 }
1985 
1986 /*
1987  *----------------------------------------------------------------------
1988  *
1989  * CheckAllRequirements --
1990  *
1991  *  This function checks to see whether all requirements in a set
1992  *  have valid syntax.
1993  *
1994  * Results:
1995  *  TCL_OK is returned if all requirements are valid.
1996  *  Otherwise TCL_ERROR is returned and an error message
1997  *  is left in the interp's result.
1998  *
1999  * Side effects:
2000  *  May modify the interpreter result.
2001  *
2002  *----------------------------------------------------------------------
2003  */
2004 
2005 static int
2006 CheckAllRequirements(interp, reqc, reqv)
2007      Tcl_Interp* interp;
2008      int reqc;                   /* Requirements to check. */
2009      Tcl_Obj *CONST reqv[];
2010 {
2011     int i;
2012     for (i = 0; i < reqc; i++) {
2013   if ((CheckRequirement(interp, Tcl_GetString(reqv[i])) != TCL_OK)) {
2014       return TCL_ERROR;
2015   }
2016     }
2017     return TCL_OK;
2018 }
2019 
2020 /*
2021  *----------------------------------------------------------------------
2022  *
2023  * CheckRequirement --
2024  *
2025  *  This function checks to see whether a requirement has valid syntax.
2026  *
2027  * Results:
2028  *  If string is a properly formed requirement then TCL_OK is returned.
2029  *  Otherwise TCL_ERROR is returned and an error message is left in the
2030  *  interp's result.
2031  *
2032  * Side effects:
2033  *  None.
2034  *
2035  *----------------------------------------------------------------------
2036  */
2037 
2038 static int
2039 CheckRequirement(interp, string)
2040      Tcl_Interp *interp;  /* Used for error reporting. */
2041      CONST char *string;  /* Supposedly a requirement. */
2042 {
2043     /* Syntax of requirement = version
2044      *                       = version-version
2045      *                       = version-
2046      */
2047 
2048     char* dash = NULL;
2049     char* buf;
2050 
2051     dash = strchr (string, '-');
2052     if (dash == NULL) {
2053   /* no dash found, has to be a simple version */
2054   return CheckVersionAndConvert (interp, string, NULL, NULL);
2055     }
2056     if (strchr (dash+1, '-') != NULL) {
2057   /* More dashes found after the first. This is wrong. */
2058   Tcl_AppendResult(interp, "expected versionMin-versionMax but got \"", string,
2059        "\"", NULL);
2060   return TCL_ERROR;
2061 #endif
2062     }
2063 #ifdef TCL_TIP268
2064 
2065     /* Exactly one dash is present. Copy the string, split at the location of
2066      * dash and check that both parts are versions. Note that the max part can
2067      * be empty.
2068      */
2069 
2070     buf   = strdup (string);
2071     dash  = buf + (dash - string);  
2072     *dash = '\0';     /* buf  now <=> min part */
2073     dash ++;          /* dash now <=> max part */
2074 
2075     if ((CheckVersionAndConvert(interp, buf, NULL, NULL) != TCL_OK) ||
2076   ((*dash != '\0') &&
2077    (CheckVersionAndConvert(interp, dash, NULL, NULL) != TCL_OK))) {
2078   free (buf);
2079   return TCL_ERROR;
2080     }
2081 
2082     free (buf);
2083     return TCL_OK;
2084 #endif
2085 }
static Package* FindPackage (Tcl_Interp * interp, CONST char * name) [static]

Definition at line 1652 of file tclPkg.c.
References Package::availPtr, ckalloc, Package::clientData, Interp::packageTable, Tcl_CreateHashEntry, Tcl_GetHashValue, Tcl_SetHashValue, and Package::version.
Referenced by Tcl_PackageObjCmd(), and Tcl_PkgProvideEx().1655 {
1656     Interp *iPtr = (Interp *) interp;
1657     Tcl_HashEntry *hPtr;
1658     int new;
1659     Package *pkgPtr;
1660 
1661     hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &new);
1662     if (new) {
1663   pkgPtr = (Package *) ckalloc(sizeof(Package));
1664   pkgPtr->version = NULL;
1665   pkgPtr->availPtr = NULL;
1666   pkgPtr->clientData = NULL;
1667   Tcl_SetHashValue(hPtr, pkgPtr);
1668     } else {
1669   pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
1670     }
1671     return pkgPtr;
1672 }
int Tcl_PackageObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 975 of file tclPkg.c.
References Package::availPtr, CheckVersion(), ckalloc, ckfree, ComparePkgVersions(), CONST, FindPackage(), PkgAvail::nextPtr, Interp::packageTable, Interp::packageUnknown, panic, PkgAvail::script, Tcl_AppendElement(), Tcl_DecrRefCount, Tcl_DeleteHashEntry(), TCL_DYNAMIC, TCL_ERROR, Tcl_EventuallyFree(), Tcl_FindHashEntry, Tcl_FirstHashEntry(), Tcl_Free(), Tcl_GetHashKey, Tcl_GetHashValue, Tcl_GetIndexFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_NewIntObj(), Tcl_NewStringObj(), Tcl_NextHashEntry(), TCL_OK, Tcl_PkgPresent(), Tcl_PkgProvide(), Tcl_PkgRequire(), Tcl_PkgRequireProc(), Tcl_SetIntObj(), Tcl_SetObjResult(), Tcl_SetResult(), TCL_VOLATILE, Tcl_WrongNumArgs(), PkgAvail::version, and Package::version.980 {
981     static CONST char *pkgOptions[] = {
982   "forget", "ifneeded", "names",
983 #ifdef TCL_TIP268
984   "prefer",
985 #endif
986   "present", "provide", "require", "unknown", "vcompare",
987   "versions", "vsatisfies", (char *) NULL
988     };
989     enum pkgOptions {
990   PKG_FORGET, PKG_IFNEEDED, PKG_NAMES,
991 #ifdef TCL_TIP268
992   PKG_PREFER,
993 #endif
994   PKG_PRESENT, PKG_PROVIDE, PKG_REQUIRE, PKG_UNKNOWN, PKG_VCOMPARE,
995   PKG_VERSIONS, PKG_VSATISFIES
996     };
997     Interp *iPtr = (Interp *) interp;
998     int optionIndex, exact, i, satisfies;
999     PkgAvail *availPtr, *prevPtr;
1000     Package *pkgPtr;
1001     Tcl_HashEntry *hPtr;
1002     Tcl_HashSearch search;
1003     Tcl_HashTable *tablePtr;
1004     CONST char *version;
1005     char *argv2, *argv3, *argv4;
1006 #ifdef TCL_TIP268
1007     char* iva = NULL;
1008     char* ivb = NULL;
1009 #endif
1010 
1011     if (objc < 2) {
1012         Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
1013   return TCL_ERROR;
1014     }
1015 
1016     if (Tcl_GetIndexFromObj(interp, objv[1], pkgOptions, "option", 0,
1017           &optionIndex) != TCL_OK) {
1018   return TCL_ERROR;
1019     }
1020     switch ((enum pkgOptions) optionIndex) {
1021 #ifndef TCL_TIP268
1022   case PKG_FORGET: {
1023       char *keyString;
1024       for (i = 2; i < objc; i++) {
1025     keyString = Tcl_GetString(objv[i]);
1026     hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
1027     if (hPtr == NULL) {
1028         continue; 
1029     }
1030     pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
1031     Tcl_DeleteHashEntry(hPtr);
1032     if (pkgPtr->version != NULL) {
1033         ckfree(pkgPtr->version);
1034     }
1035     while (pkgPtr->availPtr != NULL) {
1036         availPtr = pkgPtr->availPtr;
1037         pkgPtr->availPtr = availPtr->nextPtr;
1038         Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC);
1039         Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
1040         ckfree((char *) availPtr);
1041     }
1042     ckfree((char *) pkgPtr);
1043       }
1044       break;
1045 #else
1046     case PKG_FORGET: {
1047   char *keyString;
1048   for (i = 2; i < objc; i++) {
1049       keyString = Tcl_GetString(objv[i]);
1050       hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
1051       if (hPtr == NULL) {
1052     continue; 
1053       }
1054       pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
1055       Tcl_DeleteHashEntry(hPtr);
1056       if (pkgPtr->version != NULL) {
1057     ckfree(pkgPtr->version);
1058       }
1059       while (pkgPtr->availPtr != NULL) {
1060     availPtr = pkgPtr->availPtr;
1061     pkgPtr->availPtr = availPtr->nextPtr;
1062     Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC);
1063     Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
1064     ckfree((char *) availPtr);
1065       }
1066       ckfree((char *) pkgPtr);
1067   }
1068   break;
1069     }
1070     case PKG_IFNEEDED: {
1071   int length;
1072   char* argv3i;
1073   char* avi;
1074   int res;
1075 
1076   if ((objc != 4) && (objc != 5)) {
1077       Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?");
1078       return TCL_ERROR;
1079   }
1080   argv3 = Tcl_GetString(objv[3]);
1081   if (CheckVersionAndConvert(interp, argv3, &argv3i, NULL) != TCL_OK) {
1082       return TCL_ERROR;
1083 #endif
1084   }
1085 #ifndef TCL_TIP268
1086   case PKG_IFNEEDED: {
1087       int length;
1088       if ((objc != 4) && (objc != 5)) {
1089     Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?");
1090     return TCL_ERROR;
1091 #else
1092   argv2 = Tcl_GetString(objv[2]);
1093   if (objc == 4) {
1094       hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
1095       if (hPtr == NULL) {
1096     Tcl_Free (argv3i);
1097     return TCL_OK;
1098 #endif
1099       }
1100 #ifndef TCL_TIP268
1101       argv3 = Tcl_GetString(objv[3]);
1102       if (CheckVersion(interp, argv3) != TCL_OK) {
1103 #else
1104       pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
1105   } else {
1106       pkgPtr = FindPackage(interp, argv2);
1107   }
1108   argv3 = Tcl_GetStringFromObj(objv[3], &length);
1109 
1110   for (availPtr = pkgPtr->availPtr, prevPtr = NULL;
1111        availPtr != NULL;
1112        prevPtr = availPtr, availPtr = availPtr->nextPtr) {
1113 
1114       if (CheckVersionAndConvert (interp, availPtr->version, &avi, NULL) != TCL_OK) {
1115     Tcl_Free (argv3i);
1116 #endif
1117     return TCL_ERROR;
1118       }
1119 #ifndef TCL_TIP268
1120       argv2 = Tcl_GetString(objv[2]);
1121       if (objc == 4) {
1122     hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
1123     if (hPtr == NULL) {
1124 #else
1125 
1126       res = CompareVersions(avi, argv3i, NULL);
1127       Tcl_Free (avi);
1128 
1129       if (res == 0){
1130     if (objc == 4) {
1131         Tcl_Free (argv3i);
1132         Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
1133 #endif
1134         return TCL_OK;
1135     }
1136 #ifndef TCL_TIP268
1137     pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
1138       } else {
1139     pkgPtr = FindPackage(interp, argv2);
1140       }
1141       argv3 = Tcl_GetStringFromObj(objv[3], &length);
1142       for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL;
1143      prevPtr = availPtr, availPtr = availPtr->nextPtr) {
1144     if (ComparePkgVersions(availPtr->version, argv3, (int *) NULL)
1145       == 0) {
1146         if (objc == 4) {
1147       Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
1148       return TCL_OK;
1149         }
1150         Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
1151         break;
1152     }
1153       }
1154       if (objc == 4) {
1155     return TCL_OK;
1156 #else
1157     Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
1158     break;
1159 #endif
1160       }
1161 #ifndef TCL_TIP268
1162       if (availPtr == NULL) {
1163     availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail));
1164     availPtr->version = ckalloc((unsigned) (length + 1));
1165     strcpy(availPtr->version, argv3);
1166     if (prevPtr == NULL) {
1167         availPtr->nextPtr = pkgPtr->availPtr;
1168         pkgPtr->availPtr = availPtr;
1169     } else {
1170         availPtr->nextPtr = prevPtr->nextPtr;
1171         prevPtr->nextPtr = availPtr;
1172     }
1173 #else
1174   }
1175   Tcl_Free (argv3i);
1176   if (objc == 4) {
1177       return TCL_OK;
1178   }
1179   if (availPtr == NULL) {
1180       availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail));
1181       availPtr->version = ckalloc((unsigned) (length + 1));
1182       strcpy(availPtr->version, argv3);
1183       if (prevPtr == NULL) {
1184     availPtr->nextPtr = pkgPtr->availPtr;
1185     pkgPtr->availPtr = availPtr;
1186       } else {
1187     availPtr->nextPtr = prevPtr->nextPtr;
1188     prevPtr->nextPtr = availPtr;
1189 #endif
1190       }
1191 #ifndef TCL_TIP268
1192       argv4 = Tcl_GetStringFromObj(objv[4], &length);
1193       availPtr->script = ckalloc((unsigned) (length + 1));
1194       strcpy(availPtr->script, argv4);
1195       break;
1196 #endif
1197   }
1198 #ifndef TCL_TIP268
1199   case PKG_NAMES: {
1200       if (objc != 2) {
1201     Tcl_WrongNumArgs(interp, 2, objv, NULL);
1202 #else
1203   argv4 = Tcl_GetStringFromObj(objv[4], &length);
1204   availPtr->script = ckalloc((unsigned) (length + 1));
1205   strcpy(availPtr->script, argv4);
1206   break;
1207     }
1208     case PKG_NAMES: {
1209   if (objc != 2) {
1210       Tcl_WrongNumArgs(interp, 2, objv, NULL);
1211       return TCL_ERROR;
1212   }
1213   tablePtr = &iPtr->packageTable;
1214   for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
1215        hPtr = Tcl_NextHashEntry(&search)) {
1216       pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
1217       if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
1218     Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr));
1219       }
1220   }
1221   break;
1222     }
1223     case PKG_PRESENT: {
1224   if (objc < 3) {
1225   presentSyntax:
1226       Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");
1227       return TCL_ERROR;
1228   }
1229   argv2 = Tcl_GetString(objv[2]);
1230   if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
1231       exact = 1;
1232   } else {
1233       exact = 0;
1234   }
1235   version = NULL;
1236   if (objc == (4 + exact)) {
1237       version =  Tcl_GetString(objv[3 + exact]);
1238       if (CheckVersionAndConvert(interp, version, NULL, NULL) != TCL_OK) {
1239 #endif
1240     return TCL_ERROR;
1241       }
1242 #ifndef TCL_TIP268
1243       tablePtr = &iPtr->packageTable;
1244       for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
1245      hPtr = Tcl_NextHashEntry(&search)) {
1246 #else
1247   } else if ((objc != 3) || exact) {
1248       goto presentSyntax;
1249   }
1250   if (exact) {
1251       argv3   = Tcl_GetString(objv[3]);
1252       version = Tcl_PkgPresent(interp, argv3, version, exact);
1253   } else {
1254       version = Tcl_PkgPresent(interp, argv2, version, exact);
1255   }
1256   if (version == NULL) {
1257       return TCL_ERROR;
1258   }
1259   Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) );
1260   break;
1261     }
1262     case PKG_PROVIDE: {
1263   if ((objc != 3) && (objc != 4)) {
1264       Tcl_WrongNumArgs(interp, 2, objv, "package ?version?");
1265       return TCL_ERROR;
1266   }
1267   argv2 = Tcl_GetString(objv[2]);
1268   if (objc == 3) {
1269       hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
1270       if (hPtr != NULL) {
1271 #endif
1272     pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
1273 #ifndef TCL_TIP268
1274     if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
1275         Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr));
1276 #else
1277     if (pkgPtr->version != NULL) {
1278         Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE);
1279 #endif
1280     }
1281       }
1282 #ifndef TCL_TIP268
1283       break;
1284 #else
1285       return TCL_OK;
1286 #endif
1287   }
1288 #ifndef TCL_TIP268
1289   case PKG_PRESENT: {
1290       if (objc < 3) {
1291     presentSyntax:
1292     Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");
1293     return TCL_ERROR;
1294 #else
1295   argv3 = Tcl_GetString(objv[3]);
1296   if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) {
1297       return TCL_ERROR;
1298   }
1299   return Tcl_PkgProvide(interp, argv2, argv3);
1300     }
1301     case PKG_REQUIRE: {
1302   if (objc < 3) {
1303   requireSyntax:
1304       Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?requirement...?");
1305       return TCL_ERROR;
1306   }
1307   version = NULL;
1308   argv2   = Tcl_GetString(objv[2]);
1309   if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
1310       Tcl_Obj* ov;
1311       int res;
1312 
1313       if (objc != 5) {
1314     goto requireSyntax;
1315 #endif
1316       }
1317 #ifndef TCL_TIP268
1318       argv2 = Tcl_GetString(objv[2]);
1319       if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
1320     exact = 1;
1321       } else {
1322     exact = 0;
1323 #else
1324       version = Tcl_GetString(objv[4]);
1325       if (CheckVersionAndConvert(interp, version, NULL, NULL) != TCL_OK) {
1326     return TCL_ERROR;
1327 #endif
1328       }
1329 #ifdef TCL_TIP268
1330       /* Create a new-style requirement for the exact version. */
1331 
1332       ov      = ExactRequirement (version);
1333 #endif
1334       version = NULL;
1335 #ifndef TCL_TIP268
1336       if (objc == (4 + exact)) {
1337     version =  Tcl_GetString(objv[3 + exact]);
1338     if (CheckVersion(interp, version) != TCL_OK) {
1339         return TCL_ERROR;
1340     }
1341       } else if ((objc != 3) || exact) {
1342     goto presentSyntax;
1343       }
1344       if (exact) {
1345     argv3 =  Tcl_GetString(objv[3]);
1346     version = Tcl_PkgPresent(interp, argv3, version, exact);
1347       } else {
1348     version = Tcl_PkgPresent(interp, argv2, version, exact);
1349       }
1350       if (version == NULL) {
1351 #else
1352       argv3   = Tcl_GetString(objv[3]);
1353 
1354       Tcl_IncrRefCount (ov);
1355       res = Tcl_PkgRequireProc(interp, argv3, 1, &ov, NULL);
1356       Tcl_DecrRefCount (ov);
1357       return res;
1358   } else {
1359       if (CheckAllRequirements (interp, objc-3, objv+3) != TCL_OK) {
1360 #endif
1361     return TCL_ERROR;
1362       }
1363 #ifndef TCL_TIP268
1364       Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) );
1365       break;
1366 #else
1367       return Tcl_PkgRequireProc(interp, argv2, objc-3, objv+3, NULL);
1368 #endif
1369   }
1370 #ifndef TCL_TIP268
1371   case PKG_PROVIDE: {
1372       if ((objc != 3) && (objc != 4)) {
1373     Tcl_WrongNumArgs(interp, 2, objv, "package ?version?");
1374 #else
1375   break;
1376     }
1377     case PKG_UNKNOWN: {
1378   int length;
1379   if (objc == 2) {
1380       if (iPtr->packageUnknown != NULL) {
1381     Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE);
1382       }
1383   } else if (objc == 3) {
1384       if (iPtr->packageUnknown != NULL) {
1385     ckfree(iPtr->packageUnknown);
1386       }
1387       argv2 = Tcl_GetStringFromObj(objv[2], &length);
1388       if (argv2[0] == 0) {
1389     iPtr->packageUnknown = NULL;
1390       } else {
1391     iPtr->packageUnknown = (char *) ckalloc((unsigned)
1392               (length + 1));
1393     strcpy(iPtr->packageUnknown, argv2);
1394       }
1395   } else {
1396       Tcl_WrongNumArgs(interp, 2, objv, "?command?");
1397       return TCL_ERROR;
1398   }
1399   break;
1400     }
1401     case PKG_PREFER: {
1402   /* See tclInt.h for the enum, just before Interp */
1403   static CONST char *pkgPreferOptions[] = {
1404       "latest", "stable", NULL
1405   };
1406 
1407   if (objc > 3) {
1408       Tcl_WrongNumArgs(interp, 2, objv, "?latest|stable?");
1409       return TCL_ERROR;
1410   } else if (objc == 3) {
1411       /* Set value. */
1412       int new;
1413       if (Tcl_GetIndexFromObj(interp, objv[2], pkgPreferOptions, "preference", 0,
1414             &new) != TCL_OK) {
1415 #endif
1416     return TCL_ERROR;
1417       }
1418 #ifndef TCL_TIP268
1419       argv2 = Tcl_GetString(objv[2]);
1420       if (objc == 3) {
1421     hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
1422     if (hPtr != NULL) {
1423         pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
1424         if (pkgPtr->version != NULL) {
1425       Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE);
1426         }
1427     }
1428     return TCL_OK;
1429 #else
1430       if (new < iPtr->packagePrefer) {
1431     iPtr->packagePrefer = new;
1432 #endif
1433       }
1434 #ifndef TCL_TIP268
1435       argv3 = Tcl_GetString(objv[3]);
1436       if (CheckVersion(interp, argv3) != TCL_OK) {
1437     return TCL_ERROR;
1438       }
1439       return Tcl_PkgProvide(interp, argv2, argv3);
1440 #endif
1441   }
1442 #ifndef TCL_TIP268
1443   case PKG_REQUIRE: {
1444       if (objc < 3) {
1445     requireSyntax:
1446     Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");
1447     return TCL_ERROR;
1448       }
1449       argv2 = Tcl_GetString(objv[2]);
1450       if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
1451     exact = 1;
1452       } else {
1453     exact = 0;
1454       }
1455       version = NULL;
1456       if (objc == (4 + exact)) {
1457     version =  Tcl_GetString(objv[3 + exact]);
1458     if (CheckVersion(interp, version) != TCL_OK) {
1459         return TCL_ERROR;
1460     }
1461       } else if ((objc != 3) || exact) {
1462     goto requireSyntax;
1463       }
1464       if (exact) {
1465     argv3 =  Tcl_GetString(objv[3]);
1466     version = Tcl_PkgRequire(interp, argv3, version, exact);
1467       } else {
1468     version = Tcl_PkgRequire(interp, argv2, version, exact);
1469       }
1470       if (version == NULL) {
1471     return TCL_ERROR;
1472       }
1473       Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) );
1474       break;
1475 #else
1476   /* Always return current value. */
1477   Tcl_SetObjResult(interp, Tcl_NewStringObj (pkgPreferOptions [iPtr->packagePrefer], -1));
1478   break;
1479     }
1480     case PKG_VCOMPARE: {
1481   if (objc != 4) {
1482       Tcl_WrongNumArgs(interp, 2, objv, "version1 version2");
1483       return TCL_ERROR;
1484 #endif
1485   }
1486 #ifndef TCL_TIP268
1487   case PKG_UNKNOWN: {
1488       int length;
1489       if (objc == 2) {
1490     if (iPtr->packageUnknown != NULL) {
1491         Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE);
1492     }
1493       } else if (objc == 3) {
1494     if (iPtr->packageUnknown != NULL) {
1495         ckfree(iPtr->packageUnknown);
1496     }
1497     argv2 = Tcl_GetStringFromObj(objv[2], &length);
1498     if (argv2[0] == 0) {
1499         iPtr->packageUnknown = NULL;
1500     } else {
1501         iPtr->packageUnknown = (char *) ckalloc((unsigned)
1502           (length + 1));
1503         strcpy(iPtr->packageUnknown, argv2);
1504     }
1505       } else {
1506     Tcl_WrongNumArgs(interp, 2, objv, "?command?");
1507     return TCL_ERROR;
1508       }
1509       break;
1510 #else
1511   argv3 = Tcl_GetString(objv[3]);
1512   argv2 = Tcl_GetString(objv[2]);
1513   if ((CheckVersionAndConvert (interp, argv2, &iva, NULL) != TCL_OK) ||
1514       (CheckVersionAndConvert (interp, argv3, &ivb, NULL) != TCL_OK)) {
1515       if (iva != NULL) { Tcl_Free (iva); }
1516       /* ivb cannot be set in this branch */
1517       return TCL_ERROR;
1518 #endif
1519   }
1520 #ifndef TCL_TIP268
1521   case PKG_VCOMPARE: {
1522       if (objc != 4) {
1523     Tcl_WrongNumArgs(interp, 2, objv, "version1 version2");
1524     return TCL_ERROR;
1525       }
1526       argv3 = Tcl_GetString(objv[3]);
1527       argv2 = Tcl_GetString(objv[2]);
1528       if ((CheckVersion(interp, argv2) != TCL_OK)
1529         || (CheckVersion(interp, argv3) != TCL_OK)) {
1530     return TCL_ERROR;
1531       }
1532       Tcl_SetIntObj(Tcl_GetObjResult(interp),
1533         ComparePkgVersions(argv2, argv3, (int *) NULL));
1534       break;
1535 #else
1536 
1537   /* Comparison is done on the internal representation */
1538   Tcl_SetObjResult(interp,Tcl_NewIntObj(CompareVersions(iva, ivb, NULL)));
1539   Tcl_Free (iva);
1540   Tcl_Free (ivb);
1541   break;
1542     }
1543     case PKG_VERSIONS: {
1544   if (objc != 3) {
1545       Tcl_WrongNumArgs(interp, 2, objv, "package");
1546       return TCL_ERROR;
1547 #endif
1548   }
1549 #ifndef TCL_TIP268
1550   case PKG_VERSIONS: {
1551       if (objc != 3) {
1552     Tcl_WrongNumArgs(interp, 2, objv, "package");
1553     return TCL_ERROR;
1554 #else
1555   argv2 = Tcl_GetString(objv[2]);
1556   hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
1557   if (hPtr != NULL) {
1558       pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
1559       for (availPtr = pkgPtr->availPtr; availPtr != NULL;
1560      availPtr = availPtr->nextPtr) {
1561     Tcl_AppendElement(interp, availPtr->version);
1562 #endif
1563       }
1564 #ifndef TCL_TIP268
1565       argv2 = Tcl_GetString(objv[2]);
1566       hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
1567       if (hPtr != NULL) {
1568     pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
1569     for (availPtr = pkgPtr->availPtr; availPtr != NULL;
1570          availPtr = availPtr->nextPtr) {
1571         Tcl_AppendElement(interp, availPtr->version);
1572     }
1573       }
1574       break;
1575 #endif
1576   }
1577 #ifndef TCL_TIP268
1578   case PKG_VSATISFIES: {
1579       if (objc != 4) {
1580     Tcl_WrongNumArgs(interp, 2, objv, "version1 version2");
1581     return TCL_ERROR;
1582       }
1583       argv3 = Tcl_GetString(objv[3]);
1584       argv2 = Tcl_GetString(objv[2]);
1585       if ((CheckVersion(interp, argv2) != TCL_OK)
1586         || (CheckVersion(interp, argv3) != TCL_OK)) {
1587     return TCL_ERROR;
1588       }
1589       ComparePkgVersions(argv2, argv3, &satisfies);
1590       Tcl_SetIntObj(Tcl_GetObjResult(interp), satisfies);
1591       break;
1592 #else
1593   break;
1594     }
1595     case PKG_VSATISFIES: {
1596   char* argv2i = NULL;
1597 
1598   if (objc < 4) {
1599       Tcl_WrongNumArgs(interp, 2, objv, "version requirement requirement...");
1600       return TCL_ERROR;
1601 #endif
1602   }
1603 #ifndef TCL_TIP268
1604   default: {
1605       panic("Tcl_PackageObjCmd: bad option index to pkgOptions");
1606 #else
1607 
1608   argv2 = Tcl_GetString(objv[2]);
1609   if ((CheckVersionAndConvert(interp, argv2, &argv2i, NULL) != TCL_OK)) {
1610       return TCL_ERROR;
1611   } else if (CheckAllRequirements (interp, objc-3, objv+3) != TCL_OK) {
1612       Tcl_Free (argv2i);
1613       return TCL_ERROR;
1614 #endif
1615   }
1616 #ifdef TCL_TIP268
1617 
1618   satisfies = AllRequirementsSatisfied (argv2i, objc-3, objv+3);
1619   Tcl_Free (argv2i);
1620 
1621   Tcl_SetIntObj(Tcl_GetObjResult(interp), satisfies);
1622   break;
1623     }
1624     default: {
1625   panic("Tcl_PackageObjCmd: bad option index to pkgOptions");
1626     }
1627 #endif
1628     }
1629     return TCL_OK;
1630 }
CONST char* Tcl_PkgPresent (Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)

Definition at line 861 of file tclPkg.c.
References Tcl_PkgPresentEx().
Referenced by Tcl_PackageObjCmd().871 {
872     return Tcl_PkgPresentEx(interp, name, version, exact, (ClientData *) NULL);
873 }
CONST char* Tcl_PkgPresentEx (Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)

Definition at line 876 of file tclPkg.c.
References Package::clientData, ComparePkgVersions(), Interp::packageTable, Tcl_FindHashEntry, Tcl_Free(), Tcl_GetHashValue, TCL_OK, and Package::version.
Referenced by Tcl_PkgPresent().890 {
891     Interp *iPtr = (Interp *) interp;
892     Tcl_HashEntry *hPtr;
893     Package *pkgPtr;
894     int satisfies, result;
895 
896     hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name);
897     if (hPtr) {
898   pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
899   if (pkgPtr->version != NULL) {
900 #ifdef TCL_TIP268
901       char* pvi;
902       char* vi;
903       int thisIsMajor;
904 #endif
905       
906       /*
907        * At this point we know that the package is present.  Make sure
908        * that the provided version meets the current requirement.
909        */
910 
911       if (version == NULL) {
912     if (clientDataPtr) {
913         *clientDataPtr = pkgPtr->clientData;
914     }
915     
916     return pkgPtr->version;
917       }
918 #ifndef TCL_TIP268
919       result = ComparePkgVersions(pkgPtr->version, version, &satisfies);
920 #else
921       if (CheckVersionAndConvert (interp, pkgPtr->version, &pvi, NULL) != TCL_OK) {
922     return NULL;
923       } else if (CheckVersionAndConvert (interp, version, &vi, NULL) != TCL_OK) {
924     Tcl_Free (pvi);
925     return NULL;
926       }
927       result = CompareVersions(pvi, vi, &thisIsMajor);
928       Tcl_Free (pvi);
929       Tcl_Free (vi);
930       satisfies = (result == 0) || ((result == 1) && !thisIsMajor);
931 #endif
932       if ((satisfies && !exact) || (result == 0)) {
933     if (clientDataPtr) {
934         *clientDataPtr = pkgPtr->clientData;
935     }
936     
937     return pkgPtr->version;
938       }
939       Tcl_AppendResult(interp, "version conflict for package \"",
940            name, "\": have ", pkgPtr->version,
941            ", need ", version, (char *) NULL);
942       return NULL;
943   }
944     }
945 
946     if (version != NULL) {
947   Tcl_AppendResult(interp, "package ", name, " ", version,
948        " is not present", (char *) NULL);
949     } else {
950   Tcl_AppendResult(interp, "package ", name, " is not present",
951        (char *) NULL);
952     }
953     return NULL;
954 }
int Tcl_PkgProvide (Tcl_Interp * interp, CONST char * name, CONST char * version)

Definition at line 111 of file tclPkg.c.
References NULL, and Tcl_PkgProvideEx().
Referenced by Pkga_Init(), Pkgb_Init(), Pkgb_SafeInit(), Pkgc_Init(), Pkgc_SafeInit(), Pkgd_Init(), Pkgd_SafeInit(), ProcBodyTestInitInternal(), Registry_Init(), TCL_DECLARE_MUTEX(), Tcl_PackageObjCmd(), Tclapplescript_Init(), and Tcltest_Init().116 {
117     return Tcl_PkgProvideEx(interp, name, version, (ClientData) NULL);
118 }
int Tcl_PkgProvideEx (Tcl_Interp * interp, CONST char * name, CONST char * version, ClientData clientData)

Definition at line 121 of file tclPkg.c.
References ckalloc, Package::clientData, ComparePkgVersions(), FindPackage(), NULL, TCL_ERROR, Tcl_Free(), TCL_OK, and Package::version.
Referenced by Tcl_PkgProvide().128 {
129     Package *pkgPtr;
130 #ifdef TCL_TIP268
131     char* pvi;
132     char* vi;
133     int res;
134 #endif
135 
136     pkgPtr = FindPackage(interp, name);
137     if (pkgPtr->version == NULL) {
138   pkgPtr->version = ckalloc((unsigned) (strlen(version) + 1));
139   strcpy(pkgPtr->version, version);
140   pkgPtr->clientData = clientData;
141   return TCL_OK;
142     }
143 #ifndef TCL_TIP268
144     if (ComparePkgVersions(pkgPtr->version, version, (int *) NULL) == 0) {
145 #else
146     if (CheckVersionAndConvert (interp, pkgPtr->version, &pvi, NULL) != TCL_OK) {
147   return TCL_ERROR;
148     } else if (CheckVersionAndConvert (interp, version, &vi, NULL) != TCL_OK) {
149   Tcl_Free (pvi);
150   return TCL_ERROR;
151     }
152 
153     res = CompareVersions(pvi, vi, NULL);
154     Tcl_Free (pvi);
155     Tcl_Free (vi);
156 
157     if (res == 0) {
158 #endif
159   if (clientData != NULL) {
160       pkgPtr->clientData = clientData;
161   }
162   return TCL_OK;
163     }
164     Tcl_AppendResult(interp, "conflicting versions provided for package \"",
165          name, "\": ", pkgPtr->version, ", then ", version, (char *) NULL);
166     return TCL_ERROR;
167 }
CONST char* Tcl_PkgRequire (Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)

Definition at line 216 of file tclPkg.c.
References Tcl_PkgRequireEx().
Referenced by Tcl_PackageObjCmd().225 {
226     return Tcl_PkgRequireEx(interp, name, version, exact, (ClientData *) NULL);
227 }
CONST char* Tcl_PkgRequireEx (Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)

Definition at line 230 of file tclPkg.c.
References Tcl_DecrRefCount, Tcl_GetAssocData(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_OK, Tcl_PkgRequireProc(), Tcl_ResetResult(), Tcl_SetAssocData(), tclEmptyString, and tclEmptyStringRep.
Referenced by Tcl_InitStubs(), and Tcl_PkgRequire().244 {
245 #ifndef TCL_TIP268
246     Package *pkgPtr;
247     PkgAvail *availPtr, *bestPtr;
248     char *script;
249     int code, satisfies, result, pass;
250     Tcl_DString command;
251 #else
252     Tcl_Obj *ov;
253     int      res;
254 #endif
255 
256     /*
257      * If an attempt is being made to load this into a standalone executable
258      * on a platform where backlinking is not supported then this must be
259      * a shared version of Tcl (Otherwise the load would have failed).
260      * Detect this situation by checking that this library has been correctly
261      * initialised. If it has not been then return immediately as nothing will
262      * work.
263      */
264     
265     if (tclEmptyStringRep == NULL) {
266 
267   /*
268    * OK, so what's going on here?
269    *
270    * First, what are we doing?  We are performing a check on behalf of
271    * one particular caller, Tcl_InitStubs().  When a package is
272    * stub-enabled, it is statically linked to libtclstub.a, which
273    * contains a copy of Tcl_InitStubs().  When a stub-enabled package
274    * is loaded, its *_Init() function is supposed to call
275    * Tcl_InitStubs() before calling any other functions in the Tcl
276    * library.  The first Tcl function called by Tcl_InitStubs() through
277    * the stub table is Tcl_PkgRequireEx(), so this code right here is
278    * the first code that is part of the original Tcl library in the
279    * executable that gets executed on behalf of a newly loaded
280    * stub-enabled package.
281    *
282    * One easy error for the developer/builder of a stub-enabled package
283    * to make is to forget to define USE_TCL_STUBS when compiling the
284    * package.  When that happens, the package will contain symbols
285    * that are references to the Tcl library, rather than function
286    * pointers referencing the stub table.  On platforms that lack
287    * backlinking, those unresolved references may cause the loading
288    * of the package to also load a second copy of the Tcl library,
289    * leading to all kinds of trouble.  We would like to catch that
290    * error and report a useful message back to the user.  That's
291    * what we're doing.
292    *
293    * Second, how does this work?  If we reach this point, then the
294    * global variable tclEmptyStringRep has the value NULL.  Compare
295    * that with the definition of tclEmptyStringRep near the top of
296    * the file generic/tclObj.c.  It clearly should not have the value
297    * NULL; it should point to the char tclEmptyString.  If we see it
298    * having the value NULL, then somehow we are seeing a Tcl library
299    * that isn't completely initialized, and that's an indicator for the
300    * error condition described above.  (Further explanation is welcome.)
301    *
302    * Third, so what do we do about it?  This situation indicates
303    * the package we just loaded wasn't properly compiled to be
304    * stub-enabled, yet it thinks it is stub-enabled (it called
305    * Tcl_InitStubs()).  We want to report that the package just
306    * loaded is broken, so we want to place an error message in
307    * the interpreter result and return NULL to indicate failure
308    * to Tcl_InitStubs() so that it will also fail.  (Further
309    * explanation why we don't want to Tcl_Panic() is welcome.
310    * After all, two Tcl libraries can't be a good thing!)
311    *
312    * Trouble is that's going to be tricky.  We're now using a Tcl
313    * library that's not fully initialized.  In particular, it 
314    * doesn't have a proper value for tclEmptyStringRep.  The
315    * Tcl_Obj system heavily depends on the value of tclEmptyStringRep
316    * and all of Tcl depends (increasingly) on the Tcl_Obj system, we
317    * need to correct that flaw before making the calls to set the 
318    * interpreter result to the error message.  That's the only flaw
319    * corrected; other problems with initialization of the Tcl library
320    * are not remedied, so be very careful about adding any other calls
321    * here without checking how they behave when initialization is
322    * incomplete.
323    */
324 
325   tclEmptyStringRep = &tclEmptyString;
326         Tcl_AppendResult(interp, "Cannot load package \"", name, 
327        "\" in standalone executable: This package is not ",
328        "compiled with stub support", NULL);
329         return NULL;
330     }
331 
332 #ifdef TCL_TIP268
333     /* Translate between old and new API, and defer to the new function. */
334 
335     if (version == NULL) {
336   res = Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr);
337     } else {
338   if (exact) {
339       ov = ExactRequirement (version);
340   } else {
341       ov = Tcl_NewStringObj (version,-1);
342   }
343 
344   Tcl_IncrRefCount (ov);
345   res = Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr);
346   Tcl_DecrRefCount (ov);
347     }
348 
349     if (res != TCL_OK) {
350   return NULL;
351     }
352 
353     /* This function returns the version string explictly, and leaves the
354      * interpreter result empty. However "Tcl_PkgRequireProc" above returned
355      * the version through the interpreter result. Simply resetting the result
356      * now potentially deletes the string (obj), and the pointer to its string
357      * rep we have, as our result, may be dangling due to this. Our solution
358      * is to remember the object in interp associated data, with a proper
359      * reference count, and then reset the result. Now pointers will not
360      * dangle. It will be a leak however if nothing is done. So the next time
361      * we come through here we delete the object remembered by this call, as
362      * we can then be sure that there is no pointer to its string around
363      * anymore. Beyond that we have a deletion function which cleans up the last
364      * remembered object which was not cleaned up directly, here.
365      */
366 
367     ov = (Tcl_Obj*) Tcl_GetAssocData (interp, "tcl/Tcl_PkgRequireEx", NULL);
368     if (ov != NULL) {
369   Tcl_DecrRefCount (ov);
370     }
371 
372     ov = Tcl_GetObjResult (interp);
373     Tcl_IncrRefCount (ov);
374     Tcl_SetAssocData(interp, "tcl/Tcl_PkgRequireEx", VersionCleanupProc,
375          (ClientData) ov);
376     Tcl_ResetResult (interp);
377 
378     return Tcl_GetString (ov);
379 }
380 
381 int
382 Tcl_PkgRequireProc(interp,name,reqc,reqv,clientDataPtr)
383      Tcl_Interp *interp;  /* Interpreter in which package is now
384          * available. */
385      CONST char *name;    /* Name of desired package. */
386      int reqc;                  /* Requirements constraining the desired version. */
387      Tcl_Obj *CONST reqv[];     /* 0 means to use the latest version available. */
388      ClientData *clientDataPtr;
389 {
390     Interp *iPtr = (Interp *) interp;
391     Package *pkgPtr;
392     PkgAvail *availPtr,     *bestPtr, *bestStablePtr;
393     char     *availVersion, *bestVersion; /* Internal rep. of versions */
394     int       availStable;
395     char *script;
396     int code, satisfies, pass;
397     Tcl_DString command;
398     char* pkgVersionI;
399 
400 #endif
401     /*
402      * It can take up to three passes to find the package: one pass to run the
403      * "package unknown" script, one to run the "package ifneeded" script for
404      * a specific version, and a final pass to lookup the package loaded by
405      * the "package ifneeded" script.
406      */
407 
408     for (pass = 1; ; pass++) {
409   pkgPtr = FindPackage(interp, name);
410   if (pkgPtr->version != NULL) {
411       break;
412   }
413 
414   /* 
415    * Check whether we're already attempting to load some version
416    * of this package (circular dependency detection).
417    */
418 
419   if (pkgPtr->clientData != NULL) {
420       Tcl_AppendResult(interp, "circular package dependency: ",
421            "attempt to provide ", name, " ",
422            (char *)(pkgPtr->clientData), " requires ", name, NULL);
423 #ifndef TCL_TIP268
424       if (version != NULL) {
425     Tcl_AppendResult(interp, " ", version, NULL);
426       }
427       return NULL;
428 #else
429       AddRequirementsToResult (interp, reqc, reqv);
430       return TCL_ERROR;
431 #endif
432   }
433 
434   /*
435    * The package isn't yet present. Search the list of available
436    * versions and invoke the script for the best available version.
437    *
438    * For TIP 268 we are actually locating the best, and the best stable
439    * version.  One of them is then chosen based on the selection mode.
440    */
441 #ifndef TCL_TIP268    
442   bestPtr = NULL;
443   for (availPtr = pkgPtr->availPtr; availPtr != NULL;
444     availPtr = availPtr->nextPtr) {
445       if ((bestPtr != NULL) && (ComparePkgVersions(availPtr->version,
446         bestPtr->version, (int *) NULL) <= 0)) {
447 #else
448   bestPtr        = NULL;
449   bestStablePtr  = NULL;
450   bestVersion    = NULL;
451 
452   for (availPtr = pkgPtr->availPtr;
453        availPtr != NULL;
454        availPtr = availPtr->nextPtr) {
455       if (CheckVersionAndConvert (interp, availPtr->version,
456           &availVersion, &availStable) != TCL_OK) {
457     /* The provided version number is has invalid syntax. This
458      * should not happen. This should have been caught by the
459      * 'package ifneeded' registering the package.
460      */
461 #endif
462     continue;
463       }
464 #ifndef TCL_TIP268
465       if (version != NULL) {
466     result = ComparePkgVersions(availPtr->version, version,
467       &satisfies);
468     if ((result != 0) && exact) {
469 #else
470       if (bestPtr != NULL) {
471     int res = CompareVersions (availVersion, bestVersion, NULL);
472     /* Note: Use internal reps! */
473     if (res <= 0) {
474         /* The version of the package sought is not as good as the
475          * currently selected version. Ignore it. */
476         Tcl_Free (availVersion);
477         availVersion = NULL;
478 #endif
479         continue;
480     }
481 #ifdef TCL_TIP268
482       }
483 
484       /* We have found a version which is better than our max. */
485 
486       if (reqc > 0) {
487     /* Check satisfaction of requirements */
488     satisfies = AllRequirementsSatisfied (availVersion, reqc, reqv);
489 #endif
490     if (!satisfies) {
491 #ifdef TCL_TIP268
492         Tcl_Free (availVersion);
493         availVersion = NULL;
494 #endif
495         continue;
496     }
497       }
498       bestPtr = availPtr;
499 #ifdef TCL_TIP268
500       if (bestVersion != NULL) Tcl_Free (bestVersion);
501       bestVersion  = availVersion;
502       availVersion = NULL;
503 
504       /* If this new best version is stable then it also has to be
505        * better than the max stable version found so far.
506        */
507 
508       if (availStable) {
509     bestStablePtr = availPtr;
510       }
511   }
512 
513   if (bestVersion != NULL) {
514       Tcl_Free (bestVersion);
515   }
516 
517   /* Now choose a version among the two best. For 'latest' we simply
518    * take (actually keep) the best. For 'stable' we take the best
519    * stable, if there is any, or the best if there is nothing stable.
520    */
521 
522   if ((iPtr->packagePrefer == PKG_PREFER_STABLE) && (bestStablePtr != NULL)) {
523       bestPtr = bestStablePtr;
524 #endif
525   }
526   if (bestPtr != NULL) {
527       /*
528        * We found an ifneeded script for the package. Be careful while
529        * executing it: this could cause reentrancy, so (a) protect the
530        * script itself from deletion and (b) don't assume that bestPtr
531        * will still exist when the script completes.
532        */
533 
534       CONST char *versionToProvide = bestPtr->version;
535       script = bestPtr->script;
536       pkgPtr->clientData = (ClientData) versionToProvide;
537       Tcl_Preserve((ClientData) script);
538       Tcl_Preserve((ClientData) versionToProvide);
539       code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL);
540       Tcl_Release((ClientData) script);
541       pkgPtr = FindPackage(interp, name);
542       if (code == TCL_OK) {
543 #ifdef TCL_TIP268
544     Tcl_ResetResult(interp);
545 #endif
546     if (pkgPtr->version == NULL) {
547 #ifndef TCL_TIP268
548         Tcl_ResetResult(interp);
549 #endif
550         code = TCL_ERROR;
551         Tcl_AppendResult(interp, "attempt to provide package ",
552              name, " ", versionToProvide,
553              " failed: no version of package ", name,
554              " provided", NULL);
555 #ifndef TCL_TIP268
556     } else if (0 != ComparePkgVersions(
557       pkgPtr->version, versionToProvide, NULL)) {
558         /* At this point, it is clear that a prior
559          * [package ifneeded] command lied to us.  It said
560          * that to get a particular version of a particular
561          * package, we needed to evaluate a particular script.
562          * However, we evaluated that script and got a different
563          * version than we were told.  This is an error, and we
564          * ought to report it.
565          *
566          * However, we've been letting this type of error slide
567          * for a long time, and as a result, a lot of packages
568          * suffer from them.
569          *
570          * It's a bit too harsh to make a large number of
571          * existing packages start failing by releasing a
572          * new patch release, so we forgive this type of error
573          * for the rest of the Tcl 8.4 series.
574          *
575          * We considered reporting a warning, but in practice
576          * even that appears too harsh a change for a patch release.
577          *
578          * We limit the error reporting to only
579          * the situation where a broken ifneeded script leads
580          * to a failure to satisfy the requirement.
581          */
582         if (version) {
583       result = ComparePkgVersions(
584         pkgPtr->version, version, &satisfies);
585       if (result && (exact || !satisfies)) {
586           Tcl_ResetResult(interp);
587           code = TCL_ERROR;
588           Tcl_AppendResult(interp,
589             "attempt to provide package ", name, " ",
590             versionToProvide, " failed: package ",
591             name, " ", pkgPtr->version,
592             " provided instead", NULL);
593 #else
594     } else {
595         char* pvi;
596         char* vi;
597         int res;
598 
599         if (CheckVersionAndConvert (interp, pkgPtr->version, &pvi, NULL) != TCL_OK) {
600       code = TCL_ERROR;
601         } else if (CheckVersionAndConvert (interp, versionToProvide, &vi, NULL) != TCL_OK) {
602       Tcl_Free (pvi);
603       code = TCL_ERROR;
604         } else {
605       res = CompareVersions(pvi, vi, NULL);
606       Tcl_Free (vi);
607 
608       if (res != 0) {
609           /* At this point, it is clear that a prior
610            * [package ifneeded] command lied to us.  It said
611            * that to get a particular version of a particular
612            * package, we needed to evaluate a particular script.
613            * However, we evaluated that script and got a different
614            * version than we were told.  This is an error, and we
615            * ought to report it.
616            *
617            * However, we've been letting this type of error slide
618            * for a long time, and as a result, a lot of packages
619            * suffer from them.
620            *
621            * It's a bit too harsh to make a large number of
622            * existing packages start failing by releasing a
623            * new patch release, so we forgive this type of error
624            * for the rest of the Tcl 8.4 series.
625            *
626            * We considered reporting a warning, but in practice
627            * even that appears too harsh a change for a patch release.
628            *
629            * We limit the error reporting to only
630            * the situation where a broken ifneeded script leads
631            * to a failure to satisfy the requirement.
632            */
633 
634           if (reqc > 0) {
635               satisfies = AllRequirementsSatisfied (pvi, reqc, reqv);
636         if (!satisfies) {
637             Tcl_ResetResult(interp);
638             code = TCL_ERROR;
639             Tcl_AppendResult(interp,
640                  "attempt to provide package ", name, " ",
641                  versionToProvide, " failed: package ",
642                  name, " ", pkgPtr->version,
643                  " provided instead", NULL);
644         }
645           }
646           /*
647            * Warning generation now disabled
648            if (code == TCL_OK) {
649            Tcl_Obj *msg = Tcl_NewStringObj(
650            "attempt to provide package ", -1);
651            Tcl_Obj *cmdPtr = Tcl_NewListObj(0, NULL);
652            Tcl_ListObjAppendElement(NULL, cmdPtr,
653            Tcl_NewStringObj("tclLog", -1));
654            Tcl_AppendStringsToObj(msg, name, " ", versionToProvide,
655            " failed: package ", name, " ",
656            pkgPtr->version, " provided instead", NULL);
657            Tcl_ListObjAppendElement(NULL, cmdPtr, msg);
658            Tcl_IncrRefCount(cmdPtr);
659            Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
660            Tcl_DecrRefCount(cmdPtr);
661            Tcl_ResetResult(interp);
662            }
663           */
664 #endif
665       }
666 #ifdef TCL_TIP268
667       Tcl_Free (pvi);
668 #endif
669         }
670 #ifndef TCL_TIP268
671         /*
672          * Warning generation now disabled
673         if (code == TCL_OK) {
674       Tcl_Obj *msg = Tcl_NewStringObj(
675         "attempt to provide package ", -1);
676       Tcl_Obj *cmdPtr = Tcl_NewListObj(0, NULL);
677       Tcl_ListObjAppendElement(NULL, cmdPtr,
678         Tcl_NewStringObj("tclLog", -1));
679       Tcl_AppendStringsToObj(msg, name, " ", versionToProvide,
680         " failed: package ", name, " ",
681         pkgPtr->version, " provided instead", NULL);
682       Tcl_ListObjAppendElement(NULL, cmdPtr, msg);
683       Tcl_IncrRefCount(cmdPtr);
684       Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
685       Tcl_DecrRefCount(cmdPtr);
686       Tcl_ResetResult(interp);
687         }
688         */
689 #endif
690     }
691       } else if (code != TCL_ERROR) {
692     Tcl_Obj *codePtr = Tcl_NewIntObj(code);
693     Tcl_ResetResult(interp);
694     Tcl_AppendResult(interp, "attempt to provide package ",
695          name, " ", versionToProvide, " failed: ",
696          "bad return code: ", Tcl_GetString(codePtr), NULL);
697     Tcl_DecrRefCount(codePtr);
698     code = TCL_ERROR;
699       }
700       Tcl_Release((ClientData) versionToProvide);
701 
702       if (code != TCL_OK) {
703     /*
704      * Take a non-TCL_OK code from the script as an
705      * indication the package wasn't loaded properly,
706      * so the package system should not remember an
707      * improper load.
708      *
709      * This is consistent with our returning NULL.
710      * If we're not willing to tell our caller we
711      * got a particular version, we shouldn't store
712      * that version for telling future callers either.
713      */
714     Tcl_AddErrorInfo(interp, "\n    (\"package ifneeded\" script)");
715     if (pkgPtr->version != NULL) {
716         ckfree(pkgPtr->version);
717         pkgPtr->version = NULL;
718     }
719     pkgPtr->clientData = NULL;
720 #ifndef TCL_TIP268
721     return NULL;
722 #else
723     return TCL_ERROR;
724 #endif
725       }
726       break;
727   }
728 
729   /*
730    * The package is not in the database. If there is a "package unknown"
731    * command, invoke it (but only on the first pass; after that, we
732    * should not get here in the first place).
733    */
734 
735   if (pass > 1) {
736       break;
737   }
738   script = ((Interp *) interp)->packageUnknown;
739   if (script != NULL) {
740       Tcl_DStringInit(&command);
741       Tcl_DStringAppend(&command, script, -1);
742       Tcl_DStringAppendElement(&command, name);
743 #ifndef TCL_TIP268
744       Tcl_DStringAppend(&command, " ", 1);
745       Tcl_DStringAppend(&command, (version != NULL) ? version : "{}",
746         -1);
747       if (exact) {
748     Tcl_DStringAppend(&command, " -exact", 7);
749       }
750 #else
751       AddRequirementsToDString(&command, reqc, reqv);
752 #endif
753       code = Tcl_EvalEx(interp, Tcl_DStringValue(&command),
754             Tcl_DStringLength(&command), TCL_EVAL_GLOBAL);
755       Tcl_DStringFree(&command);
756       if ((code != TCL_OK) && (code != TCL_ERROR)) {
757     Tcl_Obj *codePtr = Tcl_NewIntObj(code);
758     Tcl_ResetResult(interp);
759     Tcl_AppendResult(interp, "bad return code: ",
760          Tcl_GetString(codePtr), NULL);
761     Tcl_DecrRefCount(codePtr);
762     code = TCL_ERROR;
763       }
764       if (code == TCL_ERROR) {
765     Tcl_AddErrorInfo(interp, "\n    (\"package unknown\" script)");
766 #ifndef TCL_TIP268
767     return NULL;
768 #else
769     return TCL_ERROR;
770 #endif
771       }
772       Tcl_ResetResult(interp);
773   }
774     }
775 
776     if (pkgPtr->version == NULL) {
777   Tcl_AppendResult(interp, "can't find package ", name, (char *) NULL);
778 #ifndef TCL_TIP268
779   if (version != NULL) {
780       Tcl_AppendResult(interp, " ", version, (char *) NULL);
781   }
782   return NULL;
783 #else
784   AddRequirementsToResult(interp, reqc, reqv);
785   return TCL_ERROR;
786 #endif
787     }
788 
789     /*
790      * At this point we know that the package is present. Make sure that the
791      * provided version meets the current requirements.
792      */
793 
794 #ifndef TCL_TIP268
795     if (version == NULL) {
796         if (clientDataPtr) {
797       *clientDataPtr = pkgPtr->clientData;
798   }
799   return pkgPtr->version;
800 #else
801     if (reqc == 0) {
802   satisfies = 1;
803     } else {
804   CheckVersionAndConvert (interp, pkgPtr->version, &pkgVersionI, NULL);
805   satisfies = AllRequirementsSatisfied (pkgVersionI, reqc, reqv);
806 
807   Tcl_Free (pkgVersionI);
808 #endif
809     }
810 #ifndef TCL_TIP268
811     result = ComparePkgVersions(pkgPtr->version, version, &satisfies);
812     if ((satisfies && !exact) || (result == 0)) {
813 #else
814     if (satisfies) {
815 #endif
816   if (clientDataPtr) {
817       *clientDataPtr = pkgPtr->clientData;
818   }
819 #ifndef TCL_TIP268
820   return pkgPtr->version;
821 #else
822   Tcl_SetObjResult (interp, Tcl_NewStringObj (pkgPtr->version, -1));
823   return TCL_OK;
824 #endif
825     }
826     Tcl_AppendResult(interp, "version conflict for package \"",
827          name, "\": have ", pkgPtr->version,
828 #ifndef TCL_TIP268
829           ", need ", version, (char *) NULL);
830     return NULL;
831 #else
832                       ", need", (char*) NULL);
833     AddRequirementsToResult (interp, reqc, reqv);
834     return TCL_ERROR;
835 #endif
836 }
int Tcl_PkgRequireProc (Tcl_Interp * interp, CONST char * name, int reqc, reqv, ClientData * clientDataPtr)

Definition at line 203 of file tclPkg.c.
References TCL_ERROR.
Referenced by Tcl_PackageObjCmd(), and Tcl_PkgRequireEx().210 {
211     return TCL_ERROR;
212 }
void TclFreePackageInfo (Interp * iPtr)

Definition at line 1693 of file tclPkg.c.
References Package::availPtr, ckfree, PkgAvail::nextPtr, PkgAvail::script, Tcl_DeleteHashTable(), TCL_DYNAMIC, Tcl_EventuallyFree(), Tcl_FirstHashEntry(), Tcl_GetHashValue, Tcl_NextHashEntry(), PkgAvail::version, and Package::version.
Referenced by DeleteInterpProc().1695 {
1696     Package *pkgPtr;
1697     Tcl_HashSearch search;
1698     Tcl_HashEntry *hPtr;
1699     PkgAvail *availPtr;
1700 
1701     for (hPtr = Tcl_FirstHashEntry(&iPtr->packageTable, &search);
1702    hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
1703   pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
1704   if (pkgPtr->version != NULL) {
1705       ckfree(pkgPtr->version);
1706   }
1707   while (pkgPtr->availPtr != NULL) {
1708       availPtr = pkgPtr->availPtr;
1709       pkgPtr->availPtr = availPtr->nextPtr;
1710       Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC);
1711       Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
1712       ckfree((char *) availPtr);
1713   }
1714   ckfree((char *) pkgPtr);
1715     }
1716     Tcl_DeleteHashTable(&iPtr->packageTable);
1717     if (iPtr->packageUnknown != NULL) {
1718   ckfree(iPtr->packageUnknown);
1719     }
1720 }

generic/tclPlatDecls.h File Reference
Classes
struct TclPlatStubs
Variables
TclPlatStubs * tclPlatStubsPtr

Variable Documentation
TclPlatStubs* tclPlatStubsPtr

Definition at line 37 of file tclStubLib.c.
Referenced by Tcl_InitStubs().

generic/tclPort.h File Reference
#include "tcl.h"
#include "../unix/tclUnixPort.h"
Defines
#define LLONG_MIN  ((Tcl_WideInt)(Tcl_LongAsWide(1)<<63))
#define LLONG_MAX  (~LLONG_MIN)

Define Documentation
#define LLONG_MAX  (~LLONG_MIN)

Definition at line 43 of file tclPort.h.
Referenced by ExprRoundFunc(), ExprWideFunc(), and Tcl_GetIntFromObj().#define LLONG_MIN  ((Tcl_WideInt)(Tcl_LongAsWide(1)<<63))

Definition at line 39 of file tclPort.h.
Referenced by ExprRoundFunc(), and ExprWideFunc().

generic/tclPosixStr.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Functions
CONST char * Tcl_ErrnoId ()
CONST char * Tcl_ErrnoMsg (int err)
CONST char * Tcl_SignalId (int sig)
CONST char * Tcl_SignalMsg (int sig)

Function Documentation
CONST char* Tcl_ErrnoId ()

Definition at line 39 of file tclPosixStr.c.
References E2BIG, EACCES, EADDRINUSE, EADDRNOTAVAIL, EAFNOSUPPORT, EAGAIN, EALREADY, EBADF, EBADRPC, EBUSY, ECHILD, ECONNABORTED, ECONNREFUSED, ECONNRESET, EDEADLK, EDESTADDRREQ, EDOM, EDQUOT, EEXIST, EFAULT, EFBIG, EHOSTDOWN, EHOSTUNREACH, EINPROGRESS, EINTR, EINVAL, EIO, EISCONN, EISDIR, ELOOP, EMFILE, EMLINK, EMSGSIZE, ENAMETOOLONG, ENETDOWN, ENETRESET, ENETUNREACH, ENFILE, ENOBUFS, ENODEV, ENOENT, ENOEXEC, ENOLCK, ENOMEM, ENOPROTOOPT, ENOSPC, ENOSYS, ENOTBLK, ENOTCONN, ENOTDIR, ENOTEMPTY, ENOTSOCK, ENOTSUP, ENOTTY, ENXIO, EOPNOTSUPP, EOVERFLOW, EPERM, EPFNOSUPPORT, EPIPE, EPROCLIM, EPROCUNAVAIL, EPROGMISMATCH, EPROGUNAVAIL, EPROTONOSUPPORT, EPROTOTYPE, ERANGE, EREMOTE, EROFS, ERPCMISMATCH, errno, ESHUTDOWN, ESOCKTNOSUPPORT, ESPIPE, ESRCH, ESTALE, ETIMEDOUT, ETOOMANYREFS, ETXTBSY, EUSERS, EWOULDBLOCK, and EXDEV.
Referenced by Tcl_PosixError(), and TestfileCmd().40 {
41     switch (errno) {
42 #ifdef E2BIG
43   case E2BIG: return "E2BIG";
44 #endif
45 #ifdef EACCES
46   case EACCES: return "EACCES";
47 #endif
48 #ifdef EADDRINUSE
49   case EADDRINUSE: return "EADDRINUSE";
50 #endif
51 #ifdef EADDRNOTAVAIL
52   case EADDRNOTAVAIL: return "EADDRNOTAVAIL";
53 #endif
54 #ifdef EADV
55   case EADV: return "EADV";
56 #endif
57 #ifdef EAFNOSUPPORT
58   case EAFNOSUPPORT: return "EAFNOSUPPORT";
59 #endif
60 #ifdef EAGAIN
61   case EAGAIN: return "EAGAIN";
62 #endif
63 #ifdef EALIGN
64   case EALIGN: return "EALIGN";
65 #endif
66 #if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY ))
67   case EALREADY: return "EALREADY";
68 #endif
69 #ifdef EBADE
70   case EBADE: return "EBADE";
71 #endif
72 #ifdef EBADF
73   case EBADF: return "EBADF";
74 #endif
75 #ifdef EBADFD
76   case EBADFD: return "EBADFD";
77 #endif
78 #ifdef EBADMSG
79   case EBADMSG: return "EBADMSG";
80 #endif
81 #ifdef EBADR
82   case EBADR: return "EBADR";
83 #endif
84 #ifdef EBADRPC
85   case EBADRPC: return "EBADRPC";
86 #endif
87 #ifdef EBADRQC
88   case EBADRQC: return "EBADRQC";
89 #endif
90 #ifdef EBADSLT
91   case EBADSLT: return "EBADSLT";
92 #endif
93 #ifdef EBFONT
94   case EBFONT: return "EBFONT";
95 #endif
96 #ifdef EBUSY
97   case EBUSY: return "EBUSY";
98 #endif
99 #ifdef ECHILD
100   case ECHILD: return "ECHILD";
101 #endif
102 #ifdef ECHRNG
103   case ECHRNG: return "ECHRNG";
104 #endif
105 #ifdef ECOMM
106   case ECOMM: return "ECOMM";
107 #endif
108 #ifdef ECONNABORTED
109   case ECONNABORTED: return "ECONNABORTED";
110 #endif
111 #ifdef ECONNREFUSED
112   case ECONNREFUSED: return "ECONNREFUSED";
113 #endif
114 #ifdef ECONNRESET
115   case ECONNRESET: return "ECONNRESET";
116 #endif
117 #if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK))
118   case EDEADLK: return "EDEADLK";
119 #endif
120 #if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK))
121   case EDEADLOCK: return "EDEADLOCK";
122 #endif
123 #ifdef EDESTADDRREQ
124   case EDESTADDRREQ: return "EDESTADDRREQ";
125 #endif
126 #ifdef EDIRTY
127   case EDIRTY: return "EDIRTY";
128 #endif
129 #ifdef EDOM
130   case EDOM: return "EDOM";
131 #endif
132 #ifdef EDOTDOT
133   case EDOTDOT: return "EDOTDOT";
134 #endif
135 #ifdef EDQUOT
136   case EDQUOT: return "EDQUOT";
137 #endif
138 #ifdef EDUPPKG
139   case EDUPPKG: return "EDUPPKG";
140 #endif
141 #ifdef EEXIST
142   case EEXIST: return "EEXIST";
143 #endif
144 #ifdef EFAULT
145   case EFAULT: return "EFAULT";
146 #endif
147 #ifdef EFBIG
148   case EFBIG: return "EFBIG";
149 #endif
150 #ifdef EHOSTDOWN
151   case EHOSTDOWN: return "EHOSTDOWN";
152 #endif
153 #ifdef EHOSTUNREACH
154   case EHOSTUNREACH: return "EHOSTUNREACH";
155 #endif
156 #if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
157   case EIDRM: return "EIDRM";
158 #endif
159 #ifdef EINIT
160   case EINIT: return "EINIT";
161 #endif
162 #ifdef EINPROGRESS
163   case EINPROGRESS: return "EINPROGRESS";
164 #endif
165 #ifdef EINTR
166   case EINTR: return "EINTR";
167 #endif
168 #ifdef EINVAL
169   case EINVAL: return "EINVAL";
170 #endif
171 #ifdef EIO
172   case EIO: return "EIO";
173 #endif
174 #ifdef EISCONN
175   case EISCONN: return "EISCONN";
176 #endif
177 #ifdef EISDIR
178   case EISDIR: return "EISDIR";
179 #endif
180 #ifdef EISNAME
181   case EISNAM: return "EISNAM";
182 #endif
183 #ifdef ELBIN
184   case ELBIN: return "ELBIN";
185 #endif
186 #ifdef EL2HLT
187   case EL2HLT: return "EL2HLT";
188 #endif
189 #ifdef EL2NSYNC
190   case EL2NSYNC: return "EL2NSYNC";
191 #endif
192 #ifdef EL3HLT
193   case EL3HLT: return "EL3HLT";
194 #endif
195 #ifdef EL3RST
196   case EL3RST: return "EL3RST";
197 #endif
198 #ifdef ELIBACC
199   case ELIBACC: return "ELIBACC";
200 #endif
201 #ifdef ELIBBAD
202   case ELIBBAD: return "ELIBBAD";
203 #endif
204 #ifdef ELIBEXEC
205   case ELIBEXEC: return "ELIBEXEC";
206 #endif
207 #ifdef ELIBMAX
208   case ELIBMAX: return "ELIBMAX";
209 #endif
210 #ifdef ELIBSCN
211   case ELIBSCN: return "ELIBSCN";
212 #endif
213 #ifdef ELNRNG
214   case ELNRNG: return "ELNRNG";
215 #endif
216 #if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT))
217   case ELOOP: return "ELOOP";
218 #endif
219 #ifdef EMFILE
220   case EMFILE: return "EMFILE";
221 #endif
222 #ifdef EMLINK
223   case EMLINK: return "EMLINK";
224 #endif
225 #ifdef EMSGSIZE
226   case EMSGSIZE: return "EMSGSIZE";
227 #endif
228 #ifdef EMULTIHOP
229   case EMULTIHOP: return "EMULTIHOP";
230 #endif
231 #ifdef ENAMETOOLONG
232   case ENAMETOOLONG: return "ENAMETOOLONG";
233 #endif
234 #ifdef ENAVAIL
235   case ENAVAIL: return "ENAVAIL";
236 #endif
237 #ifdef ENET
238   case ENET: return "ENET";
239 #endif
240 #ifdef ENETDOWN
241   case ENETDOWN: return "ENETDOWN";
242 #endif
243 #ifdef ENETRESET
244   case ENETRESET: return "ENETRESET";
245 #endif
246 #ifdef ENETUNREACH
247   case ENETUNREACH: return "ENETUNREACH";
248 #endif
249 #ifdef ENFILE
250   case ENFILE: return "ENFILE";
251 #endif
252 #ifdef ENOANO
253   case ENOANO: return "ENOANO";
254 #endif
255 #if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR))
256   case ENOBUFS: return "ENOBUFS";
257 #endif
258 #ifdef ENOCSI
259   case ENOCSI: return "ENOCSI";
260 #endif
261 #if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED))
262   case ENODATA: return "ENODATA";
263 #endif
264 #ifdef ENODEV
265   case ENODEV: return "ENODEV";
266 #endif
267 #ifdef ENOENT
268   case ENOENT: return "ENOENT";
269 #endif
270 #ifdef ENOEXEC
271   case ENOEXEC: return "ENOEXEC";
272 #endif
273 #ifdef ENOLCK
274   case ENOLCK: return "ENOLCK";
275 #endif
276 #ifdef ENOLINK
277   case ENOLINK: return "ENOLINK";
278 #endif
279 #ifdef ENOMEM
280   case ENOMEM: return "ENOMEM";
281 #endif
282 #ifdef ENOMSG
283   case ENOMSG: return "ENOMSG";
284 #endif
285 #ifdef ENONET
286   case ENONET: return "ENONET";
287 #endif
288 #ifdef ENOPKG
289   case ENOPKG: return "ENOPKG";
290 #endif
291 #ifdef ENOPROTOOPT
292   case ENOPROTOOPT: return "ENOPROTOOPT";
293 #endif
294 #ifdef ENOSPC
295   case ENOSPC: return "ENOSPC";
296 #endif
297 #if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
298   case ENOSR: return "ENOSR";
299 #endif
300 #if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR))
301   case ENOSTR: return "ENOSTR";
302 #endif
303 #ifdef ENOSYM
304   case ENOSYM: return "ENOSYM";
305 #endif
306 #ifdef ENOSYS
307   case ENOSYS: return "ENOSYS";
308 #endif
309 #ifdef ENOTBLK
310   case ENOTBLK: return "ENOTBLK";
311 #endif
312 #ifdef ENOTCONN
313   case ENOTCONN: return "ENOTCONN";
314 #endif
315 #ifdef ENOTDIR
316   case ENOTDIR: return "ENOTDIR";
317 #endif
318 #if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST))
319   case ENOTEMPTY: return "ENOTEMPTY";
320 #endif
321 #ifdef ENOTNAM
322   case ENOTNAM: return "ENOTNAM";
323 #endif
324 #ifdef ENOTSOCK
325   case ENOTSOCK: return "ENOTSOCK";
326 #endif
327 #ifdef ENOTSUP
328   case ENOTSUP: return "ENOTSUP";
329 #endif
330 #ifdef ENOTTY
331   case ENOTTY: return "ENOTTY";
332 #endif
333 #ifdef ENOTUNIQ
334   case ENOTUNIQ: return "ENOTUNIQ";
335 #endif
336 #ifdef ENXIO
337   case ENXIO: return "ENXIO";
338 #endif
339 #if defined(EOPNOTSUPP) &&  (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
340   case EOPNOTSUPP: return "EOPNOTSUPP";
341 #endif
342 #if defined(EOVERFLOW) && ( !defined(EFBIG) || (EOVERFLOW != EFBIG) ) && ( !defined(EINVAL) || (EOVERFLOW != EINVAL) )
343         case EOVERFLOW: return "EOVERFLOW";
344 #endif
345 #ifdef EPERM
346   case EPERM: return "EPERM";
347 #endif
348 #if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT))
349   case EPFNOSUPPORT: return "EPFNOSUPPORT";
350 #endif
351 #ifdef EPIPE
352   case EPIPE: return "EPIPE";
353 #endif
354 #ifdef EPROCLIM
355   case EPROCLIM: return "EPROCLIM";
356 #endif
357 #ifdef EPROCUNAVAIL
358   case EPROCUNAVAIL: return "EPROCUNAVAIL";
359 #endif
360 #ifdef EPROGMISMATCH
361   case EPROGMISMATCH: return "EPROGMISMATCH";
362 #endif
363 #ifdef EPROGUNAVAIL
364   case EPROGUNAVAIL: return "EPROGUNAVAIL";
365 #endif
366 #ifdef EPROTO
367   case EPROTO: return "EPROTO";
368 #endif
369 #ifdef EPROTONOSUPPORT
370   case EPROTONOSUPPORT: return "EPROTONOSUPPORT";
371 #endif
372 #ifdef EPROTOTYPE
373   case EPROTOTYPE: return "EPROTOTYPE";
374 #endif
375 #ifdef ERANGE
376   case ERANGE: return "ERANGE";
377 #endif
378 #if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED))
379   case EREFUSED: return "EREFUSED";
380 #endif
381 #ifdef EREMCHG
382   case EREMCHG: return "EREMCHG";
383 #endif
384 #ifdef EREMDEV
385   case EREMDEV: return "EREMDEV";
386 #endif
387 #ifdef EREMOTE
388   case EREMOTE: return "EREMOTE";
389 #endif
390 #ifdef EREMOTEIO
391   case EREMOTEIO: return "EREMOTEIO";
392 #endif
393 #ifdef EREMOTERELEASE
394   case EREMOTERELEASE: return "EREMOTERELEASE";
395 #endif
396 #ifdef EROFS
397   case EROFS: return "EROFS";
398 #endif
399 #ifdef ERPCMISMATCH
400   case ERPCMISMATCH: return "ERPCMISMATCH";
401 #endif
402 #ifdef ERREMOTE
403   case ERREMOTE: return "ERREMOTE";
404 #endif
405 #ifdef ESHUTDOWN
406   case ESHUTDOWN: return "ESHUTDOWN";
407 #endif
408 #ifdef ESOCKTNOSUPPORT
409   case ESOCKTNOSUPPORT: return "ESOCKTNOSUPPORT";
410 #endif
411 #ifdef ESPIPE
412   case ESPIPE: return "ESPIPE";
413 #endif
414 #ifdef ESRCH
415   case ESRCH: return "ESRCH";
416 #endif
417 #ifdef ESRMNT
418   case ESRMNT: return "ESRMNT";
419 #endif
420 #ifdef ESTALE
421   case ESTALE: return "ESTALE";
422 #endif
423 #ifdef ESUCCESS
424   case ESUCCESS: return "ESUCCESS";
425 #endif
426 #if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP))
427   case ETIME: return "ETIME";
428 #endif
429 #if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR))
430   case ETIMEDOUT: return "ETIMEDOUT";
431 #endif
432 #ifdef ETOOMANYREFS
433   case ETOOMANYREFS: return "ETOOMANYREFS";
434 #endif
435 #ifdef ETXTBSY
436   case ETXTBSY: return "ETXTBSY";
437 #endif
438 #ifdef EUCLEAN
439   case EUCLEAN: return "EUCLEAN";
440 #endif
441 #ifdef EUNATCH
442   case EUNATCH: return "EUNATCH";
443 #endif
444 #ifdef EUSERS
445   case EUSERS: return "EUSERS";
446 #endif
447 #ifdef EVERSION
448   case EVERSION: return "EVERSION";
449 #endif
450 #if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN))
451   case EWOULDBLOCK: return "EWOULDBLOCK";
452 #endif
453 #ifdef EXDEV
454   case EXDEV: return "EXDEV";
455 #endif
456 #ifdef EXFULL
457   case EXFULL: return "EXFULL";
458 #endif
459     }
460     return "unknown error";
461 }
CONST char* Tcl_ErrnoMsg (int err)

Definition at line 487 of file tclPosixStr.c.
References E2BIG, EACCES, EADDRINUSE, EADDRNOTAVAIL, EAFNOSUPPORT, EAGAIN, EALREADY, EBADF, EBADRPC, EBUSY, ECHILD, ECONNABORTED, ECONNREFUSED, ECONNRESET, EDEADLK, EDESTADDRREQ, EDOM, EDQUOT, EEXIST, EFAULT, EFBIG, EHOSTDOWN, EHOSTUNREACH, EINPROGRESS, EINTR, EINVAL, EIO, EISCONN, EISDIR, ELOOP, EMFILE, EMLINK, EMSGSIZE, ENAMETOOLONG, ENETDOWN, ENETRESET, ENETUNREACH, ENFILE, ENOBUFS, ENODEV, ENOENT, ENOEXEC, ENOLCK, ENOMEM, ENOPROTOOPT, ENOSPC, ENOSYS, ENOTBLK, ENOTCONN, ENOTDIR, ENOTEMPTY, ENOTSOCK, ENOTSUP, ENOTTY, ENXIO, EOPNOTSUPP, EOVERFLOW, EPERM, EPFNOSUPPORT, EPIPE, EPROCLIM, EPROCUNAVAIL, EPROGMISMATCH, EPROGUNAVAIL, EPROTONOSUPPORT, EPROTOTYPE, ERANGE, EREMOTE, EROFS, ERPCMISMATCH, errno, ESHUTDOWN, ESOCKTNOSUPPORT, ESPIPE, ESRCH, ESTALE, ETIMEDOUT, ETOOMANYREFS, ETXTBSY, EUSERS, EWOULDBLOCK, and EXDEV.
Referenced by Tcl_PosixError(), and TcpGetOptionProc().489 {
490     switch (err) {
491 #ifdef E2BIG
492   case E2BIG: return "argument list too long";
493 #endif
494 #ifdef EACCES
495   case EACCES: return "permission denied";
496 #endif
497 #ifdef EADDRINUSE
498   case EADDRINUSE: return "address already in use";
499 #endif
500 #ifdef EADDRNOTAVAIL
501   case EADDRNOTAVAIL: return "can't assign requested address";
502 #endif
503 #ifdef EADV
504   case EADV: return "advertise error";
505 #endif
506 #ifdef EAFNOSUPPORT
507   case EAFNOSUPPORT: return "address family not supported by protocol family";
508 #endif
509 #ifdef EAGAIN
510   case EAGAIN: return "resource temporarily unavailable";
511 #endif
512 #ifdef EALIGN
513   case EALIGN: return "EALIGN";
514 #endif
515 #if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY ))
516   case EALREADY: return "operation already in progress";
517 #endif
518 #ifdef EBADE
519   case EBADE: return "bad exchange descriptor";
520 #endif
521 #ifdef EBADF
522   case EBADF: return "bad file number";
523 #endif
524 #ifdef EBADFD
525   case EBADFD: return "file descriptor in bad state";
526 #endif
527 #ifdef EBADMSG
528   case EBADMSG: return "not a data message";
529 #endif
530 #ifdef EBADR
531   case EBADR: return "bad request descriptor";
532 #endif
533 #ifdef EBADRPC
534   case EBADRPC: return "RPC structure is bad";
535 #endif
536 #ifdef EBADRQC
537   case EBADRQC: return "bad request code";
538 #endif
539 #ifdef EBADSLT
540   case EBADSLT: return "invalid slot";
541 #endif
542 #ifdef EBFONT
543   case EBFONT: return "bad font file format";
544 #endif
545 #ifdef EBUSY
546   case EBUSY: return "file busy";
547 #endif
548 #ifdef ECHILD
549   case ECHILD: return "no children";
550 #endif
551 #ifdef ECHRNG
552   case ECHRNG: return "channel number out of range";
553 #endif
554 #ifdef ECOMM
555   case ECOMM: return "communication error on send";
556 #endif
557 #ifdef ECONNABORTED
558   case ECONNABORTED: return "software caused connection abort";
559 #endif
560 #ifdef ECONNREFUSED
561   case ECONNREFUSED: return "connection refused";
562 #endif
563 #ifdef ECONNRESET
564   case ECONNRESET: return "connection reset by peer";
565 #endif
566 #if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK))
567   case EDEADLK: return "resource deadlock avoided";
568 #endif
569 #if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK))
570   case EDEADLOCK: return "resource deadlock avoided";
571 #endif
572 #ifdef EDESTADDRREQ
573   case EDESTADDRREQ: return "destination address required";
574 #endif
575 #ifdef EDIRTY
576   case EDIRTY: return "mounting a dirty fs w/o force";
577 #endif
578 #ifdef EDOM
579   case EDOM: return "math argument out of range";
580 #endif
581 #ifdef EDOTDOT
582   case EDOTDOT: return "cross mount point";
583 #endif
584 #ifdef EDQUOT
585   case EDQUOT: return "disk quota exceeded";
586 #endif
587 #ifdef EDUPPKG
588   case EDUPPKG: return "duplicate package name";
589 #endif
590 #ifdef EEXIST
591   case EEXIST: return "file already exists";
592 #endif
593 #ifdef EFAULT
594   case EFAULT: return "bad address in system call argument";
595 #endif
596 #ifdef EFBIG
597   case EFBIG: return "file too large";
598 #endif
599 #ifdef EHOSTDOWN
600   case EHOSTDOWN: return "host is down";
601 #endif
602 #ifdef EHOSTUNREACH
603   case EHOSTUNREACH: return "host is unreachable";
604 #endif
605 #if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
606   case EIDRM: return "identifier removed";
607 #endif
608 #ifdef EINIT
609   case EINIT: return "initialization error";
610 #endif
611 #ifdef EINPROGRESS
612   case EINPROGRESS: return "operation now in progress";
613 #endif
614 #ifdef EINTR
615   case EINTR: return "interrupted system call";
616 #endif
617 #ifdef EINVAL
618   case EINVAL: return "invalid argument";
619 #endif
620 #ifdef EIO
621   case EIO: return "I/O error";
622 #endif
623 #ifdef EISCONN
624   case EISCONN: return "socket is already connected";
625 #endif
626 #ifdef EISDIR
627   case EISDIR: return "illegal operation on a directory";
628 #endif
629 #ifdef EISNAME
630   case EISNAM: return "is a name file";
631 #endif
632 #ifdef ELBIN
633   case ELBIN: return "ELBIN";
634 #endif
635 #ifdef EL2HLT
636   case EL2HLT: return "level 2 halted";
637 #endif
638 #ifdef EL2NSYNC
639   case EL2NSYNC: return "level 2 not synchronized";
640 #endif
641 #ifdef EL3HLT
642   case EL3HLT: return "level 3 halted";
643 #endif
644 #ifdef EL3RST
645   case EL3RST: return "level 3 reset";
646 #endif
647 #ifdef ELIBACC
648   case ELIBACC: return "can not access a needed shared library";
649 #endif
650 #ifdef ELIBBAD
651   case ELIBBAD: return "accessing a corrupted shared library";
652 #endif
653 #ifdef ELIBEXEC
654   case ELIBEXEC: return "can not exec a shared library directly";
655 #endif
656 #ifdef ELIBMAX
657   case ELIBMAX: return
658     "attempting to link in more shared libraries than system limit";
659 #endif
660 #ifdef ELIBSCN
661   case ELIBSCN: return ".lib section in a.out corrupted";
662 #endif
663 #ifdef ELNRNG
664   case ELNRNG: return "link number out of range";
665 #endif
666 #if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT))
667   case ELOOP: return "too many levels of symbolic links";
668 #endif
669 #ifdef EMFILE
670   case EMFILE: return "too many open files";
671 #endif
672 #ifdef EMLINK
673   case EMLINK: return "too many links";
674 #endif
675 #ifdef EMSGSIZE
676   case EMSGSIZE: return "message too long";
677 #endif
678 #ifdef EMULTIHOP
679   case EMULTIHOP: return "multihop attempted";
680 #endif
681 #ifdef ENAMETOOLONG
682   case ENAMETOOLONG: return "file name too long";
683 #endif
684 #ifdef ENAVAIL
685   case ENAVAIL: return "not available";
686 #endif
687 #ifdef ENET
688   case ENET: return "ENET";
689 #endif
690 #ifdef ENETDOWN
691   case ENETDOWN: return "network is down";
692 #endif
693 #ifdef ENETRESET
694   case ENETRESET: return "network dropped connection on reset";
695 #endif
696 #ifdef ENETUNREACH
697   case ENETUNREACH: return "network is unreachable";
698 #endif
699 #ifdef ENFILE
700   case ENFILE: return "file table overflow";
701 #endif
702 #ifdef ENOANO
703   case ENOANO: return "anode table overflow";
704 #endif
705 #if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR))
706   case ENOBUFS: return "no buffer space available";
707 #endif
708 #ifdef ENOCSI
709   case ENOCSI: return "no CSI structure available";
710 #endif
711 #if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED))
712   case ENODATA: return "no data available";
713 #endif
714 #ifdef ENODEV
715   case ENODEV: return "no such device";
716 #endif
717 #ifdef ENOENT
718   case ENOENT: return "no such file or directory";
719 #endif
720 #ifdef ENOEXEC
721   case ENOEXEC: return "exec format error";
722 #endif
723 #ifdef ENOLCK
724   case ENOLCK: return "no locks available";
725 #endif
726 #ifdef ENOLINK
727   case ENOLINK: return "link has be severed";
728 #endif
729 #ifdef ENOMEM
730   case ENOMEM: return "not enough memory";
731 #endif
732 #ifdef ENOMSG
733   case ENOMSG: return "no message of desired type";
734 #endif
735 #ifdef ENONET
736   case ENONET: return "machine is not on the network";
737 #endif
738 #ifdef ENOPKG
739   case ENOPKG: return "package not installed";
740 #endif
741 #ifdef ENOPROTOOPT
742   case ENOPROTOOPT: return "bad protocol option";
743 #endif
744 #ifdef ENOSPC
745   case ENOSPC: return "no space left on device";
746 #endif
747 #if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
748   case ENOSR: return "out of stream resources";
749 #endif
750 #if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR))
751   case ENOSTR: return "not a stream device";
752 #endif
753 #ifdef ENOSYM
754   case ENOSYM: return "unresolved symbol name";
755 #endif
756 #ifdef ENOSYS
757   case ENOSYS: return "function not implemented";
758 #endif
759 #ifdef ENOTBLK
760   case ENOTBLK: return "block device required";
761 #endif
762 #ifdef ENOTCONN
763   case ENOTCONN: return "socket is not connected";
764 #endif
765 #ifdef ENOTDIR
766   case ENOTDIR: return "not a directory";
767 #endif
768 #if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST))
769   case ENOTEMPTY: return "directory not empty";
770 #endif
771 #ifdef ENOTNAM
772   case ENOTNAM: return "not a name file";
773 #endif
774 #ifdef ENOTSOCK
775   case ENOTSOCK: return "socket operation on non-socket";
776 #endif
777 #ifdef ENOTSUP
778   case ENOTSUP: return "operation not supported";
779 #endif
780 #ifdef ENOTTY
781   case ENOTTY: return "inappropriate device for ioctl";
782 #endif
783 #ifdef ENOTUNIQ
784   case ENOTUNIQ: return "name not unique on network";
785 #endif
786 #ifdef ENXIO
787   case ENXIO: return "no such device or address";
788 #endif
789 #if defined(EOPNOTSUPP) &&  (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
790   case EOPNOTSUPP: return "operation not supported on socket";
791 #endif
792 #if defined(EOVERFLOW) && ( !defined(EFBIG) || (EOVERFLOW != EFBIG) ) && ( !defined(EINVAL) || (EOVERFLOW != EINVAL) )
793         case EOVERFLOW: return "file too big";
794 #endif
795 #ifdef EPERM
796   case EPERM: return "not owner";
797 #endif
798 #if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT))
799   case EPFNOSUPPORT: return "protocol family not supported";
800 #endif
801 #ifdef EPIPE
802   case EPIPE: return "broken pipe";
803 #endif
804 #ifdef EPROCLIM
805   case EPROCLIM: return "too many processes";
806 #endif
807 #ifdef EPROCUNAVAIL
808   case EPROCUNAVAIL: return "bad procedure for program";
809 #endif
810 #ifdef EPROGMISMATCH
811   case EPROGMISMATCH: return "program version wrong";
812 #endif
813 #ifdef EPROGUNAVAIL
814   case EPROGUNAVAIL: return "RPC program not available";
815 #endif
816 #ifdef EPROTO
817   case EPROTO: return "protocol error";
818 #endif
819 #ifdef EPROTONOSUPPORT
820   case EPROTONOSUPPORT: return "protocol not suppored";
821 #endif
822 #ifdef EPROTOTYPE
823   case EPROTOTYPE: return "protocol wrong type for socket";
824 #endif
825 #ifdef ERANGE
826   case ERANGE: return "math result unrepresentable";
827 #endif
828 #if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED))
829   case EREFUSED: return "EREFUSED";
830 #endif
831 #ifdef EREMCHG
832   case EREMCHG: return "remote address changed";
833 #endif
834 #ifdef EREMDEV
835   case EREMDEV: return "remote device";
836 #endif
837 #ifdef EREMOTE
838   case EREMOTE: return "pathname hit remote file system";
839 #endif
840 #ifdef EREMOTEIO
841   case EREMOTEIO: return "remote i/o error";
842 #endif
843 #ifdef EREMOTERELEASE
844   case EREMOTERELEASE: return "EREMOTERELEASE";
845 #endif
846 #ifdef EROFS
847   case EROFS: return "read-only file system";
848 #endif
849 #ifdef ERPCMISMATCH
850   case ERPCMISMATCH: return "RPC version is wrong";
851 #endif
852 #ifdef ERREMOTE
853   case ERREMOTE: return "object is remote";
854 #endif
855 #ifdef ESHUTDOWN
856   case ESHUTDOWN: return "can't send afer socket shutdown";
857 #endif
858 #ifdef ESOCKTNOSUPPORT
859   case ESOCKTNOSUPPORT: return "socket type not supported";
860 #endif
861 #ifdef ESPIPE
862   case ESPIPE: return "invalid seek";
863 #endif
864 #ifdef ESRCH
865   case ESRCH: return "no such process";
866 #endif
867 #ifdef ESRMNT
868   case ESRMNT: return "srmount error";
869 #endif
870 #ifdef ESTALE
871   case ESTALE: return "stale remote file handle";
872 #endif
873 #ifdef ESUCCESS
874   case ESUCCESS: return "Error 0";
875 #endif
876 #if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP))
877   case ETIME: return "timer expired";
878 #endif
879 #if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR))
880   case ETIMEDOUT: return "connection timed out";
881 #endif
882 #ifdef ETOOMANYREFS
883   case ETOOMANYREFS: return "too many references: can't splice";
884 #endif
885 #ifdef ETXTBSY
886   case ETXTBSY: return "text file or pseudo-device busy";
887 #endif
888 #ifdef EUCLEAN
889   case EUCLEAN: return "structure needs cleaning";
890 #endif
891 #ifdef EUNATCH
892   case EUNATCH: return "protocol driver not attached";
893 #endif
894 #ifdef EUSERS
895   case EUSERS: return "too many users";
896 #endif
897 #ifdef EVERSION
898   case EVERSION: return "version mismatch";
899 #endif
900 #if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN))
901   case EWOULDBLOCK: return "operation would block";
902 #endif
903 #ifdef EXDEV
904   case EXDEV: return "cross-domain link";
905 #endif
906 #ifdef EXFULL
907   case EXFULL: return "message tables full";
908 #endif
909   default:
910 #ifdef NO_STRERROR
911       return "unknown POSIX error";
912 #else
913       return strerror(errno);
914 #endif
915     }
916 }
CONST char* Tcl_SignalId (int sig)

Definition at line 937 of file tclPosixStr.c.
References SIGHUP, SIGPIPE, and SIGQUIT.
Referenced by TclCleanupChildren().939 {
940     switch (sig) {
941 #ifdef SIGABRT
942   case SIGABRT: return "SIGABRT";
943 #endif
944 #ifdef SIGALRM
945   case SIGALRM: return "SIGALRM";
946 #endif
947 #ifdef SIGBUS
948   case SIGBUS: return "SIGBUS";
949 #endif
950 #ifdef SIGCHLD
951   case SIGCHLD: return "SIGCHLD";
952 #endif
953 #if defined(SIGCLD) && (!defined(SIGCHLD) || (SIGCLD != SIGCHLD))
954   case SIGCLD: return "SIGCLD";
955 #endif
956 #ifdef SIGCONT
957   case SIGCONT: return "SIGCONT";
958 #endif
959 #if defined(SIGEMT) && (!defined(SIGXCPU) || (SIGEMT != SIGXCPU))
960   case SIGEMT: return "SIGEMT";
961 #endif
962 #ifdef SIGFPE
963   case SIGFPE: return "SIGFPE";
964 #endif
965 #ifdef SIGHUP
966   case SIGHUP: return "SIGHUP";
967 #endif
968 #ifdef SIGILL
969   case SIGILL: return "SIGILL";
970 #endif
971 #ifdef SIGINT
972   case SIGINT: return "SIGINT";
973 #endif
974 #ifdef SIGIO
975   case SIGIO: return "SIGIO";
976 #endif
977 #if defined(SIGIOT) && (!defined(SIGABRT) || (SIGIOT != SIGABRT))
978   case SIGIOT: return "SIGIOT";
979 #endif
980 #ifdef SIGKILL
981   case SIGKILL: return "SIGKILL";
982 #endif
983 #if defined(SIGLOST) && (!defined(SIGIOT) || (SIGLOST != SIGIOT)) && (!defined(SIGURG) || (SIGLOST != SIGURG)) && (!defined(SIGPROF) || (SIGLOST != SIGPROF)) && (!defined(SIGIO) || (SIGLOST != SIGIO))
984   case SIGLOST: return "SIGLOST";
985 #endif
986 #ifdef SIGPIPE
987   case SIGPIPE: return "SIGPIPE";
988 #endif
989 #if defined(SIGPOLL) && (!defined(SIGIO) || (SIGPOLL != SIGIO))
990   case SIGPOLL: return "SIGPOLL";
991 #endif
992 #ifdef SIGPROF
993   case SIGPROF: return "SIGPROF";
994 #endif
995 #if defined(SIGPWR) && (!defined(SIGXFSZ) || (SIGPWR != SIGXFSZ)) && (!defined(SIGLOST) || (SIGPWR != SIGLOST))
996   case SIGPWR: return "SIGPWR";
997 #endif
998 #ifdef SIGQUIT
999   case SIGQUIT: return "SIGQUIT";
1000 #endif
1001 #ifdef SIGSEGV
1002   case SIGSEGV: return "SIGSEGV";
1003 #endif
1004 #ifdef SIGSTOP
1005   case SIGSTOP: return "SIGSTOP";
1006 #endif
1007 #ifdef SIGSYS
1008   case SIGSYS: return "SIGSYS";
1009 #endif
1010 #ifdef SIGTERM
1011   case SIGTERM: return "SIGTERM";
1012 #endif
1013 #ifdef SIGTRAP
1014   case SIGTRAP: return "SIGTRAP";
1015 #endif
1016 #ifdef SIGTSTP
1017   case SIGTSTP: return "SIGTSTP";
1018 #endif
1019 #ifdef SIGTTIN
1020   case SIGTTIN: return "SIGTTIN";
1021 #endif
1022 #ifdef SIGTTOU
1023   case SIGTTOU: return "SIGTTOU";
1024 #endif
1025 #if defined(SIGURG) && (!defined(SIGIO) || (SIGURG != SIGIO))
1026   case SIGURG: return "SIGURG";
1027 #endif
1028 #if defined(SIGUSR1) && (!defined(SIGIO) || (SIGUSR1 != SIGIO))
1029   case SIGUSR1: return "SIGUSR1";
1030 #endif
1031 #if defined(SIGUSR2) && (!defined(SIGURG) || (SIGUSR2 != SIGURG))
1032   case SIGUSR2: return "SIGUSR2";
1033 #endif
1034 #ifdef SIGVTALRM
1035   case SIGVTALRM: return "SIGVTALRM";
1036 #endif
1037 #ifdef SIGWINCH
1038   case SIGWINCH: return "SIGWINCH";
1039 #endif
1040 #ifdef SIGXCPU
1041   case SIGXCPU: return "SIGXCPU";
1042 #endif
1043 #ifdef SIGXFSZ
1044   case SIGXFSZ: return "SIGXFSZ";
1045 #endif
1046     }
1047     return "unknown signal";
1048 }
CONST char* Tcl_SignalMsg (int sig)

Definition at line 1069 of file tclPosixStr.c.
References SIGHUP, SIGPIPE, and SIGQUIT.
Referenced by TclCleanupChildren().1071 {
1072     switch (sig) {
1073 #ifdef SIGABRT
1074   case SIGABRT: return "SIGABRT";
1075 #endif
1076 #ifdef SIGALRM
1077   case SIGALRM: return "alarm clock";
1078 #endif
1079 #ifdef SIGBUS
1080   case SIGBUS: return "bus error";
1081 #endif
1082 #ifdef SIGCHLD
1083   case SIGCHLD: return "child status changed";
1084 #endif
1085 #if defined(SIGCLD) && (!defined(SIGCHLD) || (SIGCLD != SIGCHLD))
1086   case SIGCLD: return "child status changed";
1087 #endif
1088 #ifdef SIGCONT
1089   case SIGCONT: return "continue after stop";
1090 #endif
1091 #if defined(SIGEMT) && (!defined(SIGXCPU) || (SIGEMT != SIGXCPU))
1092   case SIGEMT: return "EMT instruction";
1093 #endif
1094 #ifdef SIGFPE
1095   case SIGFPE: return "floating-point exception";
1096 #endif
1097 #ifdef SIGHUP
1098   case SIGHUP: return "hangup";
1099 #endif
1100 #ifdef SIGILL
1101   case SIGILL: return "illegal instruction";
1102 #endif
1103 #ifdef SIGINT
1104   case SIGINT: return "interrupt";
1105 #endif
1106 #ifdef SIGIO
1107   case SIGIO: return "input/output possible on file";
1108 #endif
1109 #if defined(SIGIOT) && (!defined(SIGABRT) || (SIGABRT != SIGIOT))
1110   case SIGIOT: return "IOT instruction";
1111 #endif
1112 #ifdef SIGKILL
1113   case SIGKILL: return "kill signal";
1114 #endif
1115 #if defined(SIGLOST) && (!defined(SIGIOT) || (SIGLOST != SIGIOT)) && (!defined(SIGURG) || (SIGLOST != SIGURG)) && (!defined(SIGPROF) || (SIGLOST != SIGPROF)) && (!defined(SIGIO) || (SIGLOST != SIGIO))
1116   case SIGLOST: return "resource lost";
1117 #endif
1118 #ifdef SIGPIPE
1119   case SIGPIPE: return "write on pipe with no readers";
1120 #endif
1121 #if defined(SIGPOLL) && (!defined(SIGIO) || (SIGPOLL != SIGIO))
1122   case SIGPOLL: return "input/output possible on file";
1123 #endif
1124 #ifdef SIGPROF
1125   case SIGPROF: return "profiling alarm";
1126 #endif
1127 #if defined(SIGPWR) && (!defined(SIGXFSZ) || (SIGPWR != SIGXFSZ)) && (!defined(SIGLOST) || (SIGPWR != SIGLOST))
1128   case SIGPWR: return "power-fail restart";
1129 #endif
1130 #ifdef SIGQUIT
1131   case SIGQUIT: return "quit signal";
1132 #endif
1133 #ifdef SIGSEGV
1134   case SIGSEGV: return "segmentation violation";
1135 #endif
1136 #ifdef SIGSTOP
1137   case SIGSTOP: return "stop";
1138 #endif
1139 #ifdef SIGSYS
1140   case SIGSYS: return "bad argument to system call";
1141 #endif
1142 #ifdef SIGTERM
1143   case SIGTERM: return "software termination signal";
1144 #endif
1145 #ifdef SIGTRAP
1146   case SIGTRAP: return "trace trap";
1147 #endif
1148 #ifdef SIGTSTP
1149   case SIGTSTP: return "stop signal from tty";
1150 #endif
1151 #ifdef SIGTTIN
1152   case SIGTTIN: return "background tty read";
1153 #endif
1154 #ifdef SIGTTOU
1155   case SIGTTOU: return "background tty write";
1156 #endif
1157 #if defined(SIGURG) && (!defined(SIGIO) || (SIGURG != SIGIO))
1158   case SIGURG: return "urgent I/O condition";
1159 #endif
1160 #if defined(SIGUSR1) && (!defined(SIGIO) || (SIGUSR1 != SIGIO))
1161   case SIGUSR1: return "user-defined signal 1";
1162 #endif
1163 #if defined(SIGUSR2) && (!defined(SIGURG) || (SIGUSR2 != SIGURG))
1164   case SIGUSR2: return "user-defined signal 2";
1165 #endif
1166 #ifdef SIGVTALRM
1167   case SIGVTALRM: return "virtual time alarm";
1168 #endif
1169 #ifdef SIGWINCH
1170   case SIGWINCH: return "window changed";
1171 #endif
1172 #ifdef SIGXCPU
1173   case SIGXCPU: return "exceeded CPU time limit";
1174 #endif
1175 #ifdef SIGXFSZ
1176   case SIGXFSZ: return "exceeded file size limit";
1177 #endif
1178     }
1179     return "unknown signal";
1180 }

generic/tclPreserve.c File Reference
#include "tclInt.h"
Classes
struct Reference
Defines
#define INITIAL_SIZE  2
Functions
TCL_DECLARE_MUTEX (preserveMutex)
void TclFinalizePreserve ()
void Tcl_Preserve (ClientData clientData)
void Tcl_Release (ClientData clientData)
void Tcl_EventuallyFree (ClientData clientData, Tcl_FreeProc *freeProc)
TclHandle TclHandleCreate (VOID *ptr)
void TclHandleFree (TclHandle handle)
TclHandle TclHandlePreserve (TclHandle handle)
void TclHandleRelease (TclHandle handle)
Variables
static Reference * refArray
static int spaceAvl = 0
static int inUse = 0
HandleStruct

Define Documentation
#define INITIAL_SIZE  2

Definition at line 42 of file tclPreserve.c.
Function Documentation
TCL_DECLARE_MUTEX (preserveMutex)

Definition at line 43 of file tclPreserve.c.
References VOID.54                             {
55     VOID *ptr;      /* Pointer to the memory block being
56          * tracked.  This field will become NULL when
57          * the memory block is deleted.  This field
58          * must be the first in the structure. */
59 #ifdef TCL_MEM_DEBUG
60     VOID *ptr2;     /* Backup copy of the abpve pointer used to
61          * ensure that the contents of the handle are
62          * not changed by anyone else. */
63 #endif
64     int refCount;   /* Number of TclHandlePreserve() calls in
65          * effect on this handle. */
66 } HandleStruct;
void Tcl_EventuallyFree (ClientData clientData, Tcl_FreeProc * freeProc)

Definition at line 268 of file tclPreserve.c.
References Reference::clientData, inUse, Reference::mustFree, panic, refArray, and Tcl_MutexLock.
Referenced by BgErrorDeleteProc(), CloseChannel(), DeleteArray(), DeleteProc(), Tcl_DeleteInterp(), Tcl_DeleteTrace(), Tcl_PackageObjCmd(), Tcl_UnstackChannel(), Tcl_UntraceVar2(), TclDeleteNamespaceVars(), TclDeleteVars(), TclFreePackageInfo(), TcpServerCloseProc(), and UnsetVarStruct().271 {
272     Reference *refPtr;
273     int i;
274 
275     /*
276      * See if there is a reference for this pointer.  If so, set its
277      * "mustFree" flag (the flag had better not be set already!).
278      */
279 
280     Tcl_MutexLock(&preserveMutex);
281     for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
282   if (refPtr->clientData != clientData) {
283       continue;
284   }
285   if (refPtr->mustFree) {
286       panic("Tcl_EventuallyFree called twice for 0x%x\n", clientData);
287         }
288         refPtr->mustFree = 1;
289   refPtr->freeProc = freeProc;
290   Tcl_MutexUnlock(&preserveMutex);
291         return;
292     }
293     Tcl_MutexUnlock(&preserveMutex);
294 
295     /*
296      * No reference for this block.  Free it now.
297      */
298 
299     if (freeProc == TCL_DYNAMIC) {
300   ckfree((char *) clientData);
301     } else {
302   (*freeProc)((char *)clientData);
303     }
304 }
void Tcl_Preserve (ClientData clientData)

Definition at line 120 of file tclPreserve.c.
References Reference::clientData, inUse, refArray, Reference::refCount, Tcl_MutexLock, and Tcl_MutexUnlock.
Referenced by AcceptCallbackProc(), AfterProc(), AliasCreate(), AliasObjCmd(), CallCommandTraces(), CallVarTraces(), ChannelTimerProc(), CopyData(), HandleBgErrors(), SlaveEval(), SlaveInvokeHidden(), Tcl_DdeObjCmd(), Tcl_Main(), Tcl_NotifyChannel(), Tcl_UnregisterChannel(), TclChannelEventScriptInvoker(), TclCheckInterpTraces(), and TclFinalizeIOSubsystem().122 {
123     Reference *refPtr;
124     int i;
125 
126     /*
127      * See if there is already a reference for this pointer.  If so,
128      * just increment its reference count.
129      */
130 
131     Tcl_MutexLock(&preserveMutex);
132     for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
133   if (refPtr->clientData == clientData) {
134       refPtr->refCount++;
135       Tcl_MutexUnlock(&preserveMutex);
136       return;
137   }
138     }
139 
140     /*
141      * Make a reference array if it doesn't already exist, or make it
142      * bigger if it is full.
143      */
144 
145     if (inUse == spaceAvl) {
146   if (spaceAvl == 0) {
147       refArray = (Reference *) ckalloc((unsigned)
148         (INITIAL_SIZE*sizeof(Reference)));
149       spaceAvl = INITIAL_SIZE;
150   } else {
151       Reference *new;
152 
153       new = (Reference *) ckalloc((unsigned)
154         (2*spaceAvl*sizeof(Reference)));
155       memcpy((VOID *) new, (VOID *) refArray,
156                     spaceAvl*sizeof(Reference));
157       ckfree((char *) refArray);
158       refArray = new;
159       spaceAvl *= 2;
160   }
161     }
162 
163     /*
164      * Make a new entry for the new reference.
165      */
166 
167     refPtr = &refArray[inUse];
168     refPtr->clientData = clientData;
169     refPtr->refCount = 1;
170     refPtr->mustFree = 0;
171     refPtr->freeProc = TCL_STATIC;
172     inUse += 1;
173     Tcl_MutexUnlock(&preserveMutex);
174 }
void Tcl_Release (ClientData clientData)

Definition at line 197 of file tclPreserve.c.
References ckfree, Reference::clientData, Reference::freeProc, inUse, Reference::mustFree, refArray, Reference::refCount, TCL_DYNAMIC, Tcl_MutexLock, and Tcl_MutexUnlock.
Referenced by AcceptCallbackProc(), AfterProc(), AliasCreate(), AliasObjCmd(), CallCommandTraces(), CallVarTraces(), ChannelTimerProc(), CopyData(), HandleBgErrors(), SlaveEval(), SlaveInvokeHidden(), Tcl_DdeObjCmd(), Tcl_Main(), Tcl_NotifyChannel(), Tcl_UnregisterChannel(), TclChannelEventScriptInvoker(), TclCheckInterpTraces(), and TclFinalizeIOSubsystem().199 {
200     Reference *refPtr;
201     int mustFree;
202     Tcl_FreeProc *freeProc;
203     int i;
204 
205     Tcl_MutexLock(&preserveMutex);
206     for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
207   if (refPtr->clientData != clientData) {
208       continue;
209   }
210   refPtr->refCount--;
211   if (refPtr->refCount == 0) {
212 
213             /*
214              * Must remove information from the slot before calling freeProc
215              * to avoid reentrancy problems if the freeProc calls Tcl_Preserve
216              * on the same clientData. Copy down the last reference in the
217              * array to overwrite the current slot.
218              */
219 
220             freeProc = refPtr->freeProc;
221             mustFree = refPtr->mustFree;
222       inUse--;
223       if (i < inUse) {
224     refArray[i] = refArray[inUse];
225       }
226       if (mustFree) {
227     if (freeProc == TCL_DYNAMIC) {
228         ckfree((char *) clientData);
229     } else {
230         Tcl_MutexUnlock(&preserveMutex);
231         (*freeProc)((char *) clientData);
232         return;
233     }
234       }
235   }
236   Tcl_MutexUnlock(&preserveMutex);
237   return;
238     }
239     Tcl_MutexUnlock(&preserveMutex);
240 
241     /*
242      * Reference not found.  This is a bug in the caller.
243      */
244 
245     panic("Tcl_Release couldn't find reference for 0x%x", clientData);
246 }
void TclFinalizePreserve ()

Definition at line 88 of file tclPreserve.c.
References ckfree, inUse, NULL, refArray, spaceAvl, Tcl_MutexLock, and Tcl_MutexUnlock.
Referenced by Tcl_Finalize().89 {
90     Tcl_MutexLock(&preserveMutex);
91     if (spaceAvl != 0) {
92         ckfree((char *) refArray);
93         refArray = (Reference *) NULL;
94         inUse = 0;
95         spaceAvl = 0;
96     }
97     Tcl_MutexUnlock(&preserveMutex);
98 }
TclHandle TclHandleCreate (VOID * ptr)

Definition at line 333 of file tclPreserve.c.
References ckalloc, and HandleStruct.
Referenced by Tcl_CreateInterp().337 {
338     HandleStruct *handlePtr;
339 
340     handlePtr = (HandleStruct *) ckalloc(sizeof(HandleStruct));
341     handlePtr->ptr = ptr;
342 #ifdef TCL_MEM_DEBUG
343     handlePtr->ptr2 = ptr;
344 #endif
345     handlePtr->refCount = 0;
346     return (TclHandle) handlePtr;
347 }
void TclHandleFree (TclHandle handle)

Definition at line 370 of file tclPreserve.c.
References ckfree, HandleStruct, NULL, and panic.
Referenced by DeleteInterpProc().375 {
376     HandleStruct *handlePtr;
377 
378     handlePtr = (HandleStruct *) handle;
379 #ifdef TCL_MEM_DEBUG
380     if (handlePtr->refCount == 0x61616161) {
381   panic("using previously disposed TclHandle %x", handlePtr);
382     }
383     if (handlePtr->ptr2 != handlePtr->ptr) {
384   panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
385     handlePtr, handlePtr->ptr2, handlePtr->ptr);
386     }
387 #endif
388     handlePtr->ptr = NULL;
389     if (handlePtr->refCount == 0) {
390   ckfree((char *) handlePtr);
391     }
392 }
TclHandle TclHandlePreserve (TclHandle handle)

Definition at line 415 of file tclPreserve.c.
References HandleStruct, NULL, and panic.
Referenced by TclInitByteCodeObj().418 {
419     HandleStruct *handlePtr;
420 
421     handlePtr = (HandleStruct *) handle;
422 #ifdef TCL_MEM_DEBUG
423     if (handlePtr->refCount == 0x61616161) {
424   panic("using previously disposed TclHandle %x", handlePtr);
425     }
426     if ((handlePtr->ptr != NULL)
427       && (handlePtr->ptr != handlePtr->ptr2)) {
428   panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
429     handlePtr, handlePtr->ptr2, handlePtr->ptr);
430     }
431 #endif
432     handlePtr->refCount++;
433 
434     return handle;
435 }
void TclHandleRelease (TclHandle handle)

Definition at line 457 of file tclPreserve.c.
References ckfree, HandleStruct, NULL, and panic.460 {
461     HandleStruct *handlePtr;
462 
463     handlePtr = (HandleStruct *) handle;
464 #ifdef TCL_MEM_DEBUG
465     if (handlePtr->refCount == 0x61616161) {
466   panic("using previously disposed TclHandle %x", handlePtr);
467     }
468     if ((handlePtr->ptr != NULL)
469       && (handlePtr->ptr != handlePtr->ptr2)) {
470   panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
471     handlePtr, handlePtr->ptr2, handlePtr->ptr);
472     }
473 #endif
474     handlePtr->refCount--;
475     if ((handlePtr->refCount == 0) && (handlePtr->ptr == NULL)) {
476   ckfree((char *) handlePtr);
477     }
478 }

Variable Documentation
HandleStruct

Definition at line 66 of file tclPreserve.c.
Referenced by TclHandleCreate(), TclHandleFree(), TclHandlePreserve(), and TclHandleRelease().int inUse = 0 [static]

Definition at line 40 of file tclPreserve.c.
Referenced by Tcl_EventuallyFree(), Tcl_Preserve(), Tcl_Release(), and TclFinalizePreserve().Reference* refArray [static]

Definition at line 37 of file tclPreserve.c.
Referenced by Tcl_EventuallyFree(), Tcl_Preserve(), Tcl_Release(), and TclFinalizePreserve().int spaceAvl = 0 [static]

Definition at line 38 of file tclPreserve.c.
Referenced by TclFinalizePreserve().

generic/tclProc.c File Reference
#include "tclInt.h"
#include "tclCompile.h"
Defines
#define NUM_ARGS  20
#define NUM_LOCALS  20
Functions
static void ProcBodyDup _ANSI_ARGS_ ((Tcl_Obj *srcPtr, Tcl_Obj *dupPtr))
static void ProcBodyFree _ANSI_ARGS_ ((Tcl_Obj *objPtr))
static int ProcBodySetFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
static int ProcCompileProc _ANSI_ARGS_ ((Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description, CONST char *procName, Proc **procPtrPtr))
static int ProcessProcResultCode _ANSI_ARGS_ ((Tcl_Interp *interp, char *procName, int nameLen, int returnCode))
static int TclCompileNoOp _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Parse *parsePtr, struct CompileEnv *envPtr))
int Tcl_ProcObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int TclCreateProc (Tcl_Interp *interp, Namespace *nsPtr, CONST char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr)
int TclGetFrame (Tcl_Interp *interp, CONST char *string, CallFrame **framePtrPtr)
int Tcl_UplevelObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
Proc * TclFindProc (Interp *iPtr, CONST char *procName)
Proc * TclIsProc (Command *cmdPtr)
int TclProcInterpProc (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
int TclObjInterpProc (ClientData clientData, Tcl_Interp *interp, int objc, objv)
int TclProcCompileProc (Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description, CONST char *procName)
static int ProcCompileProc (Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description, CONST char *procName, Proc **procPtrPtr)
static int ProcessProcResultCode (Tcl_Interp *interp, char *procName, int nameLen, int returnCode)
void TclProcDeleteProc (ClientData clientData)
void TclProcCleanupProc (Proc *procPtr)
int TclUpdateReturnInfo (Interp *iPtr)
TclCmdProcType TclGetInterpProc ()
TclObjCmdProcType TclGetObjInterpProc ()
Tcl_Obj * TclNewProcBodyObj (Proc *procPtr)
static void ProcBodyDup (Tcl_Obj *srcPtr, Tcl_Obj *dupPtr)
static void ProcBodyFree (Tcl_Obj *objPtr)
static int ProcBodySetFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr)
static void ProcBodyUpdateString (Tcl_Obj *objPtr)
static int TclCompileNoOp (Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)
Variables
Tcl_ObjType tclProcBodyType

Define Documentation
#define NUM_ARGS  20
#define NUM_LOCALS  20

Referenced by TclObjInterpProc().
Function Documentation
static int TclCompileNoOp _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Parse *parsePtr, struct CompileEnv *envPtr)) [static]
static int ProcessProcResultCode _ANSI_ARGS_ ((Tcl_Interp *interp, char *procName, int nameLen, int returnCode)) [static]
static int ProcCompileProc _ANSI_ARGS_ ((Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description, CONST char *procName, Proc **procPtrPtr)) [static]
static int ProcBodySetFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr)) [static]
static void ProcBodyFree _ANSI_ARGS_ ((Tcl_Obj *objPtr)) [static]
static void ProcBodyDup _ANSI_ARGS_ ((Tcl_Obj *srcPtr, Tcl_Obj *dupPtr)) [static]
static void ProcBodyDup (Tcl_Obj * srcPtr, Tcl_Obj * dupPtr) [static]

Definition at line 1682 of file tclProc.c.
References Tcl_Obj::internalRep, Tcl_Obj::otherValuePtr, Proc::refCount, tclProcBodyType, Tcl_Obj::typePtr, and VOID.1685 {
1686     Proc *procPtr = (Proc *) srcPtr->internalRep.otherValuePtr;
1687     
1688     dupPtr->typePtr = &tclProcBodyType;
1689     dupPtr->internalRep.otherValuePtr = (VOID *) procPtr;
1690     procPtr->refCount++;
1691 }
static void ProcBodyFree (Tcl_Obj * objPtr) [static]

Definition at line 1712 of file tclProc.c.
References Proc::refCount, and TclProcCleanupProc().1714 {
1715     Proc *procPtr = (Proc *) objPtr->internalRep.otherValuePtr;
1716     procPtr->refCount--;
1717     if (procPtr->refCount <= 0) {
1718         TclProcCleanupProc(procPtr);
1719     }
1720 }
static int ProcBodySetFromAny (Tcl_Interp * interp, Tcl_Obj * objPtr) [static]

Definition at line 1741 of file tclProc.c.
References panic, and TCL_OK.1744 {
1745     panic("called ProcBodySetFromAny");
1746 
1747     /*
1748      * this to keep compilers happy.
1749      */
1750     
1751     return TCL_OK;
1752 }
static void ProcBodyUpdateString (Tcl_Obj * objPtr) [static]

Definition at line 1772 of file tclProc.c.
References panic.1774 {
1775     panic("called ProcBodyUpdateString");
1776 }
static int ProcCompileProc (Tcl_Interp * interp, Proc * procPtr, Tcl_Obj * bodyPtr, Namespace * nsPtr, CONST char * description, CONST char * procName, Proc ** procPtrPtr) [static]

Definition at line 1165 of file tclProc.c.
References ckalloc, Proc::cmdPtr, Interp::compiledProcPtr, Interp::compileEpoch, ByteCode::compileEpoch, Proc::firstLocalPtr, ByteCode::flags, Tcl_ObjType::freeIntRepProc, Tcl_Obj::internalRep, ByteCode::interpHandle, Proc::iPtr, ByteCode::nsPtr, NULL, Proc::numArgs, Tcl_Obj::otherValuePtr, Proc::refCount, TCL_BYTECODE_PRECOMPILED, Tcl_DuplicateObj(), TCL_ERROR, Tcl_GetCommandInfoFromToken(), Tcl_IncrRefCount, Tcl_SetCommandInfoFromToken(), tclByteCodeType, and Tcl_Obj::typePtr.
Referenced by TclObjInterpProc(), and TclProcCompileProc().1178 {
1179     Interp *iPtr = (Interp*)interp;
1180     int i, result;
1181     Tcl_CallFrame frame;
1182     Proc *saveProcPtr;
1183     ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
1184     CompiledLocal *localPtr;
1185  
1186     /*
1187      * If necessary, compile the procedure's body. The compiler will
1188      * allocate frame slots for the procedure's non-argument local
1189      * variables. If the ByteCode already exists, make sure it hasn't been
1190      * invalidated by someone redefining a core command (this might make the
1191      * compiled code wrong). Also, if the code was compiled in/for a
1192      * different interpreter, we recompile it. Note that compiling the body
1193      * might increase procPtr->numCompiledLocals if new local variables are
1194      * found while compiling.
1195      *
1196      * Precompiled procedure bodies, however, are immutable and therefore
1197      * they are not recompiled, even if things have changed.
1198      */
1199  
1200     if (bodyPtr->typePtr == &tclByteCodeType) {
1201   if (((Interp *) *codePtr->interpHandle != iPtr)
1202           || (codePtr->compileEpoch != iPtr->compileEpoch)
1203           || (codePtr->nsPtr != nsPtr)) {
1204             if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
1205                 if ((Interp *) *codePtr->interpHandle != iPtr) {
1206                     Tcl_AppendResult(interp,
1207                             "a precompiled script jumped interps", NULL);
1208                     return TCL_ERROR;
1209                 }
1210           codePtr->compileEpoch = iPtr->compileEpoch;
1211                 codePtr->nsPtr = nsPtr;
1212             } else {
1213                 (*tclByteCodeType.freeIntRepProc)(bodyPtr);
1214                 bodyPtr->typePtr = (Tcl_ObjType *) NULL;
1215             }
1216   }
1217     }
1218     if (bodyPtr->typePtr != &tclByteCodeType) {
1219   int numChars;
1220   char *ellipsis;
1221   
1222 #ifdef TCL_COMPILE_DEBUG
1223   if (tclTraceCompile >= 1) {
1224       /*
1225        * Display a line summarizing the top level command we
1226        * are about to compile.
1227        */
1228  
1229       numChars = strlen(procName);
1230       ellipsis = "";
1231       if (numChars > 50) {
1232     numChars = 50;
1233     ellipsis = "...";
1234       }
1235       fprintf(stdout, "Compiling %s \"%.*s%s\"\n",
1236         description, numChars, procName, ellipsis);
1237   }
1238 #endif
1239   
1240   /*
1241    * Plug the current procPtr into the interpreter and coerce
1242    * the code body to byte codes.  The interpreter needs to
1243    * know which proc it's compiling so that it can access its
1244    * list of compiled locals.
1245    *
1246    * TRICKY NOTE:  Be careful to push a call frame with the
1247    *   proper namespace context, so that the byte codes are
1248    *   compiled in the appropriate class context.
1249    */
1250 
1251   saveProcPtr = iPtr->compiledProcPtr;
1252 
1253   if (procPtrPtr != NULL && procPtr->refCount > 1) {
1254       Tcl_Command token;
1255       Tcl_CmdInfo info;
1256       Proc *new = (Proc *) ckalloc(sizeof(Proc));
1257 
1258       new->iPtr = procPtr->iPtr;
1259       new->refCount = 1;
1260       new->cmdPtr = procPtr->cmdPtr;
1261       token = (Tcl_Command) new->cmdPtr;
1262       new->bodyPtr = Tcl_DuplicateObj(bodyPtr);
1263       bodyPtr = new->bodyPtr;
1264       Tcl_IncrRefCount(bodyPtr);
1265       new->numArgs = procPtr->numArgs;
1266 
1267       new->numCompiledLocals = new->numArgs;
1268       new->firstLocalPtr = NULL;
1269       new->lastLocalPtr = NULL;
1270       localPtr = procPtr->firstLocalPtr;
1271       for (i = 0; i < new->numArgs; i++, localPtr = localPtr->nextPtr) {
1272     CompiledLocal *copy = (CompiledLocal *) ckalloc((unsigned)
1273       (sizeof(CompiledLocal) -sizeof(localPtr->name)
1274        + localPtr->nameLength + 1));
1275     if (new->firstLocalPtr == NULL) {
1276         new->firstLocalPtr = new->lastLocalPtr = copy;
1277     } else {
1278         new->lastLocalPtr->nextPtr = copy;
1279         new->lastLocalPtr = copy;
1280     }
1281     copy->nextPtr = NULL;
1282     copy->nameLength = localPtr->nameLength;
1283     copy->frameIndex = localPtr->frameIndex;
1284     copy->flags = localPtr->flags;
1285     copy->defValuePtr = localPtr->defValuePtr;
1286     if (copy->defValuePtr) {
1287         Tcl_IncrRefCount(copy->defValuePtr);
1288     }
1289     copy->resolveInfo = localPtr->resolveInfo;
1290     strcpy(copy->name, localPtr->name);
1291       }
1292 
1293 
1294       /* Reset the ClientData */
1295       Tcl_GetCommandInfoFromToken(token, &info);
1296       if (info.objClientData == (ClientData) procPtr) {
1297           info.objClientData = (ClientData) new;
1298       }
1299       if (info.clientData == (ClientData) procPtr) {
1300           info.clientData = (ClientData) new;
1301       }
1302       if (info.deleteData == (ClientData) procPtr) {
1303           info.deleteData = (ClientData) new;
1304       }
1305       Tcl_SetCommandInfoFromToken(token, &info);
1306 
1307       procPtr->refCount--;
1308       *procPtrPtr = procPtr = new;
1309   }
1310   iPtr->compiledProcPtr = procPtr;
1311  
1312   result = Tcl_PushCallFrame(interp, &frame,
1313     (Tcl_Namespace*)nsPtr, /* isProcCallFrame */ 0);
1314  
1315   if (result == TCL_OK) {
1316       result = tclByteCodeType.setFromAnyProc(interp, bodyPtr);
1317       Tcl_PopCallFrame(interp);
1318   }
1319  
1320   iPtr->compiledProcPtr = saveProcPtr;
1321   
1322   if (result != TCL_OK) {
1323       if (result == TCL_ERROR) {
1324     char buf[100 + TCL_INTEGER_SPACE];
1325 
1326     numChars = strlen(procName);
1327     ellipsis = "";
1328     if (numChars > 50) {
1329         numChars = 50;
1330         ellipsis = "...";
1331     }
1332     while ( (procName[numChars] & 0xC0) == 0x80 ) {
1333               /*
1334          * Back up truncation point so that we don't truncate
1335          * in the middle of a multi-byte character (in UTF-8)
1336          */
1337         numChars--;
1338         ellipsis = "...";
1339     }
1340     sprintf(buf, "\n    (compiling %s \"%.*s%s\", line %d)",
1341       description, numChars, procName, ellipsis,
1342       interp->errorLine);
1343     Tcl_AddObjErrorInfo(interp, buf, -1);
1344       }
1345       return result;
1346   }
1347     } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
1348   
1349   /*
1350    * The resolver epoch has changed, but we only need to invalidate
1351    * the resolver cache.
1352    */
1353 
1354   for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
1355       localPtr = localPtr->nextPtr) {
1356       localPtr->flags &= ~(VAR_RESOLVED);
1357       if (localPtr->resolveInfo) {
1358     if (localPtr->resolveInfo->deleteProc) {
1359         localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
1360     } else {
1361         ckfree((char*)localPtr->resolveInfo);
1362     }
1363     localPtr->resolveInfo = NULL;
1364       }
1365   }
1366     }
1367     return TCL_OK;
1368 }
static int ProcessProcResultCode (Tcl_Interp * interp, char * procName, int nameLen, int returnCode) [static]

Definition at line 1392 of file tclProc.c.
References Interp::errorLine, Tcl_AddObjErrorInfo(), Tcl_AppendToObj(), TCL_BREAK, TCL_CONTINUE, TCL_ERROR, Tcl_GetObjResult(), TCL_INTEGER_SPACE, TCL_OK, Tcl_ResetResult(), TCL_RETURN, and TclUpdateReturnInfo().1399 {
1400     Interp *iPtr = (Interp *) interp;
1401     char msg[100 + TCL_INTEGER_SPACE];
1402     char *ellipsis = "";
1403 
1404     if (returnCode == TCL_OK) {
1405   return TCL_OK;
1406     }
1407     if ((returnCode > TCL_CONTINUE) || (returnCode < TCL_OK)) {
1408   return returnCode;
1409     }
1410     if (returnCode == TCL_RETURN) {
1411   return TclUpdateReturnInfo(iPtr);
1412     } 
1413     if (returnCode != TCL_ERROR) {
1414   Tcl_ResetResult(interp);
1415   Tcl_AppendToObj(Tcl_GetObjResult(interp), ((returnCode == TCL_BREAK) 
1416     ? "invoked \"break\" outside of a loop"
1417     : "invoked \"continue\" outside of a loop"), -1);
1418     }
1419     if (nameLen > 60) {
1420   nameLen = 60;
1421   ellipsis = "...";
1422     }
1423     while ( (procName[nameLen] & 0xC0) == 0x80 ) {
1424         /*
1425    * Back up truncation point so that we don't truncate in the
1426    * middle of a multi-byte character (in UTF-8)
1427    */
1428   nameLen--;
1429   ellipsis = "...";
1430     }
1431     sprintf(msg, "\n    (procedure \"%.*s%s\" line %d)", nameLen, procName,
1432       ellipsis, iPtr->errorLine);
1433     Tcl_AddObjErrorInfo(interp, msg, -1);
1434     return TCL_ERROR;
1435 }
int Tcl_ProcObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 68 of file tclProc.c.
References CONST, Namespace::fullName, Interp::globalNsPtr, NULL, Tcl_CreateCommand(), Tcl_CreateObjCommand(), Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), TCL_OK, Tcl_WrongNumArgs(), TclCompileNoOp(), TclCreateProc(), TclGetNamespaceForQualName(), TclGetString, TclObjInterpProc(), tclProcBodyType, TclProcDeleteProc(), TclProcInterpProc(), and UCHAR.
Referenced by ProcBodyTestProcObjCmd().73 {
74     register Interp *iPtr = (Interp *) interp;
75     Proc *procPtr;
76     char *fullName;
77     CONST char *procName, *procArgs, *procBody;
78     Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
79     Tcl_Command cmd;
80     Tcl_DString ds;
81 
82     if (objc != 4) {
83   Tcl_WrongNumArgs(interp, 1, objv, "name args body");
84   return TCL_ERROR;
85     }
86 
87     /*
88      * Determine the namespace where the procedure should reside. Unless
89      * the command name includes namespace qualifiers, this will be the
90      * current namespace.
91      */
92     
93     fullName = TclGetString(objv[1]);
94     TclGetNamespaceForQualName(interp, fullName, (Namespace *) NULL,
95       0, &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
96 
97     if (nsPtr == NULL) {
98         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
99     "can't create procedure \"", fullName,
100     "\": unknown namespace", (char *) NULL);
101         return TCL_ERROR;
102     }
103     if (procName == NULL) {
104   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
105     "can't create procedure \"", fullName,
106     "\": bad procedure name", (char *) NULL);
107         return TCL_ERROR;
108     }
109     if ((nsPtr != iPtr->globalNsPtr)
110       && (procName != NULL) && (procName[0] == ':')) {
111   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
112     "can't create procedure \"", procName,
113     "\" in non-global namespace with name starting with \":\"",
114           (char *) NULL);
115         return TCL_ERROR;
116     }
117 
118     /*
119      *  Create the data structure to represent the procedure.
120      */
121     if (TclCreateProc(interp, nsPtr, procName, objv[2], objv[3],
122         &procPtr) != TCL_OK) {
123         return TCL_ERROR;
124     }
125 
126     /*
127      * Now create a command for the procedure. This will initially be in
128      * the current namespace unless the procedure's name included namespace
129      * qualifiers. To create the new command in the right namespace, we
130      * generate a fully qualified name for it.
131      */
132 
133     Tcl_DStringInit(&ds);
134     if (nsPtr != iPtr->globalNsPtr) {
135   Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
136   Tcl_DStringAppend(&ds, "::", 2);
137     }
138     Tcl_DStringAppend(&ds, procName, -1);
139     
140     Tcl_CreateCommand(interp, Tcl_DStringValue(&ds), TclProcInterpProc,
141       (ClientData) procPtr, TclProcDeleteProc);
142     cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds),
143       TclObjInterpProc, (ClientData) procPtr, TclProcDeleteProc);
144 
145     Tcl_DStringFree(&ds);
146     /*
147      * Now initialize the new procedure's cmdPtr field. This will be used
148      * later when the procedure is called to determine what namespace the
149      * procedure will run in. This will be different than the current
150      * namespace if the proc was renamed into a different namespace.
151      */
152     
153     procPtr->cmdPtr = (Command *) cmd;
154 
155 
156     /*
157      * Optimize for noop procs: if the body is not precompiled (like a TclPro
158      * procbody), and the argument list is just "args" and the body is empty,
159      * define a compileProc to compile a noop.
160      *
161      * Notes: 
162      *   - cannot be done for any argument list without having different
163      *     compiled/not-compiled behaviour in the "wrong argument #" case, 
164      *     or making this code much more complicated. In any case, it doesn't 
165      *     seem to make a lot of sense to verify the number of arguments we 
166      *     are about to ignore ...
167      *   - could be enhanced to handle also non-empty bodies that contain 
168      *     only comments; however, parsing the body will slow down the 
169      *     compilation of all procs whose argument list is just _args_ */
170 
171     if (objv[3]->typePtr == &tclProcBodyType) {
172   goto done;
173     }
174 
175     procArgs = Tcl_GetString(objv[2]);
176     
177     while (*procArgs == ' ') {
178   procArgs++;
179     }
180     
181     if ((procArgs[0] == 'a') && (strncmp(procArgs, "args", 4) == 0)) {
182   procArgs +=4;
183   while(*procArgs != '\0') {
184       if (*procArgs != ' ') {
185     goto done;
186       }
187       procArgs++;
188   } 
189   
190   /* 
191    * The argument list is just "args"; check the body
192    */
193   
194   procBody = Tcl_GetString(objv[3]);
195   while (*procBody != '\0') {
196       if (!isspace(UCHAR(*procBody))) {
197     goto done;
198       }
199       procBody++;
200   } 
201   
202   /* 
203    * The body is just spaces: link the compileProc
204    */
205   
206   ((Command *) cmd)->compileProc = TclCompileNoOp;
207     }
208 
209  done:
210     return TCL_OK;
211 }
int Tcl_UplevelObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 634 of file tclProc.c.
References Tcl_Interp::errorLine, Tcl_AddObjErrorInfo(), Tcl_ConcatObj(), TCL_ERROR, TCL_EVAL_DIRECT, Tcl_EvalObjEx(), TCL_INTEGER_SPACE, Tcl_WrongNumArgs(), TclGetFrame(), TclGetString, and Interp::varFramePtr.639 {
640     register Interp *iPtr = (Interp *) interp;
641     char *optLevel;
642     int result;
643     CallFrame *savedVarFramePtr, *framePtr;
644 
645     if (objc < 2) {
646   uplevelSyntax:
647   Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?");
648   return TCL_ERROR;
649     }
650 
651     /*
652      * Find the level to use for executing the command.
653      */
654 
655     optLevel = TclGetString(objv[1]);
656     result = TclGetFrame(interp, optLevel, &framePtr);
657     if (result == -1) {
658   return TCL_ERROR;
659     }
660     objc -= (result+1);
661     if (objc == 0) {
662   goto uplevelSyntax;
663     }
664     objv += (result+1);
665 
666     /*
667      * Modify the interpreter state to execute in the given frame.
668      */
669 
670     savedVarFramePtr = iPtr->varFramePtr;
671     iPtr->varFramePtr = framePtr;
672 
673     /*
674      * Execute the residual arguments as a command.
675      */
676 
677     if (objc == 1) {
678   result = Tcl_EvalObjEx(interp, objv[0], TCL_EVAL_DIRECT);
679     } else {
680   /*
681    * More than one argument: concatenate them together with spaces
682    * between, then evaluate the result.  Tcl_EvalObjEx will delete
683    * the object when it decrements its refcount after eval'ing it.
684    */
685   Tcl_Obj *objPtr;
686 
687   objPtr = Tcl_ConcatObj(objc, objv);
688   result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
689     }
690     if (result == TCL_ERROR) {
691   char msg[32 + TCL_INTEGER_SPACE];
692   sprintf(msg, "\n    (\"uplevel\" body line %d)", interp->errorLine);
693   Tcl_AddObjErrorInfo(interp, msg, -1);
694     }
695 
696     /*
697      * Restore the variable frame, and return.
698      */
699 
700     iPtr->varFramePtr = savedVarFramePtr;
701     return result;
702 }
static int TclCompileNoOp (Tcl_Interp * interp, Tcl_Parse * parsePtr, CompileEnv * envPtr) [static]

Definition at line 1796 of file tclProc.c.
References CompileEnv::currStackDepth, INST_POP, Tcl_Token::numComponents, Tcl_Parse::numWords, TCL_OK, TCL_TOKEN_SIMPLE_WORD, TclCompileTokens(), TclEmitOpcode, Tcl_Parse::tokenPtr, and Tcl_Token::type.
Referenced by Tcl_ProcObjCmd().1801 {
1802     Tcl_Token *tokenPtr;
1803     int i, code;
1804     int savedStackDepth = envPtr->currStackDepth;
1805 
1806     tokenPtr = parsePtr->tokenPtr;
1807     for(i = 1; i < parsePtr->numWords; i++) {
1808   tokenPtr = tokenPtr + tokenPtr->numComponents + 1;
1809   envPtr->currStackDepth = savedStackDepth;
1810 
1811   if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { 
1812       code = TclCompileTokens(interp, tokenPtr+1,
1813               tokenPtr->numComponents, envPtr);
1814       if (code != TCL_OK) {
1815     return code;
1816       }
1817       TclEmitOpcode(INST_POP, envPtr);
1818   } 
1819     }
1820     envPtr->currStackDepth = savedStackDepth;
1821     TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
1822     return TCL_OK;
1823 }
int TclCreateProc (Tcl_Interp * interp, Namespace * nsPtr, CONST char * procName, Tcl_Obj * argsPtr, Tcl_Obj * bodyPtr, Proc ** procPtrPtr)

Definition at line 237 of file tclProc.c.
References Proc::bodyPtr, ckalloc, ckfree, CONST, CompiledLocal::defValuePtr, Proc::firstLocalPtr, CompiledLocal::flags, CompiledLocal::frameIndex, Tcl_Obj::internalRep, Proc::iPtr, Proc::lastLocalPtr, CompiledLocal::name, CompiledLocal::nameLength, CompiledLocal::nextPtr, NULL, Proc::numArgs, Proc::numCompiledLocals, Tcl_Obj::otherValuePtr, Proc::refCount, CompiledLocal::resolveInfo, size_t(), Tcl_DecrRefCount, TCL_ERROR, Tcl_GetObjResult(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, TCL_INTEGER_SPACE, Tcl_IsShared, Tcl_NewStringObj(), TCL_OK, Tcl_SplitList(), tclProcBodyType, Tcl_Obj::typePtr, VAR_ARGUMENT, VAR_SCALAR, and VAR_UNDEFINED.
Referenced by Tcl_ProcObjCmd().243                                           :  pointer to proc data */
244 {
245     Interp *iPtr = (Interp*)interp;
246     CONST char **argArray = NULL;
247 
248     register Proc *procPtr;
249     int i, length, result, numArgs;
250     CONST char *args, *bytes, *p;
251     register CompiledLocal *localPtr = NULL;
252     Tcl_Obj *defPtr;
253     int precompiled = 0;
254     
255     if (bodyPtr->typePtr == &tclProcBodyType) {
256         /*
257          * Because the body is a TclProProcBody, the actual body is already
258          * compiled, and it is not shared with anyone else, so it's OK not to
259          * unshare it (as a matter of fact, it is bad to unshare it, because
260          * there may be no source code).
261          *
262          * We don't create and initialize a Proc structure for the procedure;
263          * rather, we use what is in the body object. Note that
264          * we initialize its cmdPtr field below after we've created the command
265          * for the procedure. We increment the ref count of the Proc struct
266          * since the command (soon to be created) will be holding a reference
267          * to it.
268          */
269     
270         procPtr = (Proc *) bodyPtr->internalRep.otherValuePtr;
271         procPtr->iPtr = iPtr;
272         procPtr->refCount++;
273         precompiled = 1;
274     } else {
275         /*
276          * If the procedure's body object is shared because its string value is
277          * identical to, e.g., the body of another procedure, we must create a
278          * private copy for this procedure to use. Such sharing of procedure
279          * bodies is rare but can cause problems. A procedure body is compiled
280          * in a context that includes the number of compiler-allocated "slots"
281          * for local variables. Each formal parameter is given a local variable
282          * slot (the "procPtr->numCompiledLocals = numArgs" assignment
283          * below). This means that the same code can not be shared by two
284          * procedures that have a different number of arguments, even if their
285          * bodies are identical. Note that we don't use Tcl_DuplicateObj since
286          * we would not want any bytecode internal representation.
287          */
288 
289         if (Tcl_IsShared(bodyPtr)) {
290             bytes = Tcl_GetStringFromObj(bodyPtr, &length);
291             bodyPtr = Tcl_NewStringObj(bytes, length);
292         }
293 
294         /*
295          * Create and initialize a Proc structure for the procedure. Note that
296          * we initialize its cmdPtr field below after we've created the command
297          * for the procedure. We increment the ref count of the procedure's
298          * body object since there will be a reference to it in the Proc
299          * structure.
300          */
301     
302         Tcl_IncrRefCount(bodyPtr);
303 
304         procPtr = (Proc *) ckalloc(sizeof(Proc));
305         procPtr->iPtr = iPtr;
306         procPtr->refCount = 1;
307         procPtr->bodyPtr = bodyPtr;
308         procPtr->numArgs  = 0;  /* actual argument count is set below. */
309         procPtr->numCompiledLocals = 0;
310         procPtr->firstLocalPtr = NULL;
311         procPtr->lastLocalPtr = NULL;
312     }
313     
314     /*
315      * Break up the argument list into argument specifiers, then process
316      * each argument specifier.
317      * If the body is precompiled, processing is limited to checking that
318      * the the parsed argument is consistent with the one stored in the
319      * Proc.
320      * THIS FAILS IF THE ARG LIST OBJECT'S STRING REP CONTAINS NULLS.
321      */
322 
323     args = Tcl_GetStringFromObj(argsPtr, &length);
324     result = Tcl_SplitList(interp, args, &numArgs, &argArray);
325     if (result != TCL_OK) {
326         goto procError;
327     }
328 
329     if (precompiled) {
330         if (numArgs > procPtr->numArgs) {
331             char buf[64 + TCL_INTEGER_SPACE + TCL_INTEGER_SPACE];
332             sprintf(buf, "\": arg list contains %d entries, precompiled header expects %d",
333                     numArgs, procPtr->numArgs);
334             Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
335                     "procedure \"", procName,
336                     buf, (char *) NULL);
337             goto procError;
338         }
339         localPtr = procPtr->firstLocalPtr;
340     } else {
341         procPtr->numArgs = numArgs;
342         procPtr->numCompiledLocals = numArgs;
343     }
344     for (i = 0;  i < numArgs;  i++) {
345         int fieldCount, nameLength, valueLength;
346         CONST char **fieldValues;
347 
348         /*
349          * Now divide the specifier up into name and default.
350          */
351 
352         result = Tcl_SplitList(interp, argArray[i], &fieldCount,
353                 &fieldValues);
354         if (result != TCL_OK) {
355             goto procError;
356         }
357         if (fieldCount > 2) {
358             ckfree((char *) fieldValues);
359             Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
360                     "too many fields in argument specifier \"",
361                     argArray[i], "\"", (char *) NULL);
362             goto procError;
363         }
364         if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
365             ckfree((char *) fieldValues);
366             Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
367                     "procedure \"", procName,
368                     "\" has argument with no name", (char *) NULL);
369             goto procError;
370         }
371   
372         nameLength = strlen(fieldValues[0]);
373         if (fieldCount == 2) {
374             valueLength = strlen(fieldValues[1]);
375         } else {
376             valueLength = 0;
377         }
378 
379         /*
380          * Check that the formal parameter name is a scalar.
381          */
382 
383         p = fieldValues[0];
384         while (*p != '\0') {
385             if (*p == '(') {
386                 CONST char *q = p;
387                 do {
388         q++;
389     } while (*q != '\0');
390     q--;
391     if (*q == ')') { /* we have an array element */
392         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
393                 "procedure \"", procName,
394                 "\" has formal parameter \"", fieldValues[0],
395           "\" that is an array element",
396           (char *) NULL);
397         ckfree((char *) fieldValues);
398         goto procError;
399     }
400       } else if ((*p == ':') && (*(p+1) == ':')) {
401     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
402             "procedure \"", procName,
403             "\" has formal parameter \"", fieldValues[0],
404       "\" that is not a simple name",
405       (char *) NULL);
406     ckfree((char *) fieldValues);
407     goto procError;
408       }
409       p++;
410   }
411 
412   if (precompiled) {
413       /*
414        * Compare the parsed argument with the stored one.
415        * For the flags, we and out VAR_UNDEFINED to support bridging
416        * precompiled <= 8.3 code in 8.4 where this is now used as an
417        * optimization indicator.  Yes, this is a hack. -- hobbs
418        */
419 
420       if ((localPtr->nameLength != nameLength)
421         || (strcmp(localPtr->name, fieldValues[0]))
422         || (localPtr->frameIndex != i)
423         || ((localPtr->flags & ~VAR_UNDEFINED)
424           != (VAR_SCALAR | VAR_ARGUMENT))
425         || ((localPtr->defValuePtr == NULL)
426           && (fieldCount == 2))
427         || ((localPtr->defValuePtr != NULL)
428           && (fieldCount != 2))) {
429     char buf[80 + TCL_INTEGER_SPACE];
430     sprintf(buf, "\": formal parameter %d is inconsistent with precompiled body",
431       i);
432     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
433       "procedure \"", procName,
434       buf, (char *) NULL);
435     ckfree((char *) fieldValues);
436     goto procError;
437       }
438 
439             /*
440              * compare the default value if any
441              */
442 
443             if (localPtr->defValuePtr != NULL) {
444                 int tmpLength;
445                 char *tmpPtr = Tcl_GetStringFromObj(localPtr->defValuePtr,
446                         &tmpLength);
447                 if ((valueLength != tmpLength)
448                         || (strncmp(fieldValues[1], tmpPtr,
449                                 (size_t) tmpLength))) {
450                     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
451                             "procedure \"", procName,
452                             "\": formal parameter \"",
453                             fieldValues[0],
454                             "\" has default value inconsistent with precompiled body",
455                             (char *) NULL);
456                     ckfree((char *) fieldValues);
457                     goto procError;
458                 }
459             }
460 
461             localPtr = localPtr->nextPtr;
462         } else {
463             /*
464              * Allocate an entry in the runtime procedure frame's array of
465              * local variables for the argument. 
466              */
467 
468             localPtr = (CompiledLocal *) ckalloc((unsigned) 
469                     (sizeof(CompiledLocal) - sizeof(localPtr->name)
470                             + nameLength+1));
471             if (procPtr->firstLocalPtr == NULL) {
472                 procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
473             } else {
474                 procPtr->lastLocalPtr->nextPtr = localPtr;
475                 procPtr->lastLocalPtr = localPtr;
476             }
477             localPtr->nextPtr = NULL;
478             localPtr->nameLength = nameLength;
479             localPtr->frameIndex = i;
480             localPtr->flags = VAR_SCALAR | VAR_ARGUMENT;
481             localPtr->resolveInfo = NULL;
482   
483             if (fieldCount == 2) {
484                 localPtr->defValuePtr =
485         Tcl_NewStringObj(fieldValues[1], valueLength);
486                 Tcl_IncrRefCount(localPtr->defValuePtr);
487             } else {
488                 localPtr->defValuePtr = NULL;
489             }
490             strcpy(localPtr->name, fieldValues[0]);
491   }
492 
493         ckfree((char *) fieldValues);
494     }
495 
496     /*
497      * Now initialize the new procedure's cmdPtr field. This will be used
498      * later when the procedure is called to determine what namespace the
499      * procedure will run in. This will be different than the current
500      * namespace if the proc was renamed into a different namespace.
501      */
502     
503     *procPtrPtr = procPtr;
504     ckfree((char *) argArray);
505     return TCL_OK;
506 
507 procError:
508     if (precompiled) {
509         procPtr->refCount--;
510     } else {
511         Tcl_DecrRefCount(bodyPtr);
512         while (procPtr->firstLocalPtr != NULL) {
513             localPtr = procPtr->firstLocalPtr;
514             procPtr->firstLocalPtr = localPtr->nextPtr;
515   
516             defPtr = localPtr->defValuePtr;
517             if (defPtr != NULL) {
518                 Tcl_DecrRefCount(defPtr);
519             }
520   
521             ckfree((char *) localPtr);
522         }
523         ckfree((char *) procPtr);
524     }
525     if (argArray != NULL) {
526   ckfree((char *) argArray);
527     }
528     return TCL_ERROR;
529 }
Proc* TclFindProc (Interp * iPtr, CONST char * procName)

Definition at line 729 of file tclProc.c.
References Command::clientData, NULL, Command::proc, Tcl_FindCommand(), TclGetOriginalCommand(), and TclProcInterpProc().
Referenced by InfoArgsCmd(), InfoBodyCmd(), and InfoDefaultCmd().732 {
733     Tcl_Command cmd;
734     Tcl_Command origCmd;
735     Command *cmdPtr;
736     
737     cmd = Tcl_FindCommand((Tcl_Interp *) iPtr, procName,
738             (Tcl_Namespace *) NULL, /*flags*/ 0);
739     if (cmd == (Tcl_Command) NULL) {
740         return NULL;
741     }
742     cmdPtr = (Command *) cmd;
743 
744     origCmd = TclGetOriginalCommand(cmd);
745     if (origCmd != NULL) {
746   cmdPtr = (Command *) origCmd;
747     }
748     if (cmdPtr->proc != TclProcInterpProc) {
749   return NULL;
750     }
751     return (Proc *) cmdPtr->clientData;
752 }
int TclGetFrame (Tcl_Interp * interp, CONST char * string, CallFrame ** framePtrPtr)

Definition at line 557 of file tclProc.c.
References CallFrame::callerVarPtr, CallFrame::level, NULL, Tcl_GetInt(), TCL_OK, UCHAR, and Interp::varFramePtr.
Referenced by Tcl_UplevelObjCmd(), Tcl_UpVar2(), and Tcl_UpvarObjCmd().562 {
563     register Interp *iPtr = (Interp *) interp;
564     int curLevel, level, result;
565     CallFrame *framePtr;
566 
567     /*
568      * Parse string to figure out which level number to go to.
569      */
570 
571     result = 1;
572     curLevel = (iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level;
573     if (*string == '#') {
574   if (Tcl_GetInt(interp, string+1, &level) != TCL_OK) {
575       return -1;
576   }
577   if (level < 0) {
578       levelError:
579       Tcl_AppendResult(interp, "bad level \"", string, "\"",
580         (char *) NULL);
581       return -1;
582   }
583     } else if (isdigit(UCHAR(*string))) { /* INTL: digit */
584   if (Tcl_GetInt(interp, string, &level) != TCL_OK) {
585       return -1;
586   }
587   level = curLevel - level;
588     } else {
589   level = curLevel - 1;
590   result = 0;
591     }
592 
593     /*
594      * Figure out which frame to use, and modify the interpreter so
595      * its variables come from that frame.
596      */
597 
598     if (level == 0) {
599   framePtr = NULL;
600     } else {
601   for (framePtr = iPtr->varFramePtr; framePtr != NULL;
602     framePtr = framePtr->callerVarPtr) {
603       if (framePtr->level == level) {
604     break;
605       }
606   }
607   if (framePtr == NULL) {
608       goto levelError;
609   }
610     }
611     *framePtrPtr = framePtr;
612     return result;
613 }
TclCmdProcType TclGetInterpProc ()

Definition at line 1592 of file tclProc.c.
References TclProcInterpProc().
Referenced by ProcBodyTestProcObjCmd().1593 {
1594     return (TclCmdProcType) TclProcInterpProc;
1595 }
TclObjCmdProcType TclGetObjInterpProc ()

Definition at line 1617 of file tclProc.c.
References TclObjInterpProc().
Referenced by ProcBodyTestProcObjCmd().1618 {
1619     return (TclObjCmdProcType) TclObjInterpProc;
1620 }
Proc* TclIsProc (Command * cmdPtr)

Definition at line 773 of file tclProc.c.
References NULL, TclGetOriginalCommand(), and TclProcInterpProc().
Referenced by InfoProcsCmd().775 {
776     Tcl_Command origCmd;
777 
778     origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr);
779     if (origCmd != NULL) {
780   cmdPtr = (Command *) origCmd;
781     }
782     if (cmdPtr->proc == TclProcInterpProc) {
783   return (Proc *) cmdPtr->clientData;
784     }
785     return (Proc *) 0;
786 }
Tcl_Obj* TclNewProcBodyObj (Proc * procPtr)

Definition at line 1642 of file tclProc.c.
References Tcl_Obj::internalRep, NULL, Tcl_Obj::otherValuePtr, Tcl_NewStringObj(), tclProcBodyType, Tcl_Obj::typePtr, and VOID.
Referenced by ProcBodyTestProcObjCmd().1645 {
1646     Tcl_Obj *objPtr;
1647 
1648     if (!procPtr) {
1649         return (Tcl_Obj *) NULL;
1650     }
1651     
1652     objPtr = Tcl_NewStringObj("", 0);
1653 
1654     if (objPtr) {
1655         objPtr->typePtr = &tclProcBodyType;
1656         objPtr->internalRep.otherValuePtr = (VOID *) procPtr;
1657 
1658         procPtr->refCount++;
1659     }
1660 
1661     return objPtr;
1662 }
int TclObjInterpProc (ClientData clientData, Tcl_Interp * interp, int objc, objv)

Definition at line 899 of file tclProc.c.
References Proc::bodyPtr, ckalloc, Proc::cmdPtr, CompiledLocal::defValuePtr, Proc::firstLocalPtr, CompiledLocal::name, CompiledLocal::nextPtr, Command::nsPtr, NULL, NUM_LOCALS, Proc::numArgs, Proc::numCompiledLocals, panic, ProcCompileProc(), TCL_ERROR, Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_NewListObj(), TCL_OK, Tcl_PushCallFrame(), TclClearVarUndefined, TclInitCompiledLocals(), TclIsVarArgument, TclIsVarTemporary, and varPtr.
Referenced by Tcl_ProcObjCmd(), TclGetObjInterpProc(), and TclProcInterpProc().907 {
908     Interp *iPtr = (Interp *) interp;
909     Proc *procPtr = (Proc *) clientData;
910     Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
911     CallFrame frame;
912     register CallFrame *framePtr = &frame;
913     register Var *varPtr;
914     register CompiledLocal *localPtr;
915     char *procName;
916     int nameLen, localCt, numArgs, argCt, i, result;
917 
918     /*
919      * This procedure generates an array "compiledLocals" that holds the
920      * storage for local variables. It starts out with stack-allocated space
921      * but uses dynamically-allocated storage if needed.
922      */
923 
924 #define NUM_LOCALS 20
925     Var localStorage[NUM_LOCALS];
926     Var *compiledLocals = localStorage;
927 
928     /*
929      * Get the procedure's name.
930      */
931     
932     procName = Tcl_GetStringFromObj(objv[0], &nameLen);
933 
934     /*
935      * If necessary, compile the procedure's body. The compiler will
936      * allocate frame slots for the procedure's non-argument local
937      * variables.  Note that compiling the body might increase
938      * procPtr->numCompiledLocals if new local variables are found
939      * while compiling.
940      */
941 
942     result = ProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
943       "body of proc", procName, &procPtr);
944     
945     if (result != TCL_OK) {
946         return result;
947     }
948 
949     /*
950      * Create the "compiledLocals" array. Make sure it is large enough to
951      * hold all the procedure's compiled local variables, including its
952      * formal parameters.
953      */
954 
955     localCt = procPtr->numCompiledLocals;
956     if (localCt > NUM_LOCALS) {
957   compiledLocals = (Var *) ckalloc((unsigned) localCt * sizeof(Var));
958     }
959     
960     /*
961      * Set up and push a new call frame for the new procedure invocation.
962      * This call frame will execute in the proc's namespace, which might
963      * be different than the current namespace. The proc's namespace is
964      * that of its command, which can change if the command is renamed
965      * from one namespace to another.
966      */
967 
968     result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
969             (Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 1);
970 
971     if (result != TCL_OK) {
972         return result;
973     }
974 
975     framePtr->objc = objc;
976     framePtr->objv = objv;  /* ref counts for args are incremented below */
977 
978     /*
979      * Initialize and resolve compiled variable references.
980      */
981 
982     framePtr->procPtr = procPtr;
983     framePtr->numCompiledLocals = localCt;
984     framePtr->compiledLocals = compiledLocals;
985 
986     TclInitCompiledLocals(interp, framePtr, nsPtr);
987 
988     /*
989      * Match and assign the call's actual parameters to the procedure's
990      * formal arguments. The formal arguments are described by the first
991      * numArgs entries in both the Proc structure's local variable list and
992      * the call frame's local variable array.
993      */
994 
995     numArgs = procPtr->numArgs;
996     varPtr = framePtr->compiledLocals;
997     localPtr = procPtr->firstLocalPtr;
998     argCt = objc;
999     for (i = 1, argCt -= 1;  i <= numArgs;  i++, argCt--) {
1000   if (!TclIsVarArgument(localPtr)) {
1001       panic("TclObjInterpProc: local variable %s is not argument but should be",
1002       localPtr->name);
1003       return TCL_ERROR;
1004   }
1005   if (TclIsVarTemporary(localPtr)) {
1006       panic("TclObjInterpProc: local variable %d is temporary but should be an argument", i);
1007       return TCL_ERROR;
1008   }
1009 
1010   /*
1011    * Handle the special case of the last formal being "args".  When
1012    * it occurs, assign it a list consisting of all the remaining
1013    * actual arguments.
1014    */
1015 
1016   if ((i == numArgs) && ((localPtr->name[0] == 'a')
1017           && (strcmp(localPtr->name, "args") == 0))) {
1018       Tcl_Obj *listPtr = Tcl_NewListObj(argCt, &(objv[i]));
1019       varPtr->value.objPtr = listPtr;
1020       Tcl_IncrRefCount(listPtr); /* local var is a reference */
1021       TclClearVarUndefined(varPtr);
1022       argCt = 0;
1023       break;    /* done processing args */
1024   } else if (argCt > 0) {
1025       Tcl_Obj *objPtr = objv[i];
1026       varPtr->value.objPtr = objPtr;
1027       TclClearVarUndefined(varPtr);
1028       Tcl_IncrRefCount(objPtr);  /* since the local variable now has
1029           * another reference to object. */
1030   } else if (localPtr->defValuePtr != NULL) {
1031       Tcl_Obj *objPtr = localPtr->defValuePtr;
1032       varPtr->value.objPtr = objPtr;
1033       TclClearVarUndefined(varPtr);
1034       Tcl_IncrRefCount(objPtr);  /* since the local variable now has
1035           * another reference to object. */
1036   } else {
1037       goto incorrectArgs;
1038   }
1039   varPtr++;
1040   localPtr = localPtr->nextPtr;
1041     }
1042     if (argCt > 0) {
1043   Tcl_Obj *objResult;
1044   int len, flags;
1045 
1046   incorrectArgs:
1047   /*
1048    * Build up equivalent to Tcl_WrongNumArgs message for proc
1049    */
1050 
1051   Tcl_ResetResult(interp);
1052   objResult = Tcl_GetObjResult(interp);
1053   Tcl_AppendToObj(objResult, "wrong # args: should be \"", -1);
1054 
1055   /*
1056    * Quote the proc name if it contains spaces (Bug 942757).
1057    */
1058   
1059   len = Tcl_ScanCountedElement(procName, nameLen, &flags);
1060   if (len != nameLen) {
1061       char *procName1 = ckalloc((unsigned) len);
1062       len = Tcl_ConvertCountedElement(procName, nameLen, procName1, flags);
1063       Tcl_AppendToObj(objResult, procName1, len);
1064       ckfree(procName1);
1065   } else {
1066       Tcl_AppendToObj(objResult, procName, len);
1067   }
1068 
1069   localPtr = procPtr->firstLocalPtr;
1070   for (i = 1;  i <= numArgs;  i++) {
1071       if (localPtr->defValuePtr != NULL) {
1072     Tcl_AppendStringsToObj(objResult,
1073       " ?", localPtr->name, "?", (char *) NULL);
1074       } else {
1075     Tcl_AppendStringsToObj(objResult,
1076       " ", localPtr->name, (char *) NULL);
1077       }
1078       localPtr = localPtr->nextPtr;
1079   }
1080   Tcl_AppendStringsToObj(objResult, "\"", (char *) NULL);
1081 
1082   result = TCL_ERROR;
1083   goto procDone;
1084     }
1085 
1086     /*
1087      * Invoke the commands in the procedure's body.
1088      */
1089 
1090 #ifdef TCL_COMPILE_DEBUG
1091     if (tclTraceExec >= 1) {
1092   fprintf(stdout, "Calling proc ");
1093   for (i = 0;  i < objc;  i++) {
1094       TclPrintObject(stdout, objv[i], 15);
1095       fprintf(stdout, " ");
1096   }
1097   fprintf(stdout, "\n");
1098   fflush(stdout);
1099     }
1100 #endif /*TCL_COMPILE_DEBUG*/
1101 
1102     iPtr->returnCode = TCL_OK;
1103     procPtr->refCount++;
1104     result = TclCompEvalObj(interp, procPtr->bodyPtr);
1105     procPtr->refCount--;
1106     if (procPtr->refCount <= 0) {
1107   TclProcCleanupProc(procPtr);
1108     }
1109 
1110     if (result != TCL_OK) {
1111   result = ProcessProcResultCode(interp, procName, nameLen, result);
1112     }
1113     
1114     /*
1115      * Pop and free the call frame for this procedure invocation, then
1116      * free the compiledLocals array if malloc'ed storage was used.
1117      */
1118     
1119     procDone:
1120     Tcl_PopCallFrame(interp);
1121     if (compiledLocals != localStorage) {
1122   ckfree((char *) compiledLocals);
1123     }
1124     return result;
1125 #undef NUM_LOCALS
1126 }
void TclProcCleanupProc (Proc * procPtr)

Definition at line 1488 of file tclProc.c.
References ckfree, CompiledLocal::defValuePtr, Tcl_ResolvedVarInfo::deleteProc, CompiledLocal::nextPtr, NULL, CompiledLocal::resolveInfo, and Tcl_DecrRefCount.
Referenced by FreeLocalVarName(), ProcBodyFree(), and TclProcDeleteProc().1490 {
1491     register CompiledLocal *localPtr;
1492     Tcl_Obj *bodyPtr = procPtr->bodyPtr;
1493     Tcl_Obj *defPtr;
1494     Tcl_ResolvedVarInfo *resVarInfo;
1495 
1496     if (bodyPtr != NULL) {
1497   Tcl_DecrRefCount(bodyPtr);
1498     }
1499     for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;  ) {
1500   CompiledLocal *nextPtr = localPtr->nextPtr;
1501 
1502         resVarInfo = localPtr->resolveInfo;
1503   if (resVarInfo) {
1504       if (resVarInfo->deleteProc) {
1505     (*resVarInfo->deleteProc)(resVarInfo);
1506       } else {
1507     ckfree((char *) resVarInfo);
1508       }
1509         }
1510 
1511   if (localPtr->defValuePtr != NULL) {
1512       defPtr = localPtr->defValuePtr;
1513       Tcl_DecrRefCount(defPtr);
1514   }
1515   ckfree((char *) localPtr);
1516   localPtr = nextPtr;
1517     }
1518     ckfree((char *) procPtr);
1519 }
int TclProcCompileProc (Tcl_Interp * interp, Proc * procPtr, Tcl_Obj * bodyPtr, Namespace * nsPtr, CONST char * description, CONST char * procName)

Definition at line 1150 of file tclProc.c.
References NULL, and ProcCompileProc().1159 {
1160     return ProcCompileProc(interp, procPtr, bodyPtr, nsPtr,
1161       description, procName, NULL);
1162 }
void TclProcDeleteProc (ClientData clientData)

Definition at line 1458 of file tclProc.c.
References Proc::refCount, and TclProcCleanupProc().
Referenced by Tcl_ProcObjCmd().1460 {
1461     Proc *procPtr = (Proc *) clientData;
1462 
1463     procPtr->refCount--;
1464     if (procPtr->refCount <= 0) {
1465   TclProcCleanupProc(procPtr);
1466     }
1467 }
int TclProcInterpProc (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv)

Definition at line 806 of file tclProc.c.
References ckalloc, ckfree, NUM_ARGS, Tcl_GetObjResult(), Tcl_IncrRefCount, Tcl_NewStringObj(), Tcl_SetResult(), TCL_VOLATILE, TclDecrRefCount, TclGetString, and TclObjInterpProc().
Referenced by Tcl_ProcObjCmd(), TclFindProc(), TclGetInterpProc(), and TclIsProc().814 {
815     register Tcl_Obj *objPtr;
816     register int i;
817     int result;
818 
819     /*
820      * This procedure generates an objv array for object arguments that hold
821      * the argv strings. It starts out with stack-allocated space but uses
822      * dynamically-allocated storage if needed.
823      */
824 
825 #define NUM_ARGS 20
826     Tcl_Obj *(objStorage[NUM_ARGS]);
827     register Tcl_Obj **objv = objStorage;
828 
829     /*
830      * Create the object argument array "objv". Make sure objv is large
831      * enough to hold the objc arguments plus 1 extra for the zero
832      * end-of-objv word.
833      */
834 
835     if ((argc + 1) > NUM_ARGS) {
836   objv = (Tcl_Obj **)
837       ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *));
838     }
839 
840     for (i = 0;  i < argc;  i++) {
841   objv[i] = Tcl_NewStringObj(argv[i], -1);
842   Tcl_IncrRefCount(objv[i]);
843     }
844     objv[argc] = 0;
845 
846     /*
847      * Use TclObjInterpProc to actually interpret the procedure.
848      */
849 
850     result = TclObjInterpProc(clientData, interp, argc, objv);
851 
852     /*
853      * Move the interpreter's object result to the string result, 
854      * then reset the object result.
855      */
856     
857     Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
858       TCL_VOLATILE);
859 
860     /*
861      * Decrement the ref counts on the objv elements since we are done
862      * with them.
863      */
864 
865     for (i = 0;  i < argc;  i++) {
866   objPtr = objv[i];
867   TclDecrRefCount(objPtr);
868     }
869     
870     /*
871      * Free the objv array if malloc'ed storage was used.
872      */
873 
874     if (objv != objStorage) {
875   ckfree((char *) objv);
876     }
877     return result;
878 #undef NUM_ARGS
879 }
int TclUpdateReturnInfo (Interp * iPtr)

Definition at line 1542 of file tclProc.c.
References ERR_IN_PROGRESS, ERROR_CODE_SET, NULL, Tcl_DecrRefCount, TCL_ERROR, TCL_GLOBAL_ONLY, Tcl_IncrRefCount, Tcl_NewStringObj(), Tcl_ObjSetVar2(), and TCL_OK.
Referenced by ProcessProcResultCode(), Tcl_EvalEx(), Tcl_EvalObjEx(), Tcl_EvalObjv(), and Tcl_FSEvalFile().1545 {
1546     int code;
1547     char *errorCode;
1548     Tcl_Obj *objPtr;
1549 
1550     code = iPtr->returnCode;
1551     iPtr->returnCode = TCL_OK;
1552     if (code == TCL_ERROR) {
1553   errorCode = ((iPtr->errorCode != NULL) ? iPtr->errorCode : "NONE");
1554   objPtr = Tcl_NewStringObj(errorCode, -1);
1555   Tcl_IncrRefCount(objPtr);
1556   Tcl_ObjSetVar2((Tcl_Interp *) iPtr, iPtr->execEnvPtr->errorCode,
1557           NULL, objPtr, TCL_GLOBAL_ONLY);
1558   Tcl_DecrRefCount(objPtr);
1559   iPtr->flags |= ERROR_CODE_SET;
1560   if (iPtr->errorInfo != NULL) {
1561       objPtr = Tcl_NewStringObj(iPtr->errorInfo, -1);
1562       Tcl_IncrRefCount(objPtr);
1563       Tcl_ObjSetVar2((Tcl_Interp *) iPtr, iPtr->execEnvPtr->errorInfo,
1564         NULL, objPtr, TCL_GLOBAL_ONLY);
1565       Tcl_DecrRefCount(objPtr);
1566       iPtr->flags |= ERR_IN_PROGRESS;
1567   }
1568     }
1569     return code;
1570 }

Variable Documentation
Tcl_ObjType tclProcBodyType
Initial value: {
    "procbody",     
    ProcBodyFree,   
    ProcBodyDup,    
    ProcBodyUpdateString, 
    ProcBodySetFromAny    
}
Definition at line 41 of file tclProc.c.
Referenced by ProcBodyDup(), Tcl_ProcObjCmd(), TclCreateProc(), TclInitObjSubsystem(), and TclNewProcBodyObj().

generic/tclRegexp.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"
Classes
struct ThreadSpecificData
Defines
#define NUM_REGEXPS  30
Functions
static TclRegexp *CompileRegexp _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *pattern, int length, int flags))
static void DupRegexpInternalRep _ANSI_ARGS_ ((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr))
static void FinalizeRegexp _ANSI_ARGS_ ((ClientData clientData))
static void FreeRegexp _ANSI_ARGS_ ((TclRegexp *regexpPtr))
static void FreeRegexpInternalRep _ANSI_ARGS_ ((Tcl_Obj *objPtr))
static int RegExpExecUniChar _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_RegExp re, CONST Tcl_UniChar *uniString, int numChars, int nmatches, int flags))
static int SetRegexpFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
Tcl_RegExp Tcl_RegExpCompile (Tcl_Interp *interp, CONST char *string)
int Tcl_RegExpExec (Tcl_Interp *interp, Tcl_RegExp re, CONST char *string, CONST char *start)
void Tcl_RegExpRange (Tcl_RegExp re, int index, CONST char **startPtr, CONST char **endPtr)
static int RegExpExecUniChar (Tcl_Interp *interp, Tcl_RegExp re, CONST Tcl_UniChar *wString, int numChars, int nmatches, int flags)
void TclRegExpRangeUniChar (Tcl_RegExp re, int index, int *startPtr, int *endPtr)
int Tcl_RegExpMatch (Tcl_Interp *interp, CONST char *string, CONST char *pattern)
int Tcl_RegExpExecObj (Tcl_Interp *interp, Tcl_RegExp re, Tcl_Obj *objPtr, int offset, int nmatches, int flags)
int Tcl_RegExpMatchObj (Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Obj *patternObj)
void Tcl_RegExpGetInfo (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr)
Tcl_RegExp Tcl_GetRegExpFromObj (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
int TclRegAbout (Tcl_Interp *interp, Tcl_RegExp re)
void TclRegError (Tcl_Interp *interp, CONST char *msg, int status)
static void FreeRegexpInternalRep (Tcl_Obj *objPtr)
static void DupRegexpInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
static int SetRegexpFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr)
static TclRegexp * CompileRegexp (Tcl_Interp *interp, CONST char *string, int length, int flags)
static void FreeRegexp (TclRegexp *regexpPtr)
static void FinalizeRegexp (ClientData clientData)
Variables
static Tcl_ThreadDataKey dataKey
static Tcl_ObjType tclRegexpType

Define Documentation
#define NUM_REGEXPS  30

Definition at line 68 of file tclRegexp.c.
Referenced by CompileRegexp(), and FinalizeRegexp().
Function Documentation
static int SetRegexpFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr)) [static]
static int RegExpExecUniChar _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_RegExp re, CONST Tcl_UniChar *uniString, int numChars, int nmatches, int flags)) [static]
static void FreeRegexpInternalRep _ANSI_ARGS_ ((Tcl_Obj *objPtr)) [static]
static void FreeRegexp _ANSI_ARGS_ ((TclRegexp *regexpPtr)) [static]
static void FinalizeRegexp _ANSI_ARGS_ ((ClientData clientData)) [static]
static void DupRegexpInternalRep _ANSI_ARGS_ ((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)) [static]
static TclRegexp* CompileRegexp _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *pattern, int length, int flags)) [static]
static TclRegexp* CompileRegexp (Tcl_Interp * interp, CONST char * string, int length, int flags) [static]

Definition at line 832 of file tclRegexp.c.
References ckalloc, ckfree, CONST, dataKey, TclRegexp::details, FinalizeRegexp(), TclRegexp::flags, FreeRegexp(), ThreadSpecificData::initialized, TclRegexp::matches, NULL, NUM_REGEXPS, TclRegexp::objPtr, ThreadSpecificData::patLengths, ThreadSpecificData::patterns, TclRegexp::re, regex_t::re_nsub, TclRegexp::refCount, REG_OKAY, ThreadSpecificData::regexps, regmatch_t::rm_eo, rm_detail_t::rm_extend, regmatch_t::rm_so, size_t(), status, TclRegexp::string, Tcl_CreateThreadExitHandler(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, TCL_TSD_INIT, Tcl_UtfToUniCharDString(), and TclRegError().
Referenced by Tcl_GetRegExpFromObj(), and Tcl_RegExpCompile().837 {
838     TclRegexp *regexpPtr;
839     CONST Tcl_UniChar *uniString;
840     int numChars;
841     Tcl_DString stringBuf;
842     int status, i;
843     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
844  
845     if (!tsdPtr->initialized) {
846   tsdPtr->initialized = 1;
847   Tcl_CreateThreadExitHandler(FinalizeRegexp, NULL);
848     }
849 
850     /*
851      * This routine maintains a second-level regular expression cache in
852      * addition to the per-object regexp cache.  The per-thread cache is needed
853      * to handle the case where for various reasons the object is lost between
854      * invocations of the regexp command, but the literal pattern is the same.
855      */
856 
857     /*
858      * Check the per-thread compiled regexp cache.  We can only reuse
859      * a regexp if it has the same pattern and the same flags.
860      */
861 
862     for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) {
863   if ((length == tsdPtr->patLengths[i])
864     && (tsdPtr->regexps[i]->flags == flags)
865     && (strcmp(string, tsdPtr->patterns[i]) == 0)) {
866       /*
867        * Move the matched pattern to the first slot in the
868        * cache and shift the other patterns down one position.
869        */
870 
871       if (i != 0) {
872     int j;
873     char *cachedString;
874 
875     cachedString = tsdPtr->patterns[i];
876     regexpPtr = tsdPtr->regexps[i];
877     for (j = i-1; j >= 0; j--) {
878         tsdPtr->patterns[j+1] = tsdPtr->patterns[j];
879         tsdPtr->patLengths[j+1] = tsdPtr->patLengths[j];
880         tsdPtr->regexps[j+1] = tsdPtr->regexps[j];
881     }
882     tsdPtr->patterns[0] = cachedString;
883     tsdPtr->patLengths[0] = length;
884     tsdPtr->regexps[0] = regexpPtr;
885       }
886       return tsdPtr->regexps[0];
887   }
888     }
889 
890     /*
891      * This is a new expression, so compile it and add it to the cache.
892      */
893     
894     regexpPtr = (TclRegexp *) ckalloc(sizeof(TclRegexp));
895     regexpPtr->objPtr = NULL;
896     regexpPtr->string = NULL;
897     regexpPtr->details.rm_extend.rm_so = -1;
898     regexpPtr->details.rm_extend.rm_eo = -1;
899 
900     /*
901      * Get the up-to-date string representation and map to unicode.
902      */
903 
904     Tcl_DStringInit(&stringBuf);
905     uniString = Tcl_UtfToUniCharDString(string, length, &stringBuf);
906     numChars = Tcl_DStringLength(&stringBuf) / sizeof(Tcl_UniChar);
907 
908     /*
909      * Compile the string and check for errors.
910      */
911 
912     regexpPtr->flags = flags;
913     status = TclReComp(&regexpPtr->re, uniString, (size_t) numChars, flags);
914     Tcl_DStringFree(&stringBuf);
915 
916     if (status != REG_OKAY) {
917   /*
918    * Clean up and report errors in the interpreter, if possible.
919    */
920 
921   ckfree((char *)regexpPtr);
922   if (interp) {
923       TclRegError(interp,
924         "couldn't compile regular expression pattern: ",
925         status);
926   }
927   return NULL;
928     }
929 
930     /*
931      * Allocate enough space for all of the subexpressions, plus one
932      * extra for the entire pattern.
933      */
934 
935     regexpPtr->matches = (regmatch_t *) ckalloc(
936       sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));
937 
938     /*
939      * Initialize the refcount to one initially, since it is in the cache.
940      */
941 
942     regexpPtr->refCount = 1;
943 
944     /*
945      * Free the last regexp, if necessary, and make room at the head of the
946      * list for the new regexp.
947      */
948 
949     if (tsdPtr->patterns[NUM_REGEXPS-1] != NULL) {
950   TclRegexp *oldRegexpPtr = tsdPtr->regexps[NUM_REGEXPS-1];
951   if (--(oldRegexpPtr->refCount) <= 0) {
952       FreeRegexp(oldRegexpPtr);
953   }
954   ckfree(tsdPtr->patterns[NUM_REGEXPS-1]);
955     }
956     for (i = NUM_REGEXPS - 2; i >= 0; i--) {
957   tsdPtr->patterns[i+1] = tsdPtr->patterns[i];
958   tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i];
959   tsdPtr->regexps[i+1] = tsdPtr->regexps[i];
960     }
961     tsdPtr->patterns[0] = (char *) ckalloc((unsigned) (length+1));
962     strcpy(tsdPtr->patterns[0], string);
963     tsdPtr->patLengths[0] = length;
964     tsdPtr->regexps[0] = regexpPtr;
965 
966     return regexpPtr;
967 }
static void DupRegexpInternalRep (Tcl_Obj * srcPtr, Tcl_Obj * copyPtr) [static]

Definition at line 768 of file tclRegexp.c.
References Tcl_Obj::internalRep, Tcl_Obj::otherValuePtr, TclRegexp::refCount, tclRegexpType, and Tcl_Obj::typePtr.771 {
772     TclRegexp *regexpPtr = (TclRegexp *) srcPtr->internalRep.otherValuePtr;
773     regexpPtr->refCount++;
774     copyPtr->internalRep.otherValuePtr = srcPtr->internalRep.otherValuePtr;
775     copyPtr->typePtr = &tclRegexpType;
776 }
static void FinalizeRegexp (ClientData clientData) [static]

Definition at line 1014 of file tclRegexp.c.
References ckfree, dataKey, FreeRegexp(), ThreadSpecificData::initialized, NULL, NUM_REGEXPS, ThreadSpecificData::patterns, TclRegexp::refCount, ThreadSpecificData::regexps, and TCL_TSD_INIT.
Referenced by CompileRegexp().1016 {
1017     int i;
1018     TclRegexp *regexpPtr;
1019     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1020 
1021     for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) {
1022   regexpPtr = tsdPtr->regexps[i];
1023   if (--(regexpPtr->refCount) <= 0) {
1024       FreeRegexp(regexpPtr);
1025   }
1026   ckfree(tsdPtr->patterns[i]);
1027   tsdPtr->patterns[i] = NULL;
1028     }
1029     /*
1030      * We may find ourselves reinitialized if another finalization routine
1031      * invokes regexps.
1032      */
1033     tsdPtr->initialized = 0;
1034 }
static void FreeRegexp (TclRegexp * regexpPtr) [static]

Definition at line 986 of file tclRegexp.c.
References ckfree.
Referenced by CompileRegexp(), FinalizeRegexp(), and FreeRegexpInternalRep().988 {
989     TclReFree(&regexpPtr->re);
990     if (regexpPtr->matches) {
991   ckfree((char *) regexpPtr->matches);
992     }
993     ckfree((char *) regexpPtr);
994 }
static void FreeRegexpInternalRep (Tcl_Obj * objPtr) [static]

Definition at line 736 of file tclRegexp.c.
References FreeRegexp(), and TclRegexp::refCount.738 {
739     TclRegexp *regexpRepPtr = (TclRegexp *) objPtr->internalRep.otherValuePtr;
740 
741     /*
742      * If this is the last reference to the regexp, free it.
743      */
744 
745     if (--(regexpRepPtr->refCount) <= 0) {
746   FreeRegexp(regexpRepPtr);
747     }
748 }
static int RegExpExecUniChar (Tcl_Interp * interp, Tcl_RegExp re, CONST Tcl_UniChar * wString, int numChars, int nmatches, int flags) [static]

Definition at line 291 of file tclRegexp.c.
References TclRegexp::details, TclRegexp::matches, NULL, TclRegexp::re, regex_t::re_nsub, REG_NOMATCH, REG_OKAY, size_t(), status, and TclRegError().
Referenced by Tcl_RegExpExec(), and Tcl_RegExpExecObj().302 {
303     int status;
304     TclRegexp *regexpPtr = (TclRegexp *) re;
305     size_t last = regexpPtr->re.re_nsub + 1;
306     size_t nm = last;
307 
308     if (nmatches >= 0 && (size_t) nmatches < nm) {
309   nm = (size_t) nmatches;
310     }
311 
312     status = TclReExec(&regexpPtr->re, wString, (size_t) numChars,
313       &regexpPtr->details, nm, regexpPtr->matches, flags);
314 
315     /*
316      * Check for errors.
317      */
318 
319     if (status != REG_OKAY) {
320   if (status == REG_NOMATCH) {
321       return 0;
322   }
323   if (interp != NULL) {
324       TclRegError(interp, "error while matching regular expression: ",
325         status);
326   }
327   return -1;
328     }
329     return 1;
330 }
static int SetRegexpFromAny (Tcl_Interp * interp, Tcl_Obj * objPtr) [static]

Definition at line 799 of file tclRegexp.c.
References NULL, REG_ADVANCED, TCL_ERROR, Tcl_GetRegExpFromObj(), and TCL_OK.802 {
803     if (Tcl_GetRegExpFromObj(interp, objPtr, REG_ADVANCED) == NULL) {
804   return TCL_ERROR;
805     }
806     return TCL_OK;
807 }
Tcl_RegExp Tcl_GetRegExpFromObj (Tcl_Interp * interp, Tcl_Obj * objPtr, int flags)

Definition at line 555 of file tclRegexp.c.
References CompileRegexp(), TclRegexp::flags, Tcl_ObjType::freeIntRepProc, Tcl_Obj::internalRep, NULL, Tcl_Obj::otherValuePtr, TclRegexp::refCount, Tcl_GetStringFromObj(), tclRegexpType, Tcl_Obj::typePtr, and VOID.
Referenced by SetRegexpFromAny(), SplitMacPath(), Tcl_LsearchObjCmd(), Tcl_RegExpMatchObj(), Tcl_RegexpObjCmd(), Tcl_RegsubObjCmd(), TclpGetNativePathType(), and TestregexpObjCmd().563 {
564     int length;
565     Tcl_ObjType *typePtr;
566     TclRegexp *regexpPtr;
567     char *pattern;
568 
569     typePtr = objPtr->typePtr;
570     regexpPtr = (TclRegexp *) objPtr->internalRep.otherValuePtr;
571 
572     if ((typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) {
573   pattern = Tcl_GetStringFromObj(objPtr, &length);
574 
575   regexpPtr = CompileRegexp(interp, pattern, length, flags);
576   if (regexpPtr == NULL) {
577       return NULL;
578   }
579 
580   /*
581    * Add a reference to the regexp so it will persist even if it is
582    * pushed out of the current thread's regexp cache.  This reference
583    * will be removed when the object's internal rep is freed.
584    */
585 
586   regexpPtr->refCount++;
587 
588   /*
589    * Free the old representation and set our type.
590    */
591 
592   if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
593       (*typePtr->freeIntRepProc)(objPtr);
594   }
595   objPtr->internalRep.otherValuePtr = (VOID *) regexpPtr;
596   objPtr->typePtr = &tclRegexpType;
597     }
598     return (Tcl_RegExp) regexpPtr;
599 }
Tcl_RegExp Tcl_RegExpCompile (Tcl_Interp * interp, CONST char * string)

Definition at line 141 of file tclRegexp.c.
References CompileRegexp(), and REG_ADVANCED.
Referenced by Tcl_RegExpMatch().146 {
147     return (Tcl_RegExp) CompileRegexp(interp, string, (int) strlen(string),
148       REG_ADVANCED);
149 }
int Tcl_RegExpExec (Tcl_Interp * interp, Tcl_RegExp re, CONST char * string, CONST char * start)

Definition at line 173 of file tclRegexp.c.
References CONST, NULL, TclRegexp::objPtr, REG_NOTBOL, RegExpExecUniChar(), TclRegexp::string, Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, and Tcl_UtfToUniCharDString().
Referenced by SplitMacPath(), Tcl_RegExpMatch(), and TclpGetNativePathType().182 {
183     int flags, result, numChars;
184     TclRegexp *regexp = (TclRegexp *)re;
185     Tcl_DString ds;
186     CONST Tcl_UniChar *ustr;
187 
188     /*
189      * If the starting point is offset from the beginning of the buffer,
190      * then we need to tell the regexp engine not to match "^".
191      */
192 
193     if (string > start) {
194   flags = REG_NOTBOL;
195     } else {
196   flags = 0;
197     }
198 
199     /*
200      * Remember the string for use by Tcl_RegExpRange().
201      */
202 
203     regexp->string = string;
204     regexp->objPtr = NULL;
205 
206     /*
207      * Convert the string to Unicode and perform the match.
208      */
209 
210     Tcl_DStringInit(&ds);
211     ustr = Tcl_UtfToUniCharDString(string, -1, &ds);
212     numChars = Tcl_DStringLength(&ds) / sizeof(Tcl_UniChar);
213     result = RegExpExecUniChar(interp, re, ustr, numChars,
214       -1 /* nmatches */, flags);
215     Tcl_DStringFree(&ds);
216 
217     return result;
218 }
int Tcl_RegExpExecObj (Tcl_Interp * interp, Tcl_RegExp re, Tcl_Obj * objPtr, int offset, int nmatches, int flags)

Definition at line 434 of file tclRegexp.c.
References NULL, TclRegexp::objPtr, RegExpExecUniChar(), TclRegexp::string, and Tcl_GetUnicodeFromObj().
Referenced by Tcl_LsearchObjCmd(), Tcl_RegExpMatchObj(), Tcl_RegexpObjCmd(), Tcl_RegsubObjCmd(), and TestregexpObjCmd().446 {
447     TclRegexp *regexpPtr = (TclRegexp *) re;
448     Tcl_UniChar *udata;
449     int length;
450 
451     /*
452      * Save the target object so we can extract strings from it later.
453      */
454 
455     regexpPtr->string = NULL;
456     regexpPtr->objPtr = objPtr;
457 
458     udata = Tcl_GetUnicodeFromObj(objPtr, &length);
459 
460     if (offset > length) {
461   offset = length;
462     }
463     udata += offset;
464     length -= offset;
465     
466     return RegExpExecUniChar(interp, re, udata, length, nmatches, flags);
467 }
void Tcl_RegExpGetInfo (Tcl_RegExp regexp, Tcl_RegExpInfo * infoPtr)

Definition at line 523 of file tclRegexp.c.
References TclRegexp::details, Tcl_RegExpInfo::extendStart, TclRegexp::matches, Tcl_RegExpInfo::matches, Tcl_RegExpInfo::nsubs, TclRegexp::re, regex_t::re_nsub, rm_detail_t::rm_extend, and regmatch_t::rm_so.
Referenced by Tcl_RegexpObjCmd(), Tcl_RegsubObjCmd(), and TestregexpObjCmd().526 {
527     TclRegexp *regexpPtr = (TclRegexp *) regexp;
528 
529     infoPtr->nsubs = regexpPtr->re.re_nsub;
530     infoPtr->matches = (Tcl_RegExpIndices *) regexpPtr->matches;
531     infoPtr->extendStart = regexpPtr->details.rm_extend.rm_so;
532 }
int Tcl_RegExpMatch (Tcl_Interp * interp, CONST char * string, CONST char * pattern)

Definition at line 399 of file tclRegexp.c.
References NULL, TclRegexp::re, Tcl_RegExpCompile(), and Tcl_RegExpExec().
Referenced by Tcl_ArrayObjCmd().404 {
405     Tcl_RegExp re;
406 
407     re = Tcl_RegExpCompile(interp, pattern);
408     if (re == NULL) {
409   return -1;
410     }
411     return Tcl_RegExpExec(interp, re, string, string);
412 }
int Tcl_RegExpMatchObj (Tcl_Interp * interp, Tcl_Obj * stringObj, Tcl_Obj * patternObj)

Definition at line 489 of file tclRegexp.c.
References NULL, TclRegexp::re, Tcl_GetRegExpFromObj(), TCL_REG_ADVANCED, TCL_REG_NOSUB, and Tcl_RegExpExecObj().
Referenced by Tcl_SwitchObjCmd().494 {
495     Tcl_RegExp re;
496 
497     re = Tcl_GetRegExpFromObj(interp, patternObj,
498       TCL_REG_ADVANCED | TCL_REG_NOSUB);
499     if (re == NULL) {
500   return -1;
501     }
502     return Tcl_RegExpExecObj(interp, re, stringObj, 0 /* offset */,
503       0 /* nmatches */, 0 /* flags */);
504 }
void Tcl_RegExpRange (Tcl_RegExp re, int index, CONST char ** startPtr, CONST char ** endPtr)

Definition at line 240 of file tclRegexp.c.
References CONST, TclRegexp::matches, NULL, TclRegexp::objPtr, TclRegexp::re, regex_t::re_nsub, regmatch_t::rm_eo, regmatch_t::rm_so, size_t(), TclRegexp::string, Tcl_GetString(), and Tcl_UtfAtIndex().
Referenced by SplitMacPath(), and TclpGetNativePathType().250 {
251     TclRegexp *regexpPtr = (TclRegexp *) re;
252     CONST char *string;
253 
254     if ((size_t) index > regexpPtr->re.re_nsub) {
255   *startPtr = *endPtr = NULL;
256     } else if (regexpPtr->matches[index].rm_so < 0) {
257   *startPtr = *endPtr = NULL;
258     } else {
259   if (regexpPtr->objPtr) {
260       string = Tcl_GetString(regexpPtr->objPtr);
261   } else {
262       string = regexpPtr->string;
263   }
264   *startPtr = Tcl_UtfAtIndex(string, regexpPtr->matches[index].rm_so);
265   *endPtr = Tcl_UtfAtIndex(string, regexpPtr->matches[index].rm_eo);
266     }
267 }
int TclRegAbout (Tcl_Interp * interp, Tcl_RegExp re)

Definition at line 621 of file tclRegexp.c.
References TclRegexp::re, regex_t::re_info, regex_t::re_nsub, REG_UBACKREF, REG_UBBS, REG_UBOUNDS, REG_UBRACES, REG_UBSALNUM, REG_UEMPTYMATCH, REG_UIMPOSSIBLE, REG_ULOCALE, REG_ULOOKAHEAD, REG_UNONPOSIX, REG_UPBOTCH, REG_USHORTEST, REG_UUNPORT, REG_UUNSPEC, Tcl_AppendElement(), TCL_INTEGER_SPACE, and Tcl_ResetResult().
Referenced by Tcl_RegexpObjCmd(), and TestregexpObjCmd().624 {
625     TclRegexp *regexpPtr = (TclRegexp *)re;
626     char buf[TCL_INTEGER_SPACE];
627     static struct infoname {
628   int bit;
629   char *text;
630     } infonames[] = {
631   {REG_UBACKREF,    "REG_UBACKREF"},
632   {REG_ULOOKAHEAD,  "REG_ULOOKAHEAD"},
633   {REG_UBOUNDS,   "REG_UBOUNDS"},
634   {REG_UBRACES,   "REG_UBRACES"},
635   {REG_UBSALNUM,    "REG_UBSALNUM"},
636   {REG_UPBOTCH,   "REG_UPBOTCH"},
637   {REG_UBBS,    "REG_UBBS"},
638   {REG_UNONPOSIX,   "REG_UNONPOSIX"},
639   {REG_UUNSPEC,   "REG_UUNSPEC"},
640   {REG_UUNPORT,   "REG_UUNPORT"},
641   {REG_ULOCALE,   "REG_ULOCALE"},
642   {REG_UEMPTYMATCH, "REG_UEMPTYMATCH"},
643   {REG_UIMPOSSIBLE, "REG_UIMPOSSIBLE"},
644   {REG_USHORTEST,   "REG_USHORTEST"},
645   {0,     ""}
646     };
647     struct infoname *inf;
648     int n;
649 
650     Tcl_ResetResult(interp);
651 
652     sprintf(buf, "%u", (unsigned)(regexpPtr->re.re_nsub));
653     Tcl_AppendElement(interp, buf);
654 
655     /*
656      * Must count bits before generating list, because we must know
657      * whether {} are needed before we start appending names.
658      */
659     n = 0;
660     for (inf = infonames; inf->bit != 0; inf++) {
661   if (regexpPtr->re.re_info&inf->bit) {
662       n++;
663   }
664     }
665     if (n != 1) {
666   Tcl_AppendResult(interp, " {", NULL);
667     }
668     for (inf = infonames; inf->bit != 0; inf++) {
669   if (regexpPtr->re.re_info&inf->bit) {
670       Tcl_AppendElement(interp, inf->text);
671   }
672     }
673     if (n != 1) {
674   Tcl_AppendResult(interp, "}", NULL);
675     }
676 
677     return 0;
678 }
void TclRegError (Tcl_Interp * interp, CONST char * msg, int status)

Definition at line 697 of file tclRegexp.c.
References NULL, REG_ITOA, size_t(), Tcl_ResetResult(), and VOID.
Referenced by CompileRegexp(), and RegExpExecUniChar().701 {
702     char buf[100];    /* ample in practice */
703     char cbuf[100];   /* lots in practice */
704     size_t n;
705     char *p;
706 
707     Tcl_ResetResult(interp);
708     n = TclReError(status, (regex_t *)NULL, buf, sizeof(buf));
709     p = (n > sizeof(buf)) ? "..." : "";
710     Tcl_AppendResult(interp, msg, buf, p, NULL);
711 
712     sprintf(cbuf, "%d", status);
713     (VOID) TclReError(REG_ITOA, (regex_t *)NULL, cbuf, sizeof(cbuf));
714     Tcl_SetErrorCode(interp, "REGEXP", cbuf, buf, NULL);
715 }
void TclRegExpRangeUniChar (Tcl_RegExp re, int index, int * startPtr, int * endPtr)

Definition at line 353 of file tclRegexp.c.
References TclRegexp::details, TclRegexp::flags, TclRegexp::matches, TclRegexp::re, regex_t::re_nsub, REG_EXPECT, regmatch_t::rm_eo, rm_detail_t::rm_extend, regmatch_t::rm_so, and size_t().
Referenced by TestregexpObjCmd().364 {
365     TclRegexp *regexpPtr = (TclRegexp *) re;
366 
367     if ((regexpPtr->flags&REG_EXPECT) && index == -1) {
368   *startPtr = regexpPtr->details.rm_extend.rm_so;
369   *endPtr = regexpPtr->details.rm_extend.rm_eo;
370     } else if ((size_t) index > regexpPtr->re.re_nsub) {
371   *startPtr = -1;
372   *endPtr = -1;
373     } else {
374   *startPtr = regexpPtr->matches[index].rm_so;
375   *endPtr = regexpPtr->matches[index].rm_eo;
376     }
377 }

Variable Documentation
Tcl_ThreadDataKey dataKey [static]

Definition at line 84 of file tclRegexp.c.Tcl_ObjType tclRegexpType [static]
Initial value: {
    "regexp",       
    FreeRegexpInternalRep,    
    DupRegexpInternalRep,   
    NULL,       
    SetRegexpFromAny      
}
Definition at line 108 of file tclRegexp.c.
Referenced by DupRegexpInternalRep(), and Tcl_GetRegExpFromObj().

generic/tclRegexp.h File Reference
#include "regex.h"
Classes
struct TclRegexp

generic/tclResolve.c File Reference
#include "tclInt.h"
Functions
static void BumpCmdRefEpochs _ANSI_ARGS_ ((Namespace *nsPtr))
void Tcl_AddInterpResolvers (Tcl_Interp *interp, CONST char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc)
int Tcl_GetInterpResolvers (Tcl_Interp *interp, CONST char *name, Tcl_ResolverInfo *resInfoPtr)
int Tcl_RemoveInterpResolvers (Tcl_Interp *interp, CONST char *name)
static void BumpCmdRefEpochs (Namespace *nsPtr)
void Tcl_SetNamespaceResolvers (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc)
int Tcl_GetNamespaceResolvers (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfoPtr)

Function Documentation
static void BumpCmdRefEpochs _ANSI_ARGS_ ((Namespace *nsPtr)) [static]
static void BumpCmdRefEpochs (Namespace * nsPtr) [static]

Definition at line 260 of file tclResolve.c.
References NULL, Tcl_FirstHashEntry(), Tcl_GetHashValue, and Tcl_NextHashEntry().
Referenced by Tcl_AddInterpResolvers(), and Tcl_RemoveInterpResolvers().262 {
263     Tcl_HashEntry *entry;
264     Tcl_HashSearch search;
265     Namespace *childNsPtr;
266 
267     nsPtr->cmdRefEpoch++;
268 
269     for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
270       entry != NULL;
271       entry = Tcl_NextHashEntry(&search)) {
272 
273         childNsPtr = (Namespace *) Tcl_GetHashValue(entry);
274         BumpCmdRefEpochs(childNsPtr);
275     }
276 }
void Tcl_AddInterpResolvers (Tcl_Interp * interp, CONST char * name, Tcl_ResolveCmdProc * cmdProc, Tcl_ResolveVarProc * varProc, Tcl_ResolveCompiledVarProc * compiledVarProc)

Definition at line 62 of file tclResolve.c.
References BumpCmdRefEpochs(), ckalloc, ResolverScheme::cmdResProc, ResolverScheme::compiledVarResProc, Interp::compileEpoch, Interp::globalNsPtr, ResolverScheme::name, ResolverScheme::nextPtr, NULL, Interp::resolverPtr, and ResolverScheme::varResProc.74 {
75     Interp *iPtr = (Interp*)interp;
76     ResolverScheme *resPtr;
77 
78     /*
79      *  Since we're adding a new name resolution scheme, we must force
80      *  all code to be recompiled to use the new scheme.  If there
81      *  are new compiled variable resolution rules, bump the compiler
82      *  epoch to invalidate compiled code.  If there are new command
83      *  resolution rules, bump the cmdRefEpoch in all namespaces.
84      */
85     if (compiledVarProc) {
86         iPtr->compileEpoch++;
87     }
88     if (cmdProc) {
89         BumpCmdRefEpochs(iPtr->globalNsPtr);
90     }
91 
92     /*
93      *  Look for an existing scheme with the given name.  If found,
94      *  then replace its rules.
95      */
96     for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
97         if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
98             resPtr->cmdResProc = cmdProc;
99             resPtr->varResProc = varProc;
100             resPtr->compiledVarResProc = compiledVarProc;
101             return;
102         }
103     }
104 
105     /*
106      *  Otherwise, this is a new scheme.  Add it to the FRONT
107      *  of the linked list, so that it overrides existing schemes.
108      */
109     resPtr = (ResolverScheme *) ckalloc(sizeof(ResolverScheme));
110     resPtr->name = (char*)ckalloc((unsigned)(strlen(name)+1));
111     strcpy(resPtr->name, name);
112     resPtr->cmdResProc = cmdProc;
113     resPtr->varResProc = varProc;
114     resPtr->compiledVarResProc = compiledVarProc;
115     resPtr->nextPtr = iPtr->resolverPtr;
116     iPtr->resolverPtr = resPtr;
117 }
int Tcl_GetInterpResolvers (Tcl_Interp * interp, CONST char * name, Tcl_ResolverInfo * resInfoPtr)

Definition at line 141 of file tclResolve.c.
References ResolverScheme::cmdResProc, Tcl_ResolverInfo::cmdResProc, ResolverScheme::compiledVarResProc, Tcl_ResolverInfo::compiledVarResProc, ResolverScheme::name, ResolverScheme::nextPtr, NULL, Interp::resolverPtr, ResolverScheme::varResProc, and Tcl_ResolverInfo::varResProc.148 {
149     Interp *iPtr = (Interp*)interp;
150     ResolverScheme *resPtr;
151 
152     /*
153      *  Look for an existing scheme with the given name.  If found,
154      *  then return pointers to its procedures.
155      */
156     for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
157         if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
158       resInfoPtr->cmdResProc = resPtr->cmdResProc;
159       resInfoPtr->varResProc = resPtr->varResProc;
160       resInfoPtr->compiledVarResProc = resPtr->compiledVarResProc;
161             return 1;
162         }
163     }
164 
165     return 0;
166 }
int Tcl_GetNamespaceResolvers (Tcl_Namespace * namespacePtr, Tcl_ResolverInfo * resInfoPtr)

Definition at line 398 of file tclResolve.c.
References Namespace::cmdResProc, Tcl_ResolverInfo::cmdResProc, Namespace::compiledVarResProc, Tcl_ResolverInfo::compiledVarResProc, NULL, Namespace::varResProc, and Tcl_ResolverInfo::varResProc.402                                             : pointers for all
403            * name resolution procedures
404            * assigned to this namespace. */
405 {
406     Namespace *nsPtr = (Namespace*)namespacePtr;
407 
408     resInfoPtr->cmdResProc = nsPtr->cmdResProc;
409     resInfoPtr->varResProc = nsPtr->varResProc;
410     resInfoPtr->compiledVarResProc = nsPtr->compiledVarResProc;
411 
412     if (nsPtr->cmdResProc != NULL ||
413         nsPtr->varResProc != NULL ||
414         nsPtr->compiledVarResProc != NULL) {
415   return 1;
416     }
417     return 0;
418 }
int Tcl_RemoveInterpResolvers (Tcl_Interp * interp, CONST char * name)

Definition at line 193 of file tclResolve.c.
References BumpCmdRefEpochs(), ckfree, ResolverScheme::cmdResProc, ResolverScheme::compiledVarResProc, Interp::compileEpoch, Interp::globalNsPtr, ResolverScheme::name, ResolverScheme::nextPtr, NULL, and Interp::resolverPtr.198 {
199     Interp *iPtr = (Interp*)interp;
200     ResolverScheme **prevPtrPtr, *resPtr;
201 
202     /*
203      *  Look for an existing scheme with the given name.
204      */
205     prevPtrPtr = &iPtr->resolverPtr;
206     for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
207         if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
208             break;
209         }
210         prevPtrPtr = &resPtr->nextPtr;
211     }
212 
213     /*
214      *  If we found the scheme, delete it.
215      */
216     if (resPtr) {
217         /*
218          *  If we're deleting a scheme with compiled variable resolution
219          *  rules, bump the compiler epoch to invalidate compiled code.
220          *  If we're deleting a scheme with command resolution rules,
221          *  bump the cmdRefEpoch in all namespaces.
222          */
223         if (resPtr->compiledVarResProc) {
224             iPtr->compileEpoch++;
225         }
226         if (resPtr->cmdResProc) {
227             BumpCmdRefEpochs(iPtr->globalNsPtr);
228         }
229 
230         *prevPtrPtr = resPtr->nextPtr;
231         ckfree(resPtr->name);
232         ckfree((char *) resPtr);
233 
234         return 1;
235     }
236     return 0;
237 }
void Tcl_SetNamespaceResolvers (Tcl_Namespace * namespacePtr, Tcl_ResolveCmdProc * cmdProc, Tcl_ResolveVarProc * varProc, Tcl_ResolveCompiledVarProc * compiledVarProc)

Definition at line 349 of file tclResolve.c.
References Namespace::cmdRefEpoch, Namespace::cmdResProc, Namespace::compiledVarResProc, Namespace::resolverEpoch, and Namespace::varResProc.358 {
359     Namespace *nsPtr = (Namespace*)namespacePtr;
360 
361     /*
362      *  Plug in the new command resolver, and bump the epoch counters
363      *  so that all code will have to be recompiled and all commands
364      *  will have to be resolved again using the new policy.
365      */
366     nsPtr->cmdResProc = cmdProc;
367     nsPtr->varResProc = varProc;
368     nsPtr->compiledVarResProc = compiledVarProc;
369 
370     nsPtr->cmdRefEpoch++;
371     nsPtr->resolverEpoch++;
372 }

generic/tclResult.c File Reference
#include "tclInt.h"
Defines
#define STATIC_LIST_SIZE  16
Functions
static void ResetObjResult _ANSI_ARGS_ ((Interp *iPtr))
static void SetupAppendBuffer _ANSI_ARGS_ ((Interp *iPtr, int newSpace))
void Tcl_SaveResult (Tcl_Interp *interp, Tcl_SavedResult *statePtr)
void Tcl_RestoreResult (Tcl_Interp *interp, Tcl_SavedResult *statePtr)
void Tcl_DiscardResult (Tcl_SavedResult *statePtr)
void Tcl_SetResult (Tcl_Interp *interp, char *string, Tcl_FreeProc *freeProc)
CONST char * Tcl_GetStringResult (Tcl_Interp *interp)
void Tcl_SetObjResult (Tcl_Interp *interp, Tcl_Obj *objPtr)
Tcl_Obj * Tcl_GetObjResult (Tcl_Interp *interp)
void Tcl_AppendResultVA (Tcl_Interp *interp, va_list argList)
void Tcl_AppendResult TCL_VARARGS_DEF (Tcl_Interp *, arg1)
void Tcl_AppendElement (Tcl_Interp *interp, CONST char *string)
static void SetupAppendBuffer (Interp *iPtr, int newSpace)
void Tcl_FreeResult (Tcl_Interp *interp)
void Tcl_ResetResult (Tcl_Interp *interp)
static void ResetObjResult (Interp *iPtr)
void Tcl_SetErrorCodeVA (Tcl_Interp *interp, va_list argList)
void Tcl_SetObjErrorCode (Tcl_Interp *interp, Tcl_Obj *errorObjPtr)
void TclTransferResult (Tcl_Interp *sourceInterp, int result, Tcl_Interp *targetInterp)

Define Documentation
#define STATIC_LIST_SIZE  16

Function Documentation
static void SetupAppendBuffer _ANSI_ARGS_ ((Interp *iPtr, int newSpace)) [static]
static void ResetObjResult _ANSI_ARGS_ ((Interp *iPtr)) [static]
static void ResetObjResult (Interp * iPtr) [static]

Definition at line 820 of file tclResult.c.
References Tcl_Obj::bytes, ckfree, Tcl_ObjType::freeIntRepProc, Tcl_Obj::length, NULL, Tcl_IncrRefCount, Tcl_IsShared, TclDecrRefCount, tclEmptyStringRep, TclNewObj, and Tcl_Obj::typePtr.
Referenced by Tcl_FreeResult(), Tcl_GetObjResult(), Tcl_ResetResult(), and Tcl_SetResult().823 {
824     register Tcl_Obj *objResultPtr = iPtr->objResultPtr;
825 
826     if (Tcl_IsShared(objResultPtr)) {
827   TclDecrRefCount(objResultPtr);
828   TclNewObj(objResultPtr);
829   Tcl_IncrRefCount(objResultPtr);
830   iPtr->objResultPtr = objResultPtr;
831     } else {
832   if ((objResultPtr->bytes != NULL)
833           && (objResultPtr->bytes != tclEmptyStringRep)) {
834       ckfree((char *) objResultPtr->bytes);
835   }
836   objResultPtr->bytes  = tclEmptyStringRep;
837   objResultPtr->length = 0;
838   if ((objResultPtr->typePtr != NULL)
839           && (objResultPtr->typePtr->freeIntRepProc != NULL)) {
840       objResultPtr->typePtr->freeIntRepProc(objResultPtr);
841   }
842   objResultPtr->typePtr = (Tcl_ObjType *) NULL;
843     }
844 }
static void SetupAppendBuffer (Interp * iPtr, int newSpace) [static]

Definition at line 661 of file tclResult.c.
References ckalloc, ckfree, NULL, Tcl_Interp::result, and Tcl_FreeResult().
Referenced by Tcl_AppendElement(), and Tcl_AppendResultVA().665 {
666     int totalSpace;
667 
668     /*
669      * Make the append buffer larger, if that's necessary, then copy the
670      * result into the append buffer and make the append buffer the official
671      * Tcl result.
672      */
673 
674     if (iPtr->result != iPtr->appendResult) {
675   /*
676    * If an oversized buffer was used recently, then free it up
677    * so we go back to a smaller buffer.  This avoids tying up
678    * memory forever after a large operation.
679    */
680 
681   if (iPtr->appendAvl > 500) {
682       ckfree(iPtr->appendResult);
683       iPtr->appendResult = NULL;
684       iPtr->appendAvl = 0;
685   }
686   iPtr->appendUsed = strlen(iPtr->result);
687     } else if (iPtr->result[iPtr->appendUsed] != 0) {
688   /*
689    * Most likely someone has modified a result created by
690    * Tcl_AppendResult et al. so that it has a different size.
691    * Just recompute the size.
692    */
693 
694   iPtr->appendUsed = strlen(iPtr->result);
695     }
696     
697     totalSpace = newSpace + iPtr->appendUsed;
698     if (totalSpace >= iPtr->appendAvl) {
699   char *new;
700 
701   if (totalSpace < 100) {
702       totalSpace = 200;
703   } else {
704       totalSpace *= 2;
705   }
706   new = (char *) ckalloc((unsigned) totalSpace);
707   strcpy(new, iPtr->result);
708   if (iPtr->appendResult != NULL) {
709       ckfree(iPtr->appendResult);
710   }
711   iPtr->appendResult = new;
712   iPtr->appendAvl = totalSpace;
713     } else if (iPtr->result != iPtr->appendResult) {
714   strcpy(iPtr->appendResult, iPtr->result);
715     }
716     
717     Tcl_FreeResult((Tcl_Interp *) iPtr);
718     iPtr->result = iPtr->appendResult;
719 }
void Tcl_AppendElement (Tcl_Interp * interp, CONST char * string)

Definition at line 594 of file tclResult.c.
References Interp::appendAvl, Interp::appendResult, Interp::appendUsed, Interp::result, SetupAppendBuffer(), Tcl_ConvertElement(), Tcl_GetObjResult(), Tcl_ScanElement(), Tcl_SetResult(), TCL_VOLATILE, TclGetString, and TclNeedSpace().
Referenced by Tcl_AfterObjCmd(), Tcl_GetInterpPath(), Tcl_PackageObjCmd(), TclGetAndDetachPids(), TclGetLoadedPackages(), TclRegAbout(), TestChannelCmd(), TestcmdtokenCmd(), TestfilehandlerCmd(), TestfilewaitCmd(), TestlinkCmd(), TestparsevarObjCmd(), TestsaveresultCmd(), and TestsetCmd().599 {
600     Interp *iPtr = (Interp *) interp;
601     char *dst;
602     int size;
603     int flags;
604 
605     /*
606      * If the string result is empty, move the object result to the
607      * string result, then reset the object result.
608      */
609 
610     if (*(iPtr->result) == 0) {
611   Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
612           TCL_VOLATILE);
613     }
614 
615     /*
616      * See how much space is needed, and grow the append buffer if
617      * needed to accommodate the list element.
618      */
619 
620     size = Tcl_ScanElement(string, &flags) + 1;
621     if ((iPtr->result != iPtr->appendResult)
622       || (iPtr->appendResult[iPtr->appendUsed] != 0)
623       || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) {
624        SetupAppendBuffer(iPtr, size+iPtr->appendUsed);
625     }
626 
627     /*
628      * Convert the string into a list element and copy it to the
629      * buffer that's forming, with a space separator if needed.
630      */
631 
632     dst = iPtr->appendResult + iPtr->appendUsed;
633     if (TclNeedSpace(iPtr->appendResult, dst)) {
634   iPtr->appendUsed++;
635   *dst = ' ';
636   dst++;
637     }
638     iPtr->appendUsed += Tcl_ConvertElement(string, dst, flags);
639 }
void Tcl_AppendResultVA (Tcl_Interp * interp, va_list argList)

Definition at line 449 of file tclResult.c.
References Interp::appendAvl, Interp::appendResult, Interp::appendUsed, ckalloc, ckfree, ckrealloc, NULL, Interp::result, SetupAppendBuffer(), STATIC_LIST_SIZE, Tcl_GetObjResult(), Tcl_SetResult(), TCL_VOLATILE, and TclGetString.
Referenced by TCL_VARARGS_DEF().453 {
454 #define STATIC_LIST_SIZE 16
455     Interp *iPtr = (Interp *) interp;
456     char *string, *static_list[STATIC_LIST_SIZE];
457     char **args = static_list;
458     int nargs_space = STATIC_LIST_SIZE;
459     int nargs, newSpace, i;
460 
461     /*
462      * If the string result is empty, move the object result to the
463      * string result, then reset the object result.
464      */
465 
466     if (*(iPtr->result) == 0) {
467   Tcl_SetResult((Tcl_Interp *) iPtr,
468           TclGetString(Tcl_GetObjResult((Tcl_Interp *) iPtr)),
469           TCL_VOLATILE);
470     }
471     
472     /*
473      * Scan through all the arguments to see how much space is needed
474      * and save pointers to the arguments in the args array,
475      * reallocating as necessary.
476      */
477 
478     nargs = 0;
479     newSpace = 0;
480     while (1) {
481   string = va_arg(argList, char *);
482   if (string == NULL) {
483       break;
484   }
485   if (nargs >= nargs_space) {
486       /* 
487        * Expand the args buffer
488        */
489       nargs_space += STATIC_LIST_SIZE;
490       if (args == static_list) {
491         args = (void *)ckalloc(nargs_space * sizeof(char *));
492     for (i = 0; i < nargs; ++i) {
493         args[i] = static_list[i];
494     }
495       } else {
496     args = (void *)ckrealloc((void *)args,
497       nargs_space * sizeof(char *));
498       }
499   }
500     newSpace += strlen(string);
501   args[nargs++] = string;
502     }
503 
504     /*
505      * If the append buffer isn't already setup and large enough to hold
506      * the new data, set it up.
507      */
508 
509     if ((iPtr->result != iPtr->appendResult)
510       || (iPtr->appendResult[iPtr->appendUsed] != 0)
511       || ((newSpace + iPtr->appendUsed) >= iPtr->appendAvl)) {
512        SetupAppendBuffer(iPtr, newSpace);
513     }
514 
515     /*
516      * Now go through all the argument strings again, copying them into the
517      * buffer.
518      */
519 
520     for (i = 0; i < nargs; ++i) {
521   string = args[i];
522     strcpy(iPtr->appendResult + iPtr->appendUsed, string);
523     iPtr->appendUsed += strlen(string);
524     }
525  
526     /*
527      * If we had to allocate a buffer from the heap, 
528      * free it now.
529      */
530  
531     if (args != static_list) {
532       ckfree((void *)args);
533     }
534 #undef STATIC_LIST_SIZE
535 }
void Tcl_DiscardResult (Tcl_SavedResult * statePtr)

Definition at line 193 of file tclResult.c.
References ckfree, TCL_DYNAMIC, and TclDecrRefCount.
Referenced by CopyRenameOneFile(), TestsaveresultCmd(), and TraceExecutionProc().195 {
196     TclDecrRefCount(statePtr->objResultPtr);
197 
198     if (statePtr->result == statePtr->appendResult) {
199   ckfree(statePtr->appendResult);
200     } else if (statePtr->freeProc) {
201   if (statePtr->freeProc == TCL_DYNAMIC) {
202       ckfree(statePtr->result);
203   } else {
204       (*statePtr->freeProc)(statePtr->result);
205   }
206     }
207 }
void Tcl_FreeResult (Tcl_Interp * interp)

Definition at line 744 of file tclResult.c.
References ckfree, Interp::freeProc, NULL, ResetObjResult(), Interp::result, and TCL_DYNAMIC.
Referenced by DeleteInterpProc(), and SetupAppendBuffer().746 {
747     register Interp *iPtr = (Interp *) interp;
748     
749     if (iPtr->freeProc != NULL) {
750   if (iPtr->freeProc == TCL_DYNAMIC) {
751       ckfree(iPtr->result);
752   } else {
753       (*iPtr->freeProc)(iPtr->result);
754   }
755   iPtr->freeProc = 0;
756     }
757     
758     ResetObjResult(iPtr);
759 }
Tcl_Obj* Tcl_GetObjResult (Tcl_Interp * interp)

Definition at line 393 of file tclResult.c.
References ckfree, Interp::freeProc, NULL, Interp::objResultPtr, ResetObjResult(), Interp::result, Interp::resultSpace, TCL_DYNAMIC, and TclInitStringRep.
Referenced by AliasDelete(), AliasList(), AppendSystemError(), AsyncHandlerProc(), CannotSetAttribute(), CheckAccess(), CheckIfVarUnset(), CompileMathFuncCall(), ConvertFileNameFormat(), CopyData(), DdeServicesOnAck(), DeleteKey(), DeleteValue(), ExecuteCallback(), ExecuteRemoteObject(), ExprAbsFunc(), ExprCallMathFunc(), ExprIntFunc(), ExprRoundFunc(), ExprWideFunc(), FormatClock(), GetFileFinderAttributes(), GetFileReadOnly(), GetInterp(), GetKeyNames(), GetType(), GetValue(), GetValueNames(), GetVariableIndex(), HandleBgErrors(), IllegalExprOperandType(), InfoArgsCmd(), InfoBodyCmd(), InfoCmdCountCmd(), InfoCompleteCmd(), InfoDefaultCmd(), InfoExistsCmd(), InfoHostnameCmd(), InfoLevelCmd(), InfoLibraryCmd(), InfoNameOfExecutableCmd(), InfoPatchLevelCmd(), InfoSharedlibCmd(), InfoTclVersionCmd(), LinkTraceProc(), LoadTableEncoding(), LogSyntaxError(), NamespaceChildrenCmd(), NamespaceCurrentCmd(), NamespaceDeleteCmd(), NamespaceExistsCmd(), NamespaceInscopeCmd(), NamespaceOriginCmd(), NamespaceParentCmd(), NamespaceQualifiersCmd(), NamespaceTailCmd(), NamespaceWhichCmd(), OpenKey(), ParseKeyName(), PrintParse(), ProcBodyTestProcObjCmd(), ProcessProcResultCode(), ProcessUnexpectedResult(), Prompt(), SetBooleanFromAny(), SetDdeError(), SetDoubleFromAny(), SetEndOffsetFromAny(), SetFileFinderAttributes(), SetFileReadOnly(), SetIndexFromAny(), SetIntFromAny(), SetIntOrWideFromAny(), SetOSTypeFromAny(), SetPermissionsAttribute(), SetValue(), SetWideIntFromAny(), SlaveCreate(), SlaveExpose(), SlaveHidden(), SlaveHide(), SlaveInvokeHidden(), SlaveMarkTrusted(), SlaveObjCmd(), SlaveRecursionLimit(), SortCompare(), StatError(), StdinProc(), Tcl_AfterObjCmd(), Tcl_AppendElement(), Tcl_AppendResultVA(), Tcl_ArrayObjCmd(), Tcl_BackgroundError(), Tcl_BeepObjCmd(), Tcl_BinaryObjCmd(), Tcl_CaseObjCmd(), Tcl_CatchObjCmd(), Tcl_CloseObjCmd(), Tcl_CreateNamespace(), Tcl_DdeObjCmd(), TCL_DECLARE_MUTEX(), Tcl_DStringGetResult(), Tcl_EncodingObjCmd(), Tcl_EofObjCmd(), Tcl_Eval(), Tcl_EvalEx(), Tcl_EvalTokens(), Tcl_EvalTokensStandard(), Tcl_ExecObjCmd(), Tcl_Export(), Tcl_ExposeCommand(), Tcl_ExprBoolean(), Tcl_ExprDouble(), Tcl_ExprLong(), Tcl_ExprString(), Tcl_FblockedObjCmd(), Tcl_FcopyObjCmd(), Tcl_FileObjCmd(), Tcl_FindCommand(), Tcl_FindNamespace(), Tcl_FindNamespaceVar(), Tcl_ForeachObjCmd(), Tcl_ForgetImport(), Tcl_GetAlias(), Tcl_GetAliasObj(), Tcl_GetChannelNamesEx(), Tcl_GetEncodingNames(), Tcl_GetLongFromObj(), Tcl_GetMathFuncInfo(), Tcl_GetsObjCmd(), Tcl_GetStringResult(), Tcl_GlobObjCmd(), Tcl_HideCommand(), Tcl_Import(), Tcl_InterpObjCmd(), Tcl_JoinObjCmd(), Tcl_ListObjCmd(), Tcl_LlengthObjCmd(), Tcl_LrangeObjCmd(), Tcl_LreplaceObjCmd(), Tcl_LsearchObjCmd(), Tcl_LsObjCmd(), Tcl_LsortObjCmd(), Tcl_MacBGNotifyObjCmd(), Tcl_MacSourceObjCmd(), Tcl_Main(), Tcl_PackageObjCmd(), Tcl_ParseVar(), Tcl_PidObjCmd(), Tcl_PkgRequireEx(), Tcl_ProcObjCmd(), Tcl_RecordAndEval(), Tcl_RegexpObjCmd(), Tcl_RegsubObjCmd(), Tcl_ResourceObjCmd(), Tcl_ReturnObjCmd(), Tcl_ScanObjCmd(), Tcl_SourceRCFile(), Tcl_SplitObjCmd(), Tcl_StringObjCmd(), Tcl_SubstObj(), Tcl_TellObjCmd(), Tcl_TraceObjCmd(), TclArraySet(), TclCompileAppendCmd(), TclCompileBreakCmd(), TclCompileCatchCmd(), TclCompileContinueCmd(), TclCompileExprCmd(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileIncrCmd(), TclCompileLappendCmd(), TclCompileSetCmd(), TclCompileWhileCmd(), TclCopyChannel(), TclCreateProc(), TclDoGlob(), TclEvalObjvInternal(), TclExecuteByteCode(), TclExprFloatError(), TclFileAttrsCmd(), TclGetIntForIndex(), TclGlob(), TclInterpReady(), TclInvoke(), TclInvokeObjectCommand(), TclObjInvoke(), TclPreventAliasLoop(), TclProcInterpProc(), TclRenameCommand(), TclTraceVariableObjCmd(), TclTransferResult(), TestbooleanobjCmd(), TestChannelEventCmd(), TestconvertobjCmd(), TestdoubleobjCmd(), TesteventProc(), TestfeventCmd(), TestgetvarfullnameCmd(), TestindexobjCmd(), TestintobjCmd(), TestlocaleCmd(), TestobjCmd(), TestregexpObjCmd(), TestsaveresultCmd(), TeststringobjCmd(), TraceVarProc(), ValidateFormat(), and VerifyExprObjType().395 {
396     register Interp *iPtr = (Interp *) interp;
397     Tcl_Obj *objResultPtr;
398     int length;
399 
400     /*
401      * If the string result is non-empty, move the string result to the
402      * object result, then reset the string result.
403      */
404     
405     if (*(iPtr->result) != 0) {
406   ResetObjResult(iPtr);
407   
408   objResultPtr = iPtr->objResultPtr;
409   length = strlen(iPtr->result);
410   TclInitStringRep(objResultPtr, iPtr->result, length);
411   
412   if (iPtr->freeProc != NULL) {
413       if (iPtr->freeProc == TCL_DYNAMIC) {
414     ckfree(iPtr->result);
415       } else {
416     (*iPtr->freeProc)(iPtr->result);
417       }
418       iPtr->freeProc = 0;
419   }
420   iPtr->result = iPtr->resultSpace;
421   iPtr->resultSpace[0] = 0;
422     }
423     return iPtr->objResultPtr;
424 }
CONST char* Tcl_GetStringResult (Tcl_Interp * interp)

Definition at line 299 of file tclResult.c.
References Tcl_GetObjResult(), Tcl_SetResult(), TCL_VOLATILE, and TclGetString.
Referenced by EncodingFromUtfProc(), EncodingToUtfProc(), Tcl_GetInt(), Tcl_Main(), TclGetLong(), and TraceExecutionProc().301 {
302     /*
303      * If the string result is empty, move the object result to the
304      * string result, then reset the object result.
305      */
306     
307     if (*(interp->result) == 0) {
308   Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
309           TCL_VOLATILE);
310     }
311     return interp->result;
312 }
void Tcl_ResetResult (Tcl_Interp * interp)

Definition at line 782 of file tclResult.c.
References ckfree, ERR_ALREADY_LOGGED, ERR_IN_PROGRESS, ERROR_CODE_SET, NULL, ResetObjResult(), Tcl_Interp::result, and TCL_DYNAMIC.
Referenced by AliasObjCmd(), CheckIfVarUnset(), CompileMathFuncCall(), CopyData(), CopyRenameOneFile(), DdeGetServicesList(), DelDeleteProc(), DoTildeSubst(), EncodingFromUtfProc(), EncodingToUtfProc(), ExecuteCallback(), ExprAbsFunc(), ExprCallMathFunc(), ExprIntFunc(), ExprRoundFunc(), ExprWideFunc(), GetTimesCmd(), GetVariableIndex(), IllegalExprOperandType(), LinkTraceProc(), LoadTableEncoding(), LogSyntaxError(), ProcessProcResultCode(), ProcessUnexpectedResult(), SetBooleanFromAny(), SetDoubleFromAny(), SetEndOffsetFromAny(), SetFsPathFromAny(), SetIntFromAny(), SetIntOrWideFromAny(), SetOSTypeFromAny(), SetValue(), SetWideIntFromAny(), SortCompare(), Tcl_BackgroundError(), Tcl_BadChannelOption(), Tcl_BinaryObjCmd(), Tcl_CaseObjCmd(), Tcl_CatchObjCmd(), Tcl_DdeObjCmd(), Tcl_DStringResult(), Tcl_EvalEx(), Tcl_EvalTokens(), Tcl_EvalTokensStandard(), Tcl_ExecObjCmd(), Tcl_FindCommand(), Tcl_FindNamespace(), Tcl_FindNamespaceVar(), Tcl_ForeachObjCmd(), Tcl_ForObjCmd(), Tcl_FSEvalFile(), Tcl_FSLoadFile(), Tcl_GetEncodingNames(), Tcl_GetLongFromObj(), Tcl_GetsObjCmd(), Tcl_GlobObjCmd(), Tcl_Import(), Tcl_InterpObjCmd(), Tcl_LsearchObjCmd(), Tcl_LsObjCmd(), Tcl_ParseVar(), Tcl_PkgRequireEx(), Tcl_ReadObjCmd(), Tcl_RecordAndEval(), Tcl_ResourceObjCmd(), Tcl_RestoreResult(), Tcl_ReturnObjCmd(), Tcl_SourceRCFile(), Tcl_SubstObj(), Tcl_SwitchObjCmd(), Tcl_UpdateObjCmd(), Tcl_VwaitObjCmd(), Tcl_WhileObjCmd(), TclArraySet(), TclCleanupChildren(), TclCompileAppendCmd(), TclCompileBreakCmd(), TclCompileCatchCmd(), TclCompileContinueCmd(), TclCompileExprCmd(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileIncrCmd(), TclCompileLappendCmd(), TclCompileScript(), TclCompileSetCmd(), TclCompileStringCmd(), TclCompileWhileCmd(), TclExecuteByteCode(), TclExprFloatError(), TclFileMakeDirsCmd(), TclFSMakePathFromNormalized(), TclFSMakePathRelative(), TclGetIntForIndex(), TclGlob(), TclInterpReady(), TclObjInvoke(), tclOSAStoreCmd(), TclpMatchInDirectory(), TclpSetVariables(), TclRegAbout(), TclRegError(), TclTransferResult(), TestcmdtraceCmd(), TestintobjCmd(), VarErrMsg(), and VerifyExprObjType().784 {
785     register Interp *iPtr = (Interp *) interp;
786 
787     ResetObjResult(iPtr);
788     if (iPtr->freeProc != NULL) {
789   if (iPtr->freeProc == TCL_DYNAMIC) {
790       ckfree(iPtr->result);
791   } else {
792       (*iPtr->freeProc)(iPtr->result);
793   }
794   iPtr->freeProc = 0;
795     }
796     iPtr->result = iPtr->resultSpace;
797     iPtr->resultSpace[0] = 0;
798     iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS | ERROR_CODE_SET);
799 }
void Tcl_RestoreResult (Tcl_Interp* interp, Tcl_SavedResult * statePtr)

Definition at line 124 of file tclResult.c.
References Interp::appendAvl, Interp::appendResult, Interp::appendUsed, ckfree, Interp::freeProc, NULL, Interp::objResultPtr, Interp::result, Interp::resultSpace, Tcl_DecrRefCount, and Tcl_ResetResult().
Referenced by CopyRenameOneFile(), ExecuteCallback(), HandleBgErrors(), TestReport(), TestsaveresultCmd(), TraceCommandProc(), TraceExecutionProc(), and TraceVarProc().127 {
128     Interp *iPtr = (Interp *) interp;
129 
130     Tcl_ResetResult(interp);
131 
132     /*
133      * Restore the string result.
134      */
135 
136     iPtr->freeProc = statePtr->freeProc;
137     if (statePtr->result == statePtr->resultSpace) {
138   /*
139    * Copy the static string data into the interp buffer.
140    */
141 
142   iPtr->result = iPtr->resultSpace;
143   strcpy(iPtr->result, statePtr->result);
144     } else if (statePtr->result == statePtr->appendResult) {
145   /*
146    * Move the append buffer back into the interp.
147    */
148 
149   if (iPtr->appendResult != NULL) {
150       ckfree((char *)iPtr->appendResult);
151   }
152 
153   iPtr->appendResult = statePtr->appendResult;
154   iPtr->appendAvl = statePtr->appendAvl;
155   iPtr->appendUsed = statePtr->appendUsed;
156   iPtr->result = iPtr->appendResult;
157     } else {
158   /*
159    * Move the dynamic or static string back into the interpreter.
160    */
161 
162   iPtr->result = statePtr->result;
163     }
164 
165     /*
166      * Restore the object result.
167      */
168 
169     Tcl_DecrRefCount(iPtr->objResultPtr);
170     iPtr->objResultPtr = statePtr->objResultPtr;
171 }
void Tcl_SaveResult (Tcl_Interp * interp, Tcl_SavedResult * statePtr)

Definition at line 50 of file tclResult.c.
References Interp::appendAvl, Interp::appendResult, Interp::appendUsed, Interp::freeProc, NULL, Interp::objResultPtr, Interp::result, Interp::resultSpace, Tcl_IncrRefCount, and Tcl_NewObj().
Referenced by CopyRenameOneFile(), ExecuteCallback(), HandleBgErrors(), TestReport(), TestsaveresultCmd(), TraceCommandProc(), TraceExecutionProc(), and TraceVarProc().53 {
54     Interp *iPtr = (Interp *) interp;
55 
56     /*
57      * Move the result object into the save state.  Note that we don't need
58      * to change its refcount because we're moving it, not adding a new
59      * reference.  Put an empty object into the interpreter.
60      */
61 
62     statePtr->objResultPtr = iPtr->objResultPtr;
63     iPtr->objResultPtr = Tcl_NewObj(); 
64     Tcl_IncrRefCount(iPtr->objResultPtr); 
65 
66     /*
67      * Save the string result. 
68      */
69 
70     statePtr->freeProc = iPtr->freeProc;
71     if (iPtr->result == iPtr->resultSpace) {
72   /*
73    * Copy the static string data out of the interp buffer.
74    */
75 
76   statePtr->result = statePtr->resultSpace;
77   strcpy(statePtr->result, iPtr->result);
78   statePtr->appendResult = NULL;
79     } else if (iPtr->result == iPtr->appendResult) {
80   /*
81    * Move the append buffer out of the interp.
82    */
83 
84   statePtr->appendResult = iPtr->appendResult;
85   statePtr->appendAvl = iPtr->appendAvl;
86   statePtr->appendUsed = iPtr->appendUsed;
87   statePtr->result = statePtr->appendResult;
88   iPtr->appendResult = NULL;
89   iPtr->appendAvl = 0;
90   iPtr->appendUsed = 0;
91     } else {
92   /*
93    * Move the dynamic or static string out of the interpreter.
94    */
95 
96   statePtr->result = iPtr->result;
97   statePtr->appendResult = NULL;
98     }
99 
100     iPtr->result = iPtr->resultSpace;
101     iPtr->resultSpace[0] = 0;
102     iPtr->freeProc = 0;
103 }
void Tcl_SetErrorCodeVA (Tcl_Interp * interp, va_list argList)

Definition at line 868 of file tclResult.c.
References ERROR_CODE_SET, Interp::flags, NULL, TCL_APPEND_VALUE, TCL_GLOBAL_ONLY, TCL_LIST_ELEMENT, Tcl_SetVar2(), and void().872 {
873     char *string;
874     int flags;
875     Interp *iPtr = (Interp *) interp;
876 
877     /*
878      * Scan through the arguments one at a time, appending them to
879      * $errorCode as list elements.
880      */
881 
882     flags = TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT;
883     while (1) {
884   string = va_arg(argList, char *);
885   if (string == NULL) {
886       break;
887   }
888   (void) Tcl_SetVar2((Tcl_Interp *) iPtr, "errorCode",
889     (char *) NULL, string, flags);
890   flags |= TCL_APPEND_VALUE;
891     }
892     iPtr->flags |= ERROR_CODE_SET;
893 }
void Tcl_SetObjErrorCode (Tcl_Interp * interp, Tcl_Obj * errorObjPtr)

Definition at line 954 of file tclResult.c.
References ERROR_CODE_SET, Interp::flags, NULL, TCL_GLOBAL_ONLY, and Tcl_SetVar2Ex().
Referenced by Tcl_DdeObjCmd(), TclTransferResult(), and TestsetobjerrorcodeCmd().957 {
958     Interp *iPtr;
959     
960     iPtr = (Interp *) interp;
961     Tcl_SetVar2Ex(interp, "errorCode", NULL, errorObjPtr, TCL_GLOBAL_ONLY);
962     iPtr->flags |= ERROR_CODE_SET;
963 }
void Tcl_SetObjResult (Tcl_Interp * interp, Tcl_Obj * objPtr)

Definition at line 335 of file tclResult.c.
References ckfree, Interp::freeProc, NULL, Interp::objResultPtr, Interp::result, Interp::resultSpace, TCL_DYNAMIC, Tcl_IncrRefCount, and TclDecrRefCount.
Referenced by AliasCreate(), AliasDescribe(), BroadcastValue(), CopyData(), ExecuteCallback(), ExprAbsFunc(), InfoArgsCmd(), InfoBodyCmd(), InfoCommandsCmd(), InfoFunctionsCmd(), InfoGlobalsCmd(), InfoLevelCmd(), InfoLocalsCmd(), InfoProcsCmd(), InfoScriptCmd(), InfoVarsCmd(), LinkTraceProc(), NamespaceChildrenCmd(), NamespaceCodeCmd(), NamespaceExportCmd(), ObjTraceProc(), Pkga_EqObjCmd(), Pkga_QuoteObjCmd(), Pkgb_SubObjCmd(), Pkgb_UnsafeObjCmd(), Pkgc_SubObjCmd(), Pkgc_UnsafeObjCmd(), Pkgd_SubObjCmd(), Pkgd_UnsafeObjCmd(), SlaveRecursionLimit(), Tcl_AfterObjCmd(), Tcl_AppendObjCmd(), Tcl_ArrayObjCmd(), Tcl_ConcatObjCmd(), Tcl_DdeObjCmd(), Tcl_ErrorObjCmd(), Tcl_ExecObjCmd(), Tcl_ExprObjCmd(), Tcl_FileEventObjCmd(), Tcl_FileObjCmd(), Tcl_FormatObjCmd(), Tcl_GetIntFromObj(), Tcl_GetsObjCmd(), Tcl_GlobObjCmd(), Tcl_IncrObjCmd(), Tcl_InterpObjCmd(), Tcl_LappendObjCmd(), Tcl_LindexObjCmd(), Tcl_LinsertObjCmd(), Tcl_LreplaceObjCmd(), Tcl_LsearchObjCmd(), Tcl_LsetObjCmd(), Tcl_PackageObjCmd(), Tcl_PwdObjCmd(), Tcl_ReadObjCmd(), Tcl_RegsubObjCmd(), Tcl_ReturnObjCmd(), Tcl_ScanObjCmd(), Tcl_SetObjCmd(), Tcl_StringObjCmd(), Tcl_SubstObjCmd(), Tcl_TimeObjCmd(), Tcl_TraceObjCmd(), Tcl_WrongNumArgs(), TclCleanupChildren(), TclCompileScript(), TclExecuteByteCode(), TclFileAttrsCmd(), TclGlob(), TclListObjSetElement(), TclLsetFlat(), TclLsetList(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), TclTransferResult(), TestbooleanobjCmd(), TestChannelEventCmd(), TestdoubleobjCmd(), TestencodingObjCmd(), TestfeventCmd(), TestfilelinkCmd(), TestintobjCmd(), TestmainthreadCmd(), TestNumUtfCharsCmd(), TestobjCmd(), TestsaveresultCmd(), TeststringobjCmd(), TestwinclockCmd(), and TestwincpuidCmd().341 {
342     register Interp *iPtr = (Interp *) interp;
343     register Tcl_Obj *oldObjResult = iPtr->objResultPtr;
344 
345     iPtr->objResultPtr = objPtr;
346     Tcl_IncrRefCount(objPtr); /* since interp result is a reference */
347 
348     /*
349      * We wait until the end to release the old object result, in case
350      * we are setting the result to itself.
351      */
352     
353     TclDecrRefCount(oldObjResult);
354 
355     /*
356      * Reset the string result since we just set the result object.
357      */
358 
359     if (iPtr->freeProc != NULL) {
360   if (iPtr->freeProc == TCL_DYNAMIC) {
361       ckfree(iPtr->result);
362   } else {
363       (*iPtr->freeProc)(iPtr->result);
364   }
365   iPtr->freeProc = 0;
366     }
367     iPtr->result = iPtr->resultSpace;
368     iPtr->resultSpace[0] = 0;
369 }
void Tcl_SetResult (Tcl_Interp * interp, char * string, Tcl_FreeProc * freeProc)

Definition at line 227 of file tclResult.c.
References ckalloc, ckfree, Interp::freeProc, NULL, ResetObjResult(), Interp::result, Interp::resultSpace, TCL_DYNAMIC, TCL_RESULT_SIZE, and TCL_VOLATILE.
Referenced by FlushChannel(), ObjMakeUpvar(), ParsePrimaryExpr(), ParseTokens(), ProcessUnexpectedResult(), Tcl_AppendElement(), Tcl_AppendResultVA(), Tcl_ArrayObjCmd(), Tcl_DStringGetResult(), Tcl_DStringResult(), Tcl_Eval(), Tcl_ExprBoolean(), Tcl_ExprDouble(), Tcl_ExprLong(), Tcl_ExprString(), Tcl_FormatObjCmd(), Tcl_FSMatchInDirectory(), Tcl_GetInt(), Tcl_GetStringResult(), Tcl_LoadObjCmd(), Tcl_OSACmd(), Tcl_PackageObjCmd(), Tcl_ParseBraces(), Tcl_ParseCommand(), Tcl_ParseQuotedString(), Tcl_ParseVarName(), Tcl_RecordAndEval(), Tcl_SplitList(), TclCompileLlengthCmd(), TclCreatePipeline(), TclDoGlob(), TclFindElement(), TclGetLong(), TclInvoke(), TclInvokeObjectCommand(), TclOSACompileCmd(), tclOSAInfoCmd(), tclOSALoadCmd(), tclOSARunCmd(), TclpDlopen(), TclpFindSymbol(), TclpGetCwd(), TclProcInterpProc(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), TestasyncCmd(), TestcmdinfoCmd(), TestcmdtokenCmd(), TestcmdtraceCmd(), TestdelCmd(), TestdstringCmd(), TestevalexObjCmd(), TestexprlongCmd(), TestfilehandlerCmd(), TestFilesystemObjCmd(), TestfilewaitCmd(), TestfindexecutableCmd(), TestmainthreadCmd(), TestMathFunc2(), TestobjCmd(), TestsaveresultCmd(), TestsetCmd(), TestseterrorcodeCmd(), TestSimpleFilesystemObjCmd(), TestvolumetypeCmd(), TestWrongNumArgsObjCmd(), and ValidateFormat().232                                                                  :
233          * TCL_STATIC, TCL_VOLATILE, or the address
234          * of a Tcl_FreeProc such as free. */
235 {
236     Interp *iPtr = (Interp *) interp;
237     int length;
238     register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
239     char *oldResult = iPtr->result;
240 
241     if (string == NULL) {
242   iPtr->resultSpace[0] = 0;
243   iPtr->result = iPtr->resultSpace;
244   iPtr->freeProc = 0;
245     } else if (freeProc == TCL_VOLATILE) {
246   length = strlen(string);
247   if (length > TCL_RESULT_SIZE) {
248       iPtr->result = (char *) ckalloc((unsigned) length+1);
249       iPtr->freeProc = TCL_DYNAMIC;
250   } else {
251       iPtr->result = iPtr->resultSpace;
252       iPtr->freeProc = 0;
253   }
254   strcpy(iPtr->result, string);
255     } else {
256   iPtr->result = string;
257   iPtr->freeProc = freeProc;
258     }
259 
260     /*
261      * If the old result was dynamically-allocated, free it up.  Do it
262      * here, rather than at the beginning, in case the new result value
263      * was part of the old result value.
264      */
265 
266     if (oldFreeProc != 0) {
267   if (oldFreeProc == TCL_DYNAMIC) {
268       ckfree(oldResult);
269   } else {
270       (*oldFreeProc)(oldResult);
271   }
272     }
273 
274     /*
275      * Reset the object result since we just set the string result.
276      */
277 
278     ResetObjResult(iPtr);
279 }

void Tcl_AppendResult TCL_VARARGS_DEF (Tcl_Interp *, arg1)

Definition at line 560 of file tclResult.c.
References Tcl_AppendResultVA(), and TCL_VARARGS_START.561 {
562     Tcl_Interp *interp;
563     va_list argList;
564 
565     interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
566     Tcl_AppendResultVA(interp, argList);
567     va_end(argList);
568 }
void TclTransferResult (Tcl_Interp * sourceInterp, int result, Tcl_Interp * targetInterp)

Definition at line 995 of file tclResult.c.
References ERR_ALREADY_LOGGED, ERR_IN_PROGRESS, Interp::flags, NULL, Tcl_AddErrorInfo(), TCL_ERROR, Tcl_GetObjResult(), Tcl_GetVar2Ex(), TCL_GLOBAL_ONLY, Tcl_ResetResult(), Tcl_SetObjErrorCode(), Tcl_SetObjResult(), and Tcl_SetVar2Ex().
Referenced by AliasObjCmd(), SlaveCreate(), SlaveEval(), SlaveExpose(), SlaveHide(), SlaveInvokeHidden(), and Tcl_InterpObjCmd().1006 {
1007     Interp *iPtr;
1008     Tcl_Obj *objPtr;
1009 
1010     if (sourceInterp == targetInterp) {
1011   return;
1012     }
1013 
1014     if (result == TCL_ERROR) {
1015   /*
1016    * An error occurred, so transfer error information from the source
1017    * interpreter to the target interpreter.  Setting the flags tells
1018    * the target interp that it has inherited a partial traceback
1019    * chain, not just a simple error message.
1020    */
1021 
1022   iPtr = (Interp *) sourceInterp;
1023         if ((iPtr->flags & ERR_ALREADY_LOGGED) == 0) {
1024             Tcl_AddErrorInfo(sourceInterp, "");
1025         }
1026         iPtr->flags &= ~(ERR_ALREADY_LOGGED);
1027         
1028         Tcl_ResetResult(targetInterp);
1029         
1030   objPtr = Tcl_GetVar2Ex(sourceInterp, "errorInfo", NULL,
1031     TCL_GLOBAL_ONLY);
1032   if (objPtr) {
1033       Tcl_SetVar2Ex(targetInterp, "errorInfo", NULL, objPtr,
1034         TCL_GLOBAL_ONLY);
1035       ((Interp *) targetInterp)->flags |= ERR_IN_PROGRESS;
1036   }
1037 
1038   objPtr = Tcl_GetVar2Ex(sourceInterp, "errorCode", NULL,
1039     TCL_GLOBAL_ONLY);
1040   if (objPtr) {
1041       Tcl_SetObjErrorCode(targetInterp, objPtr);
1042   }
1043 
1044     }
1045 
1046     ((Interp *) targetInterp)->returnCode = ((Interp *) sourceInterp)->returnCode;
1047     Tcl_SetObjResult(targetInterp, Tcl_GetObjResult(sourceInterp));
1048     Tcl_ResetResult(sourceInterp);
1049 }

generic/tclScan.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Classes
struct CharSet
struct CharSet::Range
Defines
#define SCAN_NOSKIP  0x1
#define SCAN_SUPPRESS  0x2
#define SCAN_UNSIGNED  0x4
#define SCAN_WIDTH  0x8
#define SCAN_SIGNOK  0x10
#define SCAN_NODIGITS  0x20
#define SCAN_NOZERO  0x40
#define SCAN_XOK  0x80
#define SCAN_PTOK  0x100
#define SCAN_EXPOK  0x200
#define SCAN_LONGER  0x400
#define STATIC_LIST_SIZE  16
Functions
static char *BuildCharSet _ANSI_ARGS_ ((CharSet *cset, char *format))
static int CharInSet _ANSI_ARGS_ ((CharSet *cset, int ch))
static void ReleaseCharSet _ANSI_ARGS_ ((CharSet *cset))
static int ValidateFormat _ANSI_ARGS_ ((Tcl_Interp *interp, char *format, int numVars, int *totalVars))
static char * BuildCharSet (CharSet *cset, char *format)
static int CharInSet (CharSet *cset, int c)
static void ReleaseCharSet (CharSet *cset)
static int ValidateFormat (Tcl_Interp *interp, char *format, int numVars, int *totalSubs)
int Tcl_ScanObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)

Define Documentation
#define SCAN_EXPOK  0x200

Definition at line 34 of file tclScan.c.
Referenced by Tcl_ScanObjCmd().#define SCAN_LONGER  0x400

Definition at line 36 of file tclScan.c.
Referenced by Tcl_ScanObjCmd(), and ValidateFormat().#define SCAN_NODIGITS  0x20

Definition at line 30 of file tclScan.c.
Referenced by Tcl_ScanObjCmd().#define SCAN_NOSKIP  0x1

Definition at line 24 of file tclScan.c.
Referenced by Tcl_ScanObjCmd().#define SCAN_NOZERO  0x40

Definition at line 31 of file tclScan.c.
Referenced by Tcl_ScanObjCmd().#define SCAN_PTOK  0x100

Definition at line 33 of file tclScan.c.
Referenced by Tcl_ScanObjCmd().#define SCAN_SIGNOK  0x10

Definition at line 29 of file tclScan.c.
Referenced by Tcl_ScanObjCmd().#define SCAN_SUPPRESS  0x2

Definition at line 25 of file tclScan.c.
Referenced by Tcl_ScanObjCmd(), and ValidateFormat().#define SCAN_UNSIGNED  0x4

Definition at line 26 of file tclScan.c.
Referenced by Tcl_ScanObjCmd().#define SCAN_WIDTH  0x8

Definition at line 27 of file tclScan.c.
Referenced by ValidateFormat().#define SCAN_XOK  0x80

Definition at line 32 of file tclScan.c.
Referenced by Tcl_ScanObjCmd().#define STATIC_LIST_SIZE  16

Function Documentation
static int ValidateFormat _ANSI_ARGS_ ((Tcl_Interp *interp, char *format, int numVars, int *totalVars)) [static]
static void ReleaseCharSet _ANSI_ARGS_ ((CharSet *cset)) [static]
static int CharInSet _ANSI_ARGS_ ((CharSet *cset, int ch)) [static]
static char* BuildCharSet _ANSI_ARGS_ ((CharSet *cset, char *format)) [static]
static char* BuildCharSet (CharSet * cset, char * format) [static]

Definition at line 83 of file tclScan.c.
References ckalloc, NULL, and Tcl_UtfToUniChar().
Referenced by Tcl_ScanObjCmd().86 {
87     Tcl_UniChar ch, start;
88     int offset, nranges;
89     char *end;
90 
91     memset(cset, 0, sizeof(CharSet));
92     
93     offset = Tcl_UtfToUniChar(format, &ch);
94     if (ch == '^') {
95   cset->exclude = 1;
96   format += offset;
97   offset = Tcl_UtfToUniChar(format, &ch);
98     }
99     end = format + offset;
100 
101     /*
102      * Find the close bracket so we can overallocate the set.
103      */
104 
105     if (ch == ']') {
106   end += Tcl_UtfToUniChar(end, &ch);
107     }
108     nranges = 0;
109     while (ch != ']') {
110   if (ch == '-') {
111       nranges++;
112   }
113   end += Tcl_UtfToUniChar(end, &ch);
114     }
115 
116     cset->chars = (Tcl_UniChar *) ckalloc(sizeof(Tcl_UniChar)
117       * (end - format - 1));
118     if (nranges > 0) {
119   cset->ranges = (struct Range *) ckalloc(sizeof(struct Range)*nranges);
120     } else {
121   cset->ranges = NULL;
122     }
123 
124     /*
125      * Now build the character set.
126      */
127 
128     cset->nchars = cset->nranges = 0;
129     format += Tcl_UtfToUniChar(format, &ch);
130     start = ch;
131     if (ch == ']' || ch == '-') {
132   cset->chars[cset->nchars++] = ch;
133   format += Tcl_UtfToUniChar(format, &ch);
134     }
135     while (ch != ']') {
136   if (*format == '-') {
137       /*
138        * This may be the first character of a range, so don't add
139        * it yet.
140        */
141 
142       start = ch;
143   } else if (ch == '-') {
144       /*
145        * Check to see if this is the last character in the set, in which
146        * case it is not a range and we should add the previous character
147        * as well as the dash.
148        */
149 
150       if (*format == ']') {
151     cset->chars[cset->nchars++] = start;
152     cset->chars[cset->nchars++] = ch;
153       } else {
154     format += Tcl_UtfToUniChar(format, &ch);
155 
156     /*
157      * Check to see if the range is in reverse order.
158      */
159 
160     if (start < ch) {
161         cset->ranges[cset->nranges].start = start;
162         cset->ranges[cset->nranges].end = ch;
163     } else {
164         cset->ranges[cset->nranges].start = ch;
165         cset->ranges[cset->nranges].end = start;
166     }       
167     cset->nranges++;
168       }
169   } else {
170       cset->chars[cset->nchars++] = ch;
171   }
172   format += Tcl_UtfToUniChar(format, &ch);
173     }
174     return format;
175 }
static int CharInSet (CharSet * cset, int c) [static]

Definition at line 194 of file tclScan.c.
Referenced by Tcl_ScanObjCmd().198 {
199     Tcl_UniChar ch = (Tcl_UniChar) c;
200     int i, match = 0;
201     for (i = 0; i < cset->nchars; i++) {
202   if (cset->chars[i] == ch) {
203       match = 1;
204       break;
205   }
206     }
207     if (!match) {
208   for (i = 0; i < cset->nranges; i++) {
209       if ((cset->ranges[i].start <= ch)
210         && (ch <= cset->ranges[i].end)) {
211     match = 1;
212     break;
213       }
214   }
215     }
216     return (cset->exclude ? !match : match);    
217 }
static void ReleaseCharSet (CharSet * cset) [static]

Definition at line 236 of file tclScan.c.
References ckfree.
Referenced by Tcl_ScanObjCmd().238 {
239     ckfree((char *)cset->chars);
240     if (cset->ranges) {
241   ckfree((char *)cset->ranges);
242     }
243 }
int Tcl_ScanObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 565 of file tclScan.c.
References BuildCharSet(), CharInSet(), ckalloc, ckfree, format, NULL, ReleaseCharSet(), SCAN_EXPOK, SCAN_LONGER, SCAN_NODIGITS, SCAN_NOSKIP, SCAN_NOZERO, SCAN_PTOK, SCAN_SIGNOK, SCAN_SUPPRESS, SCAN_UNSIGNED, SCAN_XOK, size_t(), strtod(), strtol(), strtoll(), strtoul(), strtoull(), Tcl_DecrRefCount, TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_ListObjAppendElement(), TCL_LL_MODIFIER, Tcl_NewDoubleObj(), Tcl_NewIntObj(), Tcl_NewLongObj(), Tcl_NewObj(), Tcl_NewStringObj(), Tcl_NewWideIntObj(), Tcl_ObjSetVar2(), TCL_OK, Tcl_SetListObj(), Tcl_SetObjResult(), Tcl_UniCharIsSpace(), Tcl_UtfToUniChar(), Tcl_WrongNumArgs(), UCHAR, and ValidateFormat().570 {
571     char *format;
572     int numVars, nconversions, totalVars = -1;
573     int objIndex, offset, i, result, code;
574     long value;
575     char *string, *end, *baseString;
576     char op = 0;
577     int base = 0;
578     int underflow = 0;
579     size_t width;
580     long (*fn)() = NULL;
581 #ifndef TCL_WIDE_INT_IS_LONG
582     Tcl_WideInt (*lfn)() = NULL;
583     Tcl_WideInt wideValue;
584 #endif
585     Tcl_UniChar ch, sch;
586     Tcl_Obj **objs = NULL, *objPtr = NULL;
587     int flags;
588     char buf[513];        /* Temporary buffer to hold scanned
589              * number strings before they are
590              * passed to strtoul. */
591 
592     if (objc < 3) {
593         Tcl_WrongNumArgs(interp, 1, objv,
594     "string format ?varName varName ...?");
595   return TCL_ERROR;
596     }
597 
598     format = Tcl_GetStringFromObj(objv[2], NULL);
599     numVars = objc-3;
600 
601     /*
602      * Check for errors in the format string.
603      */
604     
605     if (ValidateFormat(interp, format, numVars, &totalVars) == TCL_ERROR) {
606   return TCL_ERROR;
607     }
608 
609     /*
610      * Allocate space for the result objects.
611      */
612 
613     if (totalVars > 0) {
614   objs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj*) * totalVars);
615   for (i = 0; i < totalVars; i++) {
616       objs[i] = NULL;
617   }
618     }
619 
620     string = Tcl_GetStringFromObj(objv[1], NULL);
621     baseString = string;
622 
623     /*
624      * Iterate over the format string filling in the result objects until
625      * we reach the end of input, the end of the format string, or there
626      * is a mismatch.
627      */
628 
629     objIndex = 0;
630     nconversions = 0;
631     while (*format != '\0') {
632   format += Tcl_UtfToUniChar(format, &ch);
633 
634   flags = 0;
635 
636   /*
637    * If we see whitespace in the format, skip whitespace in the string.
638    */
639 
640   if (Tcl_UniCharIsSpace(ch)) {
641       offset = Tcl_UtfToUniChar(string, &sch);
642       while (Tcl_UniCharIsSpace(sch)) {
643     if (*string == '\0') {
644         goto done;
645     }
646     string += offset;
647     offset = Tcl_UtfToUniChar(string, &sch);
648       }
649       continue;
650   }
651       
652   if (ch != '%') {
653       literal:
654       if (*string == '\0') {
655     underflow = 1;
656     goto done;
657       }
658       string += Tcl_UtfToUniChar(string, &sch);
659       if (ch != sch) {
660     goto done;
661       }
662       continue;
663   }
664 
665   format += Tcl_UtfToUniChar(format, &ch);
666   if (ch == '%') {
667       goto literal;
668   }
669 
670   /*
671    * Check for assignment suppression ('*') or an XPG3-style
672    * assignment ('%n$').
673    */
674 
675   if (ch == '*') {
676       flags |= SCAN_SUPPRESS;
677       format += Tcl_UtfToUniChar(format, &ch);
678   } else if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
679       value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */
680       if (*end == '$') {
681     format = end+1;
682     format += Tcl_UtfToUniChar(format, &ch);
683     objIndex = (int) value - 1;
684       }
685   }
686 
687   /*
688    * Parse any width specifier.
689    */
690 
691   if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
692       width = strtoul(format-1, &format, 10); /* INTL: "C" locale. */
693       format += Tcl_UtfToUniChar(format, &ch);
694   } else {
695       width = 0;
696   }
697 
698   /*
699    * Handle any size specifier.
700    */
701 
702   switch (ch) {
703   case 'l':
704   case 'L':
705       flags |= SCAN_LONGER;
706       /*
707        * Fall through so we skip to the next character.
708        */
709   case 'h':
710       format += Tcl_UtfToUniChar(format, &ch);
711   }
712 
713   /*
714    * Handle the various field types.
715    */
716 
717   switch (ch) {
718       case 'n':
719     if (!(flags & SCAN_SUPPRESS)) {
720         objPtr = Tcl_NewIntObj(string - baseString);
721         Tcl_IncrRefCount(objPtr);
722         objs[objIndex++] = objPtr;
723     }
724     nconversions++;
725     continue;
726 
727       case 'd':
728     op = 'i';
729     base = 10;
730     fn = (long (*)())strtol;
731 #ifndef TCL_WIDE_INT_IS_LONG
732     lfn = (Tcl_WideInt (*)())strtoll;
733 #endif
734     break;
735       case 'i':
736     op = 'i';
737     base = 0;
738     fn = (long (*)())strtol;
739 #ifndef TCL_WIDE_INT_IS_LONG
740     lfn = (Tcl_WideInt (*)())strtoll;
741 #endif
742     break;
743       case 'o':
744     op = 'i';
745     base = 8;
746     fn = (long (*)())strtoul;
747 #ifndef TCL_WIDE_INT_IS_LONG
748     lfn = (Tcl_WideInt (*)())strtoull;
749 #endif
750     break;
751       case 'x':
752     op = 'i';
753     base = 16;
754     fn = (long (*)())strtoul;
755 #ifndef TCL_WIDE_INT_IS_LONG
756     lfn = (Tcl_WideInt (*)())strtoull;
757 #endif
758     break;
759       case 'u':
760     op = 'i';
761     base = 10;
762     flags |= SCAN_UNSIGNED;
763     fn = (long (*)())strtoul;
764 #ifndef TCL_WIDE_INT_IS_LONG
765     lfn = (Tcl_WideInt (*)())strtoull;
766 #endif
767     break;
768 
769       case 'f':
770       case 'e':
771       case 'g':
772     op = 'f';
773     break;
774 
775       case 's':
776     op = 's';
777     break;
778 
779       case 'c':
780     op = 'c';
781     flags |= SCAN_NOSKIP;
782     break;
783       case '[':
784     op = '[';
785     flags |= SCAN_NOSKIP;
786     break;
787   }
788 
789   /*
790    * At this point, we will need additional characters from the
791    * string to proceed.
792    */
793 
794   if (*string == '\0') {
795       underflow = 1;
796       goto done;
797   }
798   
799   /*
800    * Skip any leading whitespace at the beginning of a field unless
801    * the format suppresses this behavior.
802    */
803 
804   if (!(flags & SCAN_NOSKIP)) {
805       while (*string != '\0') {
806     offset = Tcl_UtfToUniChar(string, &sch);
807     if (!Tcl_UniCharIsSpace(sch)) {
808         break;
809     }
810     string += offset;
811       }
812       if (*string == '\0') {
813     underflow = 1;
814     goto done;
815       }
816   }
817 
818   /*
819    * Perform the requested scanning operation.
820    */
821   
822   switch (op) {
823       case 's':
824     /*
825      * Scan a string up to width characters or whitespace.
826      */
827 
828     if (width == 0) {
829         width = (size_t) ~0;
830     }
831     end = string;
832     while (*end != '\0') {
833         offset = Tcl_UtfToUniChar(end, &sch);
834         if (Tcl_UniCharIsSpace(sch)) {
835       break;
836         }
837         end += offset;
838         if (--width == 0) {
839       break;
840         }
841     }
842     if (!(flags & SCAN_SUPPRESS)) {
843         objPtr = Tcl_NewStringObj(string, end-string);
844         Tcl_IncrRefCount(objPtr);
845         objs[objIndex++] = objPtr;
846     }
847     string = end;
848     break;
849 
850       case '[': {
851     CharSet cset;
852 
853     if (width == 0) {
854         width = (size_t) ~0;
855     }
856     end = string;
857 
858     format = BuildCharSet(&cset, format);
859     while (*end != '\0') {
860         offset = Tcl_UtfToUniChar(end, &sch);
861         if (!CharInSet(&cset, (int)sch)) {
862       break;
863         }
864         end += offset;
865         if (--width == 0) {
866       break;
867         }
868     }
869     ReleaseCharSet(&cset);
870 
871     if (string == end) {
872         /*
873          * Nothing matched the range, stop processing
874          */
875         goto done;
876     }
877     if (!(flags & SCAN_SUPPRESS)) {
878         objPtr = Tcl_NewStringObj(string, end-string);
879         Tcl_IncrRefCount(objPtr);
880         objs[objIndex++] = objPtr;
881     }
882     string = end;
883     
884     break;
885       }
886       case 'c':
887     /*
888      * Scan a single Unicode character.
889      */
890 
891     string += Tcl_UtfToUniChar(string, &sch);
892     if (!(flags & SCAN_SUPPRESS)) {
893         objPtr = Tcl_NewIntObj((int)sch);
894         Tcl_IncrRefCount(objPtr);
895         objs[objIndex++] = objPtr;
896     }
897     break;
898 
899       case 'i':
900     /*
901      * Scan an unsigned or signed integer.
902      */
903 
904     if ((width == 0) || (width > sizeof(buf) - 1)) {
905         width = sizeof(buf) - 1;
906     }
907     flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_NOZERO;
908     for (end = buf; width > 0; width--) {
909         switch (*string) {
910       /*
911        * The 0 digit has special meaning at the beginning of
912        * a number.  If we are unsure of the base, it
913        * indicates that we are in base 8 or base 16 (if it is
914        * followed by an 'x').
915        *
916        * 8.1 - 8.3.4 incorrectly handled 0x... base-16
917        * cases for %x by not reading the 0x as the
918        * auto-prelude for base-16. [Bug #495213]
919        */
920       case '0':
921           if (base == 0) {
922         base = 8;
923         flags |= SCAN_XOK;
924           }
925           if (base == 16) {
926         flags |= SCAN_XOK;
927           }
928           if (flags & SCAN_NOZERO) {
929         flags &= ~(SCAN_SIGNOK | SCAN_NODIGITS
930           | SCAN_NOZERO);
931           } else {
932         flags &= ~(SCAN_SIGNOK | SCAN_XOK
933           | SCAN_NODIGITS);
934           }
935           goto addToInt;
936 
937       case '1': case '2': case '3': case '4':
938       case '5': case '6': case '7':
939           if (base == 0) {
940         base = 10;
941           }
942           flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);
943           goto addToInt;
944 
945       case '8': case '9':
946           if (base == 0) {
947         base = 10;
948           }
949           if (base <= 8) {
950         break;
951           }
952           flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);
953           goto addToInt;
954 
955       case 'A': case 'B': case 'C':
956       case 'D': case 'E': case 'F': 
957       case 'a': case 'b': case 'c':
958       case 'd': case 'e': case 'f':
959           if (base <= 10) {
960         break;
961           }
962           flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);
963           goto addToInt;
964 
965       case '+': case '-':
966           if (flags & SCAN_SIGNOK) {
967         flags &= ~SCAN_SIGNOK;
968         goto addToInt;
969           }
970           break;
971 
972       case 'x': case 'X':
973           if ((flags & SCAN_XOK) && (end == buf+1)) {
974         base = 16;
975         flags &= ~SCAN_XOK;
976         goto addToInt;
977           }
978           break;
979         }
980 
981         /*
982          * We got an illegal character so we are done accumulating.
983          */
984 
985         break;
986 
987         addToInt:
988         /*
989          * Add the character to the temporary buffer.
990          */
991 
992         *end++ = *string++;
993         if (*string == '\0') {
994       break;
995         }
996     }
997 
998     /*
999      * Check to see if we need to back up because we only got a
1000      * sign or a trailing x after a 0.
1001      */
1002 
1003     if (flags & SCAN_NODIGITS) {
1004         if (*string == '\0') {
1005       underflow = 1;
1006         }
1007         goto done;
1008     } else if (end[-1] == 'x' || end[-1] == 'X') {
1009         end--;
1010         string--;
1011     }
1012 
1013 
1014     /*
1015      * Scan the value from the temporary buffer.  If we are
1016      * returning a large unsigned value, we have to convert it back
1017      * to a string since Tcl only supports signed values.
1018      */
1019 
1020     if (!(flags & SCAN_SUPPRESS)) {
1021         *end = '\0';
1022 #ifndef TCL_WIDE_INT_IS_LONG
1023         if (flags & SCAN_LONGER) {
1024       wideValue = (Tcl_WideInt) (*lfn)(buf, NULL, base);
1025       if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
1026           /* INTL: ISO digit */
1027           sprintf(buf, "%" TCL_LL_MODIFIER "u",
1028             (Tcl_WideUInt)wideValue);
1029           objPtr = Tcl_NewStringObj(buf, -1);
1030       } else {
1031           objPtr = Tcl_NewWideIntObj(wideValue);
1032       }
1033         } else {
1034 #endif /* !TCL_WIDE_INT_IS_LONG */
1035       value = (long) (*fn)(buf, NULL, base);
1036       if ((flags & SCAN_UNSIGNED) && (value < 0)) {
1037           sprintf(buf, "%lu", value); /* INTL: ISO digit */
1038           objPtr = Tcl_NewStringObj(buf, -1);
1039       } else if ((flags & SCAN_LONGER)
1040         || (unsigned long) value > UINT_MAX) {
1041           objPtr = Tcl_NewLongObj(value);
1042       } else {
1043           objPtr = Tcl_NewIntObj(value);
1044       }
1045 #ifndef TCL_WIDE_INT_IS_LONG
1046         }
1047 #endif
1048         Tcl_IncrRefCount(objPtr);
1049         objs[objIndex++] = objPtr;
1050     }
1051 
1052     break;
1053 
1054       case 'f':
1055     /*
1056      * Scan a floating point number
1057      */
1058 
1059     if ((width == 0) || (width > sizeof(buf) - 1)) {
1060         width = sizeof(buf) - 1;
1061     }
1062     flags &= ~SCAN_LONGER;
1063     flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_PTOK | SCAN_EXPOK;
1064     for (end = buf; width > 0; width--) {
1065         switch (*string) {
1066       case '0': case '1': case '2': case '3':
1067       case '4': case '5': case '6': case '7':
1068       case '8': case '9':
1069           flags &= ~(SCAN_SIGNOK | SCAN_NODIGITS);
1070           goto addToFloat;
1071       case '+': case '-':
1072           if (flags & SCAN_SIGNOK) {
1073         flags &= ~SCAN_SIGNOK;
1074         goto addToFloat;
1075           }
1076           break;
1077       case '.':
1078           if (flags & SCAN_PTOK) {
1079         flags &= ~(SCAN_SIGNOK | SCAN_PTOK);
1080         goto addToFloat;
1081           }
1082           break;
1083       case 'e': case 'E':
1084           /*
1085            * An exponent is not allowed until there has
1086            * been at least one digit.
1087            */
1088 
1089           if ((flags & (SCAN_NODIGITS | SCAN_EXPOK))
1090             == SCAN_EXPOK) {
1091         flags = (flags & ~(SCAN_EXPOK|SCAN_PTOK))
1092             | SCAN_SIGNOK | SCAN_NODIGITS;
1093         goto addToFloat;
1094           }
1095           break;
1096         }
1097 
1098         /*
1099          * We got an illegal character so we are done accumulating.
1100          */
1101 
1102         break;
1103 
1104         addToFloat:
1105         /*
1106          * Add the character to the temporary buffer.
1107          */
1108 
1109         *end++ = *string++;
1110         if (*string == '\0') {
1111       break;
1112         }
1113     }
1114 
1115     /*
1116      * Check to see if we need to back up because we saw a
1117      * trailing 'e' or sign.
1118      */
1119 
1120     if (flags & SCAN_NODIGITS) {
1121         if (flags & SCAN_EXPOK) {
1122       /*
1123        * There were no digits at all so scanning has
1124        * failed and we are done.
1125        */
1126       if (*string == '\0') {
1127           underflow = 1;
1128       }
1129       goto done;
1130         }
1131 
1132         /*
1133          * We got a bad exponent ('e' and maybe a sign).
1134          */
1135 
1136         end--;
1137         string--;
1138         if (*end != 'e' && *end != 'E') {
1139       end--;
1140       string--;
1141         }
1142     }
1143 
1144     /*
1145      * Scan the value from the temporary buffer.
1146      */
1147 
1148     if (!(flags & SCAN_SUPPRESS)) {
1149         double dvalue;
1150         *end = '\0';
1151         dvalue = strtod(buf, NULL);
1152         objPtr = Tcl_NewDoubleObj(dvalue);
1153         Tcl_IncrRefCount(objPtr);
1154         objs[objIndex++] = objPtr;
1155     }
1156     break;
1157   }
1158   nconversions++;
1159     }
1160 
1161     done:
1162     result = 0;
1163     code = TCL_OK;
1164 
1165     if (numVars) {
1166   /*
1167    * In this case, variables were specified (classic scan)
1168    */
1169   for (i = 0; i < totalVars; i++) {
1170       if (objs[i] != NULL) {
1171     Tcl_Obj *tmpPtr;
1172     
1173     result++;
1174     tmpPtr = Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], 0);
1175     Tcl_DecrRefCount(objs[i]);
1176     if (tmpPtr == NULL) {
1177         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1178           "couldn't set variable \"",
1179           Tcl_GetString(objv[i+3]), "\"", (char *) NULL);
1180         code = TCL_ERROR;
1181     }
1182       }
1183   }
1184     } else {
1185   /*
1186    * Here no vars were specified, we want a list returned (inline scan)
1187    */
1188   objPtr = Tcl_NewObj();
1189   for (i = 0; i < totalVars; i++) {
1190       if (objs[i] != NULL) {
1191     Tcl_ListObjAppendElement(NULL, objPtr, objs[i]);
1192     Tcl_DecrRefCount(objs[i]);
1193       } else {
1194     /*
1195      * More %-specifiers than matching chars, so we
1196      * just spit out empty strings for these
1197      */
1198     Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj());
1199       }
1200   }
1201     }
1202     if (objs != NULL) {
1203   ckfree((char*) objs);
1204     }
1205     if (code == TCL_OK) {
1206   if (underflow && (nconversions == 0)) {
1207       if (numVars) {
1208     objPtr = Tcl_NewIntObj(-1);
1209       } else {
1210     if (objPtr) {
1211         Tcl_SetListObj(objPtr, 0, NULL);
1212     } else {
1213         objPtr = Tcl_NewObj();
1214     }
1215       }
1216   } else if (numVars) {
1217       objPtr = Tcl_NewIntObj(result);
1218   }
1219   Tcl_SetObjResult(interp, objPtr);
1220     }
1221     return code;
1222 }
static int ValidateFormat (Tcl_Interp * interp, char * format, int numVars, int * totalSubs) [static]

Definition at line 263 of file tclScan.c.
References ckalloc, ckfree, ckrealloc, NULL, SCAN_LONGER, SCAN_SUPPRESS, SCAN_WIDTH, STATIC_LIST_SIZE, strtoul(), TCL_ERROR, Tcl_GetObjResult(), TCL_OK, Tcl_SetResult(), TCL_STATIC, Tcl_UniCharToUtf(), TCL_UTF_MAX, Tcl_UtfToUniChar(), and UCHAR.
Referenced by Tcl_ScanObjCmd().270 {
271 #define STATIC_LIST_SIZE 16
272     int gotXpg, gotSequential, value, i, flags;
273     char *end;
274     Tcl_UniChar ch;
275     int staticAssign[STATIC_LIST_SIZE];
276     int *nassign = staticAssign;
277     int objIndex, xpgSize, nspace = STATIC_LIST_SIZE;
278     char buf[TCL_UTF_MAX+1];
279 
280     /*
281      * Initialize an array that records the number of times a variable
282      * is assigned to by the format string.  We use this to detect if
283      * a variable is multiply assigned or left unassigned.
284      */
285 
286     if (numVars > nspace) {
287   nassign = (int*)ckalloc(sizeof(int) * numVars);
288   nspace = numVars;
289     }
290     for (i = 0; i < nspace; i++) {
291   nassign[i] = 0;
292     }
293 
294     xpgSize = objIndex = gotXpg = gotSequential = 0;
295 
296     while (*format != '\0') {
297   format += Tcl_UtfToUniChar(format, &ch);
298 
299   flags = 0;
300 
301   if (ch != '%') {
302       continue;
303   }
304   format += Tcl_UtfToUniChar(format, &ch);
305   if (ch == '%') {
306       continue;
307   }
308   if (ch == '*') {
309       flags |= SCAN_SUPPRESS;
310       format += Tcl_UtfToUniChar(format, &ch);
311       goto xpgCheckDone;
312   }
313 
314   if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
315       /*
316        * Check for an XPG3-style %n$ specification.  Note: there
317        * must not be a mixture of XPG3 specs and non-XPG3 specs
318        * in the same format string.
319        */
320 
321       value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */
322       if (*end != '$') {
323     goto notXpg;
324       }
325       format = end+1;
326       format += Tcl_UtfToUniChar(format, &ch);
327       gotXpg = 1;
328       if (gotSequential) {
329     goto mixedXPG;
330       }
331       objIndex = value - 1;
332       if ((objIndex < 0) || (numVars && (objIndex >= numVars))) {
333     goto badIndex;
334       } else if (numVars == 0) {
335     /*
336      * In the case where no vars are specified, the user can
337      * specify %9999$ legally, so we have to consider special
338      * rules for growing the assign array.  'value' is
339      * guaranteed to be > 0.
340      */
341     xpgSize = (xpgSize > value) ? xpgSize : value;
342       }
343       goto xpgCheckDone;
344   }
345 
346   notXpg:
347   gotSequential = 1;
348   if (gotXpg) {
349       mixedXPG:
350       Tcl_SetResult(interp,
351         "cannot mix \"%\" and \"%n$\" conversion specifiers",
352         TCL_STATIC);
353       goto error;
354   }
355 
356   xpgCheckDone:
357   /*
358    * Parse any width specifier.
359    */
360 
361   if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
362       value = strtoul(format-1, &format, 10); /* INTL: "C" locale. */
363       flags |= SCAN_WIDTH;
364       format += Tcl_UtfToUniChar(format, &ch);
365   }
366 
367   /*
368    * Handle any size specifier.
369    */
370 
371   switch (ch) {
372   case 'l':
373   case 'L':
374       flags |= SCAN_LONGER;
375   case 'h':
376       format += Tcl_UtfToUniChar(format, &ch);
377   }
378 
379   if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) {
380       goto badIndex;
381   }
382 
383   /*
384    * Handle the various field types.
385    */
386 
387   switch (ch) {
388       case 'c':
389                 if (flags & SCAN_WIDTH) {
390         Tcl_SetResult(interp,
391           "field width may not be specified in %c conversion",
392           TCL_STATIC);
393         goto error;
394                 }
395     /*
396      * Fall through!
397      */
398       case 'n':
399       case 's':
400     if (flags & SCAN_LONGER) {
401     invalidLonger:
402         buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
403         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
404          "'l' modifier may not be specified in %", buf,
405          " conversion", NULL);
406         goto error;
407     }
408     /*
409      * Fall through!
410      */
411       case 'd':
412       case 'e':
413       case 'f':
414       case 'g':
415       case 'i':
416       case 'o':
417       case 'u':
418       case 'x':
419     break;
420     /*
421      * Bracket terms need special checking
422      */
423       case '[':
424     if (flags & SCAN_LONGER) {
425         goto invalidLonger;
426     }
427     if (*format == '\0') {
428         goto badSet;
429     }
430     format += Tcl_UtfToUniChar(format, &ch);
431     if (ch == '^') {
432         if (*format == '\0') {
433       goto badSet;
434         }
435         format += Tcl_UtfToUniChar(format, &ch);
436     }
437     if (ch == ']') {
438         if (*format == '\0') {
439       goto badSet;
440         }
441         format += Tcl_UtfToUniChar(format, &ch);
442     }
443     while (ch != ']') {
444         if (*format == '\0') {
445       goto badSet;
446         }
447         format += Tcl_UtfToUniChar(format, &ch);
448     }
449     break;
450       badSet:
451     Tcl_SetResult(interp, "unmatched [ in format string",
452       TCL_STATIC);
453     goto error;
454       default:
455       {
456     char buf[TCL_UTF_MAX+1];
457 
458     buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
459     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
460       "bad scan conversion character \"", buf, "\"", NULL);
461     goto error;
462       }
463   }
464   if (!(flags & SCAN_SUPPRESS)) {
465       if (objIndex >= nspace) {
466     /*
467      * Expand the nassign buffer.  If we are using XPG specifiers,
468      * make sure that we grow to a large enough size.  xpgSize is
469      * guaranteed to be at least one larger than objIndex.
470      */
471     value = nspace;
472     if (xpgSize) {
473         nspace = xpgSize;
474     } else {
475         nspace += STATIC_LIST_SIZE;
476     }
477     if (nassign == staticAssign) {
478         nassign = (void *)ckalloc(nspace * sizeof(int));
479         for (i = 0; i < STATIC_LIST_SIZE; ++i) {
480       nassign[i] = staticAssign[i];
481         }
482     } else {
483         nassign = (void *)ckrealloc((void *)nassign,
484           nspace * sizeof(int));
485     }
486     for (i = value; i < nspace; i++) {
487         nassign[i] = 0;
488     }
489       }
490       nassign[objIndex]++;
491       objIndex++;
492   }
493     }
494 
495     /*
496      * Verify that all of the variable were assigned exactly once.
497      */
498 
499     if (numVars == 0) {
500   if (xpgSize) {
501       numVars = xpgSize;
502   } else {
503       numVars = objIndex;
504   }
505     }
506     if (totalSubs) {
507   *totalSubs = numVars;
508     }
509     for (i = 0; i < numVars; i++) {
510   if (nassign[i] > 1) {
511       Tcl_SetResult(interp, "variable is assigned by multiple \"%n$\" conversion specifiers", TCL_STATIC);
512       goto error;
513   } else if (!xpgSize && (nassign[i] == 0)) {
514       /*
515        * If the space is empty, and xpgSize is 0 (means XPG wasn't
516        * used, and/or numVars != 0), then too many vars were given
517        */
518       Tcl_SetResult(interp, "variable is not assigned by any conversion specifiers", TCL_STATIC);
519       goto error;
520   }
521     }
522 
523     if (nassign != staticAssign) {
524   ckfree((char *)nassign);
525     }
526     return TCL_OK;
527 
528     badIndex:
529     if (gotXpg) {
530   Tcl_SetResult(interp, "\"%n$\" argument index out of range",
531     TCL_STATIC);
532     } else {
533   Tcl_SetResult(interp, 
534     "different numbers of variable names and field specifiers",
535     TCL_STATIC);
536     }
537 
538     error:
539     if (nassign != staticAssign) {
540   ckfree((char *)nassign);
541     }
542     return TCL_ERROR;
543 #undef STATIC_LIST_SIZE
544 }

generic/tclStringObj.c File Reference
#include "tclInt.h"
Classes
struct String
Defines
#define STRING_UALLOC(numChars)  (numChars * sizeof(Tcl_UniChar))
#define STRING_SIZE(ualloc)
#define GET_STRING(objPtr)  ((String *) (objPtr)->internalRep.otherValuePtr)
#define SET_STRING(objPtr, stringPtr)  (objPtr)->internalRep.otherValuePtr = (VOID *) (stringPtr)
#define TCL_GROWTH_MIN_ALLOC  1024
#define STATIC_LIST_SIZE  16
Functions
static void AppendUnicodeToUnicodeRep _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int appendNumChars))
static void AppendUnicodeToUtfRep _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int numChars))
static void AppendUtfToUnicodeRep _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST char *bytes, int numBytes))
static void FillUnicodeRep _ANSI_ARGS_ ((Tcl_Obj *objPtr))
static void DupStringInternalRep _ANSI_ARGS_ ((Tcl_Obj *objPtr, Tcl_Obj *copyPtr))
static int SetStringFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
Tcl_Obj * Tcl_NewStringObj (CONST char *bytes, int length)
Tcl_Obj * Tcl_DbNewStringObj (CONST char *bytes, int length, CONST char *file, int line)
Tcl_Obj * Tcl_NewUnicodeObj (CONST Tcl_UniChar *unicode, int numChars)
int Tcl_GetCharLength (Tcl_Obj *objPtr)
Tcl_UniChar Tcl_GetUniChar (Tcl_Obj *objPtr, int index)
Tcl_UniChar * Tcl_GetUnicode (Tcl_Obj *objPtr)
Tcl_UniChar * Tcl_GetUnicodeFromObj (Tcl_Obj *objPtr, int *lengthPtr)
Tcl_Obj * Tcl_GetRange (Tcl_Obj *objPtr, int first, int last)
void Tcl_SetStringObj (Tcl_Obj *objPtr, CONST char *bytes, int length)
void Tcl_SetObjLength (Tcl_Obj *objPtr, int length)
int Tcl_AttemptSetObjLength (Tcl_Obj *objPtr, int length)
void Tcl_SetUnicodeObj (Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int numChars)
void Tcl_AppendToObj (Tcl_Obj *objPtr, CONST char *bytes, int length)
void Tcl_AppendUnicodeToObj (Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int length)
void Tcl_AppendObjToObj (Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr)
static void AppendUnicodeToUnicodeRep (Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int appendNumChars)
static void AppendUnicodeToUtfRep (Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int numChars)
static void AppendUtfToUnicodeRep (Tcl_Obj *objPtr, CONST char *bytes, int numBytes)
static void AppendUtfToUtfRep (Tcl_Obj *objPtr, CONST char *bytes, int numBytes)
void Tcl_AppendStringsToObjVA (Tcl_Obj *objPtr, va_list argList)
void Tcl_AppendStringsToObj TCL_VARARGS_DEF (Tcl_Obj *, arg1)
static void FillUnicodeRep (Tcl_Obj *objPtr)
static void DupStringInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
static int SetStringFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr)
static void UpdateStringOfString (Tcl_Obj *objPtr)
static void FreeStringInternalRep (Tcl_Obj *objPtr)
Variables
Tcl_ObjType tclStringType

Define Documentation
#define GET_STRING(objPtr)  ((String *) (objPtr)->internalRep.otherValuePtr)

Definition at line 112 of file tclStringObj.c.
Referenced by AppendUnicodeToUnicodeRep(), AppendUtfToUtfRep(), DupStringInternalRep(), FillUnicodeRep(), FreeStringInternalRep(), Tcl_AppendObjToObj(), Tcl_AppendStringsToObjVA(), Tcl_AppendToObj(), Tcl_AppendUnicodeToObj(), Tcl_AttemptSetObjLength(), Tcl_GetCharLength(), Tcl_GetRange(), Tcl_GetUniChar(), Tcl_GetUnicode(), Tcl_GetUnicodeFromObj(), Tcl_SetObjLength(), and UpdateStringOfString().#define SET_STRING(objPtr, stringPtr)  (objPtr)->internalRep.otherValuePtr = (VOID *) (stringPtr)

Definition at line 114 of file tclStringObj.c.
Referenced by AppendUnicodeToUnicodeRep(), DupStringInternalRep(), FillUnicodeRep(), SetStringFromAny(), Tcl_AttemptSetObjLength(), Tcl_NewUnicodeObj(), Tcl_SetObjLength(), and Tcl_SetUnicodeObj().#define STATIC_LIST_SIZE  16
#define STRING_SIZE(ualloc)
Value:((unsigned) ((ualloc) \
                 ? sizeof(String) - sizeof(Tcl_UniChar) + (ualloc) \
                 : sizeof(String)))
Definition at line 108 of file tclStringObj.c.
Referenced by AppendUnicodeToUnicodeRep(), DupStringInternalRep(), FillUnicodeRep(), SetStringFromAny(), Tcl_AttemptSetObjLength(), Tcl_NewUnicodeObj(), Tcl_SetObjLength(), and Tcl_SetUnicodeObj().#define STRING_UALLOC(numChars)  (numChars * sizeof(Tcl_UniChar))

Definition at line 106 of file tclStringObj.c.
Referenced by AppendUnicodeToUnicodeRep(), DupStringInternalRep(), FillUnicodeRep(), SetStringFromAny(), Tcl_AttemptSetObjLength(), Tcl_NewUnicodeObj(), Tcl_SetObjLength(), and Tcl_SetUnicodeObj().#define TCL_GROWTH_MIN_ALLOC  1024

Definition at line 152 of file tclStringObj.c.
Referenced by AppendUnicodeToUnicodeRep(), AppendUtfToUtfRep(), and Tcl_AppendStringsToObjVA().
Function Documentation
static int SetStringFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr)) [static]
static void DupStringInternalRep _ANSI_ARGS_ ((Tcl_Obj *objPtr, Tcl_Obj *copyPtr)) [static]
static void FillUnicodeRep _ANSI_ARGS_ ((Tcl_Obj *objPtr)) [static]
static void AppendUtfToUnicodeRep _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST char *bytes, int numBytes)) [static]
static void AppendUnicodeToUtfRep _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int numChars)) [static]
static void AppendUnicodeToUnicodeRep _ANSI_ARGS_ ((Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int appendNumChars)) [static]
static void AppendUnicodeToUnicodeRep (Tcl_Obj * objPtr, CONST Tcl_UniChar * unicode, int appendNumChars) [static]

Definition at line 1207 of file tclStringObj.c.
References attemptckrealloc, ckrealloc, GET_STRING, NULL, String::numChars, SET_STRING, SetStringFromAny(), size_t(), STRING_SIZE, STRING_UALLOC, TCL_GROWTH_MIN_ALLOC, Tcl_InvalidateStringRep(), String::uallocated, String::unicode, and VOID.
Referenced by AppendUtfToUnicodeRep(), Tcl_AppendObjToObj(), and Tcl_AppendUnicodeToObj().1211 {
1212     String *stringPtr, *tmpString;
1213     size_t numChars;
1214 
1215     if (appendNumChars < 0) {
1216   appendNumChars = 0;
1217   if (unicode) {
1218       while (unicode[appendNumChars] != 0) { appendNumChars++; }
1219   }
1220     }
1221     if (appendNumChars == 0) {
1222   return;
1223     }
1224 
1225     SetStringFromAny(NULL, objPtr);
1226     stringPtr = GET_STRING(objPtr);
1227 
1228     /*
1229      * If not enough space has been allocated for the unicode rep,
1230      * reallocate the internal rep object with additional space.  First
1231      * try to double the required allocation; if that fails, try a more
1232      * modest increase.  See the "TCL STRING GROWTH ALGORITHM" comment at
1233      * the top of this file for an explanation of this growth algorithm.
1234      */
1235 
1236     numChars = stringPtr->numChars + appendNumChars;
1237 
1238     if (STRING_UALLOC(numChars) >= stringPtr->uallocated) {
1239       stringPtr->uallocated = STRING_UALLOC(2 * numChars);
1240   tmpString = (String *) attemptckrealloc((char *)stringPtr,
1241     STRING_SIZE(stringPtr->uallocated));
1242   if (tmpString == NULL) {
1243       stringPtr->uallocated =
1244           STRING_UALLOC(numChars + appendNumChars) 
1245     + TCL_GROWTH_MIN_ALLOC;
1246       tmpString = (String *) ckrealloc((char *)stringPtr,
1247         STRING_SIZE(stringPtr->uallocated));
1248   }
1249   stringPtr = tmpString;
1250   SET_STRING(objPtr, stringPtr);
1251     }
1252 
1253     /*
1254      * Copy the new string onto the end of the old string, then add the
1255      * trailing null.
1256      */
1257 
1258     memcpy((VOID*) (stringPtr->unicode + stringPtr->numChars), unicode,
1259       appendNumChars * sizeof(Tcl_UniChar));
1260     stringPtr->unicode[numChars] = 0;
1261     stringPtr->numChars = numChars;
1262 
1263     Tcl_InvalidateStringRep(objPtr);
1264 }
static void AppendUnicodeToUtfRep (Tcl_Obj * objPtr, CONST Tcl_UniChar * unicode, int numChars) [static]

Definition at line 1284 of file tclStringObj.c.
References AppendUtfToUtfRep(), CONST, Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, and Tcl_UniCharToUtfDString().
Referenced by Tcl_AppendUnicodeToObj().1288 {
1289     Tcl_DString dsPtr;
1290     CONST char *bytes;
1291     
1292     if (numChars < 0) {
1293   numChars = 0;
1294   if (unicode) {
1295       while (unicode[numChars] != 0) { numChars++; }
1296   }
1297     }
1298     if (numChars == 0) {
1299   return;
1300     }
1301 
1302     Tcl_DStringInit(&dsPtr);
1303     bytes = Tcl_UniCharToUtfDString(unicode, numChars, &dsPtr);
1304     AppendUtfToUtfRep(objPtr, bytes, Tcl_DStringLength(&dsPtr));
1305     Tcl_DStringFree(&dsPtr);
1306 }
static void AppendUtfToUnicodeRep (Tcl_Obj * objPtr, CONST char * bytes, int numBytes) [static]

Definition at line 1327 of file tclStringObj.c.
References AppendUnicodeToUnicodeRep(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_NumUtfChars(), and Tcl_UtfToUniCharDString().
Referenced by Tcl_AppendObjToObj(), and Tcl_AppendToObj().1331 {
1332     Tcl_DString dsPtr;
1333     int numChars;
1334     Tcl_UniChar *unicode;
1335 
1336     if (numBytes < 0) {
1337   numBytes = (bytes ? strlen(bytes) : 0);
1338     }
1339     if (numBytes == 0) {
1340   return;
1341     }
1342     
1343     Tcl_DStringInit(&dsPtr);
1344     numChars = Tcl_NumUtfChars(bytes, numBytes);
1345     unicode = (Tcl_UniChar *)Tcl_UtfToUniCharDString(bytes, numBytes, &dsPtr);
1346     AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
1347     Tcl_DStringFree(&dsPtr);
1348 }
static void AppendUtfToUtfRep (Tcl_Obj * objPtr, CONST char * bytes, int numBytes) [static]

Definition at line 1368 of file tclStringObj.c.
References String::allocated, GET_STRING, String::hasUnicode, String::numChars, size_t(), Tcl_AttemptSetObjLength(), TCL_GROWTH_MIN_ALLOC, Tcl_SetObjLength(), and VOID.
Referenced by AppendUnicodeToUtfRep(), Tcl_AppendObjToObj(), and Tcl_AppendToObj().1372 {
1373     String *stringPtr;
1374     int newLength, oldLength;
1375 
1376     if (numBytes < 0) {
1377   numBytes = (bytes ? strlen(bytes) : 0);
1378     }
1379     if (numBytes == 0) {
1380   return;
1381     }
1382 
1383     /*
1384      * Copy the new string onto the end of the old string, then add the
1385      * trailing null.
1386      */
1387 
1388     oldLength = objPtr->length;
1389     newLength = numBytes + oldLength;
1390 
1391     stringPtr = GET_STRING(objPtr);
1392     if (newLength > (int) stringPtr->allocated) {
1393 
1394   /*
1395    * There isn't currently enough space in the string representation
1396    * so allocate additional space.  First, try to double the length
1397    * required.  If that fails, try a more modest allocation.  See the
1398    * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an
1399    * explanation of this growth algorithm.
1400    */
1401 
1402   if (Tcl_AttemptSetObjLength(objPtr, 2 * newLength) == 0) {
1403       Tcl_SetObjLength(objPtr,
1404         newLength + numBytes + TCL_GROWTH_MIN_ALLOC);
1405   }
1406     }
1407 
1408     /*
1409      * Invalidate the unicode data.
1410      */
1411     
1412     stringPtr->numChars = -1;
1413     stringPtr->hasUnicode = 0;
1414     
1415     memcpy((VOID *) (objPtr->bytes + oldLength), (VOID *) bytes,
1416       (size_t) numBytes);
1417     objPtr->bytes[newLength] = 0;
1418     objPtr->length = newLength;
1419 }
static void DupStringInternalRep (Tcl_Obj * srcPtr, Tcl_Obj * copyPtr) [static]

Definition at line 1683 of file tclStringObj.c.
References String::allocated, ckalloc, GET_STRING, String::hasUnicode, NULL, String::numChars, SET_STRING, size_t(), STRING_SIZE, STRING_UALLOC, tclStringType, String::uallocated, String::unicode, and VOID.1688 {
1689     String *srcStringPtr = GET_STRING(srcPtr);
1690     String *copyStringPtr = NULL;
1691 
1692     /*
1693      * If the src obj is a string of 1-byte Utf chars, then copy the
1694      * string rep of the source object and create an "empty" Unicode
1695      * internal rep for the new object.  Otherwise, copy Unicode
1696      * internal rep, and invalidate the string rep of the new object.
1697      */
1698     
1699     if (srcStringPtr->hasUnicode == 0) {
1700       copyStringPtr = (String *) ckalloc(STRING_SIZE(STRING_UALLOC(0)));
1701   copyStringPtr->uallocated = STRING_UALLOC(0);
1702     } else {
1703   copyStringPtr = (String *) ckalloc(
1704       STRING_SIZE(srcStringPtr->uallocated));
1705   copyStringPtr->uallocated = srcStringPtr->uallocated;
1706 
1707   memcpy((VOID *) copyStringPtr->unicode,
1708     (VOID *) srcStringPtr->unicode,
1709     (size_t) srcStringPtr->numChars * sizeof(Tcl_UniChar));
1710   copyStringPtr->unicode[srcStringPtr->numChars] = 0;
1711     }
1712     copyStringPtr->numChars = srcStringPtr->numChars;
1713     copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
1714     copyStringPtr->allocated = srcStringPtr->allocated;
1715 
1716     /*
1717      * Tricky point: the string value was copied by generic object
1718      * management code, so it doesn't contain any extra bytes that
1719      * might exist in the source object.
1720      */
1721 
1722     copyStringPtr->allocated = copyPtr->length;
1723 
1724     SET_STRING(copyPtr, copyStringPtr);
1725     copyPtr->typePtr = &tclStringType;
1726 }
static void FillUnicodeRep (Tcl_Obj * objPtr) [static]

Definition at line 1612 of file tclStringObj.c.
References ckrealloc, GET_STRING, String::hasUnicode, String::numChars, SET_STRING, size_t(), STRING_SIZE, STRING_UALLOC, Tcl_NumUtfChars(), TclUtfToUniChar, String::uallocated, and String::unicode.
Referenced by Tcl_AppendObjToObj(), Tcl_GetCharLength(), Tcl_GetUnicode(), and Tcl_GetUnicodeFromObj().1614 {
1615     String *stringPtr;
1616     size_t uallocated;
1617     char *src, *srcEnd;
1618     Tcl_UniChar *dst;
1619     src = objPtr->bytes;
1620     
1621     stringPtr = GET_STRING(objPtr);
1622     if (stringPtr->numChars == -1) {
1623   stringPtr->numChars = Tcl_NumUtfChars(src, objPtr->length);
1624     }
1625     stringPtr->hasUnicode = (stringPtr->numChars > 0);
1626 
1627     uallocated = STRING_UALLOC(stringPtr->numChars);
1628     if (uallocated > stringPtr->uallocated) {
1629     
1630   /*
1631    * If not enough space has been allocated for the unicode rep,
1632    * reallocate the internal rep object.
1633    */
1634 
1635   /*
1636    * There isn't currently enough space in the Unicode
1637    * representation so allocate additional space.  If the current
1638    * Unicode representation isn't empty (i.e. it looks like we've
1639    * done some appends) then overallocate the space so
1640    * that we won't have to do as much reallocation in the future.
1641    */
1642 
1643   if (stringPtr->uallocated > 0) {
1644       uallocated *= 2;
1645   }
1646   stringPtr = (String *) ckrealloc((char*) stringPtr,
1647     STRING_SIZE(uallocated));
1648   stringPtr->uallocated = uallocated;
1649     }
1650 
1651     /*
1652      * Convert src to Unicode and store the coverted data in "unicode".
1653      */
1654     
1655     srcEnd = src + objPtr->length;
1656     for (dst = stringPtr->unicode; src < srcEnd; dst++) {
1657   src += TclUtfToUniChar(src, dst);
1658     }
1659     *dst = 0;
1660     
1661     SET_STRING(objPtr, stringPtr);
1662 }
static void FreeStringInternalRep (Tcl_Obj * objPtr) [static]

Definition at line 1875 of file tclStringObj.c.
References ckfree, and GET_STRING.1877 {
1878     ckfree((char *) GET_STRING(objPtr));
1879 }
static int SetStringFromAny (Tcl_Interp * interp, Tcl_Obj * objPtr) [static]

Definition at line 1746 of file tclStringObj.c.
References String::allocated, ckalloc, String::hasUnicode, NULL, String::numChars, SET_STRING, STRING_SIZE, STRING_UALLOC, TCL_OK, tclStringType, Tcl_Obj::typePtr, String::uallocated, and Tcl_ObjType::updateStringProc.
Referenced by AppendUnicodeToUnicodeRep(), Tcl_AppendObjToObj(), Tcl_AppendStringsToObjVA(), Tcl_AppendToObj(), Tcl_AppendUnicodeToObj(), Tcl_AttemptSetObjLength(), Tcl_GetCharLength(), Tcl_GetRange(), Tcl_GetUniChar(), Tcl_GetUnicode(), Tcl_GetUnicodeFromObj(), and Tcl_SetObjLength().1749 {
1750     /*
1751      * The Unicode object is optimized for the case where each UTF char
1752      * in a string is only one byte.  In this case, we store the value of
1753      * numChars, but we don't copy the bytes to the unicodeObj->unicode.
1754      */
1755 
1756     if (objPtr->typePtr != &tclStringType) {
1757   String *stringPtr;
1758 
1759   if (objPtr->typePtr != NULL) {
1760       if (objPtr->bytes == NULL) {
1761     objPtr->typePtr->updateStringProc(objPtr);
1762       }
1763       if ((objPtr->typePtr->freeIntRepProc) != NULL) {
1764     (*objPtr->typePtr->freeIntRepProc)(objPtr);
1765       }
1766   }
1767   objPtr->typePtr = &tclStringType;
1768 
1769   /*
1770    * Allocate enough space for the basic String structure.
1771    */
1772 
1773   stringPtr = (String *) ckalloc(STRING_SIZE(STRING_UALLOC(0)));
1774   stringPtr->numChars = -1;
1775   stringPtr->uallocated = STRING_UALLOC(0);
1776   stringPtr->hasUnicode = 0;
1777 
1778   if (objPtr->bytes != NULL) {
1779       stringPtr->allocated = objPtr->length;      
1780       objPtr->bytes[objPtr->length] = 0;
1781   } else {
1782       objPtr->length = 0;
1783   }
1784   SET_STRING(objPtr, stringPtr);
1785     }
1786     return TCL_OK;
1787 }
void Tcl_AppendObjToObj (Tcl_Obj * objPtr, Tcl_Obj * appendObjPtr)

Definition at line 1119 of file tclStringObj.c.
References AppendUnicodeToUnicodeRep(), AppendUtfToUnicodeRep(), AppendUtfToUtfRep(), FillUnicodeRep(), GET_STRING, String::hasUnicode, NULL, String::numChars, SetStringFromAny(), Tcl_GetStringFromObj(), tclStringType, Tcl_Obj::typePtr, and String::unicode.
Referenced by Tcl_FSGetNormalizedPath(), Tcl_GlobObjCmd(), Tcl_StringObjCmd(), Tcl_SubstObj(), TclObjInvoke(), TclPtrSetVar(), and UpdateStringOfFsPath().1122 {
1123     String *stringPtr;
1124     int length, numChars, allOneByteChars;
1125     char *bytes;
1126 
1127     SetStringFromAny(NULL, objPtr);
1128 
1129     /*
1130      * If objPtr has a valid Unicode rep, then get a Unicode string
1131      * from appendObjPtr and append it.
1132      */
1133 
1134     stringPtr = GET_STRING(objPtr);
1135     if (stringPtr->hasUnicode != 0) {
1136   
1137   /*
1138    * If appendObjPtr is not of the "String" type, don't convert it.
1139    */
1140 
1141   if (appendObjPtr->typePtr == &tclStringType) {
1142       stringPtr = GET_STRING(appendObjPtr);
1143       if ((stringPtr->numChars == -1)
1144         || (stringPtr->hasUnicode == 0)) {
1145     
1146     /*
1147      * If appendObjPtr is a string obj with no valid Unicode
1148      * rep, then fill its unicode rep.
1149      */
1150 
1151     FillUnicodeRep(appendObjPtr);
1152     stringPtr = GET_STRING(appendObjPtr);
1153       }
1154       AppendUnicodeToUnicodeRep(objPtr, stringPtr->unicode,
1155         stringPtr->numChars);
1156   } else {
1157       bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
1158       AppendUtfToUnicodeRep(objPtr, bytes, length);
1159   }
1160   return;
1161     }
1162 
1163     /*
1164      * Append to objPtr's UTF string rep.  If we know the number of
1165      * characters in both objects before appending, then set the combined
1166      * number of characters in the final (appended-to) object.
1167      */
1168 
1169     bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
1170 
1171     allOneByteChars = 0;
1172     numChars = stringPtr->numChars;
1173     if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
1174   stringPtr = GET_STRING(appendObjPtr);
1175   if ((stringPtr->numChars >= 0) && (stringPtr->numChars == length)) {
1176       numChars += stringPtr->numChars;
1177       allOneByteChars = 1;
1178   }
1179     }
1180 
1181     AppendUtfToUtfRep(objPtr, bytes, length);
1182 
1183     if (allOneByteChars) {
1184   stringPtr = GET_STRING(objPtr);
1185   stringPtr->numChars = numChars;
1186     }
1187 }
void Tcl_AppendStringsToObjVA (Tcl_Obj * objPtr, va_list argList)

Definition at line 1440 of file tclStringObj.c.
References String::allocated, ckalloc, ckfree, ckrealloc, GET_STRING, NULL, panic, SetStringFromAny(), STATIC_LIST_SIZE, Tcl_AttemptSetObjLength(), TCL_GROWTH_MIN_ALLOC, Tcl_IsShared, and Tcl_SetObjLength().
Referenced by TCL_VARARGS_DEF().1443 {
1444 #define STATIC_LIST_SIZE 16
1445     String *stringPtr;
1446     int newLength, oldLength, attemptLength;
1447     register char *string, *dst;
1448     char *static_list[STATIC_LIST_SIZE];
1449     char **args = static_list;
1450     int nargs_space = STATIC_LIST_SIZE;
1451     int nargs, i;
1452 
1453     if (Tcl_IsShared(objPtr)) {
1454   panic("Tcl_AppendStringsToObj called with shared object");
1455     }
1456 
1457     SetStringFromAny(NULL, objPtr);
1458 
1459     /*
1460      * Figure out how much space is needed for all the strings, and
1461      * expand the string representation if it isn't big enough. If no
1462      * bytes would be appended, just return.  Note that on some platforms
1463      * (notably OS/390) the argList is an array so we need to use memcpy.
1464      */
1465 
1466     nargs = 0;
1467     newLength = 0;
1468     oldLength = objPtr->length;
1469     while (1) {
1470   string = va_arg(argList, char *);
1471   if (string == NULL) {
1472       break;
1473   }
1474   if (nargs >= nargs_space) {
1475       /* 
1476        * Expand the args buffer
1477        */
1478       nargs_space += STATIC_LIST_SIZE;
1479       if (args == static_list) {
1480         args = (void *)ckalloc(nargs_space * sizeof(char *));
1481     for (i = 0; i < nargs; ++i) {
1482         args[i] = static_list[i];
1483     }
1484       } else {
1485     args = (void *)ckrealloc((void *)args,
1486       nargs_space * sizeof(char *));
1487       }
1488   }
1489   newLength += strlen(string);
1490   args[nargs++] = string;
1491     }
1492     if (newLength == 0) {
1493   goto done;
1494     }
1495 
1496     stringPtr = GET_STRING(objPtr);
1497     if (oldLength + newLength > (int) stringPtr->allocated) {
1498 
1499   /*
1500    * There isn't currently enough space in the string
1501    * representation, so allocate additional space.  If the current
1502    * string representation isn't empty (i.e. it looks like we're
1503    * doing a series of appends) then try to allocate extra space to
1504    * accomodate future growth: first try to double the required memory;
1505    * if that fails, try a more modest allocation.  See the "TCL STRING
1506    * GROWTH ALGORITHM" comment at the top of this file for an explanation
1507    * of this growth algorithm.  Otherwise, if the current string
1508    * representation is empty, exactly enough memory is allocated.
1509    */
1510 
1511   if (oldLength == 0) {
1512       Tcl_SetObjLength(objPtr, newLength);
1513   } else {
1514       attemptLength = 2 * (oldLength + newLength);
1515       if (Tcl_AttemptSetObjLength(objPtr, attemptLength) == 0) {
1516     attemptLength = oldLength + (2 * newLength) +
1517         TCL_GROWTH_MIN_ALLOC;
1518     Tcl_SetObjLength(objPtr, attemptLength);
1519       }
1520   }
1521     }
1522 
1523     /*
1524      * Make a second pass through the arguments, appending all the
1525      * strings to the object.
1526      */
1527 
1528     dst = objPtr->bytes + oldLength;
1529     for (i = 0; i < nargs; ++i) {
1530   string = args[i];
1531   if (string == NULL) {
1532       break;
1533   }
1534   while (*string != 0) {
1535       *dst = *string;
1536       dst++;
1537       string++;
1538   }
1539     }
1540 
1541     /*
1542      * Add a null byte to terminate the string.  However, be careful:
1543      * it's possible that the object is totally empty (if it was empty
1544      * originally and there was nothing to append).  In this case dst is
1545      * NULL; just leave everything alone.
1546      */
1547 
1548     if (dst != NULL) {
1549   *dst = 0;
1550     }
1551     objPtr->length = oldLength + newLength;
1552 
1553     done:
1554     /*
1555      * If we had to allocate a buffer from the heap, 
1556      * free it now.
1557      */
1558  
1559     if (args != static_list) {
1560       ckfree((void *)args);
1561     }
1562 #undef STATIC_LIST_SIZE
1563 }
void Tcl_AppendToObj (Tcl_Obj * objPtr, CONST char * bytes, int length)

Definition at line 1011 of file tclStringObj.c.
References AppendUtfToUnicodeRep(), AppendUtfToUtfRep(), GET_STRING, String::hasUnicode, NULL, panic, SetStringFromAny(), and Tcl_IsShared.
Referenced by AppendSystemError(), CheckIfVarUnset(), CompileMathFuncCall(), ConvertFileNameFormat(), DeleteKey(), ExprAbsFunc(), ExprIntFunc(), ExprRoundFunc(), ExprWideFunc(), GetVariableIndex(), NamespaceCurrentCmd(), NamespaceQualifiersCmd(), NamespaceTailCmd(), OpenKey(), ProcessProcResultCode(), ProcessUnexpectedResult(), SetBooleanFromAny(), SetDoubleFromAny(), SetIndexFromAny(), SetIntFromAny(), SetIntOrWideFromAny(), SetValue(), SetWideIntFromAny(), SortCompare(), SplitMacPath(), SplitUnixPath(), SplitWinPath(), StdinProc(), Tcl_CaseObjCmd(), Tcl_CatchObjCmd(), Tcl_ExecObjCmd(), Tcl_ExprObjCmd(), Tcl_ForeachObjCmd(), Tcl_FormatObjCmd(), Tcl_FSChdir(), Tcl_FSGetNormalizedPath(), Tcl_FSJoinPath(), Tcl_FSSplitPath(), Tcl_GetCommandFullName(), Tcl_GetLongFromObj(), Tcl_GetVariableFullName(), Tcl_GlobObjCmd(), Tcl_JoinObjCmd(), Tcl_LsortObjCmd(), Tcl_Main(), Tcl_StringObjCmd(), Tcl_SubstObj(), Tcl_WrongNumArgs(), TclArraySet(), TclCompileAppendCmd(), TclCompileBreakCmd(), TclCompileCatchCmd(), TclCompileContinueCmd(), TclCompileExprCmd(), TclCompileForCmd(), TclCompileForeachCmd(), TclCompileIncrCmd(), TclCompileLappendCmd(), TclCompileSetCmd(), TclCompileWhileCmd(), TclExecuteByteCode(), TclExprFloatError(), TclInterpReady(), TclObjInvoke(), TclpCreateProcess(), TclpGetNativePathType(), TclpNativeJoinPath(), TclpObjListVolumes(), TclpObjNormalizePath(), TestconvertobjCmd(), TestindexobjCmd(), TestintobjCmd(), TestobjCmd(), TeststringobjCmd(), UpdateStringOfFsPath(), and VerifyExprObjType().1018 {
1019     String *stringPtr;
1020 
1021     if (Tcl_IsShared(objPtr)) {
1022   panic("Tcl_AppendToObj called with shared object");
1023     }
1024     
1025     SetStringFromAny(NULL, objPtr);
1026 
1027     if (length < 0) {
1028   length = (bytes ? strlen(bytes) : 0);
1029     }
1030     if (length == 0) {
1031   return;
1032     }
1033 
1034     /*
1035      * If objPtr has a valid Unicode rep, then append the Unicode
1036      * conversion of "bytes" to the objPtr's Unicode rep, otherwise
1037      * append "bytes" to objPtr's string rep.
1038      */
1039 
1040     stringPtr = GET_STRING(objPtr);
1041     if (stringPtr->hasUnicode != 0) {
1042   AppendUtfToUnicodeRep(objPtr, bytes, length);
1043 
1044   stringPtr = GET_STRING(objPtr);
1045     } else {
1046   AppendUtfToUtfRep(objPtr, bytes, length);
1047     }
1048 }
void Tcl_AppendUnicodeToObj (Tcl_Obj * objPtr, CONST Tcl_UniChar * unicode, int length)

Definition at line 1068 of file tclStringObj.c.
References AppendUnicodeToUnicodeRep(), AppendUnicodeToUtfRep(), GET_STRING, String::hasUnicode, NULL, panic, SetStringFromAny(), and Tcl_IsShared.
Referenced by Tcl_RegsubObjCmd(), and Tcl_StringObjCmd().1073 {
1074     String *stringPtr;
1075 
1076     if (Tcl_IsShared(objPtr)) {
1077   panic("Tcl_AppendUnicodeToObj called with shared object");
1078     }
1079 
1080     if (length == 0) {
1081   return;
1082     }
1083 
1084     SetStringFromAny(NULL, objPtr);
1085     stringPtr = GET_STRING(objPtr);
1086 
1087     /*
1088      * If objPtr has a valid Unicode rep, then append the "unicode"
1089      * to the objPtr's Unicode rep, otherwise the UTF conversion of
1090      * "unicode" to objPtr's string rep.
1091      */
1092 
1093     if (stringPtr->hasUnicode != 0) {
1094   AppendUnicodeToUnicodeRep(objPtr, unicode, length);
1095     } else {
1096   AppendUnicodeToUtfRep(objPtr, unicode, length);
1097     }
1098 }
int Tcl_AttemptSetObjLength (Tcl_Obj * objPtr, int length)

Definition at line 851 of file tclStringObj.c.
References String::allocated, attemptckalloc, attemptckrealloc, GET_STRING, String::hasUnicode, NULL, String::numChars, panic, SET_STRING, SetStringFromAny(), size_t(), STRING_SIZE, STRING_UALLOC, Tcl_InvalidateStringRep(), Tcl_IsShared, tclEmptyStringRep, String::uallocated, String::unicode, and VOID.
Referenced by AppendUtfToUtfRep(), and Tcl_AppendStringsToObjVA().857 {
858     String *stringPtr;
859 
860     if (Tcl_IsShared(objPtr)) {
861   panic("Tcl_AttemptSetObjLength called with shared object");
862     }
863     SetStringFromAny(NULL, objPtr);
864         
865     stringPtr = GET_STRING(objPtr);
866 
867     /* Check that we're not extending a pure unicode string */
868 
869     if (length > (int) stringPtr->allocated && 
870       (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) {
871   char *new;
872 
873   /*
874    * Not enough space in current string. Reallocate the string
875    * space and free the old string.
876    */
877   if (objPtr->bytes != tclEmptyStringRep && objPtr->bytes != NULL) {
878       new = (char *) attemptckrealloc((char *)objPtr->bytes,
879         (unsigned)(length+1));
880       if (new == NULL) {
881     return 0;
882       }
883   } else {
884       new = (char *) attemptckalloc((unsigned) (length+1));
885       if (new == NULL) {
886     return 0;
887       }
888       if (objPtr->bytes != NULL && objPtr->length != 0) {
889         memcpy((VOID *) new, (VOID *) objPtr->bytes,
890           (size_t) objPtr->length);
891         Tcl_InvalidateStringRep(objPtr);
892       }
893   }
894   objPtr->bytes = new;
895   stringPtr->allocated = length;
896   /* Invalidate the unicode data. */
897   stringPtr->hasUnicode = 0;
898     }
899     
900     if (objPtr->bytes != NULL) {
901   objPtr->length = length;
902   if (objPtr->bytes != tclEmptyStringRep) {
903       /* Ensure the string is NULL-terminated */
904       objPtr->bytes[length] = 0;
905   }
906   /* Invalidate the unicode data. */
907   stringPtr->numChars = -1;
908   stringPtr->hasUnicode = 0;
909     } else {
910   /* Changing length of pure unicode string */
911   size_t uallocated = STRING_UALLOC(length);
912   if (uallocated > stringPtr->uallocated) {
913       stringPtr = (String *) attemptckrealloc((char*) stringPtr,
914         STRING_SIZE(uallocated));
915       if (stringPtr == NULL) {
916           return 0;
917       }
918       SET_STRING(objPtr, stringPtr);
919       stringPtr->uallocated = uallocated;
920   }
921   stringPtr->numChars = length;
922   stringPtr->hasUnicode = (length > 0);
923   /* Ensure the string is NULL-terminated */
924   stringPtr->unicode[length] = 0;
925   stringPtr->allocated = 0;
926   objPtr->length = 0;
927     }
928     return 1;
929 }
Tcl_Obj* Tcl_DbNewStringObj (CONST char * bytes, int length, CONST char * file, int line)

Definition at line 277 of file tclStringObj.c.
References Tcl_NewStringObj().288 {
289     return Tcl_NewStringObj(bytes, length);
290 }
int Tcl_GetCharLength (Tcl_Obj * objPtr)

Definition at line 369 of file tclStringObj.c.
References FillUnicodeRep(), GET_STRING, String::hasUnicode, NULL, String::numChars, SetStringFromAny(), and Tcl_NumUtfChars().
Referenced by Tcl_GetRange(), Tcl_GetUniChar(), Tcl_RegexpObjCmd(), Tcl_StringObjCmd(), and TclExecuteByteCode().371 {
372     String *stringPtr;
373     
374     SetStringFromAny(NULL, objPtr);
375     stringPtr = GET_STRING(objPtr);
376 
377     /*
378      * If numChars is unknown, then calculate the number of characaters
379      * while populating the Unicode string.
380      */
381     
382     if (stringPtr->numChars == -1) {
383   register int i = objPtr->length;
384   register unsigned char *str = (unsigned char *) objPtr->bytes;
385 
386   /*
387    * This is a speed sensitive function, so run specially over the
388    * string to count continuous ascii characters before resorting
389    * to the Tcl_NumUtfChars call.  This is a long form of:
390    stringPtr->numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length);
391   */
392 
393   while (i && (*str < 0xC0)) { i--; str++; }
394   stringPtr->numChars = objPtr->length - i;
395   if (i) {
396       stringPtr->numChars += Tcl_NumUtfChars(objPtr->bytes
397         + (objPtr->length - i), i);
398   }
399 
400   if (stringPtr->numChars == objPtr->length) {
401 
402       /*
403        * Since we've just calculated the number of chars, and all
404        * UTF chars are 1-byte long, we don't need to store the
405        * unicode string.
406        */
407 
408       stringPtr->hasUnicode = 0;
409 
410   } else {
411     
412       /*
413        * Since we've just calucalated the number of chars, and not
414        * all UTF chars are 1-byte long, go ahead and populate the
415        * unicode string.
416        */
417 
418       FillUnicodeRep(objPtr);
419 
420       /*
421        * We need to fetch the pointer again because we have just
422        * reallocated the structure to make room for the Unicode data.
423        */
424       
425       stringPtr = GET_STRING(objPtr);
426   }
427     }
428     return stringPtr->numChars;
429 }
Tcl_Obj* Tcl_GetRange (Tcl_Obj * objPtr, int first, int last)

Definition at line 618 of file tclStringObj.c.
References GET_STRING, NULL, String::numChars, SetStringFromAny(), Tcl_GetCharLength(), Tcl_GetString(), Tcl_NewStringObj(), Tcl_NewUnicodeObj(), and String::unicode.
Referenced by Tcl_RegexpObjCmd(), Tcl_StringObjCmd(), and TestregexpObjCmd().622 {
623     Tcl_Obj *newObjPtr;   /* The Tcl object to find the range of. */
624     String *stringPtr;
625     
626     SetStringFromAny(NULL, objPtr);
627     stringPtr = GET_STRING(objPtr);
628 
629     if (stringPtr->numChars == -1) {
630     
631   /*
632    * We haven't yet calculated the length, so we don't have the
633    * Unicode str.  We need to know the number of chars before we
634    * can do indexing.
635    */
636 
637   Tcl_GetCharLength(objPtr);
638 
639   /*
640    * We need to fetch the pointer again because we may have just
641    * reallocated the structure.
642    */
643   
644   stringPtr = GET_STRING(objPtr);
645     }
646 
647     if (objPtr->bytes && stringPtr->numChars == objPtr->length) {
648   char *str = Tcl_GetString(objPtr);
649 
650   /*
651    * All of the characters in the Utf string are 1 byte chars,
652    * so we don't store the unicode char.  Create a new string
653    * object containing the specified range of chars.
654    */
655   
656   newObjPtr = Tcl_NewStringObj(&str[first], last-first+1);
657 
658   /*
659    * Since we know the new string only has 1-byte chars, we
660    * can set it's numChars field.
661    */
662   
663   SetStringFromAny(NULL, newObjPtr);
664   stringPtr = GET_STRING(newObjPtr);
665   stringPtr->numChars = last-first+1;
666     } else {
667   newObjPtr = Tcl_NewUnicodeObj(stringPtr->unicode + first,
668     last-first+1);
669     }
670     return newObjPtr;
671 }
Tcl_UniChar Tcl_GetUniChar (Tcl_Obj * objPtr, int index)

Definition at line 449 of file tclStringObj.c.
References GET_STRING, String::hasUnicode, NULL, String::numChars, SetStringFromAny(), Tcl_GetCharLength(), and String::unicode.
Referenced by Tcl_RegexpObjCmd(), Tcl_StringObjCmd(), and TclExecuteByteCode().452 {
453     Tcl_UniChar unichar;
454     String *stringPtr;
455     
456     SetStringFromAny(NULL, objPtr);
457     stringPtr = GET_STRING(objPtr);
458 
459     if (stringPtr->numChars == -1) {
460 
461   /*
462    * We haven't yet calculated the length, so we don't have the
463    * Unicode str.  We need to know the number of chars before we
464    * can do indexing.
465    */
466 
467   Tcl_GetCharLength(objPtr);
468 
469   /*
470    * We need to fetch the pointer again because we may have just
471    * reallocated the structure.
472    */
473   
474   stringPtr = GET_STRING(objPtr);
475     }
476     if (stringPtr->hasUnicode == 0) {
477 
478   /*
479    * All of the characters in the Utf string are 1 byte chars,
480    * so we don't store the unicode char.  We get the Utf string
481    * and convert the index'th byte to a Unicode character.
482    */
483 
484   unichar = (Tcl_UniChar) objPtr->bytes[index];
485     } else {
486   unichar = stringPtr->unicode[index];
487     }
488     return unichar;
489 }
Tcl_UniChar* Tcl_GetUnicode (Tcl_Obj * objPtr)

Definition at line 511 of file tclStringObj.c.
References FillUnicodeRep(), GET_STRING, String::hasUnicode, NULL, String::numChars, SetStringFromAny(), and String::unicode.
Referenced by TclExecuteByteCode().513 {
514     String *stringPtr;
515     
516     SetStringFromAny(NULL, objPtr);
517     stringPtr = GET_STRING(objPtr);
518     
519     if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
520 
521   /*
522    * We haven't yet calculated the length, or all of the characters
523    * in the Utf string are 1 byte chars (so we didn't store the
524    * unicode str).  Since this function must return a unicode string,
525    * and one has not yet been stored, force the Unicode to be
526    * calculated and stored now.
527    */
528 
529   FillUnicodeRep(objPtr);
530 
531   /*
532    * We need to fetch the pointer again because we have just
533    * reallocated the structure to make room for the Unicode data.
534    */
535   
536   stringPtr = GET_STRING(objPtr);
537     }
538     return stringPtr->unicode;
539 }
Tcl_UniChar* Tcl_GetUnicodeFromObj (Tcl_Obj * objPtr, int * lengthPtr)

Definition at line 561 of file tclStringObj.c.
References FillUnicodeRep(), GET_STRING, String::hasUnicode, NULL, String::numChars, SetStringFromAny(), and String::unicode.
Referenced by Tcl_RegExpExecObj(), Tcl_RegsubObjCmd(), Tcl_StringObjCmd(), TclExecuteByteCode(), and TeststringobjCmd().566 {
567     String *stringPtr;
568     
569     SetStringFromAny(NULL, objPtr);
570     stringPtr = GET_STRING(objPtr);
571     
572     if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
573 
574   /*
575    * We haven't yet calculated the length, or all of the characters
576    * in the Utf string are 1 byte chars (so we didn't store the
577    * unicode str).  Since this function must return a unicode string,
578    * and one has not yet been stored, force the Unicode to be
579    * calculated and stored now.
580    */
581 
582   FillUnicodeRep(objPtr);
583 
584   /*
585    * We need to fetch the pointer again because we have just
586    * reallocated the structure to make room for the Unicode data.
587    */
588   
589   stringPtr = GET_STRING(objPtr);
590     }
591 
592     if (lengthPtr != NULL) {
593   *lengthPtr = stringPtr->numChars;
594     }
595     return stringPtr->unicode;
596 }
Tcl_Obj* Tcl_NewStringObj (CONST char * bytes, int length)

Definition at line 200 of file tclStringObj.c.
References TclInitStringRep, and TclNewObj.
Referenced by AppendDllPath(), AppendEnvironment(), AppendLocals(), ComparePkgVersions(), ConvertFileNameFormat(), CopyRenameOneFile(), DdeServerProc(), DdeServicesOnAck(), DoWriteChars(), ExecuteCallback(), ExprAbsFunc(), FileNameInit(), FsUpdateCwd(), GetGroupAttribute(), GetKeyNames(), GetLexeme(), GetOwnerAttribute(), GetPermissionsAttribute(), GetTimesCmd(), GetValue(), GetValueNames(), InfoArgsCmd(), InfoBodyCmd(), InfoCommandsCmd(), InfoGlobalsCmd(), InfoProcsCmd(), InfoVarsCmd(), NamespaceChildrenCmd(), NamespaceCodeCmd(), NativeFilesystemSeparator(), ObjTraceProc(), ObjValue(), OpenEncodingFile(), ParseKeyName(), ParsePrimaryExpr(), Pkgb_UnsafeObjCmd(), Pkgc_UnsafeObjCmd(), Pkgd_UnsafeObjCmd(), PretendTclpAccess(), PretendTclpOpenFileChannel(), PretendTclpStat(), PrintParse(), SetFsPathFromAny(), SimpleCopy(), SimpleListVolumes(), SlaveHidden(), SlaveRecursionLimit(), SplitMacPath(), SplitUnixPath(), SplitWinPath(), StoreStatData(), Tcl_Access(), Tcl_AddObjErrorInfo(), Tcl_AfterObjCmd(), Tcl_AppendAllObjTypes(), Tcl_AppendExportList(), Tcl_ArrayObjCmd(), Tcl_BeepObjCmd(), Tcl_CdObjCmd(), Tcl_Chdir(), Tcl_CreateAlias(), Tcl_CreateAliasObj(), Tcl_CreateSlave(), Tcl_DbNewStringObj(), Tcl_DdeObjCmd(), Tcl_EvalFile(), Tcl_ExprBoolean(), Tcl_ExprDouble(), Tcl_ExprLong(), Tcl_ExprObjCmd(), Tcl_FileObjCmd(), Tcl_FSChdir(), Tcl_FSFileSystemInfo(), Tcl_FSGetNormalizedPath(), Tcl_FSJoinPath(), Tcl_FSLoadFile(), Tcl_FSSplitPath(), Tcl_GetChannelNamesEx(), Tcl_GetEncodingNames(), Tcl_GetIntFromObj(), Tcl_GetPathType(), Tcl_GetRange(), Tcl_GetSlave(), Tcl_GlobObjCmd(), Tcl_Import(), Tcl_InterpObjCmd(), Tcl_JoinPath(), Tcl_LinkVar(), Tcl_ListMathFuncs(), Tcl_LsObjCmd(), Tcl_Main(), Tcl_OpenFileChannel(), Tcl_PackageObjCmd(), Tcl_PidObjCmd(), Tcl_PkgRequireEx(), Tcl_RecordAndEval(), Tcl_RecordAndEvalObj(), Tcl_ResourceObjCmd(), Tcl_ScanObjCmd(), Tcl_SetVar2(), Tcl_SplitObjCmd(), Tcl_SplitPath(), Tcl_Stat(), Tcl_SubstObj(), Tcl_TimeObjCmd(), Tcl_TraceObjCmd(), Tcl_TranslateFileName(), Tcl_UnsetVar2(), Tcl_UpVar2(), TclCompileIncrCmd(), TclCompileScript(), TclCompileStringCmd(), TclCompileWhileCmd(), TclCreateExecEnv(), TclCreateProc(), TclDoGlob(), TclEvalObjvInternal(), TclExecuteByteCode(), TclFileAttrsCmd(), TclFileDirname(), TclFindEncodings(), TclFSMakePathRelative(), TclFSNormalizeAbsolutePath(), TclGetLibraryPath(), TclGlob(), TclInvoke(), TclListObjSetElement(), TclLsetFlat(), TclLsetList(), TclNewFSPathObj(), TclNewProcBodyObj(), TclObjInvoke(), TclObjLookupVar(), TclpCreateProcess(), TclpFilesystemPathType(), TclpGetNativePathType(), TclpInitLibraryPath(), TclpMatchInDirectory(), TclpNativeToNormalized(), TclpObjCopyDirectory(), TclpObjGetCwd(), TclpObjListVolumes(), TclpObjNormalizePath(), TclpObjRemoveDirectory(), TclProcInterpProc(), TclSetStartupScriptFileName(), TclTraceCommandObjCmd(), TclTraceExecutionObjCmd(), TclTraceVariableObjCmd(), TclUpdateReturnInfo(), TestChannelCmd(), TestChannelEventCmd(), TestlinkCmd(), TestobjCmd(), TestsaveresultCmd(), TeststringobjCmd(), TestwincpuidCmd(), and WinReadLinkDirectory().207 {
208     register Tcl_Obj *objPtr;
209 
210     if (length < 0) {
211   length = (bytes? strlen(bytes) : 0);
212     }
213     TclNewObj(objPtr);
214     TclInitStringRep(objPtr, bytes, length);
215     return objPtr;
216 }
Tcl_Obj* Tcl_NewUnicodeObj (CONST Tcl_UniChar * unicode, int numChars)

Definition at line 314 of file tclStringObj.c.
References String::allocated, ckalloc, String::hasUnicode, String::numChars, SET_STRING, size_t(), STRING_SIZE, STRING_UALLOC, Tcl_InvalidateStringRep(), TclNewObj, tclStringType, Tcl_Obj::typePtr, String::uallocated, String::unicode, and VOID.
Referenced by Tcl_GetRange(), and Tcl_RegsubObjCmd().319 {
320     Tcl_Obj *objPtr;
321     String *stringPtr;
322     size_t uallocated;
323 
324     if (numChars < 0) {
325   numChars = 0;
326   if (unicode) {
327       while (unicode[numChars] != 0) { numChars++; }
328   }
329     }
330     uallocated = STRING_UALLOC(numChars);
331 
332     /*
333      * Create a new obj with an invalid string rep.
334      */
335 
336     TclNewObj(objPtr);
337     Tcl_InvalidateStringRep(objPtr);
338     objPtr->typePtr = &tclStringType;
339 
340     stringPtr = (String *) ckalloc(STRING_SIZE(uallocated));
341     stringPtr->numChars = numChars;
342     stringPtr->uallocated = uallocated;
343     stringPtr->hasUnicode = (numChars > 0);
344     stringPtr->allocated = 0;
345     memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated);
346     stringPtr->unicode[numChars] = 0;
347     SET_STRING(objPtr, stringPtr);
348     return objPtr;
349 }
void Tcl_SetObjLength (Tcl_Obj * objPtr, int length)

Definition at line 756 of file tclStringObj.c.
References String::allocated, ckalloc, ckrealloc, GET_STRING, String::hasUnicode, NULL, String::numChars, panic, SET_STRING, SetStringFromAny(), size_t(), STRING_SIZE, STRING_UALLOC, Tcl_InvalidateStringRep(), Tcl_IsShared, tclEmptyStringRep, String::uallocated, String::unicode, and VOID.
Referenced by AppendUtfToUtfRep(), DoReadChars(), FilterInputBytes(), ReadChars(), Tcl_AppendStringsToObjVA(), Tcl_BinaryObjCmd(), Tcl_CloseObjCmd(), Tcl_DdeObjCmd(), Tcl_ExecObjCmd(), Tcl_FSJoinPath(), Tcl_LsObjCmd(), Tcl_ReadObjCmd(), Tcl_StringObjCmd(), TclObjInvoke(), TclpGetNativePathType(), TclpNativeJoinPath(), and TeststringobjCmd().762 {
763     String *stringPtr;
764 
765     if (Tcl_IsShared(objPtr)) {
766   panic("Tcl_SetObjLength called with shared object");
767     }
768     SetStringFromAny(NULL, objPtr);
769     
770     stringPtr = GET_STRING(objPtr);
771     
772     /* Check that we're not extending a pure unicode string */
773     
774     if (length > (int) stringPtr->allocated && 
775       (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) {
776   char *new;
777 
778   /*
779    * Not enough space in current string. Reallocate the string
780    * space and free the old string.
781    */
782   if (objPtr->bytes != tclEmptyStringRep && objPtr->bytes != NULL) {
783       new = (char *) ckrealloc((char *)objPtr->bytes,
784         (unsigned)(length+1));
785   } else {
786       new = (char *) ckalloc((unsigned) (length+1));
787       if (objPtr->bytes != NULL && objPtr->length != 0) {
788     memcpy((VOID *) new, (VOID *) objPtr->bytes,
789       (size_t) objPtr->length);
790     Tcl_InvalidateStringRep(objPtr);
791       }
792   }
793   objPtr->bytes = new;
794   stringPtr->allocated = length;
795   /* Invalidate the unicode data. */
796   stringPtr->hasUnicode = 0;
797     }
798     
799     if (objPtr->bytes != NULL) {
800         objPtr->length = length;
801         if (objPtr->bytes != tclEmptyStringRep) {
802             /* Ensure the string is NULL-terminated */
803             objPtr->bytes[length] = 0;
804         }
805         /* Invalidate the unicode data. */
806         stringPtr->numChars = -1;
807         stringPtr->hasUnicode = 0;
808     } else {
809         /* Changing length of pure unicode string */
810         size_t uallocated = STRING_UALLOC(length);
811         if (uallocated > stringPtr->uallocated) {
812             stringPtr = (String *) ckrealloc((char*) stringPtr,
813                     STRING_SIZE(uallocated));
814             SET_STRING(objPtr, stringPtr);
815             stringPtr->uallocated = uallocated;
816         }
817         stringPtr->numChars = length;
818         stringPtr->hasUnicode = (length > 0);
819         /* Ensure the string is NULL-terminated */
820         stringPtr->unicode[length] = 0;
821         stringPtr->allocated = 0;
822         objPtr->length = 0;
823     }
824 }
void Tcl_SetStringObj (Tcl_Obj * objPtr, CONST char * bytes, int length)

Definition at line 695 of file tclStringObj.c.
References Tcl_ObjType::freeIntRepProc, NULL, panic, Tcl_InvalidateStringRep(), Tcl_IsShared, and TclInitStringRep.
Referenced by BuildResourceForkList(), FormatClock(), GetType(), GetValue(), InfoHostnameCmd(), InfoLibraryCmd(), InfoNameOfExecutableCmd(), InfoPatchLevelCmd(), InfoSharedlibCmd(), InfoTclVersionCmd(), NamespaceParentCmd(), OpenLibraryResource(), SetDdeError(), SetFsPathFromAny(), SlaveInvokeHidden(), Tcl_ArrayObjCmd(), Tcl_DdeObjCmd(), Tcl_EncodingObjCmd(), Tcl_FileObjCmd(), Tcl_Import(), Tcl_PidObjCmd(), Tcl_ResourceObjCmd(), Tcl_StringObjCmd(), TclMacRegisterResourceFork(), TclpObjNormalizePath(), TclpSetInitialEncodings(), TestlocaleCmd(), and TeststringobjCmd().703 {
704     register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
705 
706     /*
707      * Free any old string rep, then set the string rep to a copy of
708      * the length bytes starting at "bytes".
709      */
710 
711     if (Tcl_IsShared(objPtr)) {
712   panic("Tcl_SetStringObj called with shared object");
713     }
714 
715     /*
716      * Set the type to NULL and free any internal rep for the old type.
717      */
718 
719     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
720   oldTypePtr->freeIntRepProc(objPtr);
721     }
722     objPtr->typePtr = NULL;
723 
724     Tcl_InvalidateStringRep(objPtr);
725     if (length < 0) {
726   length = (bytes? strlen(bytes) : 0);
727     }
728     TclInitStringRep(objPtr, bytes, length);
729 }
void Tcl_SetUnicodeObj (Tcl_Obj * objPtr, CONST Tcl_UniChar * unicode, int numChars)

Definition at line 948 of file tclStringObj.c.
References String::allocated, ckalloc, Tcl_ObjType::freeIntRepProc, String::hasUnicode, NULL, String::numChars, SET_STRING, size_t(), STRING_SIZE, STRING_UALLOC, Tcl_InvalidateStringRep(), tclStringType, String::uallocated, String::unicode, and VOID.
Referenced by Tcl_StringObjCmd().954 {
955     Tcl_ObjType *typePtr;
956     String *stringPtr;
957     size_t uallocated;
958 
959     if (numChars < 0) {
960   numChars = 0;
961   if (unicode) {
962       while (unicode[numChars] != 0) { numChars++; }
963   }
964     }
965     uallocated = STRING_UALLOC(numChars);
966 
967     /*
968      * Free the internal rep if one exists, and invalidate the string rep.
969      */
970 
971     typePtr = objPtr->typePtr;
972     if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) {
973   (*typePtr->freeIntRepProc)(objPtr);
974     }
975     objPtr->typePtr = &tclStringType;
976 
977     /*
978      * Allocate enough space for the String structure + Unicode string.
979      */
980   
981     stringPtr = (String *) ckalloc(STRING_SIZE(uallocated));
982     stringPtr->numChars = numChars;
983     stringPtr->uallocated = uallocated;
984     stringPtr->hasUnicode = (numChars > 0);
985     stringPtr->allocated = 0;
986     memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated);
987     stringPtr->unicode[numChars] = 0;
988     SET_STRING(objPtr, stringPtr);
989     Tcl_InvalidateStringRep(objPtr);
990     return;
991 }
void Tcl_AppendStringsToObj TCL_VARARGS_DEF (Tcl_Obj *, arg1)

Definition at line 1584 of file tclStringObj.c.
References Tcl_AppendStringsToObjVA(), and TCL_VARARGS_START.1585 {
1586     register Tcl_Obj *objPtr;
1587     va_list argList;
1588 
1589     objPtr = TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
1590     Tcl_AppendStringsToObjVA(objPtr, argList);
1591     va_end(argList);
1592 }
static void UpdateStringOfString (Tcl_Obj * objPtr) [static]

Definition at line 1808 of file tclStringObj.c.
References String::allocated, ckalloc, GET_STRING, NULL, String::numChars, Tcl_UniCharToUtf(), TCL_UTF_MAX, tclEmptyStringRep, and String::unicode.1810 {
1811     int i, size;
1812     Tcl_UniChar *unicode;
1813     char dummy[TCL_UTF_MAX];
1814     char *dst;
1815     String *stringPtr;
1816 
1817     stringPtr = GET_STRING(objPtr);
1818     if ((objPtr->bytes == NULL) || (stringPtr->allocated == 0)) {
1819 
1820   if (stringPtr->numChars <= 0) {
1821 
1822       /*
1823        * If there is no Unicode rep, or the string has 0 chars,
1824        * then set the string rep to an empty string.
1825        */
1826 
1827       objPtr->bytes = tclEmptyStringRep;
1828       objPtr->length = 0;
1829       return;
1830   }
1831 
1832   unicode = stringPtr->unicode;
1833 
1834   /*
1835    * Translate the Unicode string to UTF.  "size" will hold the
1836    * amount of space the UTF string needs.
1837    */
1838 
1839   size = 0;
1840   for (i = 0; i < stringPtr->numChars; i++) {
1841       size += Tcl_UniCharToUtf((int) unicode[i], dummy);
1842   }
1843   
1844   dst = (char *) ckalloc((unsigned) (size + 1));
1845   objPtr->bytes = dst;
1846   objPtr->length = size;
1847   stringPtr->allocated = size;
1848 
1849   for (i = 0; i < stringPtr->numChars; i++) {
1850       dst += Tcl_UniCharToUtf(unicode[i], dst);
1851   }
1852   *dst = '\0';
1853     }
1854     return;
1855 }

Variable Documentation
Tcl_ObjType tclStringType
Initial value: {
    "string",       
    FreeStringInternalRep,    
    DupStringInternalRep,   
    UpdateStringOfString,   
    SetStringFromAny      
}
Definition at line 69 of file tclStringObj.c.
Referenced by DupStringInternalRep(), SetStringFromAny(), Tcl_AppendObjToObj(), Tcl_NewUnicodeObj(), Tcl_SetUnicodeObj(), Tcl_StringObjCmd(), TclExecuteByteCode(), and TclInitObjSubsystem().

generic/tclStubInit.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Variables
Tcl_NotifierProcs tclOriginalNotifier
TclIntStubs tclIntStubs
TclIntPlatStubs tclIntPlatStubs
TclPlatStubs tclPlatStubs
static TclStubHooks tclStubHooks
TclStubs tclStubs

Variable Documentation
TclIntPlatStubs tclIntPlatStubs

Definition at line 299 of file tclStubInit.c.TclIntStubs tclIntStubs

Definition at line 70 of file tclStubInit.c.Tcl_NotifierProcs tclOriginalNotifier
Initial value: {
    Tcl_SetTimer,
    Tcl_WaitForEvent,

    Tcl_CreateFileHandler,
    Tcl_DeleteFileHandler,

    NULL,
    NULL,
    NULL,
    NULL
}
Definition at line 46 of file tclStubInit.c.TclPlatStubs tclPlatStubs
Initial value: {
    TCL_STUB_MAGIC,
    NULL,

 

 

 
}
Definition at line 381 of file tclStubInit.c.TclStubHooks tclStubHooks [static]
Initial value: {
    &tclPlatStubs,
    &tclIntStubs,
    &tclIntPlatStubs
}
Definition at line 405 of file tclStubInit.c.TclStubs tclStubs

Definition at line 411 of file tclStubInit.c.

generic/tclStubLib.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Functions
static TclStubs *HasStubSupport _ANSI_ARGS_ ((Tcl_Interp *interp))
static TclStubs * HasStubSupport (Tcl_Interp *interp)
CONST char * Tcl_InitStubs (Tcl_Interp *interp, CONST char *version, int exact)
Variables
TclStubs * tclStubsPtr = NULL
TclPlatStubs * tclPlatStubsPtr = NULL
TclIntStubs * tclIntStubsPtr = NULL
TclIntPlatStubs * tclIntPlatStubsPtr = NULL

Function Documentation
static TclStubs* HasStubSupport _ANSI_ARGS_ ((Tcl_Interp *interp)) [static]
static TclStubs* HasStubSupport (Tcl_Interp * interp) [static]

Definition at line 44 of file tclStubLib.c.
References TclStubs::magic, NULL, Interp::stubTable, TCL_STATIC, and TCL_STUB_MAGIC.
Referenced by Tcl_InitStubs().46 {
47     Interp *iPtr = (Interp *) interp;
48 
49     if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
50   return iPtr->stubTable;
51     }
52     interp->result = "This interpreter does not support stubs-enabled extensions.";
53     interp->freeProc = TCL_STATIC;
54 
55     return NULL;
56 }
CONST char* Tcl_InitStubs (Tcl_Interp * interp, CONST char * version, int exact)

Definition at line 81 of file tclStubLib.c.
References CONST, HasStubSupport(), TclStubs::hooks, NULL, Tcl_PkgRequireEx(), TclStubHooks::tclIntPlatStubs, tclIntPlatStubsPtr, TclStubHooks::tclIntStubs, tclIntStubsPtr, TclStubHooks::tclPlatStubs, tclPlatStubsPtr, and tclStubsPtr.85 {
86     CONST char *actualVersion = NULL;
87     ClientData pkgData = NULL;
88 
89     /*
90      * We can't optimize this check by caching tclStubsPtr because
91      * that prevents apps from being able to load/unload Tcl dynamically
92      * multiple times. [Bug 615304]
93      */
94 
95     tclStubsPtr = HasStubSupport(interp);
96     if (!tclStubsPtr) {
97   return NULL;
98     }
99 
100     actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, exact, &pkgData);
101     if (actualVersion == NULL) {
102   return NULL;
103     }
104     tclStubsPtr = (TclStubs*)pkgData;
105 
106     if (tclStubsPtr->hooks) {
107   tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
108   tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
109   tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
110     } else {
111   tclPlatStubsPtr = NULL;
112   tclIntStubsPtr = NULL;
113   tclIntPlatStubsPtr = NULL;
114     }
115     
116     return actualVersion;
117 }

Variable Documentation
TclIntPlatStubs* tclIntPlatStubsPtr = NULL

Definition at line 39 of file tclStubLib.c.
Referenced by Tcl_InitStubs().TclIntStubs* tclIntStubsPtr = NULL

Definition at line 38 of file tclStubLib.c.
Referenced by Tcl_InitStubs().TclPlatStubs* tclPlatStubsPtr = NULL

Definition at line 37 of file tclStubLib.c.
Referenced by Tcl_InitStubs().TclStubs* tclStubsPtr = NULL

Definition at line 36 of file tclStubLib.c.
Referenced by Tcl_InitStubs().

generic/tclTest.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"
#include <locale.h>
#include "tclIO.h"
Classes
struct TestAsyncHandler
struct DelCmd
struct TclEncoding
struct TestEvent
Defines
#define TCL_TEST
#define OUT_OF_RANGE(x)
#define OUT_OF_URANGE(x)  (((Tcl_WideUInt)(x)) > (Tcl_WideUInt)ULONG_MAX)
Functions
int Tcltest_Init _ANSI_ARGS_ ((Tcl_Interp *interp))
static int AsyncHandlerProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int code))
static void CleanupTestSetassocdataTests _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp))
static void CmdDelProc1 _ANSI_ARGS_ ((ClientData clientData))
static int CmdProc1 _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv))
static void CmdTraceDeleteProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *cmdProc, ClientData cmdClientData, int argc, char **argv))
static int EncodingToUtfProc _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 void MainLoop _ANSI_ARGS_ ((void))
static int NoopObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
static int ObjTraceProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int level, CONST char *command, Tcl_Command commandToken, int objc, Tcl_Obj *CONST objv[]))
static void ObjTraceDeleteProc _ANSI_ARGS_ ((ClientData))
static void PrintParse _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Parse *parsePtr))
static void SpecialFree _ANSI_ARGS_ ((char *blockPtr))
static int TestaccessprocCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv))
static int PretendTclpAccess _ANSI_ARGS_ ((CONST char *path, int mode))
static int TestencodingObjCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
static int TesteventObjCmd _ANSI_ARGS_ ((ClientData unused, Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]))
static int TesteventProc _ANSI_ARGS_ ((Tcl_Event *event, int flags))
static int TesteventDeleteProc _ANSI_ARGS_ ((Tcl_Event *event, ClientData clientData))
static int TestMathFunc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr))
static Tcl_Channel PretendTclpOpenFileChannel _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *fileName, CONST char *modeString, int permissions))
static void TestregexpXflags _ANSI_ARGS_ ((char *string, int length, int *cflagsPtr, int *eflagsPtr))
static int PretendTclpStat _ANSI_ARGS_ ((CONST char *path, struct stat *buf))
static void TestReport _ANSI_ARGS_ ((CONST char *cmd, Tcl_Obj *arg1, Tcl_Obj *arg2))
static Tcl_Obj *TestReportGetNativePath _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr))
static int TestReportStat _ANSI_ARGS_ ((Tcl_Obj *path, Tcl_StatBuf *buf))
static int TestReportAccess _ANSI_ARGS_ ((Tcl_Obj *path, int mode))
static Tcl_Channel TestReportOpenFileChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *fileName, int mode, int permissions))
static int TestReportMatchInDirectory _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *dirPtr, CONST char *pattern, Tcl_GlobTypeData *types))
static int TestReportChdir _ANSI_ARGS_ ((Tcl_Obj *dirName))
static int TestReportCopyFile _ANSI_ARGS_ ((Tcl_Obj *src, Tcl_Obj *dst))
static int TestReportDeleteFile _ANSI_ARGS_ ((Tcl_Obj *path))
static int TestReportCopyDirectory _ANSI_ARGS_ ((Tcl_Obj *src, Tcl_Obj *dst, Tcl_Obj **errorPtr))
static int TestReportRemoveDirectory _ANSI_ARGS_ ((Tcl_Obj *path, int recursive, Tcl_Obj **errorPtr))
static int TestReportLoadFile _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *fileName, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr))
static Tcl_Obj *TestReportLink _ANSI_ARGS_ ((Tcl_Obj *path, Tcl_Obj *to, int linkType))
static CONST char **TestReportFileAttrStrings _ANSI_ARGS_ ((Tcl_Obj *fileName, Tcl_Obj **objPtrRef))
static int TestReportFileAttrsGet _ANSI_ARGS_ ((Tcl_Interp *interp, int index, Tcl_Obj *fileName, Tcl_Obj **objPtrRef))
static int TestReportFileAttrsSet _ANSI_ARGS_ ((Tcl_Interp *interp, int index, Tcl_Obj *fileName, Tcl_Obj *objPtr))
static int TestReportUtime _ANSI_ARGS_ ((Tcl_Obj *fileName, struct utimbuf *tval))
static int TestReportNormalizePath _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint))
static int TestReportInFilesystem _ANSI_ARGS_ ((Tcl_Obj *pathPtr, ClientData *clientDataPtr))
static Tcl_Obj *SimpleCopy _ANSI_ARGS_ ((Tcl_Obj *pathPtr))
int Tcltest_Init (Tcl_Interp *interp)
static int TestasyncCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static int AsyncHandlerProc (ClientData clientData, Tcl_Interp *interp, int code)
static int TestcmdinfoCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static int CmdProc1 (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int CmdProc2 (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static void CmdDelProc1 (ClientData clientData)
static void CmdDelProc2 (ClientData clientData)
static int TestcmdtokenCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestcmdtraceCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static void CmdTraceProc (ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *cmdProc, ClientData cmdClientData, int argc, char **argv)
static void CmdTraceDeleteProc (ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *cmdProc, ClientData cmdClientData, int argc, char **argv)
static int ObjTraceProc (ClientData clientData, Tcl_Interp *interp, int level, CONST char *command, Tcl_Command token, int objc, objv)
static void ObjTraceDeleteProc (ClientData clientData)
static int TestcreatecommandCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static int CreatedCommandProc (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int CreatedCommandProc2 (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestdcallCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static void DelCallbackProc (ClientData clientData, Tcl_Interp *interp)
static int TestdelCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static int DelCmdProc (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static void DelDeleteProc (ClientData clientData)
static int TestdelassocdataCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestdstringCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static void SpecialFree (char *blockPtr)
static int TestencodingObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int EncodingToUtfProc (ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
static int EncodingFromUtfProc (ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
static void EncodingFreeProc (ClientData clientData)
static int TestevalexObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int TestevalobjvObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int TesteventObjCmd (ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
static int TesteventProc (Tcl_Event *event, int flags)
static int TesteventDeleteProc (Tcl_Event *event, ClientData clientData)
static int TestexithandlerCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static void ExitProcOdd (ClientData clientData)
static void ExitProcEven (ClientData clientData)
static int TestexprlongCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestexprstringCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestfilelinkCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static int TestgetassocdataCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestgetplatformCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestinterpdeleteCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestlinkCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestlocaleCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static int TestMathFunc (ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
static int TestMathFunc2 (ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)
static void CleanupTestSetassocdataTests (ClientData clientData, Tcl_Interp *interp)
static int TestparserObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static int TestexprparserObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static void PrintParse (Tcl_Interp *interp, Tcl_Parse *parsePtr)
static int TestparsevarObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static int TestparsevarnameObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static int TestregexpObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static void TestregexpXflags (char *string, int length, int *cflagsPtr, int *eflagsPtr)
static int TestsetassocdataCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestsetplatformCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int TeststaticpkgCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static int StaticInitProc (Tcl_Interp *interp)
static int TesttranslatefilenameCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestupvarCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestseterrorcodeCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestsetobjerrorcodeCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int TestfeventCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestpanicCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestfileCmd (ClientData dummy, Tcl_Interp *interp, int argc, argv)
static int TestgetvarfullnameCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int GetTimesCmd (ClientData unused, Tcl_Interp *interp, int argc, CONST char **argv)
static int NoopCmd (ClientData unused, Tcl_Interp *interp, int argc, CONST char **argv)
static int NoopObjCmd (ClientData unused, Tcl_Interp *interp, int objc, objv)
static int TestsetCmd (ClientData data, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestsaveresultCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static void TestsaveresultFree (char *blockPtr)
static int TeststatprocCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static int PretendTclpStat (CONST char *path, struct stat *buf)
static int TestStatProc1 (CONST char *path, struct stat *buf)
static int TestStatProc2 (CONST char *path, struct stat *buf)
static int TestStatProc3 (CONST char *path, struct stat *buf)
static int TestmainthreadCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static void MainLoop (void)
static int TestsetmainloopCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestexitmainloopCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestaccessprocCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static int PretendTclpAccess (CONST char *path, int mode)
static int TestAccessProc1 (CONST char *path, int mode)
static int TestAccessProc2 (CONST char *path, int mode)
static int TestAccessProc3 (CONST char *path, int mode)
static int TestopenfilechannelprocCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static Tcl_Channel PretendTclpOpenFileChannel (Tcl_Interp *interp, CONST char *fileName, CONST char *modeString, int permissions)
static Tcl_Channel TestOpenFileChannelProc1 (Tcl_Interp *interp, CONST char *fileName, CONST char *modeString, int permissions)
static Tcl_Channel TestOpenFileChannelProc2 (Tcl_Interp *interp, CONST char *fileName, CONST char *modeString, int permissions)
static Tcl_Channel TestOpenFileChannelProc3 (Tcl_Interp *interp, CONST char *fileName, CONST char *modeString, int permissions)
static int TestChannelCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestChannelEventCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestWrongNumArgsObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int TestGetIndexFromObjStructObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int TestFilesystemObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int TestReportInFilesystem (Tcl_Obj *pathPtr, ClientData *clientDataPtr)
static Tcl_Obj * TestReportGetNativePath (Tcl_Obj *pathObjPtr)
static void TestReportFreeInternalRep (ClientData clientData)
static ClientData TestReportDupInternalRep (ClientData clientData)
static void TestReport (CONST char *cmd, Tcl_Obj *path, Tcl_Obj *arg2)
static int TestReportStat (Tcl_Obj *path, Tcl_StatBuf *buf)
static int TestReportLstat (Tcl_Obj *path, Tcl_StatBuf *buf)
static int TestReportAccess (Tcl_Obj *path, int mode)
static Tcl_Channel TestReportOpenFileChannel (Tcl_Interp *interp, Tcl_Obj *fileName, int mode, int permissions)
static int TestReportMatchInDirectory (Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *dirPtr, CONST char *pattern, Tcl_GlobTypeData *types)
static int TestReportChdir (Tcl_Obj *dirName)
static int TestReportLoadFile (Tcl_Interp *interp, Tcl_Obj *fileName, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr)
static Tcl_Obj * TestReportLink (Tcl_Obj *path, Tcl_Obj *to, int linkType)
static int TestReportRenameFile (Tcl_Obj *src, Tcl_Obj *dst)
static int TestReportCopyFile (Tcl_Obj *src, Tcl_Obj *dst)
static int TestReportDeleteFile (Tcl_Obj *path)
static int TestReportCreateDirectory (Tcl_Obj *path)
static int TestReportCopyDirectory (Tcl_Obj *src, Tcl_Obj *dst, Tcl_Obj **errorPtr)
static int TestReportRemoveDirectory (Tcl_Obj *path, int recursive, Tcl_Obj **errorPtr)
static CONST char ** TestReportFileAttrStrings (Tcl_Obj *fileName, Tcl_Obj **objPtrRef)
static int TestReportFileAttrsGet (Tcl_Interp *interp, int index, Tcl_Obj *fileName, Tcl_Obj **objPtrRef)
static int TestReportFileAttrsSet (Tcl_Interp *interp, int index, Tcl_Obj *fileName, Tcl_Obj *objPtr)
static int TestReportUtime (Tcl_Obj *fileName, struct utimbuf *tval)
static int TestReportNormalizePath (Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint)
static int SimplePathInFilesystem (Tcl_Obj *pathPtr, ClientData *clientDataPtr)
static int TestSimpleFilesystemObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static Tcl_Obj * SimpleCopy (Tcl_Obj *pathPtr)
static Tcl_Channel SimpleOpenFileChannel (Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions)
static int SimpleAccess (Tcl_Obj *pathPtr, int mode)
static int SimpleStat (Tcl_Obj *pathPtr, Tcl_StatBuf *bufPtr)
static Tcl_Obj * SimpleListVolumes (void)
static int TestNumUtfCharsCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
Variables
static Tcl_DString delString
static Tcl_Interp * delInterp
static TestAsyncHandler * firstHandler = NULL
static Tcl_DString dstring
static Tcl_Trace cmdTrace
static int freeCount
static int exitMainLoop = 0
static Tcl_Filesystem testReportingFilesystem
static Tcl_Filesystem simpleFilesystem
static Tcl_Interp * simpleInterpPtr = NULL
static Tcl_Obj * tempFile = NULL

Define Documentation
#define OUT_OF_RANGE(x)
Value:(((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
   ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
#define OUT_OF_URANGE(x)  (((Tcl_WideUInt)(x)) > (Tcl_WideUInt)ULONG_MAX)
#define TCL_TEST

Definition at line 20 of file tclTest.c.
Function Documentation
static Tcl_Obj* SimpleCopy _ANSI_ARGS_ ((Tcl_Obj *pathPtr)) [static]
static int TestReportInFilesystem _ANSI_ARGS_ ((Tcl_Obj *pathPtr, ClientData *clientDataPtr)) [static]
static int TestReportNormalizePath _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint)) [static]
static int TestReportUtime _ANSI_ARGS_ ((Tcl_Obj *fileName, struct utimbuf *tval)) [static]
static int TestReportFileAttrsSet _ANSI_ARGS_ ((Tcl_Interp *interp, int index, Tcl_Obj *fileName, Tcl_Obj *objPtr)) [static]
static int TestReportFileAttrsGet _ANSI_ARGS_ ((Tcl_Interp *interp, int index, Tcl_Obj *fileName, Tcl_Obj **objPtrRef)) [static]
static CONST char** TestReportFileAttrStrings _ANSI_ARGS_ ((Tcl_Obj *fileName, Tcl_Obj **objPtrRef)) [static]
static Tcl_Obj* TestReportLink _ANSI_ARGS_ ((Tcl_Obj *path, Tcl_Obj *to, int linkType)) [static]
static int TestReportLoadFile _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *fileName, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr)) [static]
static int TestReportRemoveDirectory _ANSI_ARGS_ ((Tcl_Obj *path, int recursive, Tcl_Obj **errorPtr)) [static]
static int TestReportCopyDirectory _ANSI_ARGS_ ((Tcl_Obj *src, Tcl_Obj *dst, Tcl_Obj **errorPtr)) [static]
static int TestReportDeleteFile _ANSI_ARGS_ ((Tcl_Obj *path)) [static]
static int TestReportCopyFile _ANSI_ARGS_ ((Tcl_Obj *src, Tcl_Obj *dst)) [static]
static int TestReportChdir _ANSI_ARGS_ ((Tcl_Obj *dirName)) [static]
static int TestReportMatchInDirectory _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *dirPtr, CONST char *pattern, Tcl_GlobTypeData *types)) [static]
static Tcl_Channel TestReportOpenFileChannel _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *fileName, int mode, int permissions)) [static]
static int TestReportAccess _ANSI_ARGS_ ((Tcl_Obj *path, int mode)) [static]
static int TestReportStat _ANSI_ARGS_ ((Tcl_Obj *path, Tcl_StatBuf *buf)) [static]
static Tcl_Obj* TestReportGetNativePath _ANSI_ARGS_ ((Tcl_Obj *pathObjPtr)) [static]
static void TestReport _ANSI_ARGS_ ((CONST char *cmd, Tcl_Obj *arg1, Tcl_Obj *arg2)) [static]
static int PretendTclpStat _ANSI_ARGS_ ((CONST char *path, struct stat *buf)) [static]
static void TestregexpXflags _ANSI_ARGS_ ((char *string, int length, int *cflagsPtr, int *eflagsPtr)) [static]
static Tcl_Channel PretendTclpOpenFileChannel _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *fileName, CONST char *modeString, int permissions)) [static]
static int TestMathFunc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)) [static]
static int TesteventDeleteProc _ANSI_ARGS_ ((Tcl_Event *event, ClientData clientData)) [static]
static int TesteventProc _ANSI_ARGS_ ((Tcl_Event *event, int flags)) [static]
static int TesteventObjCmd _ANSI_ARGS_ ((ClientData unused, Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[])) [static]
static int TestencodingObjCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])) [static]
static int PretendTclpAccess _ANSI_ARGS_ ((CONST char *path, int mode)) [static]
static int TestaccessprocCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)) [static]
static void SpecialFree _ANSI_ARGS_ ((char *blockPtr)) [static]
static void PrintParse _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Parse *parsePtr)) [static]
static void ObjTraceDeleteProc _ANSI_ARGS_ ((ClientData)) [static]
static int ObjTraceProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int level, CONST char *command, Tcl_Command commandToken, int objc, Tcl_Obj *CONST objv[])) [static]
static int NoopObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])) [static]
static void MainLoop _ANSI_ARGS_ ((void)) [static]
static int EncodingToUtfProc _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]
static void CmdTraceDeleteProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *cmdProc, ClientData cmdClientData, int argc, char **argv)) [static]
static int CmdProc1 _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)) [static]
static void CmdDelProc1 _ANSI_ARGS_ ((ClientData clientData)) [static]
static void CleanupTestSetassocdataTests _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp)) [static]
static int AsyncHandlerProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int code)) [static]
int Tcltest_Init _ANSI_ARGS_ ((Tcl_Interp *interp))
static int AsyncHandlerProc (ClientData clientData, Tcl_Interp * interp, int code) [static]

Definition at line 852 of file tclTest.c.
References ckfree, TestAsyncHandler::command, CONST, NULL, Tcl_Eval(), Tcl_GetObjResult(), Tcl_GetString(), TCL_INTEGER_SPACE, Tcl_Merge(), and TclFormatInt().
Referenced by TestasyncCmd().857 {
858     TestAsyncHandler *asyncPtr = (TestAsyncHandler *) clientData;
859     CONST char *listArgv[4], *cmd;
860     char string[TCL_INTEGER_SPACE];
861 
862     TclFormatInt(string, code);
863     listArgv[0] = asyncPtr->command;
864     listArgv[1] = Tcl_GetString(Tcl_GetObjResult(interp));
865     listArgv[2] = string;
866     listArgv[3] = NULL;
867     cmd = Tcl_Merge(3, listArgv);
868     if (interp != NULL) {
869   code = Tcl_Eval(interp, cmd);
870     } else {
871   /*
872    * this should not happen, but by definition of how async
873    * handlers are invoked, it's possible.  Better error
874    * checking is needed here.
875    */
876     }
877     ckfree((char *)cmd);
878     return code;
879 }
static void CleanupTestSetassocdataTests (ClientData clientData, Tcl_Interp * interp) [static]

Definition at line 2902 of file tclTest.c.
References ckfree.
Referenced by TestsetassocdataCmd().2905 {
2906     ckfree((char *) clientData);
2907 }
static void CmdDelProc1 (ClientData clientData) [static]

Definition at line 999 of file tclTest.c.
References delString, Tcl_DStringAppend(), and Tcl_DStringInit().
Referenced by TestcmdinfoCmd().1001 {
1002     Tcl_DStringInit(&delString);
1003     Tcl_DStringAppend(&delString, "CmdDelProc1 ", -1);
1004     Tcl_DStringAppend(&delString, (char *) clientData, -1);
1005 }
static void CmdDelProc2 (ClientData clientData) [static]

Definition at line 1008 of file tclTest.c.
References delString, Tcl_DStringAppend(), and Tcl_DStringInit().
Referenced by TestcmdinfoCmd().1010 {
1011     Tcl_DStringInit(&delString);
1012     Tcl_DStringAppend(&delString, "CmdDelProc2 ", -1);
1013     Tcl_DStringAppend(&delString, (char *) clientData, -1);
1014 }
static int CmdProc1 (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 974 of file tclTest.c.
References NULL, and TCL_OK.
Referenced by TestcmdinfoCmd(), and TestcmdtokenCmd().979 {
980     Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData,
981       (char *) NULL);
982     return TCL_OK;
983 }
static int CmdProc2 (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 987 of file tclTest.c.
References NULL, and TCL_OK.
Referenced by TestcmdinfoCmd().992 {
993     Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData,
994       (char *) NULL);
995     return TCL_OK;
996 }
static void CmdTraceDeleteProc (ClientData clientData, Tcl_Interp * interp, int level, char * command, Tcl_CmdProc * cmdProc, ClientData cmdClientData, int argc, char ** argv) [static]

Definition at line 1207 of file tclTest.c.
References cmdTrace, and Tcl_DeleteTrace().
Referenced by TestcmdtraceCmd().1219 {
1220     /*
1221      * Remove ourselves to test whether calling Tcl_DeleteTrace within
1222      * a trace callback causes the for loop in TclExecuteByteCode that
1223      * calls traces to reference freed memory.
1224      */
1225     
1226     Tcl_DeleteTrace(interp, cmdTrace);
1227 }
static void CmdTraceProc (ClientData clientData, Tcl_Interp * interp, int level, char * command, Tcl_CmdProc * cmdProc, ClientData cmdClientData, int argc, char ** argv) [static]

Definition at line 1179 of file tclTest.c.
References Tcl_DStringAppendElement(), Tcl_DStringEndSublist(), and Tcl_DStringStartSublist().
Referenced by TestcmdtraceCmd().1193 {
1194     Tcl_DString *bufPtr = (Tcl_DString *) clientData;
1195     int i;
1196 
1197     Tcl_DStringAppendElement(bufPtr, command);
1198 
1199     Tcl_DStringStartSublist(bufPtr);
1200     for (i = 0;  i < argc;  i++) {
1201   Tcl_DStringAppendElement(bufPtr, argv[i]);
1202     }
1203     Tcl_DStringEndSublist(bufPtr);
1204 }
static int CreatedCommandProc (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 1319 of file tclTest.c.
References Tcl_Namespace::fullName, Tcl_CmdInfo::namespacePtr, NULL, TCL_ERROR, Tcl_GetCommandInfo(), and TCL_OK.
Referenced by TestcreatecommandCmd().1324 {
1325     Tcl_CmdInfo info;
1326     int found;
1327 
1328     found = Tcl_GetCommandInfo(interp, "test_ns_basic::createdcommand",
1329       &info);
1330     if (!found) {
1331   Tcl_AppendResult(interp, "CreatedCommandProc could not get command info for test_ns_basic::createdcommand",
1332           (char *) NULL);
1333   return TCL_ERROR;
1334     }
1335     Tcl_AppendResult(interp, "CreatedCommandProc in ",
1336       info.namespacePtr->fullName, (char *) NULL);
1337     return TCL_OK;
1338 }
static int CreatedCommandProc2 (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 1341 of file tclTest.c.
References Tcl_Namespace::fullName, Tcl_CmdInfo::namespacePtr, NULL, TCL_ERROR, Tcl_GetCommandInfo(), and TCL_OK.
Referenced by TestcreatecommandCmd().1346 {
1347     Tcl_CmdInfo info;
1348     int found;
1349 
1350     found = Tcl_GetCommandInfo(interp, "value:at:", &info);
1351     if (!found) {
1352   Tcl_AppendResult(interp, "CreatedCommandProc2 could not get command info for test_ns_basic::createdcommand",
1353           (char *) NULL);
1354   return TCL_ERROR;
1355     }
1356     Tcl_AppendResult(interp, "CreatedCommandProc2 in ",
1357       info.namespacePtr->fullName, (char *) NULL);
1358     return TCL_OK;
1359 }
static void DelCallbackProc (ClientData clientData, Tcl_Interp * interp) [static]

Definition at line 1412 of file tclTest.c.
References delInterp, delString, Tcl_DStringAppendElement(), TCL_INTEGER_SPACE, and TclFormatInt().
Referenced by TestdcallCmd().1416 {
1417     int id = (int) clientData;
1418     char buffer[TCL_INTEGER_SPACE];
1419 
1420     TclFormatInt(buffer, id);
1421     Tcl_DStringAppendElement(&delString, buffer);
1422     if (interp != delInterp) {
1423   Tcl_DStringAppendElement(&delString, "bogus interpreter argument!");
1424     }
1425 }
static int DelCmdProc (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 1476 of file tclTest.c.
References ckfree, DelCmd::deleteCmd, NULL, and TCL_OK.
Referenced by TestdelCmd().1481 {
1482     DelCmd *dPtr = (DelCmd *) clientData;
1483 
1484     Tcl_AppendResult(interp, dPtr->deleteCmd, (char *) NULL);
1485     ckfree(dPtr->deleteCmd);
1486     ckfree((char *) dPtr);
1487     return TCL_OK;
1488 }
static void DelDeleteProc (ClientData clientData) [static]

Definition at line 1491 of file tclTest.c.
References ckfree, DelCmd::deleteCmd, DelCmd::interp, Tcl_Eval(), and Tcl_ResetResult().
Referenced by TestdelCmd().1493 {
1494     DelCmd *dPtr = (DelCmd *) clientData;
1495 
1496     Tcl_Eval(dPtr->interp, dPtr->deleteCmd);
1497     Tcl_ResetResult(dPtr->interp);
1498     ckfree(dPtr->deleteCmd);
1499     ckfree((char *) dPtr);
1500 }
static void EncodingFreeProc (ClientData clientData) [static]

Definition at line 1822 of file tclTest.c.
References ckfree, TclEncoding::fromUtfCmd, and TclEncoding::toUtfCmd.
Referenced by TestencodingObjCmd().1824 {
1825     TclEncoding *encodingPtr;
1826 
1827     encodingPtr = (TclEncoding *) clientData;
1828     ckfree((char *) encodingPtr->toUtfCmd);
1829     ckfree((char *) encodingPtr->fromUtfCmd);
1830     ckfree((char *) encodingPtr);
1831 }
static int EncodingFromUtfProc (ClientData clientData, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr) [static]

Definition at line 1790 of file tclTest.c.
References TclEncoding::fromUtfCmd, TclEncoding::interp, Tcl_GetStringResult(), Tcl_GlobalEval(), TCL_OK, and Tcl_ResetResult().
Referenced by TestencodingObjCmd().1802 {
1803     int len;
1804     TclEncoding *encodingPtr;
1805 
1806     encodingPtr = (TclEncoding *) clientData;
1807     Tcl_GlobalEval(encodingPtr->interp, encodingPtr->fromUtfCmd);
1808 
1809     len = strlen(Tcl_GetStringResult(encodingPtr->interp));
1810     if (len > dstLen) {
1811   len = dstLen;
1812     }
1813     memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), (unsigned) len);
1814     Tcl_ResetResult(encodingPtr->interp);
1815 
1816     *srcReadPtr = srcLen;
1817     *dstWrotePtr = len;
1818     *dstCharsPtr = len;
1819     return TCL_OK;
1820 }
static int EncodingToUtfProc (ClientData clientData, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr) [static]

Definition at line 1758 of file tclTest.c.
References TclEncoding::interp, Tcl_GetStringResult(), Tcl_GlobalEval(), TCL_OK, Tcl_ResetResult(), and TclEncoding::toUtfCmd.
Referenced by TestencodingObjCmd().1770 {
1771     int len;
1772     TclEncoding *encodingPtr;
1773 
1774     encodingPtr = (TclEncoding *) clientData;
1775     Tcl_GlobalEval(encodingPtr->interp, encodingPtr->toUtfCmd);
1776 
1777     len = strlen(Tcl_GetStringResult(encodingPtr->interp));
1778     if (len > dstLen) {
1779   len = dstLen;
1780     }
1781     memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), (unsigned) len);
1782     Tcl_ResetResult(encodingPtr->interp);
1783 
1784     *srcReadPtr = srcLen;
1785     *dstWrotePtr = len;
1786     *dstCharsPtr = len;
1787     return TCL_OK;
1788 }
static void ExitProcEven (ClientData clientData) [static]

Definition at line 2200 of file tclTest.c.
References TCL_INTEGER_SPACE.
Referenced by TestexithandlerCmd().2202 {
2203     char buf[16 + TCL_INTEGER_SPACE];
2204 
2205     sprintf(buf, "even %d\n", (int) clientData);
2206     write(1, buf, strlen(buf));
2207 }
static void ExitProcOdd (ClientData clientData) [static]

Definition at line 2190 of file tclTest.c.
References TCL_INTEGER_SPACE.
Referenced by TestexithandlerCmd().2192 {
2193     char buf[16 + TCL_INTEGER_SPACE];
2194 
2195     sprintf(buf, "odd %d\n", (int) clientData);
2196     write(1, buf, strlen(buf));
2197 }
static int GetTimesCmd (ClientData unused, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 4167 of file tclTest.c.
References ckalloc, ckfree, Namespace::cmdTable, CONST, Interp::globalNsPtr, NULL, Tcl_Time::sec, Tcl_DecrRefCount, TCL_ERROR, Tcl_FindHashEntry, Tcl_GetInt(), Tcl_GetIntFromObj(), Tcl_GetTime(), Tcl_GetVar(), TCL_INTEGER_SPACE, TCL_LEAVE_ERR_MSG, Tcl_NewObj(), Tcl_NewStringObj(), TCL_OK, Tcl_ResetResult(), Tcl_SetVar(), TclGetString, and Tcl_Time::usec.
Referenced by Tcltest_Init().4172 {
4173     Interp *iPtr = (Interp *) interp;
4174     int i, n;
4175     double timePer;
4176     Tcl_Time start, stop;
4177     Tcl_Obj *objPtr;
4178     Tcl_Obj **objv;
4179     CONST char *s;
4180     char newString[TCL_INTEGER_SPACE];
4181 
4182     /* alloc & free 100000 times */
4183     fprintf(stderr, "alloc & free 100000 6 word items\n");
4184     Tcl_GetTime(&start);
4185     for (i = 0;  i < 100000;  i++) {
4186   objPtr = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj));
4187   ckfree((char *) objPtr);
4188     }
4189     Tcl_GetTime(&stop);
4190     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
4191     fprintf(stderr, "   %.3f usec per alloc+free\n", timePer/100000);
4192     
4193     /* alloc 5000 times */
4194     fprintf(stderr, "alloc 5000 6 word items\n");
4195     objv = (Tcl_Obj **) ckalloc(5000 * sizeof(Tcl_Obj *));
4196     Tcl_GetTime(&start);
4197     for (i = 0;  i < 5000;  i++) {
4198   objv[i] = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj));
4199     }
4200     Tcl_GetTime(&stop);
4201     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
4202     fprintf(stderr, "   %.3f usec per alloc\n", timePer/5000);
4203     
4204     /* free 5000 times */
4205     fprintf(stderr, "free 5000 6 word items\n");
4206     Tcl_GetTime(&start);
4207     for (i = 0;  i < 5000;  i++) {
4208   ckfree((char *) objv[i]);
4209     }
4210     Tcl_GetTime(&stop);
4211     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
4212     fprintf(stderr, "   %.3f usec per free\n", timePer/5000);
4213 
4214     /* Tcl_NewObj 5000 times */
4215     fprintf(stderr, "Tcl_NewObj 5000 times\n");
4216     Tcl_GetTime(&start);
4217     for (i = 0;  i < 5000;  i++) {
4218   objv[i] = Tcl_NewObj();
4219     }
4220     Tcl_GetTime(&stop);
4221     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
4222     fprintf(stderr, "   %.3f usec per Tcl_NewObj\n", timePer/5000);
4223     
4224     /* Tcl_DecrRefCount 5000 times */
4225     fprintf(stderr, "Tcl_DecrRefCount 5000 times\n");
4226     Tcl_GetTime(&start);
4227     for (i = 0;  i < 5000;  i++) {
4228   objPtr = objv[i];
4229   Tcl_DecrRefCount(objPtr);
4230     }
4231     Tcl_GetTime(&stop);
4232     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
4233     fprintf(stderr, "   %.3f usec per Tcl_DecrRefCount\n", timePer/5000);
4234     ckfree((char *) objv);
4235 
4236     /* TclGetString 100000 times */
4237     fprintf(stderr, "TclGetStringFromObj of \"12345\" 100000 times\n");
4238     objPtr = Tcl_NewStringObj("12345", -1);
4239     Tcl_GetTime(&start);
4240     for (i = 0;  i < 100000;  i++) {
4241   (void) TclGetString(objPtr);
4242     }
4243     Tcl_GetTime(&stop);
4244     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
4245     fprintf(stderr, "   %.3f usec per TclGetStringFromObj of \"12345\"\n",
4246       timePer/100000);
4247 
4248     /* Tcl_GetIntFromObj 100000 times */
4249     fprintf(stderr, "Tcl_GetIntFromObj of \"12345\" 100000 times\n");
4250     Tcl_GetTime(&start);
4251     for (i = 0;  i < 100000;  i++) {
4252   if (Tcl_GetIntFromObj(interp, objPtr, &n) != TCL_OK) {
4253       return TCL_ERROR;
4254   }
4255     }
4256     Tcl_GetTime(&stop);
4257     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
4258     fprintf(stderr, "   %.3f usec per Tcl_GetIntFromObj of \"12345\"\n",
4259       timePer/100000);
4260     Tcl_DecrRefCount(objPtr);
4261     
4262     /* Tcl_GetInt 100000 times */
4263     fprintf(stderr, "Tcl_GetInt of \"12345\" 100000 times\n");
4264     Tcl_GetTime(&start);
4265     for (i = 0;  i < 100000;  i++) {
4266   if (Tcl_GetInt(interp, "12345", &n) != TCL_OK) {
4267       return TCL_ERROR;
4268   }
4269     }
4270     Tcl_GetTime(&stop);
4271     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
4272     fprintf(stderr, "   %.3f usec per Tcl_GetInt of \"12345\"\n",
4273       timePer/100000);
4274 
4275     /* sprintf 100000 times */
4276     fprintf(stderr, "sprintf of 12345 100000 times\n");
4277     Tcl_GetTime(&start);
4278     for (i = 0;  i < 100000;  i++) {
4279   sprintf(newString, "%d", 12345);
4280     }
4281     Tcl_GetTime(&stop);
4282     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
4283     fprintf(stderr, "   %.3f usec per sprintf of 12345\n",
4284       timePer/100000);
4285 
4286     /* hashtable lookup 100000 times */
4287     fprintf(stderr, "hashtable lookup of \"gettimes\" 100000 times\n");
4288     Tcl_GetTime(&start);
4289     for (i = 0;  i < 100000;  i++) {
4290   (void) Tcl_FindHashEntry(&iPtr->globalNsPtr->cmdTable, "gettimes");
4291     }
4292     Tcl_GetTime(&stop);
4293     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
4294     fprintf(stderr, "   %.3f usec per hashtable lookup of \"gettimes\"\n",
4295       timePer/100000);
4296 
4297     /* Tcl_SetVar 100000 times */
4298     fprintf(stderr, "Tcl_SetVar of \"12345\" 100000 times\n");
4299     Tcl_GetTime(&start);
4300     for (i = 0;  i < 100000;  i++) {
4301   s = Tcl_SetVar(interp, "a", "12345", TCL_LEAVE_ERR_MSG);
4302   if (s == NULL) {
4303       return TCL_ERROR;
4304   }
4305     }
4306     Tcl_GetTime(&stop);
4307     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
4308     fprintf(stderr, "   %.3f usec per Tcl_SetVar of a to \"12345\"\n",
4309       timePer/100000);
4310 
4311     /* Tcl_GetVar 100000 times */
4312     fprintf(stderr, "Tcl_GetVar of a==\"12345\" 100000 times\n");
4313     Tcl_GetTime(&start);
4314     for (i = 0;  i < 100000;  i++) {
4315   s = Tcl_GetVar(interp, "a", TCL_LEAVE_ERR_MSG);
4316   if (s == NULL) {
4317       return TCL_ERROR;
4318   }
4319     }
4320     Tcl_GetTime(&stop);
4321     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
4322     fprintf(stderr, "   %.3f usec per Tcl_GetVar of a==\"12345\"\n",
4323       timePer/100000);
4324     
4325     Tcl_ResetResult(interp);
4326     return TCL_OK;
4327 }
static void MainLoop (void) [static]

Definition at line 4816 of file tclTest.c.
References exitMainLoop, and Tcl_DoOneEvent().
Referenced by TestsetmainloopCmd().4817 {
4818     while (!exitMainLoop) {
4819   Tcl_DoOneEvent(0);
4820     }
4821     fprintf(stdout,"Exit MainLoop\n");
4822     fflush(stdout);
4823 }
static int NoopCmd (ClientData unused, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 4347 of file tclTest.c.
References TCL_OK.
Referenced by Tcltest_Init().4352 {
4353     return TCL_OK;
4354 }
static int NoopObjCmd (ClientData unused, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 4374 of file tclTest.c.
References TCL_OK.
Referenced by Tcltest_Init().4379 {
4380     return TCL_OK;
4381 }
static void ObjTraceDeleteProc (ClientData clientData) [static]

Definition at line 1257 of file tclTest.c.
Referenced by TestcmdtraceCmd().1259 {
1260     int * intPtr = (int *) clientData;
1261     *intPtr = 1;    /* Record that the trace was deleted */
1262 }
static int ObjTraceProc (ClientData clientData, Tcl_Interp* interp, int level, CONST char* command, Tcl_Command token, int objc, objv) [static]

Definition at line 1230 of file tclTest.c.
References CONST, TCL_BREAK, TCL_CONTINUE, TCL_ERROR, Tcl_GetString(), Tcl_NewStringObj(), TCL_OK, TCL_RETURN, Tcl_SetObjResult(), and word().
Referenced by TestcmdtraceCmd().1238 {
1239     CONST char* word = Tcl_GetString( objv[ 0 ] );
1240     if ( !strcmp( word, "Error" ) ) {
1241   Tcl_SetObjResult( interp, Tcl_NewStringObj( command, -1 ) );
1242   return TCL_ERROR;
1243     } else if ( !strcmp( word, "Break" ) ) {
1244   return TCL_BREAK;
1245     } else if ( !strcmp( word, "Continue" ) ) {
1246   return TCL_CONTINUE;
1247     } else if ( !strcmp( word, "Return" ) ) {
1248   return TCL_RETURN;
1249     } else if ( !strcmp( word, "OtherStatus" ) ) {
1250   return 6;
1251     } else {
1252   return TCL_OK;
1253     }
1254 }
static int PretendTclpAccess (CONST char * path, int mode) [static]

Definition at line 4956 of file tclTest.c.
References Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_NewStringObj(), and TclpObjAccess().
Referenced by TestaccessprocCmd().4959 {
4960     int ret;
4961     Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);
4962     Tcl_IncrRefCount(pathPtr);
4963     ret = TclpObjAccess(pathPtr, mode);
4964     Tcl_DecrRefCount(pathPtr);
4965     return ret;
4966 }
static Tcl_Channel PretendTclpOpenFileChannel (Tcl_Interp * interp, CONST char * fileName, CONST char * modeString, int permissions) [static]

Definition at line 5071 of file tclTest.c.
References NULL, SEEK_END, Tcl_Close(), Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_NewStringObj(), Tcl_PosixError(), Tcl_Seek(), TclGetOpenMode(), and TclpOpenFileChannel().
Referenced by TestOpenFileChannelProc1(), TestOpenFileChannelProc2(), TestOpenFileChannelProc3(), and TestopenfilechannelprocCmd().5080 {
5081     Tcl_Channel ret;
5082     int mode, seekFlag;
5083     Tcl_Obj *pathPtr;
5084     mode = TclGetOpenMode(interp, modeString, &seekFlag);
5085     if (mode == -1) {
5086   return NULL;
5087     }
5088     pathPtr = Tcl_NewStringObj(fileName, -1);
5089     Tcl_IncrRefCount(pathPtr);
5090     ret = TclpOpenFileChannel(interp, pathPtr, mode, permissions);
5091     Tcl_DecrRefCount(pathPtr);
5092     if (ret != NULL) {
5093   if (seekFlag) {
5094       if (Tcl_Seek(ret, (Tcl_WideInt)0, SEEK_END) < (Tcl_WideInt)0) {
5095     if (interp != (Tcl_Interp *) NULL) {
5096         Tcl_AppendResult(interp,
5097           "could not seek to end of file while opening \"",
5098           fileName, "\": ", 
5099           Tcl_PosixError(interp), (char *) NULL);
5100     }
5101     Tcl_Close(NULL, ret);
5102     return NULL;
5103       }
5104   }
5105     }
5106     return ret;
5107 }
static int PretendTclpStat (CONST char * path, struct stat * buf) [static]

Definition at line 4640 of file tclTest.c.
References EFBIG, EOVERFLOW, errno, OUT_OF_RANGE, OUT_OF_URANGE, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_NewStringObj(), and TclpObjStat().
Referenced by TeststatprocCmd().4643 {
4644     int ret;
4645     Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);
4646 #ifdef TCL_WIDE_INT_IS_LONG
4647     Tcl_IncrRefCount(pathPtr);
4648     ret = TclpObjStat(pathPtr, buf);
4649     Tcl_DecrRefCount(pathPtr);
4650     return ret;
4651 #else /* TCL_WIDE_INT_IS_LONG */
4652     Tcl_StatBuf realBuf;
4653     Tcl_IncrRefCount(pathPtr);
4654     ret = TclpObjStat(pathPtr, &realBuf);
4655     Tcl_DecrRefCount(pathPtr);
4656     if (ret != -1) {
4657 #   define OUT_OF_RANGE(x) \
4658   (((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
4659    ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
4660 #if defined(__GNUC__) && __GNUC__ >= 2
4661 /*
4662  * Workaround gcc warning of "comparison is always false due to limited range of
4663  * data type" in this macro by checking max type size, and when necessary ANDing
4664  * with the complement of ULONG_MAX instead of the comparison:
4665  */
4666 #   define OUT_OF_URANGE(x) \
4667   ((((Tcl_WideUInt)(~ (__typeof__(x)) 0)) > (Tcl_WideUInt)ULONG_MAX) && \
4668    (((Tcl_WideUInt)(x)) & ~(Tcl_WideUInt)ULONG_MAX))
4669 #else
4670 #   define OUT_OF_URANGE(x) \
4671   (((Tcl_WideUInt)(x)) > (Tcl_WideUInt)ULONG_MAX)
4672 #endif
4673 
4674   /*
4675    * Perform the result-buffer overflow check manually.
4676    *
4677    * Note that ino_t/ino64_t is unsigned...
4678    */
4679 
4680         if (OUT_OF_URANGE(realBuf.st_ino) || OUT_OF_RANGE(realBuf.st_size)
4681 #   ifdef HAVE_ST_BLOCKS
4682     || OUT_OF_RANGE(realBuf.st_blocks)
4683 #   endif
4684       ) {
4685 #   ifdef EOVERFLOW
4686       errno = EOVERFLOW;
4687 #   else
4688 #       ifdef EFBIG
4689             errno = EFBIG;
4690 #       else
4691 #           error "what error should be returned for a value out of range?"
4692 #       endif
4693 #   endif
4694       return -1;
4695   }
4696 
4697 #   undef OUT_OF_RANGE
4698 #   undef OUT_OF_URANGE
4699 
4700   /*
4701    * Copy across all supported fields, with possible type
4702    * coercions on those fields that change between the normal
4703    * and lf64 versions of the stat structure (on Solaris at
4704    * least.)  This is slow when the structure sizes coincide,
4705    * but that's what you get for mixing interfaces...
4706    */
4707 
4708   buf->st_mode    = realBuf.st_mode;
4709   buf->st_ino     = (ino_t) realBuf.st_ino;
4710   buf->st_dev     = realBuf.st_dev;
4711   buf->st_rdev    = realBuf.st_rdev;
4712   buf->st_nlink   = realBuf.st_nlink;
4713   buf->st_uid     = realBuf.st_uid;
4714   buf->st_gid     = realBuf.st_gid;
4715   buf->st_size    = (off_t) realBuf.st_size;
4716   buf->st_atime   = realBuf.st_atime;
4717   buf->st_mtime   = realBuf.st_mtime;
4718   buf->st_ctime   = realBuf.st_ctime;
4719 #   ifdef HAVE_ST_BLOCKS
4720   buf->st_blksize = realBuf.st_blksize;
4721   buf->st_blocks  = (blkcnt_t) realBuf.st_blocks;
4722 #   endif
4723     }
4724     return ret;
4725 #endif /* TCL_WIDE_INT_IS_LONG */
4726 }
static void PrintParse (Tcl_Interp * interp, Tcl_Parse * parsePtr) [static]

Definition at line 3040 of file tclTest.c.
References Tcl_Parse::commandSize, Tcl_Parse::commandStart, Tcl_Parse::commentSize, Tcl_Parse::commentStart, NULL, Tcl_Token::numComponents, Tcl_Parse::numTokens, Tcl_Parse::numWords, Tcl_Token::size, Tcl_Token::start, Tcl_GetObjResult(), Tcl_ListObjAppendElement(), Tcl_NewIntObj(), Tcl_NewStringObj(), TCL_TOKEN_BS, TCL_TOKEN_COMMAND, TCL_TOKEN_OPERATOR, TCL_TOKEN_SIMPLE_WORD, TCL_TOKEN_SUB_EXPR, TCL_TOKEN_TEXT, TCL_TOKEN_VARIABLE, TCL_TOKEN_WORD, Tcl_Parse::tokenPtr, and Tcl_Token::type.
Referenced by TestexprparserObjCmd(), TestparserObjCmd(), and TestparsevarnameObjCmd().3044 {
3045     Tcl_Obj *objPtr;
3046     char *typeString;
3047     Tcl_Token *tokenPtr;
3048     int i;
3049 
3050     objPtr = Tcl_GetObjResult(interp);
3051     if (parsePtr->commentSize > 0) {
3052   Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
3053     Tcl_NewStringObj(parsePtr->commentStart,
3054       parsePtr->commentSize));
3055     } else {
3056   Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
3057     Tcl_NewStringObj("-", 1));
3058     }
3059     Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
3060       Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize));
3061     Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
3062       Tcl_NewIntObj(parsePtr->numWords));
3063     for (i = 0; i < parsePtr->numTokens; i++) {
3064   tokenPtr = &parsePtr->tokenPtr[i];
3065   switch (tokenPtr->type) {
3066       case TCL_TOKEN_WORD:
3067     typeString = "word";
3068     break;
3069       case TCL_TOKEN_SIMPLE_WORD:
3070     typeString = "simple";
3071     break;
3072       case TCL_TOKEN_TEXT:
3073     typeString = "text";
3074     break;
3075       case TCL_TOKEN_BS:
3076     typeString = "backslash";
3077     break;
3078       case TCL_TOKEN_COMMAND:
3079     typeString = "command";
3080     break;
3081       case TCL_TOKEN_VARIABLE:
3082     typeString = "variable";
3083     break;
3084       case TCL_TOKEN_SUB_EXPR:
3085     typeString = "subexpr";
3086     break;
3087       case TCL_TOKEN_OPERATOR:
3088     typeString = "operator";
3089     break;
3090       default:
3091     typeString = "??";
3092     break;
3093   }
3094   Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
3095     Tcl_NewStringObj(typeString, -1));
3096   Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
3097     Tcl_NewStringObj(tokenPtr->start, tokenPtr->size));
3098   Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
3099     Tcl_NewIntObj(tokenPtr->numComponents));
3100     }
3101     Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
3102       Tcl_NewStringObj(parsePtr->commandStart + parsePtr->commandSize,
3103       -1));
3104 }
static int SimpleAccess (Tcl_Obj * pathPtr, int mode) [static]

Definition at line 6426 of file tclTest.c.
References TCL_OK.6429 {
6430     /* All files exist */
6431     return TCL_OK;
6432 }
static Tcl_Obj* SimpleCopy (Tcl_Obj * pathPtr) [static]

Definition at line 6356 of file tclTest.c.
References CONST, NULL, simpleInterpPtr, Tcl_DecrRefCount, Tcl_FSDeleteFile(), Tcl_GetString(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_OK, TclCrossFilesystemCopy(), and TclpTempFileName().
Referenced by SimpleOpenFileChannel(), and SimpleStat().6358 {
6359     int res;
6360     CONST char *str;
6361     Tcl_Obj *origPtr;
6362     Tcl_Obj *tempPtr;
6363 
6364     tempPtr = TclpTempFileName();
6365     Tcl_IncrRefCount(tempPtr);
6366 
6367     /* 
6368      * We assume the same name in the current directory is ok.
6369      */
6370     str = Tcl_GetString(pathPtr);
6371     origPtr = Tcl_NewStringObj(str+10,-1);
6372     Tcl_IncrRefCount(origPtr);
6373 
6374     res = TclCrossFilesystemCopy(simpleInterpPtr, origPtr, tempPtr);
6375     Tcl_DecrRefCount(origPtr);
6376 
6377     if (res != TCL_OK) {
6378   Tcl_FSDeleteFile(tempPtr);
6379   Tcl_DecrRefCount(tempPtr);
6380   return NULL;
6381     }
6382     return tempPtr;
6383 }
static Tcl_Obj* SimpleListVolumes (void) [static]

Definition at line 6452 of file tclTest.c.
References Tcl_IncrRefCount, and Tcl_NewStringObj().6453 {
6454     /* Add one new volume */
6455     Tcl_Obj *retVal;
6456 
6457     retVal = Tcl_NewStringObj("simplefs:/",-1);
6458     Tcl_IncrRefCount(retVal);
6459     return retVal;
6460 }
static Tcl_Channel SimpleOpenFileChannel (Tcl_Interp * interp, Tcl_Obj * pathPtr, int mode, int permissions) [static]

Definition at line 6386 of file tclTest.c.
References NULL, SimpleCopy(), Tcl_DecrRefCount, Tcl_FSDeleteFile(), Tcl_FSOpenFileChannel(), and tempFile.6394 {
6395     Tcl_Obj *tempPtr;
6396     Tcl_Channel chan;
6397     
6398     if ((mode != 0) && !(mode & O_RDONLY)) {
6399   Tcl_AppendResult(interp, "read-only", 
6400     (char *) NULL);
6401   return NULL;
6402     }
6403     
6404     tempPtr = SimpleCopy(pathPtr);
6405     
6406     if (tempPtr == NULL) {
6407   return NULL;
6408     }
6409     
6410     chan = Tcl_FSOpenFileChannel(interp, tempPtr, "r", permissions);
6411 
6412     if (tempFile != NULL) {
6413         Tcl_FSDeleteFile(tempFile);
6414   Tcl_DecrRefCount(tempFile);
6415   tempFile = NULL;
6416     }
6417     /* 
6418      * Store file pointer in this global variable so we can delete
6419      * it later 
6420      */
6421     tempFile = tempPtr;
6422     return chan;
6423 }
static int SimplePathInFilesystem (Tcl_Obj * pathPtr, ClientData * clientDataPtr) [static]

Definition at line 6277 of file tclTest.c.
References CONST, Tcl_GetString(), and TCL_OK.6277                                                                     {
6278     CONST char *str = Tcl_GetString(pathPtr);
6279     if (strncmp(str,"simplefs:/",10)) {
6280   return -1;
6281     }
6282     return TCL_OK;
6283 }
static int SimpleStat (Tcl_Obj * pathPtr, Tcl_StatBuf * bufPtr) [static]

Definition at line 6435 of file tclTest.c.
References NULL, SimpleCopy(), Tcl_DecrRefCount, Tcl_FSDeleteFile(), Tcl_FSStat(), and TCL_OK.6438 {
6439     Tcl_Obj *tempPtr = SimpleCopy(pathPtr);
6440     if (tempPtr == NULL) {
6441   /* We just pretend the file exists anyway */
6442   return TCL_OK;
6443     } else {
6444   int res = Tcl_FSStat(tempPtr, bufPtr);
6445   Tcl_FSDeleteFile(tempPtr);
6446   Tcl_DecrRefCount(tempPtr);
6447   return res;
6448     }
6449 }
static void SpecialFree (char * blockPtr) [static]

Definition at line 1659 of file tclTest.c.
References ckfree.
Referenced by TestdstringCmd().1661 {
1662     ckfree(blockPtr - 4);
1663 }
static int StaticInitProc (Tcl_Interp * interp) [static]

Definition at line 3716 of file tclTest.c.
References TCL_GLOBAL_ONLY, TCL_OK, and Tcl_SetVar().
Referenced by TeststaticpkgCmd().3719 {
3720     Tcl_SetVar(interp, "x", "loaded", TCL_GLOBAL_ONLY);
3721     return TCL_OK;
3722 }
int Tcltest_Init (Tcl_Interp * interp)

Definition at line 538 of file tclTest.c.
References CONST, dstring, GetTimesCmd(), NoopCmd(), NoopObjCmd(), NULL, Tcl_CreateCommand(), Tcl_CreateMathFunc(), Tcl_CreateObjCommand(), Tcl_DeleteInterp(), Tcl_DStringInit(), TCL_EITHER, TCL_ERROR, TCL_EXACT, Tcl_GetChannel(), Tcl_GetIndexFromObj(), Tcl_GetVar2Ex(), TCL_GLOBAL_ONLY, TCL_LEAVE_ERR_MSG, Tcl_ListObjGetElements(), TCL_OK, TCL_PATCH_LEVEL, Tcl_PkgProvide(), Tcl_SetVar2Ex(), Tcl_UnregisterChannel(), TCL_VERSION, TclplatformtestInit(), TestaccessprocCmd(), TestasyncCmd(), TestChannelCmd(), TestChannelEventCmd(), TestcmdinfoCmd(), TestcmdtokenCmd(), TestcmdtraceCmd(), TestcreatecommandCmd(), TestdcallCmd(), TestdelassocdataCmd(), TestdelCmd(), TestdstringCmd(), TestencodingObjCmd(), TestevalexObjCmd(), TestevalobjvObjCmd(), TesteventObjCmd(), TestexithandlerCmd(), TestexitmainloopCmd(), TestexprlongCmd(), TestexprparserObjCmd(), TestexprstringCmd(), TestfeventCmd(), TestfileCmd(), TestfilelinkCmd(), TestFilesystemObjCmd(), TestgetassocdataCmd(), TestGetIndexFromObjStructObjCmd(), TestgetplatformCmd(), TestgetvarfullnameCmd(), TestinterpdeleteCmd(), TestlinkCmd(), TestlocaleCmd(), TestmainthreadCmd(), TestMathFunc(), TestMathFunc2(), TestNumUtfCharsCmd(), TestopenfilechannelprocCmd(), TestpanicCmd(), TestparserObjCmd(), TestparsevarnameObjCmd(), TestparsevarObjCmd(), TestregexpObjCmd(), TestsaveresultCmd(), TestsetassocdataCmd(), TestsetCmd(), TestseterrorcodeCmd(), TestsetmainloopCmd(), TestsetobjerrorcodeCmd(), TestsetplatformCmd(), TestSimpleFilesystemObjCmd(), TeststaticpkgCmd(), TeststatprocCmd(), TesttranslatefilenameCmd(), TestupvarCmd(), and TestWrongNumArgsObjCmd().
Referenced by Tcl_AppInit().540 {
541     Tcl_ValueType t3ArgTypes[2];
542 
543     Tcl_Obj *listPtr;
544     Tcl_Obj **objv;
545     int objc, index;
546     static CONST char *specialOptions[] = {
547   "-appinitprocerror", "-appinitprocdeleteinterp",
548   "-appinitprocclosestderr", "-appinitprocsetrcfile", (char *) NULL
549     };
550 
551 #ifndef TCL_TIP268
552     if (Tcl_PkgProvide(interp, "Tcltest", TCL_VERSION) == TCL_ERROR) {
553 #else
554     /* TIP #268: Full patchlevel instead of just major.minor */
555     if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) {
556 #endif
557         return TCL_ERROR;
558     }
559 
560     /*
561      * Create additional commands and math functions for testing Tcl.
562      */
563 
564     Tcl_CreateCommand(interp, "gettimes", GetTimesCmd, (ClientData) 0,
565       (Tcl_CmdDeleteProc *) NULL);
566     Tcl_CreateCommand(interp, "noop", NoopCmd, (ClientData) 0,
567       (Tcl_CmdDeleteProc *) NULL);
568     Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, (ClientData) 0,
569       (Tcl_CmdDeleteProc *) NULL);
570     Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
571       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
572     Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, 
573       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
574     Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd, 
575       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
576     Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct",
577        TestGetIndexFromObjStructObjCmd, (ClientData) 0,
578        (Tcl_CmdDeleteProc *) NULL);
579     Tcl_CreateCommand(interp, "testaccessproc", TestaccessprocCmd, (ClientData) 0,
580       (Tcl_CmdDeleteProc *) NULL);
581     Tcl_CreateCommand(interp, "testasync", TestasyncCmd, (ClientData) 0,
582       (Tcl_CmdDeleteProc *) NULL);
583     Tcl_CreateCommand(interp, "testchannel", TestChannelCmd,
584             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
585     Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd,
586             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
587     Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, (ClientData) 0,
588       (Tcl_CmdDeleteProc *) NULL);
589     Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, (ClientData) 0,
590       (Tcl_CmdDeleteProc *) NULL);
591     Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd,
592       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
593     Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd,
594       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
595     Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, (ClientData) 0,
596       (Tcl_CmdDeleteProc *) NULL);
597     Tcl_CreateCommand(interp, "testdel", TestdelCmd, (ClientData) 0,
598       (Tcl_CmdDeleteProc *) NULL);
599     Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd,
600             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
601     Tcl_DStringInit(&dstring);
602     Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, (ClientData) 0,
603       (Tcl_CmdDeleteProc *) NULL);
604     Tcl_CreateObjCommand(interp, "testencoding", TestencodingObjCmd, (ClientData) 0,
605       (Tcl_CmdDeleteProc *) NULL);
606     Tcl_CreateObjCommand(interp, "testevalex", TestevalexObjCmd,
607       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
608     Tcl_CreateObjCommand(interp, "testevalobjv", TestevalobjvObjCmd,
609       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
610     Tcl_CreateObjCommand( interp, "testevent", TesteventObjCmd,
611         (ClientData) 0, (Tcl_CmdDeleteProc*) NULL );
612     Tcl_CreateCommand(interp, "testexithandler", TestexithandlerCmd,
613             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
614     Tcl_CreateCommand(interp, "testexprlong", TestexprlongCmd,
615             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
616     Tcl_CreateObjCommand(interp, "testexprparser", TestexprparserObjCmd,
617       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
618     Tcl_CreateCommand(interp, "testexprstring", TestexprstringCmd,
619             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
620     Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, (ClientData) 0,
621             (Tcl_CmdDeleteProc *) NULL);
622     Tcl_CreateObjCommand(interp, "testfilelink", TestfilelinkCmd, 
623             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
624     Tcl_CreateObjCommand(interp, "testfile", TestfileCmd,
625             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
626     Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd,
627             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
628     Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd,
629       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
630     Tcl_CreateObjCommand(interp, "testgetvarfullname",
631       TestgetvarfullnameCmd, (ClientData) 0,
632       (Tcl_CmdDeleteProc *) NULL);
633     Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd,
634             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
635     Tcl_CreateCommand(interp, "testlink", TestlinkCmd, (ClientData) 0,
636       (Tcl_CmdDeleteProc *) NULL);
637     Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, (ClientData) 0,
638       (Tcl_CmdDeleteProc *) NULL);
639     Tcl_CreateCommand(interp, "testopenfilechannelproc",
640           TestopenfilechannelprocCmd, (ClientData) 0, 
641           (Tcl_CmdDeleteProc *) NULL);
642     Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, (ClientData) 0,
643             (Tcl_CmdDeleteProc *) NULL);
644     Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd,
645       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
646     Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd,
647       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
648     Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd,
649       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
650     Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
651       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
652     Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd,
653       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
654     Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd,
655             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
656     Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd,
657             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
658     Tcl_CreateCommand(interp, "testseterr", TestsetCmd,
659             (ClientData) TCL_LEAVE_ERR_MSG, (Tcl_CmdDeleteProc *) NULL);
660     Tcl_CreateCommand(interp, "testseterrorcode", TestseterrorcodeCmd,
661       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
662     Tcl_CreateObjCommand(interp, "testsetobjerrorcode", 
663       TestsetobjerrorcodeCmd, (ClientData) 0,
664       (Tcl_CmdDeleteProc *) NULL);
665     Tcl_CreateObjCommand(interp, "testnumutfchars",
666       TestNumUtfCharsCmd, (ClientData) 0, 
667       (Tcl_CmdDeleteProc *) NULL);
668     Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
669       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
670     Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
671       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
672     Tcl_CreateCommand(interp, "testtranslatefilename",
673             TesttranslatefilenameCmd, (ClientData) 0,
674             (Tcl_CmdDeleteProc *) NULL);
675     Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, (ClientData) 0,
676       (Tcl_CmdDeleteProc *) NULL);
677     Tcl_CreateMathFunc(interp, "T1", 0, (Tcl_ValueType *) NULL, TestMathFunc,
678       (ClientData) 123);
679     Tcl_CreateMathFunc(interp, "T2", 0, (Tcl_ValueType *) NULL, TestMathFunc,
680       (ClientData) 345);
681     Tcl_CreateCommand(interp, "teststatproc", TeststatprocCmd, (ClientData) 0,
682       (Tcl_CmdDeleteProc *) NULL);
683     Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, (ClientData) 0,
684       (Tcl_CmdDeleteProc *) NULL);
685     Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
686       (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
687     Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
688       (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
689     t3ArgTypes[0] = TCL_EITHER;
690     t3ArgTypes[1] = TCL_EITHER;
691     Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
692       (ClientData) 0);
693 
694 #ifdef TCL_THREADS
695     if (TclThread_Init(interp) != TCL_OK) {
696   return TCL_ERROR;
697     }
698 #endif
699 
700     /*
701      * Check for special options used in ../tests/main.test
702      */
703 
704     listPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
705     if (listPtr != NULL) {
706         if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
707       return TCL_ERROR;
708         }
709         if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL,
710     TCL_EXACT, &index) == TCL_OK)) {
711       switch (index) {
712           case 0: {
713         return TCL_ERROR;
714           }
715           case 1: {
716         Tcl_DeleteInterp(interp);
717         return TCL_ERROR;
718           }
719           case 2: {
720         int mode;
721         Tcl_UnregisterChannel(interp, 
722           Tcl_GetChannel(interp, "stderr", &mode));
723         return TCL_ERROR;
724           }
725           case 3: {
726         if (objc-1) {
727             Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL,
728              objv[1], TCL_GLOBAL_ONLY);
729         }
730         return TCL_ERROR;
731           }
732       }
733         }
734     }
735   
736     /*
737      * And finally add any platform specific test commands.
738      */
739     
740     return TclplatformtestInit(interp);
741 }
static int TestAccessProc1 (CONST char * path, int mode) [static]

Definition at line 4969 of file tclTest.c.
References NULL, and strstr().
Referenced by TestaccessprocCmd().4972 {
4973     return ((strstr(path, "testAccess1%.fil") == NULL) ? -1 : 0);
4974 }
static int TestAccessProc2 (CONST char * path, int mode) [static]

Definition at line 4978 of file tclTest.c.
References NULL, and strstr().
Referenced by TestaccessprocCmd().4981 {
4982     return ((strstr(path, "testAccess2%.fil") == NULL) ? -1 : 0);
4983 }
static int TestAccessProc3 (CONST char * path, int mode) [static]

Definition at line 4987 of file tclTest.c.
References NULL, and strstr().
Referenced by TestaccessprocCmd().4990 {
4991     return ((strstr(path, "testAccess3%.fil") == NULL) ? -1 : 0);
4992 }
static int TestaccessprocCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 4900 of file tclTest.c.
References NULL, PretendTclpAccess(), TCL_ERROR, TclAccessDeleteProc(), TclAccessInsertProc(), TestAccessProc1(), TestAccessProc2(), and TestAccessProc3().
Referenced by Tcltest_Init().4905 {
4906     TclAccessProc_ *proc;
4907     int retVal;
4908 
4909     if (argc != 3) {
4910   Tcl_AppendResult(interp, "wrong # args: should be \"",
4911     argv[0], " option arg\"", (char *) NULL);
4912   return TCL_ERROR;
4913     }
4914 
4915     if (strcmp(argv[2], "TclpAccess") == 0) {
4916   proc = PretendTclpAccess;
4917     } else if (strcmp(argv[2], "TestAccessProc1") == 0) {
4918   proc = TestAccessProc1;
4919     } else if (strcmp(argv[2], "TestAccessProc2") == 0) {
4920   proc = TestAccessProc2;
4921     } else if (strcmp(argv[2], "TestAccessProc3") == 0) {
4922   proc = TestAccessProc3;
4923     } else {
4924   Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
4925     "must be TclpAccess, ",
4926     "TestAccessProc1, TestAccessProc2, or TestAccessProc3",
4927     (char *) NULL);
4928   return TCL_ERROR;
4929     }
4930 
4931     if (strcmp(argv[1], "insert") == 0) {
4932   if (proc == PretendTclpAccess) {
4933       Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
4934        "must be ",
4935        "TestAccessProc1, TestAccessProc2, or TestAccessProc3",
4936        (char *) NULL);
4937       return TCL_ERROR;
4938   }
4939   retVal = TclAccessInsertProc(proc);
4940     } else if (strcmp(argv[1], "delete") == 0) {
4941   retVal = TclAccessDeleteProc(proc);
4942     } else {
4943   Tcl_AppendResult(interp, "bad option \"", argv[1], "\": ",
4944     "must be insert or delete", (char *) NULL);
4945   return TCL_ERROR;
4946     }
4947 
4948     if (retVal == TCL_ERROR) {
4949   Tcl_AppendResult(interp, "\"", argv[2], "\": ",
4950     "could not be ", argv[1], "ed", (char *) NULL);
4951     }
4952 
4953     return retVal;
4954 }
static int TestasyncCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 762 of file tclTest.c.
References AsyncHandlerProc(), ckalloc, ckfree, TestAsyncHandler::command, firstHandler, TestAsyncHandler::handler, TestAsyncHandler::id, TestAsyncHandler::nextPtr, NULL, Tcl_AsyncCreate(), Tcl_AsyncDelete(), TCL_ERROR, Tcl_GetInt(), TCL_INTEGER_SPACE, TCL_OK, Tcl_SetResult(), TCL_STATIC, TCL_VOLATILE, and TclFormatInt().
Referenced by Tcltest_Init().767 {
768     TestAsyncHandler *asyncPtr, *prevPtr;
769     int id, code;
770     static int nextId = 1;
771     char buf[TCL_INTEGER_SPACE];
772 
773     if (argc < 2) {
774   wrongNumArgs:
775   Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
776   return TCL_ERROR;
777     }
778     if (strcmp(argv[1], "create") == 0) {
779   if (argc != 3) {
780       goto wrongNumArgs;
781   }
782   asyncPtr = (TestAsyncHandler *) ckalloc(sizeof(TestAsyncHandler));
783   asyncPtr->id = nextId;
784   nextId++;
785   asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc,
786     (ClientData) asyncPtr);
787   asyncPtr->command = (char *) ckalloc((unsigned) (strlen(argv[2]) + 1));
788   strcpy(asyncPtr->command, argv[2]);
789   asyncPtr->nextPtr = firstHandler;
790   firstHandler = asyncPtr;
791   TclFormatInt(buf, asyncPtr->id);
792   Tcl_SetResult(interp, buf, TCL_VOLATILE);
793     } else if (strcmp(argv[1], "delete") == 0) {
794   if (argc == 2) {
795       while (firstHandler != NULL) {
796     asyncPtr = firstHandler;
797     firstHandler = asyncPtr->nextPtr;
798     Tcl_AsyncDelete(asyncPtr->handler);
799     ckfree(asyncPtr->command);
800     ckfree((char *) asyncPtr);
801       }
802       return TCL_OK;
803   }
804   if (argc != 3) {
805       goto wrongNumArgs;
806   }
807   if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {
808       return TCL_ERROR;
809   }
810   for (prevPtr = NULL, asyncPtr = firstHandler; asyncPtr != NULL;
811     prevPtr = asyncPtr, asyncPtr = asyncPtr->nextPtr) {
812       if (asyncPtr->id != id) {
813     continue;
814       }
815       if (prevPtr == NULL) {
816     firstHandler = asyncPtr->nextPtr;
817       } else {
818     prevPtr->nextPtr = asyncPtr->nextPtr;
819       }
820       Tcl_AsyncDelete(asyncPtr->handler);
821       ckfree(asyncPtr->command);
822       ckfree((char *) asyncPtr);
823       break;
824   }
825     } else if (strcmp(argv[1], "mark") == 0) {
826   if (argc != 5) {
827       goto wrongNumArgs;
828   }
829   if ((Tcl_GetInt(interp, argv[2], &id) != TCL_OK)
830     || (Tcl_GetInt(interp, argv[4], &code) != TCL_OK)) {
831       return TCL_ERROR;
832   }
833   for (asyncPtr = firstHandler; asyncPtr != NULL;
834     asyncPtr = asyncPtr->nextPtr) {
835       if (asyncPtr->id == id) {
836     Tcl_AsyncMark(asyncPtr->handler);
837     break;
838       }
839   }
840   Tcl_SetResult(interp, (char *)argv[3], TCL_VOLATILE);
841   return code;
842     } else {
843   Tcl_AppendResult(interp, "bad option \"", argv[1],
844     "\": must be create, delete, int, or mark",
845     (char *) NULL);
846   return TCL_ERROR;
847     }
848     return TCL_OK;
849 }
static int TestChannelCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 5211 of file tclTest.c.
References BG_FLUSH_SCHEDULED, CHANNEL_BLOCKED, CHANNEL_EOF, CHANNEL_LINEBUFFERED, CHANNEL_NONBLOCKING, CHANNEL_UNBUFFERED, CONST, INPUT_SAW_CR, ChannelBuffer::nextAdded, ChannelBuffer::nextPtr, ChannelBuffer::nextRemoved, NULL, size_t(), Channel::state, Tcl_AppendElement(), Tcl_ChannelName(), Tcl_ClearChannelHandlers(), Tcl_CutChannel(), TCL_ERROR, Tcl_FirstHashEntry(), Tcl_GetAssocData(), Tcl_GetChannel(), Tcl_GetChannelThread(), Tcl_GetHashKey, Tcl_GetHashValue, TCL_INTEGER_SPACE, Tcl_IsChannelShared(), Tcl_IsStandardChannel(), Tcl_NewStringObj(), Tcl_NextHashEntry(), TCL_OK, TCL_READABLE, Tcl_SpliceChannel(), Tcl_Tell(), TCL_TRANSLATE_AUTO, TCL_TRANSLATE_CR, TCL_TRANSLATE_CRLF, TCL_TRANSLATE_LF, Tcl_UnstackChannel(), TCL_WRITABLE, TclChannelTransform(), TclFormatInt(), and Channel::typePtr.
Referenced by Tcltest_Init().5216 {
5217     CONST char *cmdName;  /* Sub command. */
5218     Tcl_HashTable *hTblPtr; /* Hash table of channels. */
5219     Tcl_HashSearch hSearch; /* Search variable. */
5220     Tcl_HashEntry *hPtr;  /* Search variable. */
5221     Channel *chanPtr;   /* The actual channel. */
5222     ChannelState *statePtr; /* state info for channel */
5223     Tcl_Channel chan;   /* The opaque type. */
5224     size_t len;     /* Length of subcommand string. */
5225     int IOQueued;   /* How much IO is queued inside channel? */
5226     ChannelBuffer *bufPtr;  /* For iterating over queued IO. */
5227     char buf[TCL_INTEGER_SPACE];/* For sprintf. */
5228     int mode;     /* rw mode of the channel */
5229     
5230     if (argc < 2) {
5231         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
5232                 " subcommand ?additional args..?\"", (char *) NULL);
5233         return TCL_ERROR;
5234     }
5235     cmdName = argv[1];
5236     len = strlen(cmdName);
5237 
5238     chanPtr = (Channel *) NULL;
5239 
5240     if (argc > 2) {
5241         chan = Tcl_GetChannel(interp, argv[2], &mode);
5242         if (chan == (Tcl_Channel) NULL) {
5243             return TCL_ERROR;
5244         }
5245         chanPtr   = (Channel *) chan;
5246   statePtr  = chanPtr->state;
5247         chanPtr   = statePtr->topChanPtr;
5248   chan    = (Tcl_Channel) chanPtr;
5249     } else {
5250   /* lint */
5251   statePtr  = NULL;
5252   chan    = NULL;
5253     }
5254 
5255     if ((cmdName[0] == 'c') && (strncmp(cmdName, "cut", len) == 0)) {
5256         if (argc != 3) {
5257             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
5258                     " cut channelName\"", (char *) NULL);
5259             return TCL_ERROR;
5260         }
5261         Tcl_CutChannel(chan);
5262         return TCL_OK;
5263     }
5264 
5265     if ((cmdName[0] == 'c') &&
5266       (strncmp(cmdName, "clearchannelhandlers", len) == 0)) {
5267         if (argc != 3) {
5268             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
5269                     " clearchannelhandlers channelName\"", (char *) NULL);
5270             return TCL_ERROR;
5271         }
5272         Tcl_ClearChannelHandlers(chan);
5273         return TCL_OK;
5274     }
5275 
5276     if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
5277         if (argc != 3) {
5278             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
5279                     " info channelName\"", (char *) NULL);
5280             return TCL_ERROR;
5281         }
5282         Tcl_AppendElement(interp, argv[2]);
5283         Tcl_AppendElement(interp, Tcl_ChannelName(chanPtr->typePtr));
5284         if (statePtr->flags & TCL_READABLE) {
5285             Tcl_AppendElement(interp, "read");
5286         } else {
5287             Tcl_AppendElement(interp, "");
5288         }
5289         if (statePtr->flags & TCL_WRITABLE) {
5290             Tcl_AppendElement(interp, "write");
5291         } else {
5292             Tcl_AppendElement(interp, "");
5293         }
5294         if (statePtr->flags & CHANNEL_NONBLOCKING) {
5295             Tcl_AppendElement(interp, "nonblocking");
5296         } else {
5297             Tcl_AppendElement(interp, "blocking");
5298         }
5299         if (statePtr->flags & CHANNEL_LINEBUFFERED) {
5300             Tcl_AppendElement(interp, "line");
5301         } else if (statePtr->flags & CHANNEL_UNBUFFERED) {
5302             Tcl_AppendElement(interp, "none");
5303         } else {
5304             Tcl_AppendElement(interp, "full");
5305         }
5306         if (statePtr->flags & BG_FLUSH_SCHEDULED) {
5307             Tcl_AppendElement(interp, "async_flush");
5308         } else {
5309             Tcl_AppendElement(interp, "");
5310         }
5311         if (statePtr->flags & CHANNEL_EOF) {
5312             Tcl_AppendElement(interp, "eof");
5313         } else {
5314             Tcl_AppendElement(interp, "");
5315         }
5316         if (statePtr->flags & CHANNEL_BLOCKED) {
5317             Tcl_AppendElement(interp, "blocked");
5318         } else {
5319             Tcl_AppendElement(interp, "unblocked");
5320         }
5321         if (statePtr->inputTranslation == TCL_TRANSLATE_AUTO) {
5322             Tcl_AppendElement(interp, "auto");
5323             if (statePtr->flags & INPUT_SAW_CR) {
5324                 Tcl_AppendElement(interp, "saw_cr");
5325             } else {
5326                 Tcl_AppendElement(interp, "");
5327             }
5328         } else if (statePtr->inputTranslation == TCL_TRANSLATE_LF) {
5329             Tcl_AppendElement(interp, "lf");
5330             Tcl_AppendElement(interp, "");
5331         } else if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
5332             Tcl_AppendElement(interp, "cr");
5333             Tcl_AppendElement(interp, "");
5334         } else if (statePtr->inputTranslation == TCL_TRANSLATE_CRLF) {
5335             Tcl_AppendElement(interp, "crlf");
5336             if (statePtr->flags & INPUT_SAW_CR) {
5337                 Tcl_AppendElement(interp, "queued_cr");
5338             } else {
5339                 Tcl_AppendElement(interp, "");
5340             }
5341         }
5342         if (statePtr->outputTranslation == TCL_TRANSLATE_AUTO) {
5343             Tcl_AppendElement(interp, "auto");
5344         } else if (statePtr->outputTranslation == TCL_TRANSLATE_LF) {
5345             Tcl_AppendElement(interp, "lf");
5346         } else if (statePtr->outputTranslation == TCL_TRANSLATE_CR) {
5347             Tcl_AppendElement(interp, "cr");
5348         } else if (statePtr->outputTranslation == TCL_TRANSLATE_CRLF) {
5349             Tcl_AppendElement(interp, "crlf");
5350         }
5351         for (IOQueued = 0, bufPtr = statePtr->inQueueHead;
5352        bufPtr != (ChannelBuffer *) NULL;
5353        bufPtr = bufPtr->nextPtr) {
5354             IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
5355         }
5356         TclFormatInt(buf, IOQueued);
5357         Tcl_AppendElement(interp, buf);
5358         
5359         IOQueued = 0;
5360         if (statePtr->curOutPtr != (ChannelBuffer *) NULL) {
5361             IOQueued = statePtr->curOutPtr->nextAdded -
5362                 statePtr->curOutPtr->nextRemoved;
5363         }
5364         for (bufPtr = statePtr->outQueueHead;
5365        bufPtr != (ChannelBuffer *) NULL;
5366        bufPtr = bufPtr->nextPtr) {
5367             IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
5368         }
5369         TclFormatInt(buf, IOQueued);
5370         Tcl_AppendElement(interp, buf);
5371         
5372         TclFormatInt(buf, (int)Tcl_Tell((Tcl_Channel) chanPtr));
5373         Tcl_AppendElement(interp, buf);
5374 
5375         TclFormatInt(buf, statePtr->refCount);
5376         Tcl_AppendElement(interp, buf);
5377 
5378         return TCL_OK;
5379     }
5380 
5381     if ((cmdName[0] == 'i') &&
5382             (strncmp(cmdName, "inputbuffered", len) == 0)) {
5383         if (argc != 3) {
5384             Tcl_AppendResult(interp, "channel name required",
5385                     (char *) NULL);
5386             return TCL_ERROR;
5387         }
5388         
5389         for (IOQueued = 0, bufPtr = statePtr->inQueueHead;
5390        bufPtr != (ChannelBuffer *) NULL;
5391        bufPtr = bufPtr->nextPtr) {
5392             IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
5393         }
5394         TclFormatInt(buf, IOQueued);
5395         Tcl_AppendResult(interp, buf, (char *) NULL);
5396         return TCL_OK;
5397     }
5398 
5399     if ((cmdName[0] == 'i') && (strncmp(cmdName, "isshared", len) == 0)) {
5400         if (argc != 3) {
5401             Tcl_AppendResult(interp, "channel name required", (char *) NULL);
5402             return TCL_ERROR;
5403         }
5404         
5405         TclFormatInt(buf, Tcl_IsChannelShared(chan));
5406         Tcl_AppendResult(interp, buf, (char *) NULL);
5407         return TCL_OK;
5408     }
5409 
5410     if ((cmdName[0] == 'i') && (strncmp(cmdName, "isstandard", len) == 0)) {
5411   if (argc != 3) {
5412       Tcl_AppendResult(interp, "channel name required", (char *) NULL);
5413       return TCL_ERROR;
5414   }
5415   
5416   TclFormatInt(buf, Tcl_IsStandardChannel(chan));
5417   Tcl_AppendResult(interp, buf, (char *) NULL);
5418   return TCL_OK;
5419     }
5420 
5421     if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
5422         if (argc != 3) {
5423             Tcl_AppendResult(interp, "channel name required",
5424                     (char *) NULL);
5425             return TCL_ERROR;
5426         }
5427         
5428         if (statePtr->flags & TCL_READABLE) {
5429             Tcl_AppendElement(interp, "read");
5430         } else {
5431             Tcl_AppendElement(interp, "");
5432         }
5433         if (statePtr->flags & TCL_WRITABLE) {
5434             Tcl_AppendElement(interp, "write");
5435         } else {
5436             Tcl_AppendElement(interp, "");
5437         }
5438         return TCL_OK;
5439     }
5440     
5441     if ((cmdName[0] == 'm') && (strncmp(cmdName, "mthread", len) == 0)) {
5442         if (argc != 3) {
5443             Tcl_AppendResult(interp, "channel name required",
5444                     (char *) NULL);
5445             return TCL_ERROR;
5446         }
5447 
5448         TclFormatInt(buf, (long) Tcl_GetChannelThread(chan));
5449         Tcl_AppendResult(interp, buf, (char *) NULL);
5450         return TCL_OK;
5451     }
5452 
5453     if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
5454         if (argc != 3) {
5455             Tcl_AppendResult(interp, "channel name required",
5456                     (char *) NULL);
5457             return TCL_ERROR;
5458         }
5459         Tcl_AppendResult(interp, statePtr->channelName, (char *) NULL);
5460         return TCL_OK;
5461     }
5462 
5463     if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) {
5464         hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
5465         if (hTblPtr == (Tcl_HashTable *) NULL) {
5466             return TCL_OK;
5467         }
5468         for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
5469        hPtr != (Tcl_HashEntry *) NULL;
5470        hPtr = Tcl_NextHashEntry(&hSearch)) {
5471             Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
5472         }
5473         return TCL_OK;
5474     }
5475 
5476     if ((cmdName[0] == 'o') &&
5477             (strncmp(cmdName, "outputbuffered", len) == 0)) {
5478         if (argc != 3) {
5479             Tcl_AppendResult(interp, "channel name required",
5480                     (char *) NULL);
5481             return TCL_ERROR;
5482         }
5483 
5484         IOQueued = 0;
5485         if (statePtr->curOutPtr != (ChannelBuffer *) NULL) {
5486             IOQueued = statePtr->curOutPtr->nextAdded -
5487                 statePtr->curOutPtr->nextRemoved;
5488         }
5489         for (bufPtr = statePtr->outQueueHead;
5490        bufPtr != (ChannelBuffer *) NULL;
5491        bufPtr = bufPtr->nextPtr) {
5492             IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
5493         }
5494         TclFormatInt(buf, IOQueued);
5495         Tcl_AppendResult(interp, buf, (char *) NULL);
5496         return TCL_OK;
5497     }
5498 
5499     if ((cmdName[0] == 'q') &&
5500             (strncmp(cmdName, "queuedcr", len) == 0)) {
5501         if (argc != 3) {
5502             Tcl_AppendResult(interp, "channel name required",
5503                     (char *) NULL);
5504             return TCL_ERROR;
5505         }
5506 
5507         Tcl_AppendResult(interp,
5508                 (statePtr->flags & INPUT_SAW_CR) ? "1" : "0",
5509                 (char *) NULL);
5510         return TCL_OK;
5511     }
5512 
5513     if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) {
5514         hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
5515         if (hTblPtr == (Tcl_HashTable *) NULL) {
5516             return TCL_OK;
5517         }
5518         for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
5519        hPtr != (Tcl_HashEntry *) NULL;
5520        hPtr = Tcl_NextHashEntry(&hSearch)) {
5521             chanPtr  = (Channel *) Tcl_GetHashValue(hPtr);
5522       statePtr = chanPtr->state;
5523             if (statePtr->flags & TCL_READABLE) {
5524                 Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
5525             }
5526         }
5527         return TCL_OK;
5528     }
5529 
5530     if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) {
5531         if (argc != 3) {
5532             Tcl_AppendResult(interp, "channel name required",
5533                     (char *) NULL);
5534             return TCL_ERROR;
5535         }
5536         
5537         TclFormatInt(buf, statePtr->refCount);
5538         Tcl_AppendResult(interp, buf, (char *) NULL);
5539         return TCL_OK;
5540     }
5541 
5542     if ((cmdName[0] == 's') && (strncmp(cmdName, "splice", len) == 0)) {
5543         if (argc != 3) {
5544             Tcl_AppendResult(interp, "channel name required", (char *) NULL);
5545             return TCL_ERROR;
5546         }
5547 
5548         Tcl_SpliceChannel(chan);
5549         return TCL_OK;
5550     }
5551 
5552     if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {
5553         if (argc != 3) {
5554             Tcl_AppendResult(interp, "channel name required",
5555                     (char *) NULL);
5556             return TCL_ERROR;
5557         }
5558         Tcl_AppendResult(interp, Tcl_ChannelName(chanPtr->typePtr),
5559     (char *) NULL);
5560         return TCL_OK;
5561     }
5562 
5563     if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {
5564         hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
5565         if (hTblPtr == (Tcl_HashTable *) NULL) {
5566             return TCL_OK;
5567         }
5568         for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
5569        hPtr != (Tcl_HashEntry *) NULL;
5570        hPtr = Tcl_NextHashEntry(&hSearch)) {
5571             chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
5572       statePtr = chanPtr->state;
5573             if (statePtr->flags & TCL_WRITABLE) {
5574                 Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
5575             }
5576         }
5577         return TCL_OK;
5578     }
5579 
5580     if ((cmdName[0] == 't') && (strncmp(cmdName, "transform", len) == 0)) {
5581   /*
5582    * Syntax: transform channel -command command
5583    */
5584 
5585         if (argc != 5) {
5586       Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
5587         " transform channelId -command cmd\"", (char *) NULL);
5588             return TCL_ERROR;
5589         }
5590   if (strcmp(argv[3], "-command") != 0) {
5591       Tcl_AppendResult(interp, "bad argument \"", argv[3],
5592         "\": should be \"-command\"", (char *) NULL);
5593       return TCL_ERROR;
5594   }
5595 
5596   return TclChannelTransform(interp, chan,
5597     Tcl_NewStringObj(argv[4], -1));
5598     }
5599 
5600     if ((cmdName[0] == 'u') && (strncmp(cmdName, "unstack", len) == 0)) {
5601   /*
5602    * Syntax: unstack channel
5603    */
5604 
5605         if (argc != 3) {
5606       Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
5607         " unstack channel\"", (char *) NULL);
5608             return TCL_ERROR;
5609         }
5610   return Tcl_UnstackChannel(interp, chan);
5611     }
5612 
5613     Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",
5614             "cut, clearchannelhandlers, info, isshared, mode, open, "
5615       "readable, splice, writable, transform, unstack",
5616             (char *) NULL);
5617     return TCL_ERROR;
5618 }
static int TestChannelEventCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 5639 of file tclTest.c.
References EventScriptRecord::chanPtr, ckalloc, ckfree, CONST, EventScriptRecord::interp, EventScriptRecord::mask, EventScriptRecord::nextPtr, NULL, panic, EventScriptRecord::scriptPtr, Channel::state, Tcl_CreateChannelHandler(), Tcl_DecrRefCount, Tcl_DeleteChannelHandler(), TCL_ERROR, Tcl_GetChannel(), Tcl_GetInt(), Tcl_GetObjResult(), Tcl_IncrRefCount, Tcl_ListObjAppendElement(), Tcl_NewStringObj(), TCL_OK, TCL_READABLE, Tcl_SetObjResult(), TCL_WRITABLE, and TclChannelEventScriptInvoker().
Referenced by Tcltest_Init().5644 {
5645     Tcl_Obj *resultListPtr;
5646     Channel *chanPtr;
5647     ChannelState *statePtr; /* state info for channel */
5648     EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
5649     CONST char *cmd;
5650     int index, i, mask, len;
5651 
5652     if ((argc < 3) || (argc > 5)) {
5653         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
5654                 " channelName cmd ?arg1? ?arg2?\"", (char *) NULL);
5655         return TCL_ERROR;
5656     }
5657     chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);
5658     if (chanPtr == (Channel *) NULL) {
5659         return TCL_ERROR;
5660     }
5661     statePtr = chanPtr->state;
5662 
5663     cmd = argv[2];
5664     len = strlen(cmd);
5665     if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
5666         if (argc != 5) {
5667             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
5668                     " channelName add eventSpec script\"", (char *) NULL);
5669             return TCL_ERROR;
5670         }
5671         if (strcmp(argv[3], "readable") == 0) {
5672             mask = TCL_READABLE;
5673         } else if (strcmp(argv[3], "writable") == 0) {
5674             mask = TCL_WRITABLE;
5675         } else if (strcmp(argv[3], "none") == 0) {
5676             mask = 0;
5677   } else {
5678             Tcl_AppendResult(interp, "bad event name \"", argv[3],
5679                     "\": must be readable, writable, or none", (char *) NULL);
5680             return TCL_ERROR;
5681         }
5682 
5683         esPtr = (EventScriptRecord *) ckalloc((unsigned)
5684                 sizeof(EventScriptRecord));
5685         esPtr->nextPtr = statePtr->scriptRecordPtr;
5686         statePtr->scriptRecordPtr = esPtr;
5687         
5688         esPtr->chanPtr = chanPtr;
5689         esPtr->interp = interp;
5690         esPtr->mask = mask;
5691   esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);
5692   Tcl_IncrRefCount(esPtr->scriptPtr);
5693 
5694         Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
5695                 TclChannelEventScriptInvoker, (ClientData) esPtr);
5696         
5697         return TCL_OK;
5698     }
5699 
5700     if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
5701         if (argc != 4) {
5702             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
5703                     " channelName delete index\"", (char *) NULL);
5704             return TCL_ERROR;
5705         }
5706         if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
5707             return TCL_ERROR;
5708         }
5709         if (index < 0) {
5710             Tcl_AppendResult(interp, "bad event index: ", argv[3],
5711                     ": must be nonnegative", (char *) NULL);
5712             return TCL_ERROR;
5713         }
5714         for (i = 0, esPtr = statePtr->scriptRecordPtr;
5715        (i < index) && (esPtr != (EventScriptRecord *) NULL);
5716        i++, esPtr = esPtr->nextPtr) {
5717       /* Empty loop body. */
5718         }
5719         if (esPtr == (EventScriptRecord *) NULL) {
5720             Tcl_AppendResult(interp, "bad event index ", argv[3],
5721                     ": out of range", (char *) NULL);
5722             return TCL_ERROR;
5723         }
5724         if (esPtr == statePtr->scriptRecordPtr) {
5725             statePtr->scriptRecordPtr = esPtr->nextPtr;
5726         } else {
5727             for (prevEsPtr = statePtr->scriptRecordPtr;
5728      (prevEsPtr != (EventScriptRecord *) NULL) &&
5729          (prevEsPtr->nextPtr != esPtr);
5730      prevEsPtr = prevEsPtr->nextPtr) {
5731                 /* Empty loop body. */
5732             }
5733             if (prevEsPtr == (EventScriptRecord *) NULL) {
5734                 panic("TestChannelEventCmd: damaged event script list");
5735             }
5736             prevEsPtr->nextPtr = esPtr->nextPtr;
5737         }
5738         Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
5739                 TclChannelEventScriptInvoker, (ClientData) esPtr);
5740   Tcl_DecrRefCount(esPtr->scriptPtr);
5741         ckfree((char *) esPtr);
5742 
5743         return TCL_OK;
5744     }
5745 
5746     if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
5747         if (argc != 3) {
5748             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
5749                     " channelName list\"", (char *) NULL);
5750             return TCL_ERROR;
5751         }
5752   resultListPtr = Tcl_GetObjResult(interp);
5753         for (esPtr = statePtr->scriptRecordPtr;
5754        esPtr != (EventScriptRecord *) NULL;
5755        esPtr = esPtr->nextPtr) {
5756       if (esPtr->mask) {
5757           Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
5758         (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1));
5759       } else {
5760           Tcl_ListObjAppendElement(interp, resultListPtr, 
5761       Tcl_NewStringObj("none", -1));
5762       }
5763         Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
5764         }
5765   Tcl_SetObjResult(interp, resultListPtr);
5766         return TCL_OK;
5767     }
5768 
5769     if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
5770         if (argc != 3) {
5771             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
5772                     " channelName removeall\"", (char *) NULL);
5773             return TCL_ERROR;
5774         }
5775         for (esPtr = statePtr->scriptRecordPtr;
5776        esPtr != (EventScriptRecord *) NULL;
5777        esPtr = nextEsPtr) {
5778             nextEsPtr = esPtr->nextPtr;
5779             Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
5780                     TclChannelEventScriptInvoker, (ClientData) esPtr);
5781       Tcl_DecrRefCount(esPtr->scriptPtr);
5782             ckfree((char *) esPtr);
5783         }
5784         statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
5785         return TCL_OK;
5786     }
5787 
5788     if  ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
5789         if (argc != 5) {
5790             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
5791                     " channelName delete index event\"", (char *) NULL);
5792             return TCL_ERROR;
5793         }
5794         if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
5795             return TCL_ERROR;
5796         }
5797         if (index < 0) {
5798             Tcl_AppendResult(interp, "bad event index: ", argv[3],
5799                     ": must be nonnegative", (char *) NULL);
5800             return TCL_ERROR;
5801         }
5802         for (i = 0, esPtr = statePtr->scriptRecordPtr;
5803        (i < index) && (esPtr != (EventScriptRecord *) NULL);
5804        i++, esPtr = esPtr->nextPtr) {
5805       /* Empty loop body. */
5806         }
5807         if (esPtr == (EventScriptRecord *) NULL) {
5808             Tcl_AppendResult(interp, "bad event index ", argv[3],
5809                     ": out of range", (char *) NULL);
5810             return TCL_ERROR;
5811         }
5812 
5813         if (strcmp(argv[4], "readable") == 0) {
5814             mask = TCL_READABLE;
5815         } else if (strcmp(argv[4], "writable") == 0) {
5816             mask = TCL_WRITABLE;
5817         } else if (strcmp(argv[4], "none") == 0) {
5818             mask = 0;
5819   } else {
5820             Tcl_AppendResult(interp, "bad event name \"", argv[4],
5821                     "\": must be readable, writable, or none", (char *) NULL);
5822             return TCL_ERROR;
5823         }
5824   esPtr->mask = mask;
5825         Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
5826                 TclChannelEventScriptInvoker, (ClientData) esPtr);
5827   return TCL_OK;
5828     }    
5829     Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",
5830             "add, delete, list, set, or removeall", (char *) NULL);
5831     return TCL_ERROR;
5832 }
static int TestcmdinfoCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 901 of file tclTest.c.
References Tcl_CmdInfo::clientData, CmdDelProc1(), CmdDelProc2(), CmdProc1(), CmdProc2(), Tcl_CmdInfo::deleteData, Tcl_CmdInfo::deleteProc, delString, Tcl_Namespace::fullName, Tcl_CmdInfo::isNativeObjectProc, Tcl_CmdInfo::namespacePtr, NULL, Tcl_CmdInfo::objClientData, Tcl_CmdInfo::objProc, Tcl_CmdInfo::proc, Tcl_CreateCommand(), Tcl_DeleteCommand(), Tcl_DStringInit(), Tcl_DStringResult(), TCL_ERROR, Tcl_GetCommandInfo(), TCL_OK, Tcl_SetCommandInfo(), Tcl_SetResult(), and TCL_STATIC.
Referenced by Tcltest_Init().906 {
907     Tcl_CmdInfo info;
908 
909     if (argc != 3) {
910   Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
911     " option cmdName\"", (char *) NULL);
912   return TCL_ERROR;
913     }
914     if (strcmp(argv[1], "create") == 0) {
915   Tcl_CreateCommand(interp, argv[2], CmdProc1, (ClientData) "original",
916     CmdDelProc1);
917     } else if (strcmp(argv[1], "delete") == 0) {
918   Tcl_DStringInit(&delString);
919   Tcl_DeleteCommand(interp, argv[2]);
920   Tcl_DStringResult(interp, &delString);
921     } else if (strcmp(argv[1], "get") == 0) {
922   if (Tcl_GetCommandInfo(interp, argv[2], &info) ==0) {
923       Tcl_SetResult(interp, "??", TCL_STATIC);
924       return TCL_OK;
925   }
926   if (info.proc == CmdProc1) {
927       Tcl_AppendResult(interp, "CmdProc1", " ",
928         (char *) info.clientData, (char *) NULL);
929   } else if (info.proc == CmdProc2) {
930       Tcl_AppendResult(interp, "CmdProc2", " ",
931         (char *) info.clientData, (char *) NULL);
932   } else {
933       Tcl_AppendResult(interp, "unknown", (char *) NULL);
934   }
935   if (info.deleteProc == CmdDelProc1) {
936       Tcl_AppendResult(interp, " CmdDelProc1", " ",
937         (char *) info.deleteData, (char *) NULL);
938   } else if (info.deleteProc == CmdDelProc2) {
939       Tcl_AppendResult(interp, " CmdDelProc2", " ",
940         (char *) info.deleteData, (char *) NULL);
941   } else {
942       Tcl_AppendResult(interp, " unknown", (char *) NULL);
943   }
944   Tcl_AppendResult(interp, " ", info.namespacePtr->fullName,
945           (char *) NULL);
946   if (info.isNativeObjectProc) {
947       Tcl_AppendResult(interp, " nativeObjectProc", (char *) NULL);
948   } else {
949       Tcl_AppendResult(interp, " stringProc", (char *) NULL);
950   }
951     } else if (strcmp(argv[1], "modify") == 0) {
952   info.proc = CmdProc2;
953   info.clientData = (ClientData) "new_command_data";
954   info.objProc = NULL;
955         info.objClientData = (ClientData) NULL;
956   info.deleteProc = CmdDelProc2;
957   info.deleteData = (ClientData) "new_delete_data";
958   if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) {
959       Tcl_SetResult(interp, "0", TCL_STATIC);
960   } else {
961       Tcl_SetResult(interp, "1", TCL_STATIC);
962   }
963     } else {
964   Tcl_AppendResult(interp, "bad option \"", argv[1],
965     "\": must be create, delete, get, or modify",
966     (char *) NULL);
967   return TCL_ERROR;
968     }
969     return TCL_OK;
970 }
static int TestcmdtokenCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 1036 of file tclTest.c.
References CmdProc1(), NULL, Tcl_AppendElement(), Tcl_CreateCommand(), Tcl_DecrRefCount, TCL_ERROR, Tcl_GetCommandFullName(), Tcl_GetCommandName(), Tcl_GetString(), Tcl_NewObj(), TCL_OK, Tcl_SetResult(), TCL_VOLATILE, and VOID.
Referenced by Tcltest_Init().1041 {
1042     Tcl_Command token;
1043     int *l;
1044     char buf[30];
1045 
1046     if (argc != 3) {
1047   Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
1048     " option arg\"", (char *) NULL);
1049   return TCL_ERROR;
1050     }
1051     if (strcmp(argv[1], "create") == 0) {
1052   token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
1053     (ClientData) "original", (Tcl_CmdDeleteProc *) NULL);
1054   sprintf(buf, "%p", (VOID *)token);
1055   Tcl_SetResult(interp, buf, TCL_VOLATILE);
1056     } else if (strcmp(argv[1], "name") == 0) {
1057   Tcl_Obj *objPtr;
1058 
1059   if (sscanf(argv[2], "%p", &l) != 1) {
1060       Tcl_AppendResult(interp, "bad command token \"", argv[2],
1061         "\"", (char *) NULL);
1062       return TCL_ERROR;
1063   }
1064 
1065   objPtr = Tcl_NewObj();
1066   Tcl_GetCommandFullName(interp, (Tcl_Command) l, objPtr);
1067 
1068   Tcl_AppendElement(interp,
1069           Tcl_GetCommandName(interp, (Tcl_Command) l));
1070   Tcl_AppendElement(interp, Tcl_GetString(objPtr));
1071   Tcl_DecrRefCount(objPtr);
1072     } else {
1073   Tcl_AppendResult(interp, "bad option \"", argv[1],
1074     "\": must be create or name", (char *) NULL);
1075   return TCL_ERROR;
1076     }
1077     return TCL_OK;
1078 }
static int TestcmdtraceCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 1100 of file tclTest.c.
References cmdTrace, CmdTraceDeleteProc(), CmdTraceProc(), NULL, Interp::numLevels, ObjTraceDeleteProc(), ObjTraceProc(), TCL_ALLOW_INLINE_COMPILATION, Tcl_CreateObjTrace(), Tcl_CreateTrace(), Tcl_DeleteTrace(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, TCL_ERROR, Tcl_Eval(), TCL_OK, Tcl_ResetResult(), Tcl_SetResult(), and TCL_STATIC.
Referenced by Tcltest_Init().1105 {
1106     Tcl_DString buffer;
1107     int result;
1108 
1109     if (argc != 3) {
1110   Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
1111     " option script\"", (char *) NULL);
1112   return TCL_ERROR;
1113     }
1114 
1115     if (strcmp(argv[1], "tracetest") == 0) {
1116   Tcl_DStringInit(&buffer);
1117   cmdTrace = Tcl_CreateTrace(interp, 50000,
1118           (Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer);
1119   result = Tcl_Eval(interp, argv[2]);
1120   if (result == TCL_OK) {
1121       Tcl_ResetResult(interp);
1122       Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
1123   }
1124   Tcl_DeleteTrace(interp, cmdTrace);
1125   Tcl_DStringFree(&buffer);
1126     } else if (strcmp(argv[1], "deletetest") == 0) {
1127   /*
1128    * Create a command trace then eval a script to check whether it is
1129    * called. Note that this trace procedure removes itself as a
1130    * further check of the robustness of the trace proc calling code in
1131    * TclExecuteByteCode.
1132    */
1133   
1134   cmdTrace = Tcl_CreateTrace(interp, 50000,
1135           (Tcl_CmdTraceProc *) CmdTraceDeleteProc, (ClientData) NULL);
1136   Tcl_Eval(interp, argv[2]);
1137     } else if (strcmp(argv[1], "leveltest") == 0) {
1138   Interp *iPtr = (Interp *) interp;
1139   Tcl_DStringInit(&buffer);
1140   cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4,
1141     (Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer);
1142   result = Tcl_Eval(interp, argv[2]);
1143   if (result == TCL_OK) {
1144       Tcl_ResetResult(interp);
1145       Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
1146   }
1147   Tcl_DeleteTrace(interp, cmdTrace);
1148   Tcl_DStringFree(&buffer);
1149     } else if ( strcmp(argv[1], "resulttest" ) == 0 ) {
1150   /* Create an object-based trace, then eval a script. This is used
1151    * to test return codes other than TCL_OK from the trace engine.
1152    */
1153   static int deleteCalled;
1154   deleteCalled = 0;
1155   cmdTrace = Tcl_CreateObjTrace( interp, 50000,
1156                TCL_ALLOW_INLINE_COMPILATION,
1157                ObjTraceProc,
1158                (ClientData) &deleteCalled,
1159                ObjTraceDeleteProc );
1160   result = Tcl_Eval( interp, argv[ 2 ] );
1161   Tcl_DeleteTrace( interp, cmdTrace );
1162   if ( !deleteCalled ) {
1163       Tcl_SetResult( interp, "Delete wasn't called", TCL_STATIC );
1164       return TCL_ERROR;
1165   } else {
1166       return result;
1167   }
1168   
1169     } else {
1170   Tcl_AppendResult(interp, "bad option \"", argv[1],
1171        "\": must be tracetest, deletetest or resulttest",
1172        (char *) NULL);
1173   return TCL_ERROR;
1174     }
1175     return TCL_OK;
1176 }
static int TestcreatecommandCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 1286 of file tclTest.c.
References CreatedCommandProc(), CreatedCommandProc2(), NULL, Tcl_CreateCommand(), Tcl_DeleteCommand(), TCL_ERROR, and TCL_OK.
Referenced by Tcltest_Init().1291 {
1292     if (argc != 2) {
1293   Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
1294     " option\"", (char *) NULL);
1295   return TCL_ERROR;
1296     }
1297     if (strcmp(argv[1], "create") == 0) {
1298   Tcl_CreateCommand(interp, "test_ns_basic::createdcommand",
1299     CreatedCommandProc, (ClientData) NULL,
1300     (Tcl_CmdDeleteProc *) NULL);
1301     } else if (strcmp(argv[1], "delete") == 0) {
1302   Tcl_DeleteCommand(interp, "test_ns_basic::createdcommand");
1303     } else if (strcmp(argv[1], "create2") == 0) {
1304   Tcl_CreateCommand(interp, "value:at:",
1305     CreatedCommandProc2, (ClientData) NULL,
1306     (Tcl_CmdDeleteProc *) NULL);
1307     } else if (strcmp(argv[1], "delete2") == 0) {
1308   Tcl_DeleteCommand(interp, "value:at:");
1309     } else {
1310   Tcl_AppendResult(interp, "bad option \"", argv[1],
1311     "\": must be create, delete, create2, or delete2",
1312     (char *) NULL);
1313   return TCL_ERROR;
1314     }
1315     return TCL_OK;
1316 }
static int TestdcallCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 1380 of file tclTest.c.
References DelCallbackProc(), delInterp, delString, Tcl_CallWhenDeleted(), Tcl_CreateInterp(), Tcl_DeleteInterp(), Tcl_DontCallWhenDeleted(), Tcl_DStringInit(), Tcl_DStringResult(), TCL_ERROR, Tcl_GetInt(), and TCL_OK.
Referenced by Tcltest_Init().1385 {
1386     int i, id;
1387 
1388     delInterp = Tcl_CreateInterp();
1389     Tcl_DStringInit(&delString);
1390     for (i = 1; i < argc; i++) {
1391   if (Tcl_GetInt(interp, argv[i], &id) != TCL_OK) {
1392       return TCL_ERROR;
1393   }
1394   if (id < 0) {
1395       Tcl_DontCallWhenDeleted(delInterp, DelCallbackProc,
1396         (ClientData) (-id));
1397   } else {
1398       Tcl_CallWhenDeleted(delInterp, DelCallbackProc,
1399         (ClientData) id);
1400   }
1401     }
1402     Tcl_DeleteInterp(delInterp);
1403     Tcl_DStringResult(interp, &delString);
1404     return TCL_OK;
1405 }
static int TestdelassocdataCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 1521 of file tclTest.c.
References NULL, Tcl_DeleteAssocData(), TCL_ERROR, and TCL_OK.
Referenced by Tcltest_Init().1526 {
1527     if (argc != 2) {
1528         Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
1529                 " data_key\"", (char *) NULL);
1530         return TCL_ERROR;
1531     }
1532     Tcl_DeleteAssocData(interp, argv[1]);
1533     return TCL_OK;
1534 }
static int TestdelCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 1446 of file tclTest.c.
References ckalloc, DelCmdProc(), DelDeleteProc(), DelCmd::deleteCmd, DelCmd::interp, NULL, Tcl_CreateCommand(), TCL_ERROR, Tcl_GetSlave(), TCL_OK, Tcl_SetResult(), and TCL_STATIC.
Referenced by Tcltest_Init().1451 {
1452     DelCmd *dPtr;
1453     Tcl_Interp *slave;
1454 
1455     if (argc != 4) {
1456   Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
1457   return TCL_ERROR;
1458     }
1459 
1460     slave = Tcl_GetSlave(interp, argv[1]);
1461     if (slave == NULL) {
1462   return TCL_ERROR;
1463     }
1464 
1465     dPtr = (DelCmd *) ckalloc(sizeof(DelCmd));
1466     dPtr->interp = interp;
1467     dPtr->deleteCmd = (char *) ckalloc((unsigned) (strlen(argv[3]) + 1));
1468     strcpy(dPtr->deleteCmd, argv[3]);
1469 
1470     Tcl_CreateCommand(slave, argv[2], DelCmdProc, (ClientData) dPtr,
1471       DelDeleteProc);
1472     return TCL_OK;
1473 }
static int TestdstringCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 1555 of file tclTest.c.
References ckalloc, dstring, NULL, Tcl_Interp::result, SpecialFree(), Tcl_DStringAppend(), Tcl_DStringAppendElement(), Tcl_DStringEndSublist(), Tcl_DStringFree(), Tcl_DStringGetResult(), Tcl_DStringLength, Tcl_DStringResult(), Tcl_DStringStartSublist(), Tcl_DStringTrunc, Tcl_DStringValue, TCL_DYNAMIC, TCL_ERROR, Tcl_GetInt(), TCL_INTEGER_SPACE, TCL_OK, Tcl_SetResult(), TCL_STATIC, TCL_VOLATILE, and TclFormatInt().
Referenced by Tcltest_Init().1560 {
1561     int count;
1562 
1563     if (argc < 2) {
1564   wrongNumArgs:
1565   Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
1566   return TCL_ERROR;
1567     }
1568     if (strcmp(argv[1], "append") == 0) {
1569   if (argc != 4) {
1570       goto wrongNumArgs;
1571   }
1572   if (Tcl_GetInt(interp, argv[3], &count) != TCL_OK) {
1573       return TCL_ERROR;
1574   }
1575   Tcl_DStringAppend(&dstring, argv[2], count);
1576     } else if (strcmp(argv[1], "element") == 0) {
1577   if (argc != 3) {
1578       goto wrongNumArgs;
1579   }
1580   Tcl_DStringAppendElement(&dstring, argv[2]);
1581     } else if (strcmp(argv[1], "end") == 0) {
1582   if (argc != 2) {
1583       goto wrongNumArgs;
1584   }
1585   Tcl_DStringEndSublist(&dstring);
1586     } else if (strcmp(argv[1], "free") == 0) {
1587   if (argc != 2) {
1588       goto wrongNumArgs;
1589   }
1590   Tcl_DStringFree(&dstring);
1591     } else if (strcmp(argv[1], "get") == 0) {
1592   if (argc != 2) {
1593       goto wrongNumArgs;
1594   }
1595   Tcl_SetResult(interp, Tcl_DStringValue(&dstring), TCL_VOLATILE);
1596     } else if (strcmp(argv[1], "gresult") == 0) {
1597   if (argc != 3) {
1598       goto wrongNumArgs;
1599   }
1600   if (strcmp(argv[2], "staticsmall") == 0) {
1601       Tcl_SetResult(interp, "short", TCL_STATIC);
1602   } else if (strcmp(argv[2], "staticlarge") == 0) {
1603       Tcl_SetResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", TCL_STATIC);
1604   } else if (strcmp(argv[2], "free") == 0) {
1605       Tcl_SetResult(interp, (char *) ckalloc(100), TCL_DYNAMIC);
1606       strcpy(interp->result, "This is a malloc-ed string");
1607   } else if (strcmp(argv[2], "special") == 0) {
1608       interp->result = (char *) ckalloc(100);
1609       interp->result += 4;
1610       interp->freeProc = SpecialFree;
1611       strcpy(interp->result, "This is a specially-allocated string");
1612   } else {
1613       Tcl_AppendResult(interp, "bad gresult option \"", argv[2],
1614         "\": must be staticsmall, staticlarge, free, or special",
1615         (char *) NULL);
1616       return TCL_ERROR;
1617   }
1618   Tcl_DStringGetResult(interp, &dstring);
1619     } else if (strcmp(argv[1], "length") == 0) {
1620   char buf[TCL_INTEGER_SPACE];
1621   
1622   if (argc != 2) {
1623       goto wrongNumArgs;
1624   }
1625   TclFormatInt(buf, Tcl_DStringLength(&dstring));
1626   Tcl_SetResult(interp, buf, TCL_VOLATILE);
1627     } else if (strcmp(argv[1], "result") == 0) {
1628   if (argc != 2) {
1629       goto wrongNumArgs;
1630   }
1631   Tcl_DStringResult(interp, &dstring);
1632     } else if (strcmp(argv[1], "trunc") == 0) {
1633   if (argc != 3) {
1634       goto wrongNumArgs;
1635   }
1636   if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
1637       return TCL_ERROR;
1638   }
1639   Tcl_DStringTrunc(&dstring, count);
1640     } else if (strcmp(argv[1], "start") == 0) {
1641   if (argc != 2) {
1642       goto wrongNumArgs;
1643   }
1644   Tcl_DStringStartSublist(&dstring);
1645     } else {
1646   Tcl_AppendResult(interp, "bad option \"", argv[1],
1647     "\": must be append, element, end, free, get, length, ",
1648     "result, trunc, or start", (char *) NULL);
1649   return TCL_ERROR;
1650     }
1651     return TCL_OK;
1652 }
static int TestencodingObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1684 of file tclTest.c.
References ckalloc, Tcl_EncodingType::clientData, CONST, EncodingFreeProc(), EncodingFromUtfProc(), Tcl_EncodingType::encodingName, EncodingToUtfProc(), Tcl_EncodingType::freeProc, TclEncoding::fromUtfCmd, Tcl_EncodingType::fromUtfProc, TclEncoding::interp, NULL, Tcl_EncodingType::nullSize, Tcl_CreateEncoding(), TCL_ERROR, Tcl_FreeEncoding(), Tcl_GetEncoding(), Tcl_GetIndexFromObj(), Tcl_GetString(), Tcl_GetStringFromObj(), TCL_OK, Tcl_SetObjResult(), TclGetLibraryPath(), TclSetLibraryPath(), TclEncoding::toUtfCmd, and Tcl_EncodingType::toUtfProc.
Referenced by Tcltest_Init().1689 {
1690     Tcl_Encoding encoding;
1691     int index, length;
1692     char *string;
1693     TclEncoding *encodingPtr;
1694     static CONST char *optionStrings[] = {
1695   "create", "delete", "path",
1696   NULL
1697     };
1698     enum options {
1699   ENC_CREATE, ENC_DELETE, ENC_PATH
1700     };
1701     
1702     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
1703       &index) != TCL_OK) {
1704   return TCL_ERROR;
1705     }
1706 
1707     switch ((enum options) index) {
1708   case ENC_CREATE: {
1709       Tcl_EncodingType type;
1710 
1711       if (objc != 5) {
1712     return TCL_ERROR;
1713       }
1714       encodingPtr = (TclEncoding *) ckalloc(sizeof(TclEncoding));
1715       encodingPtr->interp = interp;
1716 
1717       string = Tcl_GetStringFromObj(objv[3], &length);
1718       encodingPtr->toUtfCmd = (char *) ckalloc((unsigned) (length + 1));
1719       memcpy(encodingPtr->toUtfCmd, string, (unsigned) length + 1);
1720 
1721       string = Tcl_GetStringFromObj(objv[4], &length);
1722       encodingPtr->fromUtfCmd = (char *) ckalloc((unsigned) (length + 1));
1723       memcpy(encodingPtr->fromUtfCmd, string, (unsigned) (length + 1));
1724 
1725       string = Tcl_GetStringFromObj(objv[2], &length);
1726 
1727       type.encodingName = string;
1728       type.toUtfProc = EncodingToUtfProc;
1729       type.fromUtfProc = EncodingFromUtfProc;
1730       type.freeProc = EncodingFreeProc;
1731       type.clientData = (ClientData) encodingPtr;
1732       type.nullSize = 1;
1733 
1734       Tcl_CreateEncoding(&type);
1735       break;
1736   }
1737   case ENC_DELETE: {
1738       if (objc != 3) {
1739     return TCL_ERROR;
1740       }
1741       encoding = Tcl_GetEncoding(NULL, Tcl_GetString(objv[2]));
1742       Tcl_FreeEncoding(encoding);
1743       Tcl_FreeEncoding(encoding);
1744       break;
1745   }
1746   case ENC_PATH: {
1747       if (objc == 2) {
1748     Tcl_SetObjResult(interp, TclGetLibraryPath());
1749       } else {
1750     TclSetLibraryPath(objv[2]);
1751       }
1752       break;
1753   }
1754     }
1755     return TCL_OK;
1756 }
static int TestevalexObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1851 of file tclTest.c.
References Interp::flags, NULL, TCL_ERROR, TCL_EVAL_GLOBAL, Tcl_EvalEx(), Tcl_GetStringFromObj(), TCL_OK, Tcl_SetResult(), TCL_STATIC, Tcl_WrongNumArgs(), and USE_EVAL_DIRECT.
Referenced by Tcltest_Init().1856 {
1857     Interp *iPtr = (Interp *) interp;
1858     int code, oldFlags, length, flags;
1859     char *string;
1860 
1861     if (objc == 1) {
1862   /*
1863    * The command was invoked with no arguments, so just toggle
1864    * the flag that determines whether we use Tcl_EvalEx.
1865    */
1866 
1867   if (iPtr->flags & USE_EVAL_DIRECT) {
1868       iPtr->flags &= ~USE_EVAL_DIRECT;
1869       Tcl_SetResult(interp, "disabling direct evaluation", TCL_STATIC);
1870   } else {
1871       iPtr->flags |= USE_EVAL_DIRECT;
1872       Tcl_SetResult(interp, "enabling direct evaluation", TCL_STATIC);
1873   }
1874   return TCL_OK;
1875     }
1876 
1877     flags = 0;
1878     if (objc == 3) {
1879   string = Tcl_GetStringFromObj(objv[2], &length);
1880   if (strcmp(string, "global") != 0) {
1881       Tcl_AppendResult(interp, "bad value \"", string,
1882         "\": must be global", (char *) NULL);
1883       return TCL_ERROR;
1884   }
1885   flags = TCL_EVAL_GLOBAL;
1886     } else if (objc != 2) {
1887   Tcl_WrongNumArgs(interp, 1, objv, "script ?global?");
1888         return TCL_ERROR;
1889     }
1890     Tcl_SetResult(interp, "xxx", TCL_STATIC);
1891 
1892     /*
1893      * Note, we have to set the USE_EVAL_DIRECT flag in the interpreter
1894      * in addition to calling Tcl_EvalEx.  This is needed so that even nested
1895      * commands are evaluated directly.
1896      */
1897 
1898     oldFlags = iPtr->flags;
1899     iPtr->flags |= USE_EVAL_DIRECT;
1900     string = Tcl_GetStringFromObj(objv[1], &length);
1901     code = Tcl_EvalEx(interp, string, length, flags); 
1902     iPtr->flags = (iPtr->flags & ~USE_EVAL_DIRECT)
1903       | (oldFlags & USE_EVAL_DIRECT);
1904     return code;
1905 }
static int TestevalobjvObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 1925 of file tclTest.c.
References TCL_ERROR, TCL_EVAL_GLOBAL, Tcl_EvalObjv(), Tcl_GetIntFromObj(), TCL_OK, and Tcl_WrongNumArgs().
Referenced by Tcltest_Init().1930 {
1931     int evalGlobal;
1932 
1933     if (objc < 3) {
1934   Tcl_WrongNumArgs(interp, 1, objv, "global word ?word ...?");
1935         return TCL_ERROR;
1936     }
1937     if (Tcl_GetIntFromObj(interp, objv[1], &evalGlobal) != TCL_OK) {
1938   return TCL_ERROR;
1939     }
1940     return Tcl_EvalObjv(interp, objc-2, objv+2,
1941       (evalGlobal) ? TCL_EVAL_GLOBAL : 0);
1942 }
static int TesteventDeleteProc (Tcl_Event * event, ClientData clientData) [static]

Definition at line 2116 of file tclTest.c.
References TestEvent::command, NULL, Tcl_Event::proc, TestEvent::tag, Tcl_DecrRefCount, Tcl_GetStringFromObj(), and TesteventProc().
Referenced by TesteventObjCmd().2119 {
2120     TestEvent* ev;    /* Event to examine */
2121     char* evNameStr;
2122     Tcl_Obj* targetName;  /* Name of the event(s) to delete */
2123     char* targetNameStr;
2124 
2125     if ( event->proc != TesteventProc ) {
2126   return 0;
2127     }
2128     targetName = (Tcl_Obj*) clientData;
2129     targetNameStr = (char*) Tcl_GetStringFromObj( targetName, NULL );
2130     ev = (TestEvent*) event;
2131     evNameStr = Tcl_GetStringFromObj( ev->tag, NULL );
2132     if ( strcmp( evNameStr, targetNameStr ) == 0 ) {
2133   Tcl_DecrRefCount( ev->tag );
2134   Tcl_DecrRefCount( ev->command );
2135   return 1;
2136     } else {
2137   return 0;
2138     }
2139 }
static int TesteventObjCmd (ClientData unused, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[]) [static]

Definition at line 1974 of file tclTest.c.
References ckalloc, TestEvent::command, CONST, TestEvent::header, TestEvent::interp, Tcl_Event::nextPtr, NULL, Tcl_Event::proc, TestEvent::tag, Tcl_DeleteEvents(), TCL_ERROR, TCL_EXACT, Tcl_GetIndexFromObj(), Tcl_IncrRefCount, TCL_OK, TCL_QUEUE_HEAD, TCL_QUEUE_MARK, TCL_QUEUE_TAIL, Tcl_QueueEvent(), Tcl_WrongNumArgs(), TesteventDeleteProc(), and TesteventProc().
Referenced by Tcltest_Init().1978 {
1979     
1980     static CONST char* subcommands[] = { /* Possible subcommands */
1981   "queue",
1982   "delete",
1983   NULL
1984     };
1985     int subCmdIndex;    /* Index of the chosen subcommand */
1986     static CONST char* positions[] = { /* Possible queue positions */
1987   "head",
1988   "tail",
1989   "mark",
1990   NULL
1991     };
1992     int posIndex;   /* Index of the chosen position */
1993     static CONST Tcl_QueuePosition posNum[] = { 
1994             /* Interpretation of the chosen position */
1995   TCL_QUEUE_HEAD,
1996   TCL_QUEUE_TAIL,
1997   TCL_QUEUE_MARK
1998     };
1999     TestEvent* ev;    /* Event to be queued */
2000 
2001     if ( objc < 2 ) {
2002   Tcl_WrongNumArgs( interp, 1, objv, "subcommand ?args?" );
2003   return TCL_ERROR;
2004     }
2005     if ( Tcl_GetIndexFromObj( interp, objv[1], subcommands, "subcommand",
2006             TCL_EXACT, &subCmdIndex ) != TCL_OK ) {
2007   return TCL_ERROR;
2008     }
2009     switch ( subCmdIndex ) {
2010     case 0:     /* queue */
2011   if ( objc != 5 ) {
2012       Tcl_WrongNumArgs( interp, 2, objv, "name position script" );
2013       return TCL_ERROR;
2014   }
2015   if ( Tcl_GetIndexFromObj( interp, objv[3], positions,
2016           "position specifier", TCL_EXACT,
2017           &posIndex ) != TCL_OK ) {
2018       return TCL_ERROR;
2019   }
2020   ev = (TestEvent*) ckalloc( sizeof( TestEvent ) );
2021   ev->header.proc = TesteventProc;
2022   ev->header.nextPtr = NULL;
2023   ev->interp = interp;
2024   ev->command = objv[ 4 ];
2025   Tcl_IncrRefCount( ev->command );
2026   ev->tag = objv[ 2 ];
2027   Tcl_IncrRefCount( ev->tag );
2028   Tcl_QueueEvent( (Tcl_Event*) ev, posNum[ posIndex ] );
2029   break;
2030 
2031     case 1:     /* delete */
2032   if ( objc != 3 ) {
2033       Tcl_WrongNumArgs( interp, 2, objv, "name" );
2034       return TCL_ERROR;
2035   }
2036   Tcl_DeleteEvents( TesteventDeleteProc, objv[ 2 ] );
2037   break;
2038     }
2039 
2040     return TCL_OK;
2041 
2042 }
static int TesteventProc (Tcl_Event * event, int flags) [static]

Definition at line 2066 of file tclTest.c.
References TestEvent::command, TestEvent::interp, TestEvent::tag, Tcl_AddErrorInfo(), Tcl_BackgroundError(), Tcl_DecrRefCount, TCL_EVAL_DIRECT, TCL_EVAL_GLOBAL, Tcl_EvalObjEx(), Tcl_GetBooleanFromObj(), Tcl_GetObjResult(), and TCL_OK.
Referenced by TesteventDeleteProc(), and TesteventObjCmd().2068 {
2069     TestEvent * ev = (TestEvent *) event;
2070     Tcl_Interp* interp = ev->interp;
2071     Tcl_Obj* command = ev->command;
2072     int result = Tcl_EvalObjEx( interp, command,
2073         TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT );
2074     int retval;
2075     if ( result != TCL_OK ) {
2076   Tcl_AddErrorInfo( interp,
2077         "    (command bound to \"testevent\" callback)" );
2078   Tcl_BackgroundError( interp );
2079   return 1;   /* Avoid looping on errors */
2080     }
2081     if ( Tcl_GetBooleanFromObj( interp,
2082         Tcl_GetObjResult( interp ),
2083         &retval ) != TCL_OK ) {
2084   Tcl_AddErrorInfo( interp, 
2085         "    (return value from \"testevent\" callback)" );
2086   Tcl_BackgroundError( interp );
2087   return 1;
2088     }
2089     if ( retval ) {
2090   Tcl_DecrRefCount( ev->tag );
2091   Tcl_DecrRefCount( ev->command );
2092     }
2093   
2094     return retval;
2095 }
static int TestexithandlerCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 2159 of file tclTest.c.
References ExitProcEven(), ExitProcOdd(), NULL, Tcl_CreateExitHandler(), Tcl_DeleteExitHandler(), TCL_ERROR, Tcl_GetInt(), and TCL_OK.
Referenced by Tcltest_Init().2164 {
2165     int value;
2166 
2167     if (argc != 3) {
2168   Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
2169                 " create|delete value\"", (char *) NULL);
2170         return TCL_ERROR;
2171     }
2172     if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
2173   return TCL_ERROR;
2174     }
2175     if (strcmp(argv[1], "create") == 0) {
2176   Tcl_CreateExitHandler((value & 1) ? ExitProcOdd : ExitProcEven,
2177     (ClientData) value);
2178     } else if (strcmp(argv[1], "delete") == 0) {
2179   Tcl_DeleteExitHandler((value & 1) ? ExitProcOdd : ExitProcEven,
2180     (ClientData) value);
2181     } else {
2182   Tcl_AppendResult(interp, "bad option \"", argv[1],
2183     "\": must be create or delete", (char *) NULL);
2184   return TCL_ERROR;
2185     }
2186     return TCL_OK;
2187 }
static int TestexitmainloopCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 4872 of file tclTest.c.
References exitMainLoop, and TCL_OK.
Referenced by Tcltest_Init().4877 {
4878   exitMainLoop = 1;
4879   return TCL_OK;
4880 }
static int TestexprlongCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 2227 of file tclTest.c.
References NULL, Tcl_ExprLong(), TCL_INTEGER_SPACE, TCL_OK, Tcl_SetResult(), and TCL_STATIC.
Referenced by Tcltest_Init().2232 {
2233     long exprResult;
2234     char buf[4 + TCL_INTEGER_SPACE];
2235     int result;
2236     
2237     Tcl_SetResult(interp, "This is a result", TCL_STATIC);
2238     result = Tcl_ExprLong(interp, "4+1", &exprResult);
2239     if (result != TCL_OK) {
2240         return result;
2241     }
2242     sprintf(buf, ": %ld", exprResult);
2243     Tcl_AppendResult(interp, buf, NULL);
2244     return TCL_OK;
2245 }
static int TestexprparserObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 2983 of file tclTest.c.
References parse(), PrintParse(), Tcl_AddErrorInfo(), TCL_ERROR, Tcl_FreeParse(), Tcl_GetIntFromObj(), Tcl_GetStringFromObj(), TCL_OK, Tcl_ParseExpr(), and Tcl_WrongNumArgs().
Referenced by Tcltest_Init().2988 {
2989     char *script;
2990     int length, dummy;
2991     Tcl_Parse parse;
2992 
2993     if (objc != 3) {
2994   Tcl_WrongNumArgs(interp, 1, objv, "expr length");
2995   return TCL_ERROR;
2996     }
2997     script = Tcl_GetStringFromObj(objv[1], &dummy);
2998     if (Tcl_GetIntFromObj(interp, objv[2], &length)) {
2999   return TCL_ERROR;
3000     }
3001     if (length == 0) {
3002   length = dummy;
3003     }
3004     if (Tcl_ParseExpr(interp, script, length, &parse) != TCL_OK) {
3005   Tcl_AddErrorInfo(interp, "\n    (remainder of expr: \"");
3006   Tcl_AddErrorInfo(interp, parse.term);
3007   Tcl_AddErrorInfo(interp, "\")");
3008   return TCL_ERROR;
3009     }
3010 
3011     /*
3012      * The parse completed successfully.  Just print out the contents
3013      * of the parse structure into the interpreter's result.
3014      */
3015 
3016     PrintParse(interp, &parse);
3017     Tcl_FreeParse(&parse);
3018     return TCL_OK;
3019 }
static int TestexprstringCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 2264 of file tclTest.c.
References NULL, TCL_ERROR, and Tcl_ExprString().
Referenced by Tcltest_Init().2269 {
2270     if (argc != 2) {
2271         Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
2272                 " expression\"", (char *) NULL);
2273         return TCL_ERROR;
2274     }
2275     return Tcl_ExprString(interp, argv[1]);
2276 }
static int TestfeventCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 3911 of file tclTest.c.
References NULL, Tcl_CreateInterp(), Tcl_DeleteInterp(), TCL_ERROR, Tcl_GetChannel(), Tcl_GetObjResult(), Tcl_GlobalEval(), Tcl_Init(), TCL_OK, Tcl_RegisterChannel(), and Tcl_SetObjResult().
Referenced by Tcltest_Init().3916 {
3917     static Tcl_Interp *interp2 = NULL;
3918     int code;
3919     Tcl_Channel chan;
3920 
3921     if (argc < 2) {
3922   Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
3923     " option ?arg arg ...?", (char *) NULL);
3924   return TCL_ERROR;
3925     }
3926     if (strcmp(argv[1], "cmd") == 0) {
3927   if (argc != 3) {
3928       Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
3929         " cmd script", (char *) NULL);
3930       return TCL_ERROR;
3931   }
3932         if (interp2 != (Tcl_Interp *) NULL) {
3933             code = Tcl_GlobalEval(interp2, argv[2]);
3934       Tcl_SetObjResult(interp, Tcl_GetObjResult(interp2));
3935             return code;
3936         } else {
3937             Tcl_AppendResult(interp,
3938                     "called \"testfevent code\" before \"testfevent create\"",
3939                     (char *) NULL);
3940             return TCL_ERROR;
3941         }
3942     } else if (strcmp(argv[1], "create") == 0) {
3943   if (interp2 != NULL) {
3944             Tcl_DeleteInterp(interp2);
3945   }
3946         interp2 = Tcl_CreateInterp();
3947   return Tcl_Init(interp2);
3948     } else if (strcmp(argv[1], "delete") == 0) {
3949   if (interp2 != NULL) {
3950             Tcl_DeleteInterp(interp2);
3951   }
3952   interp2 = NULL;
3953     } else if (strcmp(argv[1], "share") == 0) {
3954         if (interp2 != NULL) {
3955             chan = Tcl_GetChannel(interp, argv[2], NULL);
3956             if (chan == (Tcl_Channel) NULL) {
3957                 return TCL_ERROR;
3958             }
3959             Tcl_RegisterChannel(interp2, chan);
3960         }
3961     }
3962     
3963     return TCL_OK;
3964 }
static int TestfileCmd (ClientData dummy, Tcl_Interp * interp, int argc, argv) [static]

Definition at line 4004 of file tclTest.c.
References NULL, Tcl_DecrRefCount, Tcl_ErrnoId(), TCL_ERROR, Tcl_FSGetNormalizedPath(), Tcl_GetString(), TCL_OK, TclpObjCopyDirectory(), TclpObjCopyFile(), TclpObjCreateDirectory(), TclpObjDeleteFile(), TclpObjRemoveDirectory(), and TclpObjRenameFile().
Referenced by Tcltest_Init().4009 {
4010     int force, i, j, result;
4011     Tcl_Obj *error = NULL;
4012     char *subcmd;
4013     
4014     if (argc < 3) {
4015   return TCL_ERROR;
4016     }
4017 
4018     force = 0;
4019     i = 2;
4020     if (strcmp(Tcl_GetString(argv[2]), "-force") == 0) {
4021         force = 1;
4022   i = 3;
4023     }
4024 
4025     if (argc - i > 2) {
4026   return TCL_ERROR;
4027     }
4028 
4029     for (j = i; j < argc; j++) {
4030         if (Tcl_FSGetNormalizedPath(interp, argv[j]) == NULL) {
4031       return TCL_ERROR;
4032   }
4033     }
4034 
4035     subcmd = Tcl_GetString(argv[1]);
4036     
4037     if (strcmp(subcmd, "mv") == 0) {
4038   result = TclpObjRenameFile(argv[i], argv[i + 1]);
4039     } else if (strcmp(subcmd, "cp") == 0) {
4040         result = TclpObjCopyFile(argv[i], argv[i + 1]);
4041     } else if (strcmp(subcmd, "rm") == 0) {
4042         result = TclpObjDeleteFile(argv[i]);
4043     } else if (strcmp(subcmd, "mkdir") == 0) {
4044         result = TclpObjCreateDirectory(argv[i]);
4045     } else if (strcmp(subcmd, "cpdir") == 0) {
4046         result = TclpObjCopyDirectory(argv[i], argv[i + 1], &error);
4047     } else if (strcmp(subcmd, "rmdir") == 0) {
4048         result = TclpObjRemoveDirectory(argv[i], force, &error);
4049     } else {
4050         result = TCL_ERROR;
4051   goto end;
4052     }
4053   
4054     if (result != TCL_OK) {
4055   if (error != NULL) {
4056       if (Tcl_GetString(error)[0] != '\0') {
4057     Tcl_AppendResult(interp, Tcl_GetString(error), " ", NULL);
4058       }
4059       Tcl_DecrRefCount(error);
4060   }
4061   Tcl_AppendResult(interp, Tcl_ErrnoId(), (char *) NULL);
4062     }
4063 
4064     end:
4065 
4066     return result;
4067 }
static int TestfilelinkCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 2297 of file tclTest.c.
References NULL, TCL_CREATE_HARD_LINK, TCL_CREATE_SYMBOLIC_LINK, Tcl_DecrRefCount, TCL_ERROR, Tcl_FSConvertToPathType(), Tcl_FSLink(), Tcl_GetString(), TCL_OK, Tcl_PosixError(), Tcl_SetObjResult(), and Tcl_WrongNumArgs().
Referenced by Tcltest_Init().2302 {
2303     Tcl_Obj *contents;
2304 
2305     if (objc < 2 || objc > 3) {
2306   Tcl_WrongNumArgs(interp, 1, objv, "source ?target?");
2307   return TCL_ERROR;
2308     }
2309     
2310     if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
2311   return TCL_ERROR;
2312     }
2313     
2314     if (objc == 3) {
2315   /* Create link from source to target */
2316   contents = Tcl_FSLink(objv[1], objv[2], 
2317       TCL_CREATE_SYMBOLIC_LINK|TCL_CREATE_HARD_LINK);
2318   if (contents == NULL) {
2319       Tcl_AppendResult(interp, "could not create link from \"", 
2320         Tcl_GetString(objv[1]), "\" to \"", 
2321         Tcl_GetString(objv[2]), "\": ", 
2322         Tcl_PosixError(interp), (char *) NULL);
2323       return TCL_ERROR;
2324   }
2325     } else {
2326   /* Read link */
2327   contents = Tcl_FSLink(objv[1], NULL, 0);
2328   if (contents == NULL) {
2329       Tcl_AppendResult(interp, "could not read link \"", 
2330         Tcl_GetString(objv[1]), "\": ", 
2331         Tcl_PosixError(interp), (char *) NULL);
2332       return TCL_ERROR;
2333   }
2334     }
2335     Tcl_SetObjResult(interp, contents);
2336     if (objc == 2) {
2337   /* 
2338    * If we are creating a link, this will actually just
2339    * be objv[3], and we don't own it
2340    */
2341   Tcl_DecrRefCount(contents);
2342     }
2343     return TCL_OK;
2344 }
static int TestFilesystemObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 5961 of file tclTest.c.
References TCL_ERROR, Tcl_FSRegister(), Tcl_FSUnregister(), Tcl_GetBooleanFromObj(), TCL_OK, Tcl_SetResult(), TCL_VOLATILE, Tcl_WrongNumArgs(), and testReportingFilesystem.
Referenced by Tcltest_Init().5966 {
5967     int res, boolVal;
5968     char *msg;
5969     
5970     if (objc != 2) {
5971   Tcl_WrongNumArgs(interp, 1, objv, "boolean");
5972   return TCL_ERROR;
5973     }
5974     if (Tcl_GetBooleanFromObj(interp, objv[1], &boolVal) != TCL_OK) {
5975   return TCL_ERROR;
5976     }
5977     if (boolVal) {
5978   res = Tcl_FSRegister((ClientData)interp, &testReportingFilesystem);
5979   msg = (res == TCL_OK) ? "registered" : "failed";
5980     } else {
5981   res = Tcl_FSUnregister(&testReportingFilesystem);
5982   msg = (res == TCL_OK) ? "unregistered" : "failed";
5983     }
5984     Tcl_SetResult(interp, msg, TCL_VOLATILE);
5985     return res;
5986 }
static int TestgetassocdataCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 2364 of file tclTest.c.
References NULL, TCL_ERROR, Tcl_GetAssocData(), and TCL_OK.
Referenced by Tcltest_Init().2369 {
2370     char *res;
2371     
2372     if (argc != 2) {
2373         Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
2374                 " data_key\"", (char *) NULL);
2375         return TCL_ERROR;
2376     }
2377     res = (char *) Tcl_GetAssocData(interp, argv[1], NULL);
2378     if (res != NULL) {
2379         Tcl_AppendResult(interp, res, NULL);
2380     }
2381     return TCL_OK;
2382 }
static int TestGetIndexFromObjStructObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 5907 of file tclTest.c.
References NULL, TCL_ERROR, Tcl_GetIndexFromObjStruct(), Tcl_GetIntFromObj(), TCL_OK, and Tcl_WrongNumArgs().
Referenced by Tcltest_Init().5912 {
5913     char *ary[] = {
5914   "a", "b", "c", "d", "e", "f", (char *)NULL,(char *)NULL
5915     };
5916     int idx,target;
5917 
5918     if (objc != 3) {
5919   Tcl_WrongNumArgs(interp, 1, objv, "argument targetvalue");
5920   return TCL_ERROR;
5921     }
5922     if (Tcl_GetIndexFromObjStruct(interp, objv[1], ary, 2*sizeof(char *),
5923           "dummy", 0, &idx) != TCL_OK) {
5924   return TCL_ERROR;
5925     }
5926     if (Tcl_GetIntFromObj(interp, objv[2], &target) != TCL_OK) {
5927   return TCL_ERROR;
5928     }
5929     if (idx != target) {
5930   char buffer[64];
5931   sprintf(buffer, "%d", idx);
5932   Tcl_AppendResult(interp, "index value comparison failed: got ",
5933        buffer, NULL);
5934   sprintf(buffer, "%d", target);
5935   Tcl_AppendResult(interp, " when ", buffer, " expected", NULL);
5936   return TCL_ERROR;
5937     }
5938     Tcl_WrongNumArgs(interp, 3, objv, NULL);
5939     return TCL_OK;
5940 }
static int TestgetplatformCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 2402 of file tclTest.c.
References CONST, NULL, TCL_ERROR, TCL_OK, tclPlatform, and TclWinGetPlatform().
Referenced by Tcltest_Init().2407 {
2408     static CONST char *platformStrings[] = { "unix", "mac", "windows" };
2409     TclPlatformType *platform;
2410 
2411 #ifdef __WIN32__
2412     platform = TclWinGetPlatform();
2413 #else
2414     platform = &tclPlatform;
2415 #endif
2416     
2417     if (argc != 1) {
2418         Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
2419     (char *) NULL);
2420         return TCL_ERROR;
2421     }
2422 
2423     Tcl_AppendResult(interp, platformStrings[*platform], NULL);
2424     return TCL_OK;
2425 }
static int TestgetvarfullnameCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 4087 of file tclTest.c.
References NULL, TCL_ERROR, Tcl_FindNamespace(), Tcl_FindNamespaceVar(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetVariableFullName(), TCL_GLOBAL_ONLY, TCL_LEAVE_ERR_MSG, TCL_NAMESPACE_ONLY, TCL_OK, Tcl_PopCallFrame(), Tcl_PushCallFrame(), and Tcl_WrongNumArgs().
Referenced by Tcltest_Init().4092 {
4093     char *name, *arg;
4094     int flags = 0;
4095     Tcl_Namespace *namespacePtr;
4096     Tcl_CallFrame frame;
4097     Tcl_Var variable;
4098     int result;
4099 
4100     if (objc != 3) {
4101   Tcl_WrongNumArgs(interp, 1, objv, "name scope");
4102         return TCL_ERROR;
4103     }
4104     
4105     name = Tcl_GetString(objv[1]);
4106 
4107     arg = Tcl_GetString(objv[2]);
4108     if (strcmp(arg, "global") == 0) {
4109   flags = TCL_GLOBAL_ONLY;
4110     } else if (strcmp(arg, "namespace") == 0) {
4111   flags = TCL_NAMESPACE_ONLY;
4112     }
4113 
4114     /*
4115      * This command, like any other created with Tcl_Create[Obj]Command,
4116      * runs in the global namespace. As a "namespace-aware" command that
4117      * needs to run in a particular namespace, it must activate that
4118      * namespace itself.
4119      */
4120 
4121     if (flags == TCL_NAMESPACE_ONLY) {
4122   namespacePtr = Tcl_FindNamespace(interp, "::test_ns_var",
4123           (Tcl_Namespace *) NULL, TCL_LEAVE_ERR_MSG);
4124   if (namespacePtr == NULL) {
4125       return TCL_ERROR;
4126   }
4127   result = Tcl_PushCallFrame(interp, &frame, namespacePtr,
4128                 /*isProcCallFrame*/ 0);
4129   if (result != TCL_OK) {
4130       return result;
4131   }
4132     }
4133     
4134     variable = Tcl_FindNamespaceVar(interp, name, (Tcl_Namespace *) NULL,
4135       (flags | TCL_LEAVE_ERR_MSG));
4136 
4137     if (flags == TCL_NAMESPACE_ONLY) {
4138   Tcl_PopCallFrame(interp);
4139     }
4140     if (variable == (Tcl_Var) NULL) {
4141   return TCL_ERROR;
4142     }
4143     Tcl_GetVariableFullName(interp, variable, Tcl_GetObjResult(interp));
4144     return TCL_OK;
4145 }
static int TestinterpdeleteCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 2447 of file tclTest.c.
References NULL, Tcl_DeleteInterp(), TCL_ERROR, Tcl_GetSlave(), and TCL_OK.
Referenced by Tcltest_Init().2452 {
2453     Tcl_Interp *slaveToDelete;
2454 
2455     if (argc != 2) {
2456         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
2457                 " path\"", (char *) NULL);
2458         return TCL_ERROR;
2459     }
2460     slaveToDelete = Tcl_GetSlave(interp, argv[1]);
2461     if (slaveToDelete == (Tcl_Interp *) NULL) {
2462         return TCL_ERROR;
2463     }
2464     Tcl_DeleteInterp(slaveToDelete);
2465     return TCL_OK;
2466 }
static int TestlinkCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 2488 of file tclTest.c.
References ckalloc, ckfree, NULL, Tcl_AppendElement(), Tcl_DecrRefCount, TCL_DOUBLE_SPACE, TCL_ERROR, Tcl_GetBoolean(), Tcl_GetDouble(), Tcl_GetInt(), Tcl_GetString(), Tcl_GetWideIntFromObj(), TCL_LINK_BOOLEAN, TCL_LINK_DOUBLE, TCL_LINK_INT, TCL_LINK_READ_ONLY, TCL_LINK_STRING, TCL_LINK_WIDE_INT, Tcl_LinkVar(), Tcl_LongAsWide, Tcl_NewStringObj(), Tcl_NewWideIntObj(), TCL_OK, Tcl_PrintDouble(), Tcl_UnlinkVar(), Tcl_UpdateLinkedVar(), and TclFormatInt().
Referenced by Tcltest_Init().2493 {
2494     static int intVar = 43;
2495     static int boolVar = 4;
2496     static double realVar = 1.23;
2497     static Tcl_WideInt wideVar = Tcl_LongAsWide(79);
2498     static char *stringVar = NULL;
2499     static int created = 0;
2500     char buffer[2*TCL_DOUBLE_SPACE];
2501     int writable, flag;
2502     Tcl_Obj *tmp;
2503 
2504     if (argc < 2) {
2505   Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
2506     " option ?arg arg arg arg arg?\"", (char *) NULL);
2507   return TCL_ERROR;
2508     }
2509     if (strcmp(argv[1], "create") == 0) {
2510   if (argc != 7) {
2511       Tcl_AppendResult(interp, "wrong # args: should be \"",
2512     argv[0], " ", argv[1],
2513     " intRO realRO boolRO stringRO wideRO\"", (char *) NULL);
2514       return TCL_ERROR;
2515   }
2516   if (created) {
2517       Tcl_UnlinkVar(interp, "int");
2518       Tcl_UnlinkVar(interp, "real");
2519       Tcl_UnlinkVar(interp, "bool");
2520       Tcl_UnlinkVar(interp, "string");
2521       Tcl_UnlinkVar(interp, "wide");
2522   }
2523   created = 1;
2524   if (Tcl_GetBoolean(interp, argv[2], &writable) != TCL_OK) {
2525       return TCL_ERROR;
2526   }
2527   flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
2528   if (Tcl_LinkVar(interp, "int", (char *) &intVar,
2529     TCL_LINK_INT | flag) != TCL_OK) {
2530       return TCL_ERROR;
2531   }
2532   if (Tcl_GetBoolean(interp, argv[3], &writable) != TCL_OK) {
2533       return TCL_ERROR;
2534   }
2535   flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
2536   if (Tcl_LinkVar(interp, "real", (char *) &realVar,
2537     TCL_LINK_DOUBLE | flag) != TCL_OK) {
2538       return TCL_ERROR;
2539   }
2540   if (Tcl_GetBoolean(interp, argv[4], &writable) != TCL_OK) {
2541       return TCL_ERROR;
2542   }
2543   flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
2544   if (Tcl_LinkVar(interp, "bool", (char *) &boolVar,
2545     TCL_LINK_BOOLEAN | flag) != TCL_OK) {
2546       return TCL_ERROR;
2547   }
2548   if (Tcl_GetBoolean(interp, argv[5], &writable) != TCL_OK) {
2549       return TCL_ERROR;
2550   }
2551   flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
2552   if (Tcl_LinkVar(interp, "string", (char *) &stringVar,
2553     TCL_LINK_STRING | flag) != TCL_OK) {
2554       return TCL_ERROR;
2555   }
2556   if (Tcl_GetBoolean(interp, argv[6], &writable) != TCL_OK) {
2557       return TCL_ERROR;
2558   }
2559   flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
2560   if (Tcl_LinkVar(interp, "wide", (char *) &wideVar,
2561       TCL_LINK_WIDE_INT | flag) != TCL_OK) {
2562       return TCL_ERROR;
2563   }
2564     } else if (strcmp(argv[1], "delete") == 0) {
2565   Tcl_UnlinkVar(interp, "int");
2566   Tcl_UnlinkVar(interp, "real");
2567   Tcl_UnlinkVar(interp, "bool");
2568   Tcl_UnlinkVar(interp, "string");
2569   Tcl_UnlinkVar(interp, "wide");
2570   created = 0;
2571     } else if (strcmp(argv[1], "get") == 0) {
2572   TclFormatInt(buffer, intVar);
2573   Tcl_AppendElement(interp, buffer);
2574   Tcl_PrintDouble((Tcl_Interp *) NULL, realVar, buffer);
2575   Tcl_AppendElement(interp, buffer);
2576   TclFormatInt(buffer, boolVar);
2577   Tcl_AppendElement(interp, buffer);
2578   Tcl_AppendElement(interp, (stringVar == NULL) ? "-" : stringVar);
2579   /*
2580    * Wide ints only have an object-based interface.
2581    */
2582   tmp = Tcl_NewWideIntObj(wideVar);
2583   Tcl_AppendElement(interp, Tcl_GetString(tmp));
2584   Tcl_DecrRefCount(tmp);
2585     } else if (strcmp(argv[1], "set") == 0) {
2586   if (argc != 7) {
2587       Tcl_AppendResult(interp, "wrong # args: should be \"",
2588         argv[0], " ", argv[1],
2589         " intValue realValue boolValue stringValue wideValue\"",
2590         (char *) NULL);
2591       return TCL_ERROR;
2592   }
2593   if (argv[2][0] != 0) {
2594       if (Tcl_GetInt(interp, argv[2], &intVar) != TCL_OK) {
2595     return TCL_ERROR;
2596       }
2597   }
2598   if (argv[3][0] != 0) {
2599       if (Tcl_GetDouble(interp, argv[3], &realVar) != TCL_OK) {
2600     return TCL_ERROR;
2601       }
2602   }
2603   if (argv[4][0] != 0) {
2604       if (Tcl_GetInt(interp, argv[4], &boolVar) != TCL_OK) {
2605     return TCL_ERROR;
2606       }
2607   }
2608   if (argv[5][0] != 0) {
2609       if (stringVar != NULL) {
2610     ckfree(stringVar);
2611       }
2612       if (strcmp(argv[5], "-") == 0) {
2613     stringVar = NULL;
2614       } else {
2615     stringVar = (char *) ckalloc((unsigned) (strlen(argv[5]) + 1));
2616     strcpy(stringVar, argv[5]);
2617       }
2618   }
2619   if (argv[6][0] != 0) {
2620       tmp = Tcl_NewStringObj(argv[6], -1);
2621       if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
2622     Tcl_DecrRefCount(tmp);
2623     return TCL_ERROR;
2624       }
2625       Tcl_DecrRefCount(tmp);
2626   }
2627     } else if (strcmp(argv[1], "update") == 0) {
2628   if (argc != 7) {
2629       Tcl_AppendResult(interp, "wrong # args: should be \"",
2630         argv[0], " ", argv[1],
2631         "intValue realValue boolValue stringValue wideValue\"",
2632         (char *) NULL);
2633       return TCL_ERROR;
2634   }
2635   if (argv[2][0] != 0) {
2636       if (Tcl_GetInt(interp, argv[2], &intVar) != TCL_OK) {
2637     return TCL_ERROR;
2638       }
2639       Tcl_UpdateLinkedVar(interp, "int");
2640   }
2641   if (argv[3][0] != 0) {
2642       if (Tcl_GetDouble(interp, argv[3], &realVar) != TCL_OK) {
2643     return TCL_ERROR;
2644       }
2645       Tcl_UpdateLinkedVar(interp, "real");
2646   }
2647   if (argv[4][0] != 0) {
2648       if (Tcl_GetInt(interp, argv[4], &boolVar) != TCL_OK) {
2649     return TCL_ERROR;
2650       }
2651       Tcl_UpdateLinkedVar(interp, "bool");
2652   }
2653   if (argv[5][0] != 0) {
2654       if (stringVar != NULL) {
2655     ckfree(stringVar);
2656       }
2657       if (strcmp(argv[5], "-") == 0) {
2658     stringVar = NULL;
2659       } else {
2660     stringVar = (char *) ckalloc((unsigned) (strlen(argv[5]) + 1));
2661     strcpy(stringVar, argv[5]);
2662       }
2663       Tcl_UpdateLinkedVar(interp, "string");
2664   }
2665   if (argv[6][0] != 0) {
2666       tmp = Tcl_NewStringObj(argv[6], -1);
2667       if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
2668     Tcl_DecrRefCount(tmp);
2669     return TCL_ERROR;
2670       }
2671       Tcl_DecrRefCount(tmp);
2672       Tcl_UpdateLinkedVar(interp, "wide");
2673   }
2674     } else {
2675   Tcl_AppendResult(interp, "bad option \"", argv[1],
2676     "\": should be create, delete, get, set, or update",
2677     (char *) NULL);
2678   return TCL_ERROR;
2679     }
2680     return TCL_OK;
2681 }
static int TestlocaleCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 2701 of file tclTest.c.
References CONST, NULL, TCL_ERROR, Tcl_GetIndexFromObj(), Tcl_GetObjResult(), Tcl_GetString(), TCL_OK, Tcl_SetStringObj(), and Tcl_WrongNumArgs().
Referenced by Tcltest_Init().2706 {
2707     int index;
2708     char *locale;
2709 
2710     static CONST char *optionStrings[] = {
2711       "ctype", "numeric", "time", "collate", "monetary", 
2712   "all",  NULL
2713     };
2714     static int lcTypes[] = {
2715   LC_CTYPE, LC_NUMERIC, LC_TIME, LC_COLLATE, LC_MONETARY,
2716   LC_ALL
2717     };
2718 
2719     /*
2720      * LC_CTYPE, etc. correspond to the indices for the strings.
2721      */
2722 
2723     if (objc < 2 || objc > 3) {
2724   Tcl_WrongNumArgs(interp, 1, objv, "category ?locale?");
2725   return TCL_ERROR;
2726     }
2727     
2728     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
2729       &index) != TCL_OK) {
2730   return TCL_ERROR;
2731     }
2732 
2733     if (objc == 3) {
2734   locale = Tcl_GetString(objv[2]);
2735     } else {
2736   locale = NULL;
2737     }
2738     locale = setlocale(lcTypes[index], locale);
2739     if (locale) {
2740   Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, -1);
2741     }
2742     return TCL_OK;
2743 }
static int TestmainthreadCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 4783 of file tclTest.c.
References TCL_ERROR, Tcl_GetCurrentThread(), Tcl_NewLongObj(), TCL_OK, Tcl_SetObjResult(), Tcl_SetResult(), and TCL_STATIC.
Referenced by Tcltest_Init().4788 {
4789   if (argc == 1) {
4790       Tcl_Obj *idObj = Tcl_NewLongObj((long)Tcl_GetCurrentThread());
4791       Tcl_SetObjResult(interp, idObj);
4792       return TCL_OK;
4793   } else {
4794       Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
4795       return TCL_ERROR;
4796   }
4797 }
static int TestMathFunc (ClientData clientData, Tcl_Interp * interp, Tcl_Value * args, Tcl_Value * resultPtr) [static]

Definition at line 2764 of file tclTest.c.
References TCL_INT, and TCL_OK.
Referenced by Tcltest_Init().2769 {
2770     resultPtr->type = TCL_INT;
2771     resultPtr->intValue = (int) clientData;
2772     return TCL_OK;
2773 }
static int TestMathFunc2 (ClientData clientData, Tcl_Interp * interp, Tcl_Value * args, Tcl_Value * resultPtr) [static]

Definition at line 2794 of file tclTest.c.
References TCL_DOUBLE, TCL_ERROR, TCL_INT, Tcl_LongAsWide, TCL_OK, Tcl_SetResult(), TCL_STATIC, TCL_WIDE_INT, and Tcl_WideAsDouble.
Referenced by Tcltest_Init().2801 {
2802     int result = TCL_OK;
2803     
2804     /*
2805      * Return the maximum of the two arguments with the correct type.
2806      */
2807     
2808     if (args[0].type == TCL_INT) {
2809   int i0 = args[0].intValue;
2810   
2811   if (args[1].type == TCL_INT) {
2812       int i1 = args[1].intValue;
2813       
2814       resultPtr->type = TCL_INT;
2815       resultPtr->intValue = ((i0 > i1)? i0 : i1);
2816   } else if (args[1].type == TCL_DOUBLE) {
2817       double d0 = i0;
2818       double d1 = args[1].doubleValue;
2819 
2820       resultPtr->type = TCL_DOUBLE;
2821       resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
2822   } else if (args[1].type == TCL_WIDE_INT) {
2823       Tcl_WideInt w0 = Tcl_LongAsWide(i0);
2824       Tcl_WideInt w1 = args[1].wideValue;
2825 
2826       resultPtr->type = TCL_WIDE_INT;
2827       resultPtr->wideValue = ((w0 > w1)? w0 : w1);
2828   } else {
2829       Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC);
2830       result = TCL_ERROR;
2831   }
2832     } else if (args[0].type == TCL_DOUBLE) {
2833   double d0 = args[0].doubleValue;
2834   
2835   if (args[1].type == TCL_INT) {
2836       double d1 = args[1].intValue;
2837       
2838       resultPtr->type = TCL_DOUBLE;
2839       resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
2840   } else if (args[1].type == TCL_DOUBLE) {
2841       double d1 = args[1].doubleValue;
2842 
2843       resultPtr->type = TCL_DOUBLE;
2844       resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
2845   } else if (args[1].type == TCL_WIDE_INT) {
2846       double d1 = Tcl_WideAsDouble(args[1].wideValue);
2847 
2848       resultPtr->type = TCL_DOUBLE;
2849       resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
2850   } else {
2851       Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC);
2852       result = TCL_ERROR;
2853   }
2854     } else if (args[0].type == TCL_WIDE_INT) {
2855   Tcl_WideInt w0 = args[0].wideValue;
2856   
2857   if (args[1].type == TCL_INT) {
2858       Tcl_WideInt w1 = Tcl_LongAsWide(args[1].intValue);
2859       
2860       resultPtr->type = TCL_WIDE_INT;
2861       resultPtr->wideValue = ((w0 > w1)? w0 : w1);
2862   } else if (args[1].type == TCL_DOUBLE) {
2863       double d0 = Tcl_WideAsDouble(w0);
2864       double d1 = args[1].doubleValue;
2865 
2866       resultPtr->type = TCL_DOUBLE;
2867       resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
2868   } else if (args[1].type == TCL_WIDE_INT) {
2869       Tcl_WideInt w1 = args[1].wideValue;
2870 
2871       resultPtr->type = TCL_WIDE_INT;
2872       resultPtr->wideValue = ((w0 > w1)? w0 : w1);
2873   } else {
2874       Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC);
2875       result = TCL_ERROR;
2876   }
2877     } else {
2878   Tcl_SetResult(interp, "T3: wrong type for arg 1", TCL_STATIC);
2879   result = TCL_ERROR;
2880     }
2881     return result;
2882 }
static int TestNumUtfCharsCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 6466 of file tclTest.c.
References Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_NewIntObj(), Tcl_NumUtfChars(), TCL_OK, Tcl_SetObjResult(), and void().
Referenced by Tcltest_Init().6471 {
6472     if (objc > 1) {
6473   int len = -1;
6474   if (objc > 2) {
6475       (void) Tcl_GetStringFromObj(objv[1], &len);
6476   }
6477   len = Tcl_NumUtfChars(Tcl_GetString(objv[1]), len);
6478   Tcl_SetObjResult(interp, Tcl_NewIntObj(len));
6479     }
6480     return TCL_OK;
6481 }
static Tcl_Channel TestOpenFileChannelProc1 (Tcl_Interp * interp, CONST char * fileName, CONST char * modeString, int permissions) [static]

Definition at line 5110 of file tclTest.c.
References CONST, NULL, PretendTclpOpenFileChannel(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, and Tcl_JoinPath().
Referenced by TestopenfilechannelprocCmd().5119 {
5120     CONST char *expectname="testOpenFileChannel1%.fil";
5121     Tcl_DString ds;
5122     
5123     Tcl_DStringInit(&ds);
5124     Tcl_JoinPath(1, &expectname, &ds);
5125 
5126     if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
5127   Tcl_DStringFree(&ds);
5128   return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel1%__.fil",
5129     modeString, permissions));
5130     } else {
5131   Tcl_DStringFree(&ds);
5132   return (NULL);
5133     }
5134 }
static Tcl_Channel TestOpenFileChannelProc2 (Tcl_Interp * interp, CONST char * fileName, CONST char * modeString, int permissions) [static]

Definition at line 5138 of file tclTest.c.
References CONST, NULL, PretendTclpOpenFileChannel(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, and Tcl_JoinPath().
Referenced by TestopenfilechannelprocCmd().5147 {
5148     CONST char *expectname="testOpenFileChannel2%.fil";
5149     Tcl_DString ds;
5150     
5151     Tcl_DStringInit(&ds);
5152     Tcl_JoinPath(1, &expectname, &ds);
5153 
5154     if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
5155   Tcl_DStringFree(&ds);
5156   return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel2%__.fil",
5157     modeString, permissions));
5158     } else {
5159   Tcl_DStringFree(&ds);
5160   return (NULL);
5161     }
5162 }
static Tcl_Channel TestOpenFileChannelProc3 (Tcl_Interp * interp, CONST char * fileName, CONST char * modeString, int permissions) [static]

Definition at line 5166 of file tclTest.c.
References CONST, NULL, PretendTclpOpenFileChannel(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, and Tcl_JoinPath().
Referenced by TestopenfilechannelprocCmd().5175 {
5176     CONST char *expectname="testOpenFileChannel3%.fil";
5177     Tcl_DString ds;
5178     
5179     Tcl_DStringInit(&ds);
5180     Tcl_JoinPath(1, &expectname, &ds);
5181 
5182     if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
5183   Tcl_DStringFree(&ds);
5184   return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel3%__.fil",
5185     modeString, permissions));
5186     } else {
5187   Tcl_DStringFree(&ds);
5188   return (NULL);
5189     }
5190 }
static int TestopenfilechannelprocCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 5012 of file tclTest.c.
References NULL, PretendTclpOpenFileChannel(), TCL_ERROR, TclOpenFileChannelDeleteProc(), TclOpenFileChannelInsertProc(), TestOpenFileChannelProc1(), TestOpenFileChannelProc2(), and TestOpenFileChannelProc3().
Referenced by Tcltest_Init().5017 {
5018     TclOpenFileChannelProc_ *proc;
5019     int retVal;
5020 
5021     if (argc != 3) {
5022   Tcl_AppendResult(interp, "wrong # args: should be \"",
5023     argv[0], " option arg\"", (char *) NULL);
5024   return TCL_ERROR;
5025     }
5026 
5027     if (strcmp(argv[2], "TclpOpenFileChannel") == 0) {
5028   proc = PretendTclpOpenFileChannel;
5029     } else if (strcmp(argv[2], "TestOpenFileChannelProc1") == 0) {
5030   proc = TestOpenFileChannelProc1;
5031     } else if (strcmp(argv[2], "TestOpenFileChannelProc2") == 0) {
5032   proc = TestOpenFileChannelProc2;
5033     } else if (strcmp(argv[2], "TestOpenFileChannelProc3") == 0) {
5034   proc = TestOpenFileChannelProc3;
5035     } else {
5036   Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
5037     "must be TclpOpenFileChannel, ",
5038     "TestOpenFileChannelProc1, TestOpenFileChannelProc2, or ",
5039     "TestOpenFileChannelProc3",
5040     (char *) NULL);
5041   return TCL_ERROR;
5042     }
5043 
5044     if (strcmp(argv[1], "insert") == 0) {
5045   if (proc == PretendTclpOpenFileChannel) {
5046       Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
5047        "must be ",
5048        "TestOpenFileChannelProc1, TestOpenFileChannelProc2, or ",
5049        "TestOpenFileChannelProc3",
5050        (char *) NULL);
5051       return TCL_ERROR;
5052   }
5053   retVal = TclOpenFileChannelInsertProc(proc);
5054     } else if (strcmp(argv[1], "delete") == 0) {
5055   retVal = TclOpenFileChannelDeleteProc(proc);
5056     } else {
5057   Tcl_AppendResult(interp, "bad option \"", argv[1], "\": ",
5058     "must be insert or delete", (char *) NULL);
5059   return TCL_ERROR;
5060     }
5061 
5062     if (retVal == TCL_ERROR) {
5063   Tcl_AppendResult(interp, "\"", argv[2], "\": ",
5064     "could not be ", argv[1], "ed", (char *) NULL);
5065     }
5066 
5067     return retVal;
5068 }
static int TestpanicCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 3983 of file tclTest.c.
References ckfree, CONST, panic, Tcl_Merge(), and TCL_OK.
Referenced by Tcltest_Init().3988 {
3989     CONST char *argString;
3990     
3991     /*
3992      *  Put the arguments into a var args structure
3993      *  Append all of the arguments together separated by spaces
3994      */
3995 
3996     argString = Tcl_Merge(argc-1, argv+1);
3997     panic(argString);
3998     ckfree((char *)argString);
3999  
4000     return TCL_OK;
4001 }
static int TestparserObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 2927 of file tclTest.c.
References parse(), PrintParse(), Tcl_AddErrorInfo(), TCL_ERROR, Tcl_FreeParse(), Tcl_GetIntFromObj(), Tcl_GetStringFromObj(), TCL_OK, Tcl_ParseCommand(), and Tcl_WrongNumArgs().
Referenced by Tcltest_Init().2932 {
2933     char *script;
2934     int length, dummy;
2935     Tcl_Parse parse;
2936 
2937     if (objc != 3) {
2938   Tcl_WrongNumArgs(interp, 1, objv, "script length");
2939   return TCL_ERROR;
2940     }
2941     script = Tcl_GetStringFromObj(objv[1], &dummy);
2942     if (Tcl_GetIntFromObj(interp, objv[2], &length)) {
2943   return TCL_ERROR;
2944     }
2945     if (length == 0) {
2946   length = dummy;
2947     }
2948     if (Tcl_ParseCommand(interp, script, length, 0, &parse) != TCL_OK) {
2949   Tcl_AddErrorInfo(interp, "\n    (remainder of script: \"");
2950   Tcl_AddErrorInfo(interp, parse.term);
2951   Tcl_AddErrorInfo(interp, "\")");
2952   return TCL_ERROR;
2953     }
2954 
2955     /*
2956      * The parse completed successfully.  Just print out the contents
2957      * of the parse structure into the interpreter's result.
2958      */
2959 
2960     PrintParse(interp, &parse);
2961     Tcl_FreeParse(&parse);
2962     return TCL_OK;
2963 }
static int TestparsevarnameObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 3166 of file tclTest.c.
References parse(), PrintParse(), Tcl_AddErrorInfo(), TCL_ERROR, Tcl_FreeParse(), Tcl_GetIntFromObj(), Tcl_GetStringFromObj(), TCL_OK, Tcl_ParseVarName(), and Tcl_WrongNumArgs().
Referenced by Tcltest_Init().3171 {
3172     char *script;
3173     int append, length, dummy;
3174     Tcl_Parse parse;
3175 
3176     if (objc != 4) {
3177   Tcl_WrongNumArgs(interp, 1, objv, "script length append");
3178   return TCL_ERROR;
3179     }
3180     script = Tcl_GetStringFromObj(objv[1], &dummy);
3181     if (Tcl_GetIntFromObj(interp, objv[2], &length)) {
3182   return TCL_ERROR;
3183     }
3184     if (length == 0) {
3185   length = dummy;
3186     }
3187     if (Tcl_GetIntFromObj(interp, objv[3], &append)) {
3188   return TCL_ERROR;
3189     }
3190     if (Tcl_ParseVarName(interp, script, length, &parse, append) != TCL_OK) {
3191   Tcl_AddErrorInfo(interp, "\n    (remainder of script: \"");
3192   Tcl_AddErrorInfo(interp, parse.term);
3193   Tcl_AddErrorInfo(interp, "\")");
3194   return TCL_ERROR;
3195     }
3196 
3197     /*
3198      * The parse completed successfully.  Just print out the contents
3199      * of the parse structure into the interpreter's result.
3200      */
3201 
3202     parse.commentSize = 0;
3203     parse.commandStart = script + parse.tokenPtr->size;
3204     parse.commandSize = 0;
3205     PrintParse(interp, &parse);
3206     Tcl_FreeParse(&parse);
3207     return TCL_OK;
3208 }
static int TestparsevarObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 3124 of file tclTest.c.
References CONST, NULL, Tcl_AppendElement(), TCL_ERROR, Tcl_GetString(), TCL_OK, Tcl_ParseVar(), and Tcl_WrongNumArgs().
Referenced by Tcltest_Init().3129 {
3130     CONST char *value;
3131     CONST char *name, *termPtr;
3132 
3133     if (objc != 2) {
3134   Tcl_WrongNumArgs(interp, 1, objv, "varName");
3135   return TCL_ERROR;
3136     }
3137     name = Tcl_GetString(objv[1]);
3138     value = Tcl_ParseVar(interp, name, &termPtr);
3139     if (value == NULL) {
3140   return TCL_ERROR;
3141     }
3142 
3143     Tcl_AppendElement(interp, value);
3144     Tcl_AppendElement(interp, termPtr);
3145     return TCL_OK;
3146 }
static int TestregexpObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 3231 of file tclTest.c.
References CONST, Tcl_RegExpIndices::end, Tcl_RegExpInfo::extendStart, Tcl_RegExpInfo::matches, Tcl_RegExpInfo::nsubs, NULL, REG_ADVANCED, REG_EXPANDED, REG_EXPECT, REG_ICASE, REG_NEWLINE, REG_NLANCH, REG_NLSTOP, Tcl_RegExpIndices::start, Tcl_DecrRefCount, TCL_ERROR, TCL_EXACT, Tcl_GetIndexFromObj(), Tcl_GetObjResult(), Tcl_GetRange(), Tcl_GetRegExpFromObj(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, TCL_INTEGER_SPACE, Tcl_NewListObj(), Tcl_NewLongObj(), Tcl_NewObj(), Tcl_ObjSetVar2(), TCL_OK, TCL_REG_CANMATCH, Tcl_RegExpExecObj(), Tcl_RegExpGetInfo(), Tcl_SetIntObj(), Tcl_SetVar(), Tcl_WrongNumArgs(), TclRegAbout(), TclRegExpRangeUniChar(), TestregexpXflags(), and varPtr.
Referenced by Tcltest_Init().3236 {
3237     int i, ii, indices, stringLength, match, about;
3238     int hasxflags, cflags, eflags;
3239     Tcl_RegExp regExpr;
3240     char *string;
3241     Tcl_Obj *objPtr;
3242     Tcl_RegExpInfo info;
3243     static CONST char *options[] = {
3244   "-indices", "-nocase",  "-about", "-expanded",
3245   "-line",  "-linestop",  "-lineanchor",
3246   "-xflags",
3247   "--",   (char *) NULL
3248     };
3249     enum options {
3250   REGEXP_INDICES, REGEXP_NOCASE,  REGEXP_ABOUT, REGEXP_EXPANDED,
3251   REGEXP_MULTI, REGEXP_NOCROSS, REGEXP_NEWL,
3252   REGEXP_XFLAGS,
3253   REGEXP_LAST
3254     };
3255 
3256     indices = 0;
3257     about = 0;
3258     cflags = REG_ADVANCED;
3259     eflags = 0;
3260     hasxflags = 0;
3261     
3262     for (i = 1; i < objc; i++) {
3263   char *name;
3264   int index;
3265 
3266   name = Tcl_GetString(objv[i]);
3267   if (name[0] != '-') {
3268       break;
3269   }
3270   if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
3271     &index) != TCL_OK) {
3272       return TCL_ERROR;
3273   }
3274   switch ((enum options) index) {
3275       case REGEXP_INDICES: {
3276     indices = 1;
3277     break;
3278       }
3279       case REGEXP_NOCASE: {
3280     cflags |= REG_ICASE;
3281     break;
3282       }
3283       case REGEXP_ABOUT: {
3284     about = 1;
3285     break;
3286       }
3287       case REGEXP_EXPANDED: {
3288     cflags |= REG_EXPANDED;
3289     break;
3290       }
3291       case REGEXP_MULTI: {
3292     cflags |= REG_NEWLINE;
3293     break;
3294       }
3295       case REGEXP_NOCROSS: {
3296     cflags |= REG_NLSTOP;
3297     break;
3298       }
3299       case REGEXP_NEWL: {
3300     cflags |= REG_NLANCH;
3301     break;
3302       }
3303       case REGEXP_XFLAGS: {
3304     hasxflags = 1;
3305     break;
3306       }
3307       case REGEXP_LAST: {
3308     i++;
3309     goto endOfForLoop;
3310       }
3311   }
3312     }
3313 
3314     endOfForLoop:
3315     if (objc - i < hasxflags + 2 - about) {
3316   Tcl_WrongNumArgs(interp, 1, objv,
3317     "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
3318   return TCL_ERROR;
3319     }
3320     objc -= i;
3321     objv += i;
3322 
3323     if (hasxflags) {
3324   string = Tcl_GetStringFromObj(objv[0], &stringLength);
3325   TestregexpXflags(string, stringLength, &cflags, &eflags);
3326   objc--;
3327   objv++;
3328     }
3329 
3330     regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
3331     if (regExpr == NULL) {
3332   return TCL_ERROR;
3333     }
3334     objPtr = objv[1];
3335 
3336     if (about) {
3337   if (TclRegAbout(interp, regExpr) < 0) {
3338       return TCL_ERROR;
3339   }
3340   return TCL_OK;
3341     }
3342 
3343     match = Tcl_RegExpExecObj(interp, regExpr, objPtr, 0 /* offset */,
3344       objc-2 /* nmatches */, eflags);
3345 
3346     if (match < 0) {
3347   return TCL_ERROR;
3348     }
3349     if (match == 0) {
3350   /*
3351    * Set the interpreter's object result to an integer object w/
3352    * value 0. 
3353    */
3354   
3355   Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
3356   if (objc > 2 && (cflags&REG_EXPECT) && indices) {
3357       char *varName;
3358       CONST char *value;
3359       int start, end;
3360       char resinfo[TCL_INTEGER_SPACE * 2];
3361 
3362       varName = Tcl_GetString(objv[2]);
3363       TclRegExpRangeUniChar(regExpr, -1, &start, &end);
3364       sprintf(resinfo, "%d %d", start, end-1);
3365       value = Tcl_SetVar(interp, varName, resinfo, 0);
3366       if (value == NULL) {
3367     Tcl_AppendResult(interp, "couldn't set variable \"",
3368       varName, "\"", (char *) NULL);
3369     return TCL_ERROR;
3370       }
3371   } else if (cflags & TCL_REG_CANMATCH) {
3372       char *varName;
3373       CONST char *value;
3374       char resinfo[TCL_INTEGER_SPACE * 2];
3375 
3376       Tcl_RegExpGetInfo(regExpr, &info);
3377       varName = Tcl_GetString(objv[2]);
3378       sprintf(resinfo, "%ld", info.extendStart);
3379       value = Tcl_SetVar(interp, varName, resinfo, 0);
3380       if (value == NULL) {
3381     Tcl_AppendResult(interp, "couldn't set variable \"",
3382       varName, "\"", (char *) NULL);
3383     return TCL_ERROR;
3384       }
3385   }
3386   return TCL_OK;
3387     }
3388 
3389     /*
3390      * If additional variable names have been specified, return
3391      * index information in those variables.
3392      */
3393 
3394     objc -= 2;
3395     objv += 2;
3396 
3397     Tcl_RegExpGetInfo(regExpr, &info);
3398     for (i = 0; i < objc; i++) {
3399   int start, end;
3400   Tcl_Obj *newPtr, *varPtr, *valuePtr;
3401   
3402   varPtr = objv[i];
3403   ii = ((cflags&REG_EXPECT) && i == objc-1) ? -1 : i;
3404   if (indices) {
3405       Tcl_Obj *objs[2];
3406 
3407       if (ii == -1) {
3408     TclRegExpRangeUniChar(regExpr, ii, &start, &end);
3409       } else if (ii > info.nsubs) {
3410     start = -1;
3411     end = -1;
3412       } else {
3413     start = info.matches[ii].start;
3414     end = info.matches[ii].end;
3415       }
3416 
3417       /*
3418        * Adjust index so it refers to the last character in the
3419        * match instead of the first character after the match.
3420        */
3421       
3422       if (end >= 0) {
3423     end--;
3424       }
3425 
3426       objs[0] = Tcl_NewLongObj(start);
3427       objs[1] = Tcl_NewLongObj(end);
3428 
3429       newPtr = Tcl_NewListObj(2, objs);
3430   } else {
3431       if (ii == -1) {
3432     TclRegExpRangeUniChar(regExpr, ii, &start, &end);
3433     newPtr = Tcl_GetRange(objPtr, start, end);
3434       } else if (ii > info.nsubs) {
3435     newPtr = Tcl_NewObj();
3436       } else {
3437     newPtr = Tcl_GetRange(objPtr, info.matches[ii].start,
3438       info.matches[ii].end - 1);
3439       }
3440   }
3441   Tcl_IncrRefCount(newPtr);
3442   valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, 0);
3443   Tcl_DecrRefCount(newPtr);
3444   if (valuePtr == NULL) {
3445       Tcl_AppendResult(interp, "couldn't set variable \"",
3446         Tcl_GetString(varPtr), "\"", (char *) NULL);
3447       return TCL_ERROR;
3448   }
3449     }
3450 
3451     /*
3452      * Set the interpreter's object result to an integer object w/ value 1. 
3453      */
3454   
3455     Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
3456     return TCL_OK;
3457 }
static void TestregexpXflags (char * string, int length, int * cflagsPtr, int * eflagsPtr) [static]

Definition at line 3477 of file tclTest.c.
References REG_ADVANCED, REG_ADVF, REG_BOSONLY, REG_DUMP, REG_EXPECT, REG_EXTENDED, REG_FAKE, REG_FTRACE, REG_MTRACE, REG_NOSUB, REG_NOTBOL, REG_NOTEOL, REG_PROGRESS, REG_QUOTE, REG_SMALL, and TCL_REG_CANMATCH.
Referenced by TestregexpObjCmd().3482 {
3483     int i;
3484     int cflags;
3485     int eflags;
3486 
3487     cflags = *cflagsPtr;
3488     eflags = *eflagsPtr;
3489     for (i = 0; i < length; i++) {
3490   switch (string[i]) {
3491       case 'a': {
3492     cflags |= REG_ADVF;
3493     break;
3494       }
3495       case 'b': {
3496     cflags &= ~REG_ADVANCED;
3497     break;
3498       }
3499       case 'c': {
3500     cflags |= TCL_REG_CANMATCH;
3501     break;
3502       }
3503       case 'e': {
3504     cflags &= ~REG_ADVANCED;
3505     cflags |= REG_EXTENDED;
3506     break;
3507       }
3508       case 'q': {
3509     cflags &= ~REG_ADVANCED;
3510     cflags |= REG_QUOTE;
3511     break;
3512       }
3513       case 'o': {     /* o for opaque */
3514     cflags |= REG_NOSUB;
3515     break;
3516       }
3517       case 's': {     /* s for start */
3518     cflags |= REG_BOSONLY;
3519     break;
3520       }
3521       case '+': {
3522     cflags |= REG_FAKE;
3523     break;
3524       }
3525       case ',': {
3526     cflags |= REG_PROGRESS;
3527     break;
3528       }
3529       case '.': {
3530     cflags |= REG_DUMP;
3531     break;
3532       }
3533       case ':': {
3534     eflags |= REG_MTRACE;
3535     break;
3536       }
3537       case ';': {
3538     eflags |= REG_FTRACE;
3539     break;
3540       }
3541       case '^': {
3542     eflags |= REG_NOTBOL;
3543     break;
3544       }
3545       case '$': {
3546     eflags |= REG_NOTEOL;
3547     break;
3548       }
3549       case 't': {
3550     cflags |= REG_EXPECT;
3551     break;
3552       }
3553       case '%': {
3554     eflags |= REG_SMALL;
3555     break;
3556       }
3557   }
3558     }
3559 
3560     *cflagsPtr = cflags;
3561     *eflagsPtr = eflags;
3562 }
static void TestReport (CONST char* cmd, Tcl_Obj* path, Tcl_Obj* arg2) [static]

Definition at line 6042 of file tclTest.c.
References NULL, Tcl_DStringAppend(), Tcl_DStringAppendElement(), Tcl_DStringEndSublist(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringStartSublist(), Tcl_DStringValue, Tcl_Eval(), Tcl_FSData(), Tcl_GetString(), Tcl_RestoreResult(), Tcl_SaveResult(), and testReportingFilesystem.
Referenced by TestReportAccess(), TestReportChdir(), TestReportCopyDirectory(), TestReportCopyFile(), TestReportCreateDirectory(), TestReportDeleteFile(), TestReportFileAttrsGet(), TestReportFileAttrsSet(), TestReportFileAttrStrings(), TestReportLink(), TestReportLoadFile(), TestReportLstat(), TestReportMatchInDirectory(), TestReportNormalizePath(), TestReportOpenFileChannel(), TestReportRemoveDirectory(), TestReportRenameFile(), TestReportStat(), and TestReportUtime().6046 {
6047     Tcl_Interp* interp = (Tcl_Interp*) Tcl_FSData(&testReportingFilesystem);
6048     if (interp == NULL) {
6049   /* This is bad, but not much we can do about it */
6050     } else {
6051   /* 
6052    * No idea why I decided to program this up using the
6053    * old string-based API, but there you go.  We should
6054    * convert it to objects.
6055    */
6056   Tcl_SavedResult savedResult;
6057   Tcl_DString ds;
6058   Tcl_DStringInit(&ds);
6059   Tcl_DStringAppend(&ds, "lappend filesystemReport ",-1);
6060   Tcl_DStringStartSublist(&ds);
6061   Tcl_DStringAppendElement(&ds, cmd);
6062   if (path != NULL) {
6063       Tcl_DStringAppendElement(&ds, Tcl_GetString(path));
6064   }
6065   if (arg2 != NULL) {
6066       Tcl_DStringAppendElement(&ds, Tcl_GetString(arg2));
6067   }
6068   Tcl_DStringEndSublist(&ds);
6069   Tcl_SaveResult(interp, &savedResult);
6070   Tcl_Eval(interp, Tcl_DStringValue(&ds));
6071   Tcl_DStringFree(&ds);
6072   Tcl_RestoreResult(interp, &savedResult);
6073    }
6074 }
static int TestReportAccess (Tcl_Obj * path, int mode) [static]

Definition at line 6093 of file tclTest.c.
References NULL, Tcl_FSAccess(), TestReport(), and TestReportGetNativePath().6096 {
6097     TestReport("access",path,NULL);
6098     return Tcl_FSAccess(TestReportGetNativePath(path),mode);
6099 }
static int TestReportChdir (Tcl_Obj * dirName) [static]

Definition at line 6135 of file tclTest.c.
References NULL, Tcl_FSChdir(), TestReport(), and TestReportGetNativePath().6137 {
6138     TestReport("chdir",dirName,NULL);
6139     return Tcl_FSChdir(TestReportGetNativePath(dirName));
6140 }
static int TestReportCopyDirectory (Tcl_Obj * src, Tcl_Obj * dst, Tcl_Obj ** errorPtr) [static]

Definition at line 6203 of file tclTest.c.
References Tcl_FSCopyDirectory(), TestReport(), and TestReportGetNativePath().6209 {
6210     TestReport("copydirectory",src,dst);
6211     return Tcl_FSCopyDirectory(TestReportGetNativePath(src), 
6212           TestReportGetNativePath(dst), errorPtr);
6213 }
static int TestReportCopyFile (Tcl_Obj * src, Tcl_Obj * dst) [static]

Definition at line 6180 of file tclTest.c.
References Tcl_FSCopyFile(), TestReport(), and TestReportGetNativePath().6183 {
6184     TestReport("copyfile",src,dst);
6185     return Tcl_FSCopyFile(TestReportGetNativePath(src), 
6186           TestReportGetNativePath(dst));
6187 }
static int TestReportCreateDirectory (Tcl_Obj * path) [static]

Definition at line 6196 of file tclTest.c.
References NULL, Tcl_FSCreateDirectory(), TestReport(), and TestReportGetNativePath().6198 {
6199     TestReport("createdirectory",path,NULL);
6200     return Tcl_FSCreateDirectory(TestReportGetNativePath(path));
6201 }
static int TestReportDeleteFile (Tcl_Obj * path) [static]

Definition at line 6189 of file tclTest.c.
References NULL, Tcl_FSDeleteFile(), TestReport(), and TestReportGetNativePath().6191 {
6192     TestReport("deletefile",path,NULL);
6193     return Tcl_FSDeleteFile(TestReportGetNativePath(path));
6194 }
static ClientData TestReportDupInternalRep (ClientData clientData) [static]

Definition at line 6035 of file tclTest.c.
References Tcl_IncrRefCount.6035                                                 {
6036     Tcl_Obj *original = (Tcl_Obj*)clientData;
6037     Tcl_IncrRefCount(original);
6038     return clientData;
6039 }
static int TestReportFileAttrsGet (Tcl_Interp * interp, int index, Tcl_Obj * fileName, Tcl_Obj ** objPtrRef) [static]

Definition at line 6237 of file tclTest.c.
References NULL, Tcl_FSFileAttrsGet(), TestReport(), and TestReportGetNativePath().6242 {
6243     TestReport("fileattributesget",fileName,NULL);
6244     return Tcl_FSFileAttrsGet(interp, index, 
6245             TestReportGetNativePath(fileName), objPtrRef);
6246 }
static int TestReportFileAttrsSet (Tcl_Interp * interp, int index, Tcl_Obj * fileName, Tcl_Obj * objPtr) [static]

Definition at line 6248 of file tclTest.c.
References Tcl_FSFileAttrsSet(), TestReport(), and TestReportGetNativePath().6253 {
6254     TestReport("fileattributesset",fileName,objPtr);
6255     return Tcl_FSFileAttrsSet(interp, index, 
6256             TestReportGetNativePath(fileName), objPtr);
6257 }
static CONST char** TestReportFileAttrStrings (Tcl_Obj* fileName, Tcl_Obj** objPtrRef) [static]

Definition at line 6229 of file tclTest.c.
References NULL, Tcl_FSFileAttrStrings(), TestReport(), and TestReportGetNativePath().6232 {
6233     TestReport("fileattributestrings",fileName,NULL);
6234     return Tcl_FSFileAttrStrings(TestReportGetNativePath(fileName), objPtrRef);
6235 }
static void TestReportFreeInternalRep (ClientData clientData) [static]

Definition at line 6026 of file tclTest.c.
References NULL, and Tcl_DecrRefCount.6026                                                  {
6027     Tcl_Obj *nativeRep = (Tcl_Obj*)clientData;
6028     if (nativeRep != NULL) {
6029   /* Free the path */
6030   Tcl_DecrRefCount(nativeRep);
6031     }
6032 }
static Tcl_Obj* TestReportGetNativePath (Tcl_Obj * pathObjPtr) [static]

Definition at line 6021 of file tclTest.c.
References Tcl_FSGetInternalRep(), and testReportingFilesystem.
Referenced by TestReportAccess(), TestReportChdir(), TestReportCopyDirectory(), TestReportCopyFile(), TestReportCreateDirectory(), TestReportDeleteFile(), TestReportFileAttrsGet(), TestReportFileAttrsSet(), TestReportFileAttrStrings(), TestReportLink(), TestReportLoadFile(), TestReportLstat(), TestReportMatchInDirectory(), TestReportOpenFileChannel(), TestReportRemoveDirectory(), TestReportRenameFile(), TestReportStat(), and TestReportUtime().6021                                              {
6022     return (Tcl_Obj*) Tcl_FSGetInternalRep(pathObjPtr, &testReportingFilesystem);
6023 }
static int TestReportInFilesystem (Tcl_Obj * pathPtr, ClientData * clientDataPtr) [static]

Definition at line 5989 of file tclTest.c.
References NULL, Tcl_DecrRefCount, Tcl_DuplicateObj(), Tcl_FSGetFileSystemForPath(), Tcl_IncrRefCount, and TCL_OK.5990 {
5991     static Tcl_Obj* lastPathPtr = NULL;
5992     
5993     if (pathPtr == lastPathPtr) {
5994   /* Reject all files second time around */
5995         return -1;
5996     } else {
5997   Tcl_Obj * newPathPtr;
5998   /* Try to claim all files first time around */
5999 
6000   newPathPtr = Tcl_DuplicateObj(pathPtr);
6001   lastPathPtr = newPathPtr;
6002   Tcl_IncrRefCount(newPathPtr);
6003   if (Tcl_FSGetFileSystemForPath(newPathPtr) == NULL) {
6004       /* Nothing claimed it.  Therefore we don't either */
6005       Tcl_DecrRefCount(newPathPtr);
6006       lastPathPtr = NULL;
6007       return -1;
6008   } else {
6009       lastPathPtr = NULL;
6010       *clientDataPtr = (ClientData) newPathPtr;
6011       return TCL_OK;
6012   }
6013     }
6014 }
static Tcl_Obj* TestReportLink (Tcl_Obj * path, Tcl_Obj * to, int linkType) [static]

Definition at line 6160 of file tclTest.c.
References Tcl_FSLink(), TestReport(), and TestReportGetNativePath().6164 {
6165     TestReport("link",path,to);
6166     return Tcl_FSLink(TestReportGetNativePath(path), to, linkType);
6167 }
static int TestReportLoadFile (Tcl_Interp * interp, Tcl_Obj * fileName, Tcl_LoadHandle * handlePtr, Tcl_FSUnloadFileProc ** unloadProcPtr) [static]

Definition at line 6142 of file tclTest.c.
References NULL, Tcl_FSLoadFile(), TestReport(), and TestReportGetNativePath().6154 {
6155     TestReport("loadfile",fileName,NULL);
6156     return Tcl_FSLoadFile(interp, TestReportGetNativePath(fileName), NULL, NULL,
6157         NULL, NULL, handlePtr, unloadProcPtr);
6158 }
static int TestReportLstat (Tcl_Obj * path, Tcl_StatBuf * buf) [static]

Definition at line 6085 of file tclTest.c.
References NULL, Tcl_FSLstat(), TestReport(), and TestReportGetNativePath().6088 {
6089     TestReport("lstat",path, NULL);
6090     return Tcl_FSLstat(TestReportGetNativePath(path),buf);
6091 }
static int TestReportMatchInDirectory (Tcl_Interp * interp, Tcl_Obj * resultPtr, Tcl_Obj * dirPtr, CONST char * pattern, Tcl_GlobTypeData * types) [static]

Definition at line 6116 of file tclTest.c.
References NULL, Tcl_FSMatchInDirectory(), TCL_GLOB_TYPE_MOUNT, TCL_OK, TestReport(), and TestReportGetNativePath().6123 {
6124     if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) {
6125   TestReport("matchmounts",dirPtr, NULL);
6126   return TCL_OK;
6127     } else {
6128   TestReport("matchindirectory",dirPtr, NULL);
6129   return Tcl_FSMatchInDirectory(interp, resultPtr, 
6130               TestReportGetNativePath(dirPtr), pattern, 
6131               types);
6132     }
6133 }
static int TestReportNormalizePath (Tcl_Interp * interp, Tcl_Obj * pathPtr, int nextCheckpoint) [static]

Definition at line 6267 of file tclTest.c.
References NULL, and TestReport().6271 {
6272     TestReport("normalizepath",pathPtr,NULL);
6273     return nextCheckpoint;
6274 }
static Tcl_Channel TestReportOpenFileChannel (Tcl_Interp * interp, Tcl_Obj * fileName, int mode, int permissions) [static]

Definition at line 6101 of file tclTest.c.
References NULL, TclpOpenFileChannel(), TestReport(), and TestReportGetNativePath().6109 {
6110     TestReport("open",fileName, NULL);
6111     return TclpOpenFileChannel(interp, TestReportGetNativePath(fileName),
6112          mode, permissions);
6113 }
static int TestReportRemoveDirectory (Tcl_Obj * path, int recursive, Tcl_Obj ** errorPtr) [static]

Definition at line 6215 of file tclTest.c.
References NULL, Tcl_FSRemoveDirectory(), TestReport(), and TestReportGetNativePath().6223 {
6224     TestReport("removedirectory",path,NULL);
6225     return Tcl_FSRemoveDirectory(TestReportGetNativePath(path), recursive, 
6226          errorPtr);
6227 }
static int TestReportRenameFile (Tcl_Obj * src, Tcl_Obj * dst) [static]

Definition at line 6169 of file tclTest.c.
References Tcl_FSRenameFile(), TestReport(), and TestReportGetNativePath().6174 {
6175     TestReport("renamefile",src,dst);
6176     return Tcl_FSRenameFile(TestReportGetNativePath(src), 
6177           TestReportGetNativePath(dst));
6178 }
static int TestReportStat (Tcl_Obj * path, Tcl_StatBuf * buf) [static]

Definition at line 6077 of file tclTest.c.
References NULL, Tcl_FSStat(), TestReport(), and TestReportGetNativePath().6080 {
6081     TestReport("stat",path, NULL);
6082     return Tcl_FSStat(TestReportGetNativePath(path),buf);
6083 }
static int TestReportUtime (Tcl_Obj* fileName, struct utimbuf * tval) [static]

Definition at line 6259 of file tclTest.c.
References NULL, Tcl_FSUtime(), TestReport(), and TestReportGetNativePath().6262 {
6263     TestReport("utime",fileName,NULL);
6264     return Tcl_FSUtime(TestReportGetNativePath(fileName), tval);
6265 }
static int TestsaveresultCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 4454 of file tclTest.c.
References ckalloc, CONST, freeCount, NULL, Tcl_AppendElement(), Tcl_DiscardResult(), TCL_DYNAMIC, TCL_ERROR, Tcl_Eval(), Tcl_EvalObjEx(), Tcl_GetBooleanFromObj(), Tcl_GetIndexFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_NewStringObj(), TCL_OK, Tcl_RestoreResult(), Tcl_SaveResult(), Tcl_SetObjResult(), Tcl_SetResult(), TCL_VOLATILE, Tcl_WrongNumArgs(), and TestsaveresultFree().
Referenced by Tcltest_Init().4459 {
4460     int discard, result, index;
4461     Tcl_SavedResult state;
4462     Tcl_Obj *objPtr;
4463     static CONST char *optionStrings[] = {
4464   "append", "dynamic", "free", "object", "small", NULL
4465     };
4466     enum options {
4467   RESULT_APPEND, RESULT_DYNAMIC, RESULT_FREE, RESULT_OBJECT, RESULT_SMALL
4468     };
4469 
4470     /*
4471      * Parse arguments
4472      */
4473 
4474     if (objc != 4) {
4475   Tcl_WrongNumArgs(interp, 1, objv, "type script discard");
4476         return TCL_ERROR;
4477     }
4478     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
4479       &index) != TCL_OK) {
4480   return TCL_ERROR;
4481     }
4482     if (Tcl_GetBooleanFromObj(interp, objv[3], &discard) != TCL_OK) {
4483   return TCL_ERROR;
4484     }
4485 
4486     objPtr = NULL;    /* Lint. */
4487     switch ((enum options) index) {
4488   case RESULT_SMALL:
4489       Tcl_SetResult(interp, "small result", TCL_VOLATILE);
4490       break;
4491   case RESULT_APPEND:
4492       Tcl_AppendResult(interp, "append result", NULL);
4493       break;
4494   case RESULT_FREE: {
4495       char *buf = ckalloc(200);
4496       strcpy(buf, "free result");
4497       Tcl_SetResult(interp, buf, TCL_DYNAMIC);
4498       break;
4499   }
4500   case RESULT_DYNAMIC:
4501       Tcl_SetResult(interp, "dynamic result", TestsaveresultFree);
4502       break;
4503   case RESULT_OBJECT:
4504       objPtr = Tcl_NewStringObj("object result", -1);
4505       Tcl_SetObjResult(interp, objPtr);
4506       break;
4507     }
4508 
4509     freeCount = 0;
4510     Tcl_SaveResult(interp, &state);
4511 
4512     if (((enum options) index) == RESULT_OBJECT) {
4513   result = Tcl_EvalObjEx(interp, objv[2], 0);
4514     } else {
4515   result = Tcl_Eval(interp, Tcl_GetString(objv[2]));
4516     }
4517 
4518     if (discard) {
4519   Tcl_DiscardResult(&state);
4520     } else {
4521   Tcl_RestoreResult(interp, &state);
4522   result = TCL_OK;
4523     }
4524 
4525     switch ((enum options) index) {
4526   case RESULT_DYNAMIC: {
4527       int present = interp->freeProc == TestsaveresultFree;
4528       int called = freeCount;
4529       Tcl_AppendElement(interp, called ? "called" : "notCalled");
4530       Tcl_AppendElement(interp, present ? "present" : "missing");
4531       break;
4532   }
4533   case RESULT_OBJECT:
4534       Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr
4535         ? "same" : "different");
4536       break;
4537   default:
4538       break;
4539     }
4540     return result;
4541 }
static void TestsaveresultFree (char * blockPtr) [static]

Definition at line 4560 of file tclTest.c.
References freeCount.
Referenced by TestsaveresultCmd().4562 {
4563     freeCount++;
4564 }
static int TestsetassocdataCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 3583 of file tclTest.c.
References ckalloc, ckfree, CleanupTestSetassocdataTests(), NULL, TCL_ERROR, Tcl_GetAssocData(), TCL_OK, and Tcl_SetAssocData().
Referenced by Tcltest_Init().3588 {
3589     char *buf;
3590     char *oldData;
3591     Tcl_InterpDeleteProc *procPtr;
3592     
3593     if (argc != 3) {
3594         Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
3595                 " data_key data_item\"", (char *) NULL);
3596         return TCL_ERROR;
3597     }
3598 
3599     buf = ckalloc((unsigned) strlen(argv[2]) + 1);
3600     strcpy(buf, argv[2]);
3601 
3602     /*
3603      * If we previously associated a malloced value with the variable,
3604      * free it before associating a new value.
3605      */
3606 
3607     oldData = (char *) Tcl_GetAssocData(interp, argv[1], &procPtr);
3608     if ((oldData != NULL) && (procPtr == CleanupTestSetassocdataTests)) {
3609   ckfree(oldData);
3610     }
3611     
3612     Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests, 
3613   (ClientData) buf);
3614     return TCL_OK;
3615 }
static int TestsetCmd (ClientData data, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 4402 of file tclTest.c.
References CONST, NULL, Tcl_AppendElement(), TCL_ERROR, Tcl_GetVar2(), TCL_OK, Tcl_SetResult(), Tcl_SetVar2(), and TCL_STATIC.
Referenced by Tcltest_Init().4407 {
4408     int flags = (int) data;
4409     CONST char *value;
4410 
4411     if (argc == 2) {
4412         Tcl_SetResult(interp, "before get", TCL_STATIC);
4413   value = Tcl_GetVar2(interp, argv[1], (char *) NULL, flags);
4414         if (value == NULL) {
4415             return TCL_ERROR;
4416         }
4417   Tcl_AppendElement(interp, value);
4418         return TCL_OK;
4419     } else if (argc == 3) {
4420   Tcl_SetResult(interp, "before set", TCL_STATIC);
4421         value = Tcl_SetVar2(interp, argv[1], (char *) NULL, argv[2], flags);
4422         if (value == NULL) {
4423             return TCL_ERROR;
4424         }
4425   Tcl_AppendElement(interp, value);
4426   return TCL_OK;
4427     } else {
4428   Tcl_AppendResult(interp, "wrong # args: should be \"",
4429     argv[0], " varName ?newValue?\"", (char *) NULL);
4430   return TCL_ERROR;
4431     }
4432 }
static int TestseterrorcodeCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 3838 of file tclTest.c.
References NULL, TCL_ERROR, Tcl_SetResult(), and TCL_STATIC.
Referenced by Tcltest_Init().3843 {
3844     if (argc > 6) {
3845   Tcl_SetResult(interp, "too many args", TCL_STATIC);
3846   return TCL_ERROR;
3847     }
3848     Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4],
3849       argv[5], NULL);
3850     return TCL_ERROR;
3851 }
static int TestsetmainloopCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 4843 of file tclTest.c.
References exitMainLoop, MainLoop(), TCL_OK, and Tcl_SetMainLoop().
Referenced by Tcltest_Init().4848 {
4849   exitMainLoop = 0;
4850   Tcl_SetMainLoop(MainLoop);
4851   return TCL_OK;
4852 }
static int TestsetobjerrorcodeCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 3873 of file tclTest.c.
References Tcl_ConcatObj(), Tcl_DecrRefCount, TCL_ERROR, Tcl_IncrRefCount, Tcl_NewObj(), and Tcl_SetObjErrorCode().
Referenced by Tcltest_Init().3878 {
3879     Tcl_Obj *listObjPtr;
3880 
3881     if (objc > 1) {
3882   listObjPtr = Tcl_ConcatObj(objc - 1, objv + 1);
3883     } else {
3884   listObjPtr = Tcl_NewObj();
3885     }
3886     Tcl_IncrRefCount(listObjPtr);
3887     Tcl_SetObjErrorCode(interp, listObjPtr);
3888     Tcl_DecrRefCount(listObjPtr);
3889     return TCL_ERROR;
3890 }
static int TestsetplatformCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 3636 of file tclTest.c.
References NULL, size_t(), TCL_ERROR, TCL_OK, TCL_PLATFORM_MAC, TCL_PLATFORM_UNIX, TCL_PLATFORM_WINDOWS, tclPlatform, and TclWinGetPlatform().
Referenced by Tcltest_Init().3641 {
3642     size_t length;
3643     TclPlatformType *platform;
3644 
3645 #ifdef __WIN32__
3646     platform = TclWinGetPlatform();
3647 #else
3648     platform = &tclPlatform;
3649 #endif
3650     
3651     if (argc != 2) {
3652         Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
3653                 " platform\"", (char *) NULL);
3654         return TCL_ERROR;
3655     }
3656 
3657     length = strlen(argv[1]);
3658     if (strncmp(argv[1], "unix", length) == 0) {
3659   *platform = TCL_PLATFORM_UNIX;
3660     } else if (strncmp(argv[1], "mac", length) == 0) {
3661   *platform = TCL_PLATFORM_MAC;
3662     } else if (strncmp(argv[1], "windows", length) == 0) {
3663   *platform = TCL_PLATFORM_WINDOWS;
3664     } else {
3665         Tcl_AppendResult(interp, "unsupported platform: should be one of ",
3666     "unix, mac, or windows", (char *) NULL);
3667   return TCL_ERROR;
3668     }
3669     return TCL_OK;
3670 }
static int TestSimpleFilesystemObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 6316 of file tclTest.c.
References NULL, simpleFilesystem, simpleInterpPtr, Tcl_DecrRefCount, TCL_ERROR, Tcl_FSDeleteFile(), Tcl_FSRegister(), Tcl_FSUnregister(), Tcl_GetBooleanFromObj(), TCL_OK, Tcl_SetResult(), TCL_VOLATILE, Tcl_WrongNumArgs(), and tempFile.
Referenced by Tcltest_Init().6321 {
6322     int res, boolVal;
6323     char *msg;
6324     
6325     if (objc != 2) {
6326   Tcl_WrongNumArgs(interp, 1, objv, "boolean");
6327   return TCL_ERROR;
6328     }
6329     if (Tcl_GetBooleanFromObj(interp, objv[1], &boolVal) != TCL_OK) {
6330   return TCL_ERROR;
6331     }
6332     if (boolVal) {
6333   res = Tcl_FSRegister((ClientData)interp, &simpleFilesystem);
6334   msg = (res == TCL_OK) ? "registered" : "failed";
6335   simpleInterpPtr = interp;
6336     } else {
6337   if (tempFile != NULL) {
6338       Tcl_FSDeleteFile(tempFile);
6339       Tcl_DecrRefCount(tempFile);
6340       tempFile = NULL;
6341   }
6342   res = Tcl_FSUnregister(&simpleFilesystem);
6343   msg = (res == TCL_OK) ? "unregistered" : "failed";
6344   simpleInterpPtr = NULL;
6345     }
6346     Tcl_SetResult(interp, msg, TCL_VOLATILE);
6347     return res;
6348 }
static int TeststaticpkgCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 3691 of file tclTest.c.
References NULL, StaticInitProc(), TCL_ERROR, Tcl_GetInt(), TCL_OK, and Tcl_StaticPackage().
Referenced by Tcltest_Init().3696 {
3697     int safe, loaded;
3698 
3699     if (argc != 4) {
3700   Tcl_AppendResult(interp, "wrong # arguments: should be \"",
3701     argv[0], " pkgName safe loaded\"", (char *) NULL);
3702   return TCL_ERROR;
3703     }
3704     if (Tcl_GetInt(interp, argv[2], &safe) != TCL_OK) {
3705   return TCL_ERROR;
3706     }
3707     if (Tcl_GetInt(interp, argv[3], &loaded) != TCL_OK) {
3708   return TCL_ERROR;
3709     }
3710     Tcl_StaticPackage((loaded) ? interp : NULL, argv[1], StaticInitProc,
3711       (safe) ? StaticInitProc : NULL);
3712     return TCL_OK;
3713 }
static int TestStatProc1 (CONST char * path, struct stat * buf) [static]

Definition at line 4734 of file tclTest.c.
References NULL, and strstr().
Referenced by TeststatprocCmd().4737 {
4738     memset(buf, 0, sizeof(struct stat));
4739     buf->st_size = 1234;
4740     return ((strstr(path, "testStat1%.fil") == NULL) ? -1 : 0);
4741 }
static int TestStatProc2 (CONST char * path, struct stat * buf) [static]

Definition at line 4745 of file tclTest.c.
References NULL, and strstr().
Referenced by TeststatprocCmd().4748 {
4749     memset(buf, 0, sizeof(struct stat));
4750     buf->st_size = 2345;
4751     return ((strstr(path, "testStat2%.fil") == NULL) ? -1 : 0);
4752 }
static int TestStatProc3 (CONST char * path, struct stat * buf) [static]

Definition at line 4756 of file tclTest.c.
References NULL, and strstr().
Referenced by TeststatprocCmd().4759 {
4760     memset(buf, 0, sizeof(struct stat));
4761     buf->st_size = 3456;
4762     return ((strstr(path, "testStat3%.fil") == NULL) ? -1 : 0);
4763 }
static int TeststatprocCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 4584 of file tclTest.c.
References NULL, PretendTclpStat(), TCL_ERROR, TclStatDeleteProc(), TclStatInsertProc(), TestStatProc1(), TestStatProc2(), and TestStatProc3().
Referenced by Tcltest_Init().4589 {
4590     TclStatProc_ *proc;
4591     int retVal;
4592 
4593     if (argc != 3) {
4594   Tcl_AppendResult(interp, "wrong # args: should be \"",
4595     argv[0], " option arg\"", (char *) NULL);
4596   return TCL_ERROR;
4597     }
4598 
4599     if (strcmp(argv[2], "TclpStat") == 0) {
4600   proc = PretendTclpStat;
4601     } else if (strcmp(argv[2], "TestStatProc1") == 0) {
4602   proc = TestStatProc1;
4603     } else if (strcmp(argv[2], "TestStatProc2") == 0) {
4604   proc = TestStatProc2;
4605     } else if (strcmp(argv[2], "TestStatProc3") == 0) {
4606   proc = TestStatProc3;
4607     } else {
4608   Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
4609     "must be TclpStat, ",
4610     "TestStatProc1, TestStatProc2, or TestStatProc3",
4611     (char *) NULL);
4612   return TCL_ERROR;
4613     }
4614 
4615     if (strcmp(argv[1], "insert") == 0) {
4616   if (proc == PretendTclpStat) {
4617       Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
4618        "must be ",
4619        "TestStatProc1, TestStatProc2, or TestStatProc3",
4620        (char *) NULL);
4621       return TCL_ERROR;
4622   }
4623   retVal = TclStatInsertProc(proc);
4624     } else if (strcmp(argv[1], "delete") == 0) {
4625   retVal = TclStatDeleteProc(proc);
4626     } else {
4627   Tcl_AppendResult(interp, "bad option \"", argv[1], "\": ",
4628     "must be insert or delete", (char *) NULL);
4629   return TCL_ERROR;
4630     }
4631 
4632     if (retVal == TCL_ERROR) {
4633   Tcl_AppendResult(interp, "\"", argv[2], "\": ",
4634     "could not be ", argv[1], "ed", (char *) NULL);
4635     }
4636 
4637     return retVal;
4638 }
static int TesttranslatefilenameCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 3742 of file tclTest.c.
References CONST, NULL, Tcl_DStringFree(), TCL_ERROR, TCL_OK, and Tcl_TranslateFileName().
Referenced by Tcltest_Init().3747 {
3748     Tcl_DString buffer;
3749     CONST char *result;
3750 
3751     if (argc != 2) {
3752   Tcl_AppendResult(interp, "wrong # arguments: should be \"",
3753     argv[0], " path\"", (char *) NULL);
3754   return TCL_ERROR;
3755     }
3756     result = Tcl_TranslateFileName(interp, argv[1], &buffer);
3757     if (result == NULL) {
3758   return TCL_ERROR;
3759     }
3760     Tcl_AppendResult(interp, result, NULL);
3761     Tcl_DStringFree(&buffer);
3762     return TCL_OK;
3763 }
static int TestupvarCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 3784 of file tclTest.c.
References NULL, TCL_ERROR, TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, Tcl_UpVar(), and Tcl_UpVar2().
Referenced by Tcltest_Init().3789 {
3790     int flags = 0;
3791     
3792     if ((argc != 5) && (argc != 6)) {
3793   Tcl_AppendResult(interp, "wrong # arguments: should be \"",
3794     argv[0], " level name ?name2? dest global\"", (char *) NULL);
3795   return TCL_ERROR;
3796     }
3797 
3798     if (argc == 5) {
3799   if (strcmp(argv[4], "global") == 0) {
3800       flags = TCL_GLOBAL_ONLY;
3801   } else if (strcmp(argv[4], "namespace") == 0) {
3802       flags = TCL_NAMESPACE_ONLY;
3803   }
3804   return Tcl_UpVar(interp, argv[1], argv[2], argv[3], flags);
3805     } else {
3806   if (strcmp(argv[5], "global") == 0) {
3807       flags = TCL_GLOBAL_ONLY;
3808   } else if (strcmp(argv[5], "namespace") == 0) {
3809       flags = TCL_NAMESPACE_ONLY;
3810   }
3811   return Tcl_UpVar2(interp, argv[1], argv[2], 
3812     (argv[3][0] == 0) ? (char *) NULL : argv[3], argv[4],
3813     flags);
3814     }
3815 }
static int TestWrongNumArgsObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 5851 of file tclTest.c.
References NULL, TCL_ERROR, Tcl_GetIntFromObj(), Tcl_GetStringFromObj(), TCL_OK, Tcl_SetResult(), TCL_STATIC, and Tcl_WrongNumArgs().
Referenced by Tcltest_Init().5856 {
5857     int i, length;
5858     char *msg;
5859 
5860     if (objc < 3) {
5861   /*
5862    * Don't use Tcl_WrongNumArgs here, as that is the function
5863    * we want to test!
5864    */
5865   Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC);
5866   return TCL_ERROR;
5867     }
5868     
5869     if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) {
5870   return TCL_ERROR;
5871     }
5872 
5873     msg = Tcl_GetStringFromObj(objv[2], &length);
5874     if (length == 0) {
5875   msg = NULL;
5876     }
5877     
5878     if (i > objc - 3) {
5879   /*
5880    * Asked for more arguments than were given.
5881    */
5882   Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC);
5883   return TCL_ERROR;
5884     }
5885 
5886     Tcl_WrongNumArgs(interp, i, &(objv[3]), msg);
5887     return TCL_OK;
5888 }

Variable Documentation
Tcl_Trace cmdTrace [static]

Definition at line 78 of file tclTest.c.
Referenced by CmdTraceDeleteProc(), and TestcmdtraceCmd().Tcl_Interp* delInterp [static]

Definition at line 49 of file tclTest.c.
Referenced by DelCallbackProc(), and TestdcallCmd().Tcl_DString delString [static]

Definition at line 48 of file tclTest.c.
Referenced by CmdDelProc1(), CmdDelProc2(), DelCallbackProc(), TestcmdinfoCmd(), and TestdcallCmd().Tcl_DString dstring [static]

Definition at line 71 of file tclTest.c.
Referenced by ComparePkgVersions(), TclpCreateTempFile(), Tcltest_Init(), and TestdstringCmd().int exitMainLoop = 0 [static]

Definition at line 113 of file tclTest.c.
Referenced by MainLoop(), TestexitmainloopCmd(), and TestsetmainloopCmd().TestAsyncHandler* firstHandler = NULL [static]

Definition at line 64 of file tclTest.c.
Referenced by TestasyncCmd().int freeCount [static]

Definition at line 107 of file tclTest.c.
Referenced by TestsaveresultCmd(), and TestsaveresultFree().Tcl_Filesystem simpleFilesystem [static]

Definition at line 461 of file tclTest.c.
Referenced by TestSimpleFilesystemObjCmd().Tcl_Interp* simpleInterpPtr = NULL [static]

Definition at line 6290 of file tclTest.c.
Referenced by SimpleCopy(), and TestSimpleFilesystemObjCmd().Tcl_Obj* tempFile = NULL [static]

Definition at line 6292 of file tclTest.c.
Referenced by SimpleOpenFileChannel(), and TestSimpleFilesystemObjCmd().Tcl_Filesystem testReportingFilesystem [static]

Definition at line 427 of file tclTest.c.
Referenced by TestFilesystemObjCmd(), TestReport(), and TestReportGetNativePath().

generic/tclTestObj.c File Reference
#include "tclInt.h"
Classes
struct TestString
Defines
#define NUMBER_OF_OBJECT_VARS  20
#define MAX_STRINGS  11
Functions
static int CheckIfVarUnset _ANSI_ARGS_ ((Tcl_Interp *interp, int varIndex))
static int GetVariableIndex _ANSI_ARGS_ ((Tcl_Interp *interp, char *string, int *indexPtr))
static void SetVarToObj _ANSI_ARGS_ ((int varIndex, Tcl_Obj *objPtr))
int TclObjTest_Init _ANSI_ARGS_ ((Tcl_Interp *interp))
static int TestbooleanobjCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
int TclObjTest_Init (Tcl_Interp *interp)
static int TestbooleanobjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static int TestconvertobjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static int TestdoubleobjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static int TestindexobjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static int TestintobjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static int TestobjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static int TeststringobjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static void SetVarToObj (int varIndex, Tcl_Obj *objPtr)
static int GetVariableIndex (Tcl_Interp *interp, char *string, int *indexPtr)
static int CheckIfVarUnset (Tcl_Interp *interp, int varIndex)
Variables
static Tcl_Obj * varPtr [NUMBER_OF_OBJECT_VARS]

Define Documentation
#define MAX_STRINGS  11

Referenced by TeststringobjCmd().#define NUMBER_OF_OBJECT_VARS  20

Definition at line 26 of file tclTestObj.c.
Referenced by GetVariableIndex(), TclObjTest_Init(), and TestobjCmd().
Function Documentation
static int TestbooleanobjCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])) [static]
int TclObjTest_Init _ANSI_ARGS_ ((Tcl_Interp *interp))
static void SetVarToObj _ANSI_ARGS_ ((int varIndex, Tcl_Obj *objPtr)) [static]
static int GetVariableIndex _ANSI_ARGS_ ((Tcl_Interp *interp, char *string, int *indexPtr)) [static]
static int CheckIfVarUnset _ANSI_ARGS_ ((Tcl_Interp *interp, int varIndex)) [static]
static int CheckIfVarUnset (Tcl_Interp * interp, int varIndex) [static]

Definition at line 1179 of file tclTestObj.c.
References Tcl_AppendToObj(), Tcl_GetObjResult(), TCL_INTEGER_SPACE, Tcl_ResetResult(), and varPtr.
Referenced by TestbooleanobjCmd(), TestdoubleobjCmd(), TestintobjCmd(), TestobjCmd(), and TeststringobjCmd().1182 {
1183     if (varPtr[varIndex] == NULL) {
1184   char buf[32 + TCL_INTEGER_SPACE];
1185   
1186   sprintf(buf, "variable %d is unset (NULL)", varIndex);
1187   Tcl_ResetResult(interp);
1188   Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
1189   return 1;
1190     }
1191     return 0;
1192 }
static int GetVariableIndex (Tcl_Interp * interp, char * string, int * indexPtr) [static]

Definition at line 1138 of file tclTestObj.c.
References NUMBER_OF_OBJECT_VARS, Tcl_AppendToObj(), TCL_ERROR, Tcl_GetInt(), Tcl_GetObjResult(), TCL_OK, and Tcl_ResetResult().
Referenced by TestbooleanobjCmd(), TestdoubleobjCmd(), TestintobjCmd(), TestobjCmd(), and TeststringobjCmd().1144 {
1145     int index;
1146     
1147     if (Tcl_GetInt(interp, string, &index) != TCL_OK) {
1148   return TCL_ERROR;
1149     }
1150     if (index < 0 || index >= NUMBER_OF_OBJECT_VARS) {
1151   Tcl_ResetResult(interp);
1152   Tcl_AppendToObj(Tcl_GetObjResult(interp), "bad variable index", -1);
1153   return TCL_ERROR;
1154     }
1155 
1156     *indexPtr = index;
1157     return TCL_OK;
1158 }
static void SetVarToObj (int varIndex, Tcl_Obj * objPtr) [static]

Definition at line 1108 of file tclTestObj.c.
References Tcl_DecrRefCount, Tcl_IncrRefCount, and varPtr.
Referenced by TestbooleanobjCmd(), TestdoubleobjCmd(), TestintobjCmd(), TestobjCmd(), and TeststringobjCmd().1111 {
1112     if (varPtr[varIndex] != NULL) {
1113   Tcl_DecrRefCount(varPtr[varIndex]);
1114     }
1115     varPtr[varIndex] = objPtr;
1116     if (objPtr != NULL) {
1117   Tcl_IncrRefCount(objPtr);
1118     }
1119 }
int TclObjTest_Init (Tcl_Interp * interp)

Definition at line 89 of file tclTestObj.c.
References NULL, NUMBER_OF_OBJECT_VARS, Tcl_CreateObjCommand(), TCL_OK, TestbooleanobjCmd(), TestconvertobjCmd(), TestdoubleobjCmd(), TestindexobjCmd(), TestintobjCmd(), TestobjCmd(), TeststringobjCmd(), and varPtr.
Referenced by Tcl_AppInit().91 {
92     register int i;
93     
94     for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
95         varPtr[i] = NULL;
96     }
97   
98     Tcl_CreateObjCommand(interp, "testbooleanobj", TestbooleanobjCmd,
99       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
100     Tcl_CreateObjCommand(interp, "testconvertobj", TestconvertobjCmd,
101       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
102     Tcl_CreateObjCommand(interp, "testdoubleobj", TestdoubleobjCmd,
103       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
104     Tcl_CreateObjCommand(interp, "testintobj", TestintobjCmd,
105       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
106     Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd,
107       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
108     Tcl_CreateObjCommand(interp, "testobj", TestobjCmd,
109       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
110     Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd,
111       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
112     return TCL_OK;
113 }
static int TestbooleanobjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 134 of file tclTestObj.c.
References CheckIfVarUnset(), GetVariableIndex(), NULL, SetVarToObj(), TCL_ERROR, Tcl_GetBooleanFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_IsShared, Tcl_NewBooleanObj(), TCL_OK, Tcl_SetBooleanObj(), Tcl_SetObjResult(), Tcl_WrongNumArgs(), and varPtr.
Referenced by TclObjTest_Init().139 {
140     int varIndex, boolValue;
141     char *index, *subCmd;
142 
143     if (objc < 3) {
144   wrongNumArgs:
145   Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
146   return TCL_ERROR;
147     }
148 
149     index = Tcl_GetString(objv[2]);
150     if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
151   return TCL_ERROR;
152     }
153 
154     subCmd = Tcl_GetString(objv[1]);
155     if (strcmp(subCmd, "set") == 0) {
156   if (objc != 4) {
157       goto wrongNumArgs;
158   }
159   if (Tcl_GetBooleanFromObj(interp, objv[3], &boolValue) != TCL_OK) {
160       return TCL_ERROR;
161   }
162 
163   /*
164    * If the object currently bound to the variable with index varIndex
165    * has ref count 1 (i.e. the object is unshared) we can modify that
166    * object directly. Otherwise, if RC>1 (i.e. the object is shared),
167    * we must create a new object to modify/set and decrement the old
168    * formerly-shared object's ref count. This is "copy on write".
169    */
170 
171   if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
172       Tcl_SetBooleanObj(varPtr[varIndex], boolValue);
173   } else {
174       SetVarToObj(varIndex, Tcl_NewBooleanObj(boolValue));
175   }
176   Tcl_SetObjResult(interp, varPtr[varIndex]);
177     } else if (strcmp(subCmd, "get") == 0) {
178   if (objc != 3) {
179       goto wrongNumArgs;
180   }
181   if (CheckIfVarUnset(interp, varIndex)) {
182       return TCL_ERROR;
183   }
184   Tcl_SetObjResult(interp, varPtr[varIndex]);
185     } else if (strcmp(subCmd, "not") == 0) {
186   if (objc != 3) {
187       goto wrongNumArgs;
188   }
189   if (CheckIfVarUnset(interp, varIndex)) {
190       return TCL_ERROR;
191   }
192   if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
193           &boolValue) != TCL_OK) {
194       return TCL_ERROR;
195   }
196   if (!Tcl_IsShared(varPtr[varIndex])) {
197       Tcl_SetBooleanObj(varPtr[varIndex], !boolValue);
198   } else {
199       SetVarToObj(varIndex, Tcl_NewBooleanObj(!boolValue));
200   }
201   Tcl_SetObjResult(interp, varPtr[varIndex]);
202     } else {
203   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
204     "bad option \"", Tcl_GetString(objv[1]),
205     "\": must be set, get, or not", (char *) NULL);
206   return TCL_ERROR;
207     }
208     return TCL_OK;
209 }
static int TestconvertobjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 229 of file tclTestObj.c.
References NULL, Tcl_AppendToObj(), TCL_ERROR, Tcl_GetDoubleFromObj(), Tcl_GetObjResult(), Tcl_GetString(), TCL_OK, and Tcl_WrongNumArgs().
Referenced by TclObjTest_Init().234 {
235     char *subCmd;
236     char buf[20];
237 
238     if (objc < 3) {
239   wrongNumArgs:
240   Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
241   return TCL_ERROR;
242     }
243 
244     subCmd = Tcl_GetString(objv[1]);
245     if (strcmp(subCmd, "double") == 0) {
246   double d;
247 
248   if (objc != 3) {
249       goto wrongNumArgs;
250   }
251   if (Tcl_GetDoubleFromObj(interp, objv[2], &d) != TCL_OK) {
252       return TCL_ERROR;
253   }
254   sprintf(buf, "%f", d);
255         Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
256     } else {
257   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
258     "bad option \"", Tcl_GetString(objv[1]),
259     "\": must be double", (char *) NULL);
260   return TCL_ERROR;
261     }
262     return TCL_OK;
263 }
static int TestdoubleobjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 285 of file tclTestObj.c.
References CheckIfVarUnset(), GetVariableIndex(), NULL, SetVarToObj(), TCL_ERROR, Tcl_GetDouble(), Tcl_GetDoubleFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_IsShared, Tcl_NewDoubleObj(), TCL_OK, Tcl_SetDoubleObj(), Tcl_SetObjResult(), Tcl_WrongNumArgs(), and varPtr.
Referenced by TclObjTest_Init().290 {
291     int varIndex;
292     double doubleValue;
293     char *index, *subCmd, *string;
294   
295     if (objc < 3) {
296   wrongNumArgs:
297   Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
298   return TCL_ERROR;
299     }
300 
301     index = Tcl_GetString(objv[2]);
302     if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
303   return TCL_ERROR;
304     }
305 
306     subCmd = Tcl_GetString(objv[1]);
307     if (strcmp(subCmd, "set") == 0) {
308   if (objc != 4) {
309       goto wrongNumArgs;
310   }
311   string = Tcl_GetString(objv[3]);
312   if (Tcl_GetDouble(interp, string, &doubleValue) != TCL_OK) {
313       return TCL_ERROR;
314   }
315 
316   /*
317    * If the object currently bound to the variable with index varIndex
318    * has ref count 1 (i.e. the object is unshared) we can modify that
319    * object directly. Otherwise, if RC>1 (i.e. the object is shared),
320    * we must create a new object to modify/set and decrement the old
321    * formerly-shared object's ref count. This is "copy on write".
322    */
323 
324   if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
325       Tcl_SetDoubleObj(varPtr[varIndex], doubleValue);
326   } else {
327       SetVarToObj(varIndex, Tcl_NewDoubleObj(doubleValue));
328   }
329   Tcl_SetObjResult(interp, varPtr[varIndex]);
330     } else if (strcmp(subCmd, "get") == 0) {
331   if (objc != 3) {
332       goto wrongNumArgs;
333   }
334   if (CheckIfVarUnset(interp, varIndex)) {
335       return TCL_ERROR;
336   }
337   Tcl_SetObjResult(interp, varPtr[varIndex]);
338     } else if (strcmp(subCmd, "mult10") == 0) {
339   if (objc != 3) {
340       goto wrongNumArgs;
341   }
342   if (CheckIfVarUnset(interp, varIndex)) {
343       return TCL_ERROR;
344   }
345   if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
346          &doubleValue) != TCL_OK) {
347       return TCL_ERROR;
348   }
349   if (!Tcl_IsShared(varPtr[varIndex])) {
350       Tcl_SetDoubleObj(varPtr[varIndex], (doubleValue * 10.0));
351   } else {
352       SetVarToObj(varIndex, Tcl_NewDoubleObj( (doubleValue * 10.0) ));
353   }
354   Tcl_SetObjResult(interp, varPtr[varIndex]);
355     } else if (strcmp(subCmd, "div10") == 0) {
356   if (objc != 3) {
357       goto wrongNumArgs;
358   }
359   if (CheckIfVarUnset(interp, varIndex)) {
360       return TCL_ERROR;
361   }
362   if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
363          &doubleValue) != TCL_OK) {
364       return TCL_ERROR;
365   }
366   if (!Tcl_IsShared(varPtr[varIndex])) {
367       Tcl_SetDoubleObj(varPtr[varIndex], (doubleValue / 10.0));
368   } else {
369       SetVarToObj(varIndex, Tcl_NewDoubleObj( (doubleValue / 10.0) ));
370   }
371   Tcl_SetObjResult(interp, varPtr[varIndex]);
372     } else {
373   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
374     "bad option \"", Tcl_GetString(objv[1]),
375     "\": must be set, get, mult10, or div10", (char *) NULL);
376   return TCL_ERROR;
377     }
378     return TCL_OK;
379 }
static int TestindexobjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 400 of file tclTestObj.c.
References ckalloc, CONST, IndexRep::index, NULL, IndexRep::offset, IndexRep::tablePtr, Tcl_AppendToObj(), TCL_ERROR, Tcl_GetBooleanFromObj(), Tcl_GetIndexFromObj(), Tcl_GetIntFromObj(), Tcl_GetObjResult(), Tcl_GetString(), TCL_OK, Tcl_SetIntObj(), and VOID.
Referenced by TclObjTest_Init().405 {
406     int allowAbbrev, index, index2, setError, i, result;
407     CONST char **argv;
408     static CONST char *tablePtr[] = {"a", "b", "check", (char *) NULL};
409     /*
410      * Keep this structure declaration in sync with tclIndexObj.c
411      */
412     struct IndexRep {
413   VOID *tablePtr;     /* Pointer to the table of strings */
414   int offset;     /* Offset between table entries */
415   int index;      /* Selected index into table. */
416     };
417     struct IndexRep *indexRep;
418 
419     if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]),
420       "check") == 0)) {
421   /*
422    * This code checks to be sure that the results of
423    * Tcl_GetIndexFromObj are properly cached in the object and
424    * returned on subsequent lookups.
425    */
426 
427   if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) {
428       return TCL_ERROR;
429   }
430 
431   Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1], tablePtr,
432     "token", 0, &index);
433   indexRep = (struct IndexRep *) objv[1]->internalRep.otherValuePtr;
434   indexRep->index = index2;
435   result = Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1],
436     tablePtr, "token", 0, &index);
437   if (result == TCL_OK) {
438       Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
439   }
440   return result;
441     }
442 
443     if (objc < 5) {
444   Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args", -1);
445   return TCL_ERROR;
446     }
447 
448     if (Tcl_GetBooleanFromObj(interp, objv[1], &setError) != TCL_OK) {
449   return TCL_ERROR;
450     }
451     if (Tcl_GetBooleanFromObj(interp, objv[2], &allowAbbrev) != TCL_OK) {
452   return TCL_ERROR;
453     }
454 
455     argv = (CONST char **) ckalloc((unsigned) ((objc-3) * sizeof(char *)));
456     for (i = 4; i < objc; i++) {
457   argv[i-4] = Tcl_GetString(objv[i]);
458     }
459     argv[objc-4] = NULL;
460     
461     /*
462      * Tcl_GetIndexFromObj assumes that the table is statically-allocated
463      * so that its address is different for each index object. If we
464      * accidently allocate a table at the same address as that cached in
465      * the index object, clear out the object's cached state.
466      */
467 
468     if ( objv[3]->typePtr != NULL
469    && !strcmp( "index", objv[3]->typePtr->name ) ) {
470   indexRep = (struct IndexRep *) objv[3]->internalRep.otherValuePtr;
471   if (indexRep->tablePtr == (VOID *) argv) {
472       objv[3]->typePtr->freeIntRepProc(objv[3]);
473       objv[3]->typePtr = NULL;
474   }
475     }
476 
477     result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
478       argv, "token", (allowAbbrev? 0 : TCL_EXACT), &index);
479     ckfree((char *) argv);
480     if (result == TCL_OK) {
481   Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
482     }
483     return result;
484 }
static int TestintobjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 505 of file tclTestObj.c.
References CheckIfVarUnset(), GetVariableIndex(), LONG_MAX, SetVarToObj(), Tcl_AppendToObj(), TCL_ERROR, Tcl_GetInt(), Tcl_GetIntFromObj(), Tcl_GetLongFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_IsShared, Tcl_NewIntObj(), Tcl_NewLongObj(), TCL_OK, Tcl_ResetResult(), Tcl_SetIntObj(), Tcl_SetLongObj(), Tcl_SetObjResult(), Tcl_WrongNumArgs(), and varPtr.
Referenced by TclObjTest_Init().510 {
511     int intValue, varIndex, i;
512     long longValue;
513     char *index, *subCmd, *string;
514   
515     if (objc < 3) {
516   wrongNumArgs:
517   Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
518   return TCL_ERROR;
519     }
520 
521     index = Tcl_GetString(objv[2]);
522     if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
523   return TCL_ERROR;
524     }
525 
526     subCmd = Tcl_GetString(objv[1]);
527     if (strcmp(subCmd, "set") == 0) {
528   if (objc != 4) {
529       goto wrongNumArgs;
530   }
531   string = Tcl_GetString(objv[3]);
532   if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
533       return TCL_ERROR;
534   }
535   intValue = i;
536 
537   /*
538    * If the object currently bound to the variable with index varIndex
539    * has ref count 1 (i.e. the object is unshared) we can modify that
540    * object directly. Otherwise, if RC>1 (i.e. the object is shared),
541    * we must create a new object to modify/set and decrement the old
542    * formerly-shared object's ref count. This is "copy on write".
543    */
544 
545   if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
546       Tcl_SetIntObj(varPtr[varIndex], intValue);
547   } else {
548       SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
549   }
550   Tcl_SetObjResult(interp, varPtr[varIndex]);
551     } else if (strcmp(subCmd, "set2") == 0) { /* doesn't set result */
552   if (objc != 4) {
553       goto wrongNumArgs;
554   }
555   string = Tcl_GetString(objv[3]);
556   if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
557       return TCL_ERROR;
558   }
559   intValue = i;
560   if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
561       Tcl_SetIntObj(varPtr[varIndex], intValue);
562   } else {
563       SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
564   }
565     } else if (strcmp(subCmd, "setlong") == 0) {
566   if (objc != 4) {
567       goto wrongNumArgs;
568   }
569   string = Tcl_GetString(objv[3]);
570   if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
571       return TCL_ERROR;
572   }
573   intValue = i;
574   if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
575       Tcl_SetLongObj(varPtr[varIndex], intValue);
576   } else {
577       SetVarToObj(varIndex, Tcl_NewLongObj(intValue));
578   }
579   Tcl_SetObjResult(interp, varPtr[varIndex]);
580     } else if (strcmp(subCmd, "setmaxlong") == 0) {
581   long maxLong = LONG_MAX;
582   if (objc != 3) {
583       goto wrongNumArgs;
584   }
585   if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
586       Tcl_SetLongObj(varPtr[varIndex], maxLong);
587   } else {
588       SetVarToObj(varIndex, Tcl_NewLongObj(maxLong));
589   }
590     } else if (strcmp(subCmd, "ismaxlong") == 0) {
591   if (objc != 3) {
592       goto wrongNumArgs;
593   }
594   if (CheckIfVarUnset(interp, varIndex)) {
595       return TCL_ERROR;
596   }
597   if (Tcl_GetLongFromObj(interp, varPtr[varIndex], &longValue) != TCL_OK) {
598       return TCL_ERROR;
599   }
600   Tcl_AppendToObj(Tcl_GetObjResult(interp),
601           ((longValue == LONG_MAX)? "1" : "0"), -1);
602     } else if (strcmp(subCmd, "get") == 0) {
603   if (objc != 3) {
604       goto wrongNumArgs;
605   }
606   if (CheckIfVarUnset(interp, varIndex)) {
607       return TCL_ERROR;
608   }
609   Tcl_SetObjResult(interp, varPtr[varIndex]);
610     } else if (strcmp(subCmd, "get2") == 0) {
611   if (objc != 3) {
612       goto wrongNumArgs;
613   }
614   if (CheckIfVarUnset(interp, varIndex)) {
615       return TCL_ERROR;
616   }
617   string = Tcl_GetString(varPtr[varIndex]);
618   Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
619     } else if (strcmp(subCmd, "inttoobigtest") == 0) {
620   /*
621    * If long ints have more bits than ints on this platform, verify
622    * that Tcl_GetIntFromObj returns an error if the long int held
623    * in an integer object's internal representation is too large
624    * to fit in an int.
625    */
626   
627   if (objc != 3) {
628       goto wrongNumArgs;
629   }
630 #if (INT_MAX == LONG_MAX)   /* int is same size as long int */
631   Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
632 #else 
633   if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
634       Tcl_SetLongObj(varPtr[varIndex], LONG_MAX);
635   } else {
636       SetVarToObj(varIndex, Tcl_NewLongObj(LONG_MAX));
637   }
638   if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) {
639       Tcl_ResetResult(interp);
640       Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
641       return TCL_OK;
642   }
643   Tcl_AppendToObj(Tcl_GetObjResult(interp), "0", -1);
644 #endif
645     } else if (strcmp(subCmd, "mult10") == 0) {
646   if (objc != 3) {
647       goto wrongNumArgs;
648   }
649   if (CheckIfVarUnset(interp, varIndex)) {
650       return TCL_ERROR;
651   }
652   if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
653             &intValue) != TCL_OK) {
654       return TCL_ERROR;
655   }
656   if (!Tcl_IsShared(varPtr[varIndex])) {
657       Tcl_SetIntObj(varPtr[varIndex], (intValue * 10));
658   } else {
659       SetVarToObj(varIndex, Tcl_NewIntObj( (intValue * 10) ));
660   }
661   Tcl_SetObjResult(interp, varPtr[varIndex]);
662     } else if (strcmp(subCmd, "div10") == 0) {
663   if (objc != 3) {
664       goto wrongNumArgs;
665   }
666   if (CheckIfVarUnset(interp, varIndex)) {
667       return TCL_ERROR;
668   }
669   if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
670             &intValue) != TCL_OK) {
671       return TCL_ERROR;
672   }
673   if (!Tcl_IsShared(varPtr[varIndex])) {
674       Tcl_SetIntObj(varPtr[varIndex], (intValue / 10));
675   } else {
676       SetVarToObj(varIndex, Tcl_NewIntObj( (intValue / 10) ));
677   }
678   Tcl_SetObjResult(interp, varPtr[varIndex]);
679     } else {
680   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
681     "bad option \"", Tcl_GetString(objv[1]),
682     "\": must be set, get, get2, mult10, or div10",
683     (char *) NULL);
684   return TCL_ERROR;
685     }
686     return TCL_OK;
687 }
static int TestobjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 707 of file tclTestObj.c.
References CheckIfVarUnset(), GetVariableIndex(), NUMBER_OF_OBJECT_VARS, SetVarToObj(), Tcl_AppendAllObjTypes(), Tcl_AppendToObj(), Tcl_ConvertToType(), Tcl_DecrRefCount, Tcl_DuplicateObj(), TCL_ERROR, Tcl_GetObjResult(), Tcl_GetObjType(), Tcl_GetString(), TCL_INTEGER_SPACE, Tcl_InvalidateStringRep(), Tcl_NewObj(), Tcl_NewStringObj(), TCL_OK, Tcl_SetObjResult(), Tcl_SetResult(), TCL_VOLATILE, Tcl_WrongNumArgs(), TclFormatInt(), and varPtr.
Referenced by TclObjTest_Init().712 {
713     int varIndex, destIndex, i;
714     char *index, *subCmd, *string;
715     Tcl_ObjType *targetType;
716   
717     if (objc < 2) {
718   wrongNumArgs:
719   Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
720   return TCL_ERROR;
721     }
722 
723     subCmd = Tcl_GetString(objv[1]);
724     if (strcmp(subCmd, "assign") == 0) {
725         if (objc != 4) {
726             goto wrongNumArgs;
727         }
728         index = Tcl_GetString(objv[2]);
729         if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
730             return TCL_ERROR;
731         }
732         if (CheckIfVarUnset(interp, varIndex)) {
733       return TCL_ERROR;
734   }
735   string = Tcl_GetString(objv[3]);
736         if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
737             return TCL_ERROR;
738         }
739         SetVarToObj(destIndex, varPtr[varIndex]);
740   Tcl_SetObjResult(interp, varPtr[destIndex]);
741      } else if (strcmp(subCmd, "convert") == 0) {
742         char *typeName;
743         if (objc != 4) {
744             goto wrongNumArgs;
745         }
746         index = Tcl_GetString(objv[2]);
747         if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
748             return TCL_ERROR;
749         }
750         if (CheckIfVarUnset(interp, varIndex)) {
751       return TCL_ERROR;
752   }
753         typeName = Tcl_GetString(objv[3]);
754         if ((targetType = Tcl_GetObjType(typeName)) == NULL) {
755       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
756         "no type ", typeName, " found", (char *) NULL);
757             return TCL_ERROR;
758         }
759         if (Tcl_ConvertToType(interp, varPtr[varIndex], targetType)
760             != TCL_OK) {
761             return TCL_ERROR;
762         }
763   Tcl_SetObjResult(interp, varPtr[varIndex]);
764     } else if (strcmp(subCmd, "duplicate") == 0) {
765         if (objc != 4) {
766             goto wrongNumArgs;
767         }
768         index = Tcl_GetString(objv[2]);
769         if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
770             return TCL_ERROR;
771         }
772         if (CheckIfVarUnset(interp, varIndex)) {
773       return TCL_ERROR;
774   }
775   string = Tcl_GetString(objv[3]);
776         if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
777             return TCL_ERROR;
778         }
779         SetVarToObj(destIndex, Tcl_DuplicateObj(varPtr[varIndex]));
780   Tcl_SetObjResult(interp, varPtr[destIndex]);
781     } else if (strcmp(subCmd, "freeallvars") == 0) {
782         if (objc != 2) {
783             goto wrongNumArgs;
784         }
785         for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
786             if (varPtr[i] != NULL) {
787                 Tcl_DecrRefCount(varPtr[i]);
788                 varPtr[i] = NULL;
789             }
790         }
791     } else if ( strcmp ( subCmd, "invalidateStringRep" ) == 0 ) {
792   if ( objc != 3 ) {
793       goto wrongNumArgs;
794   }
795   index = Tcl_GetString( objv[2] );
796   if ( GetVariableIndex( interp, index, &varIndex ) != TCL_OK ) {
797       return TCL_ERROR;
798   }
799         if (CheckIfVarUnset(interp, varIndex)) {
800       return TCL_ERROR;
801   }
802   Tcl_InvalidateStringRep( varPtr[varIndex] );
803   Tcl_SetObjResult( interp, varPtr[varIndex] );
804     } else if (strcmp(subCmd, "newobj") == 0) {
805         if (objc != 3) {
806             goto wrongNumArgs;
807         }
808         index = Tcl_GetString(objv[2]);
809         if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
810             return TCL_ERROR;
811         }
812         SetVarToObj(varIndex, Tcl_NewObj());
813   Tcl_SetObjResult(interp, varPtr[varIndex]);
814     } else if (strcmp(subCmd, "objtype") == 0) {
815   char *typeName;
816 
817   /*
818    * return an object containing the name of the argument's type
819    * of internal rep.  If none exists, return "none".
820    */
821   
822         if (objc != 3) {
823             goto wrongNumArgs;
824         }
825   if (objv[2]->typePtr == NULL) {
826       Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1));
827   } else {
828       typeName = objv[2]->typePtr->name;
829       Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));
830   }
831     } else if (strcmp(subCmd, "refcount") == 0) {
832   char buf[TCL_INTEGER_SPACE];
833 
834         if (objc != 3) {
835             goto wrongNumArgs;
836         }
837         index = Tcl_GetString(objv[2]);
838         if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
839             return TCL_ERROR;
840         }
841         if (CheckIfVarUnset(interp, varIndex)) {
842       return TCL_ERROR;
843   }
844   TclFormatInt(buf, varPtr[varIndex]->refCount);
845         Tcl_SetResult(interp, buf, TCL_VOLATILE);
846     } else if (strcmp(subCmd, "type") == 0) {
847         if (objc != 3) {
848             goto wrongNumArgs;
849         }
850         index = Tcl_GetString(objv[2]);
851         if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
852             return TCL_ERROR;
853         }
854         if (CheckIfVarUnset(interp, varIndex)) {
855       return TCL_ERROR;
856   }
857         if (varPtr[varIndex]->typePtr == NULL) { /* a string! */
858       Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", -1);
859         } else {
860             Tcl_AppendToObj(Tcl_GetObjResult(interp),
861                     varPtr[varIndex]->typePtr->name, -1);
862         }
863     } else if (strcmp(subCmd, "types") == 0) {
864         if (objc != 2) {
865             goto wrongNumArgs;
866         }
867   if (Tcl_AppendAllObjTypes(interp,
868     Tcl_GetObjResult(interp)) != TCL_OK) {
869       return TCL_ERROR;
870   }
871     } else {
872   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
873     "bad option \"",
874     Tcl_GetString(objv[1]),
875     "\": must be assign, convert, duplicate, freeallvars, ",
876     "newobj, objcount, objtype, refcount, type, or types",
877     (char *) NULL);
878   return TCL_ERROR;
879     }
880     return TCL_OK;
881 }
static int TeststringobjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 902 of file tclTestObj.c.
References TestString::allocated, CheckIfVarUnset(), CONST, GetVariableIndex(), MAX_STRINGS, SetVarToObj(), Tcl_AppendToObj(), Tcl_DuplicateObj(), TCL_ERROR, Tcl_GetIndexFromObj(), Tcl_GetIntFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_GetUnicodeFromObj(), Tcl_IsShared, Tcl_NewObj(), Tcl_NewStringObj(), TCL_OK, Tcl_SetIntObj(), Tcl_SetObjLength(), Tcl_SetObjResult(), Tcl_SetStringObj(), Tcl_WrongNumArgs(), TestString::uallocated, and varPtr.
Referenced by TclObjTest_Init().907 {
908     int varIndex, option, i, length;
909 #define MAX_STRINGS 11
910     char *index, *string, *strings[MAX_STRINGS+1];
911     TestString *strPtr;
912     static CONST char *options[] = {
913   "append", "appendstrings", "get", "get2", "length", "length2",
914   "set", "set2", "setlength", "ualloc", "getunicode", 
915   (char *) NULL
916     };
917 
918     if (objc < 3) {
919   wrongNumArgs:
920   Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
921   return TCL_ERROR;
922     }
923 
924     index = Tcl_GetString(objv[2]);
925     if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
926   return TCL_ERROR;
927     }
928 
929     if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &option)
930       != TCL_OK) {
931   return TCL_ERROR;
932     }
933     switch (option) {
934   case 0:       /* append */
935       if (objc != 5) {
936     goto wrongNumArgs;
937       }
938       if (Tcl_GetIntFromObj(interp, objv[4], &length) != TCL_OK) {
939     return TCL_ERROR;
940       }
941       if (varPtr[varIndex] == NULL) {
942     SetVarToObj(varIndex, Tcl_NewObj());
943       }
944       
945       /*
946        * If the object bound to variable "varIndex" is shared, we must
947        * "copy on write" and append to a copy of the object. 
948        */
949       
950       if (Tcl_IsShared(varPtr[varIndex])) {
951     SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
952       }
953       string = Tcl_GetString(objv[3]);
954       Tcl_AppendToObj(varPtr[varIndex], string, length);
955       Tcl_SetObjResult(interp, varPtr[varIndex]);
956       break;
957   case 1:       /* appendstrings */
958       if (objc > (MAX_STRINGS+3)) {
959     goto wrongNumArgs;
960       }
961       if (varPtr[varIndex] == NULL) {
962     SetVarToObj(varIndex, Tcl_NewObj());
963       }
964 
965       /*
966        * If the object bound to variable "varIndex" is shared, we must
967        * "copy on write" and append to a copy of the object. 
968        */
969 
970       if (Tcl_IsShared(varPtr[varIndex])) {
971     SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
972       }
973       for (i = 3;  i < objc;  i++) {
974     strings[i-3] = Tcl_GetString(objv[i]);
975       }
976       for ( ; i < 12 + 3; i++) {
977     strings[i - 3] = NULL;
978       }
979       Tcl_AppendStringsToObj(varPtr[varIndex], strings[0], strings[1],
980         strings[2], strings[3], strings[4], strings[5],
981         strings[6], strings[7], strings[8], strings[9],
982         strings[10], strings[11]);
983       Tcl_SetObjResult(interp, varPtr[varIndex]);
984       break;
985   case 2:       /* get */
986       if (objc != 3) {
987     goto wrongNumArgs;
988       }
989       if (CheckIfVarUnset(interp, varIndex)) {
990     return TCL_ERROR;
991       }
992       Tcl_SetObjResult(interp, varPtr[varIndex]);
993       break;
994   case 3:       /* get2 */
995       if (objc != 3) {
996     goto wrongNumArgs;
997       }
998       if (CheckIfVarUnset(interp, varIndex)) {
999     return TCL_ERROR;
1000       }
1001       string = Tcl_GetString(varPtr[varIndex]);
1002       Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
1003       break;
1004   case 4:       /* length */
1005       if (objc != 3) {
1006     goto wrongNumArgs;
1007       }
1008       Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
1009         ? varPtr[varIndex]->length : -1);
1010       break;
1011   case 5:       /* length2 */
1012       if (objc != 3) {
1013     goto wrongNumArgs;
1014       }
1015       if (varPtr[varIndex] != NULL) {
1016     strPtr = (TestString *)
1017         (varPtr[varIndex])->internalRep.otherValuePtr;
1018     length = (int) strPtr->allocated;
1019       } else {
1020     length = -1;
1021       }
1022       Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
1023       break;
1024   case 6:       /* set */
1025       if (objc != 4) {
1026     goto wrongNumArgs;
1027       }
1028 
1029       /*
1030        * If the object currently bound to the variable with index
1031        * varIndex has ref count 1 (i.e. the object is unshared) we
1032        * can modify that object directly. Otherwise, if RC>1 (i.e.
1033        * the object is shared), we must create a new object to
1034        * modify/set and decrement the old formerly-shared object's
1035        * ref count. This is "copy on write".
1036        */
1037     
1038       string = Tcl_GetStringFromObj(objv[3], &length);
1039       if ((varPtr[varIndex] != NULL)
1040         && !Tcl_IsShared(varPtr[varIndex])) {
1041     Tcl_SetStringObj(varPtr[varIndex], string, length);
1042       } else {
1043     SetVarToObj(varIndex, Tcl_NewStringObj(string, length));
1044       }
1045       Tcl_SetObjResult(interp, varPtr[varIndex]);
1046       break;
1047   case 7:       /* set2 */
1048       if (objc != 4) {
1049     goto wrongNumArgs;
1050       }
1051       SetVarToObj(varIndex, objv[3]);
1052       break;
1053   case 8:       /* setlength */
1054       if (objc != 4) {
1055     goto wrongNumArgs;
1056       }
1057       if (Tcl_GetIntFromObj(interp, objv[3], &length) != TCL_OK) {
1058     return TCL_ERROR;
1059       }
1060       if (varPtr[varIndex] != NULL) {
1061     Tcl_SetObjLength(varPtr[varIndex], length);
1062       }
1063       break;
1064   case 9:       /* ualloc */
1065       if (objc != 3) {
1066     goto wrongNumArgs;
1067       }
1068       if (varPtr[varIndex] != NULL) {
1069     strPtr = (TestString *)
1070         (varPtr[varIndex])->internalRep.otherValuePtr;
1071     length = (int) strPtr->uallocated;
1072       } else {
1073     length = -1;
1074       }
1075       Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
1076       break;
1077   case 10:      /* getunicode */
1078       if (objc != 3) {
1079     goto wrongNumArgs;
1080       }
1081       Tcl_GetUnicodeFromObj(varPtr[varIndex], NULL);
1082       break;
1083     }
1084 
1085     return TCL_OK;
1086 }

Variable Documentation
Tcl_Obj* varPtr[NUMBER_OF_OBJECT_VARS] [static]

Definition at line 27 of file tclTestObj.c.
Referenced by AppendLocals(), CallVarTraces(), CheckIfVarUnset(), DeleteArray(), DupNsVarName(), FreeNsVarName(), InfoExistsCmd(), InfoGlobalsCmd(), InfoVarsCmd(), NewVar(), ObjMakeUpvar(), SetVarToObj(), Tcl_AppendObjCmd(), Tcl_ArrayObjCmd(), Tcl_FindNamespaceVar(), Tcl_GetVar2Ex(), Tcl_GetVariableFullName(), Tcl_LappendObjCmd(), Tcl_ObjGetVar2(), Tcl_ObjSetVar2(), Tcl_SetVar2Ex(), Tcl_TraceVar2(), Tcl_UntraceVar2(), Tcl_VariableObjCmd(), Tcl_VarTraceInfo2(), TclArraySet(), TclDeleteCompiledLocalVars(), TclDeleteNamespaceVars(), TclDeleteVars(), TclExecuteByteCode(), TclIncrVar2(), TclInitCompiledLocals(), TclLookupArrayElement(), TclLookupSimpleVar(), TclLookupVar(), TclObjInterpProc(), TclObjLookupVar(), TclObjTest_Init(), TclObjUnsetVar2(), TclPtrIncrVar(), TclTraceVariableObjCmd(), TclVarTraceExists(), TestbooleanobjCmd(), TestdoubleobjCmd(), TestintobjCmd(), TestobjCmd(), TestregexpObjCmd(), and TeststringobjCmd().

generic/tclTestProcBodyObj.c File Reference
#include "tclInt.h"
Classes
struct CmdTable
Functions
static int ProcBodyTestProcObjCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
static int ProcBodyTestInitInternal _ANSI_ARGS_ ((Tcl_Interp *interp, int isSafe))
static int RegisterCommand _ANSI_ARGS_ ((Tcl_Interp *interp, char *namespace, CONST CmdTable *cmdTablePtr))
int Procbodytest_Init _ANSI_ARGS_ ((Tcl_Interp *interp))
int Procbodytest_Init (Tcl_Interp *interp)
int Procbodytest_SafeInit (Tcl_Interp *interp)
static int RegisterCommand (Tcl_Interp *interp, char *namespace, CONST CmdTable *cmdTablePtr)
static int ProcBodyTestInitInternal (Tcl_Interp *interp, int isSafe)
static int ProcBodyTestProcObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
Variables
static char packageName [] = "procbodytest"
static char packageVersion [] = "1.0"
static char procCommand [] = "proc"
static CONST CmdTable commands []
static CONST CmdTable safeCommands []

Function Documentation
int Procbodytest_Init _ANSI_ARGS_ ((Tcl_Interp *interp))
static int RegisterCommand _ANSI_ARGS_ ((Tcl_Interp *interp, char *namespace, CONST CmdTable *cmdTablePtr)) [static]
static int ProcBodyTestInitInternal _ANSI_ARGS_ ((Tcl_Interp *interp, int isSafe)) [static]
static int ProcBodyTestProcObjCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])) [static]
int Procbodytest_Init (Tcl_Interp * interp)

Definition at line 92 of file tclTestProcBodyObj.c.
References ProcBodyTestInitInternal().
Referenced by Tcl_AppInit().95 {
96     return ProcBodyTestInitInternal(interp, 0);
97 }
int Procbodytest_SafeInit (Tcl_Interp * interp)

Definition at line 116 of file tclTestProcBodyObj.c.
References ProcBodyTestInitInternal().
Referenced by Tcl_AppInit().119 {
120     return ProcBodyTestInitInternal(interp, 1);
121 }
static int ProcBodyTestInitInternal (Tcl_Interp * interp, int isSafe) [static]

Definition at line 179 of file tclTestProcBodyObj.c.
References CONST, packageName, packageVersion, RegisterCommand(), TCL_ERROR, TCL_OK, and Tcl_PkgProvide().
Referenced by Procbodytest_Init(), and Procbodytest_SafeInit().183 {
184     CONST CmdTable *cmdTablePtr;
185 
186     cmdTablePtr = (isSafe) ? &safeCommands[0] : &commands[0];
187     for ( ; cmdTablePtr->cmdName ; cmdTablePtr++) {
188         if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) {
189             return TCL_ERROR;
190         }
191     }
192     
193     return Tcl_PkgProvide(interp, packageName, packageVersion);
194 }
static int ProcBodyTestProcObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 230 of file tclTestProcBodyObj.c.
References Command::clientData, NULL, Command::objClientData, Command::objProc, Command::proc, Tcl_DecrRefCount, TCL_ERROR, Tcl_FindCommand(), Tcl_GetObjResult(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, TCL_LEAVE_ERR_MSG, Tcl_ProcObjCmd(), Tcl_WrongNumArgs(), TclGetInterpProc(), TclGetObjInterpProc(), and TclNewProcBodyObj().235 {
236     char *fullName;
237     Tcl_Command procCmd;
238     Command *cmdPtr;
239     Proc *procPtr = (Proc *) NULL;
240     Tcl_Obj *bodyObjPtr;
241     Tcl_Obj *myobjv[5];
242     int result;
243     
244     if (objc != 4) {
245   Tcl_WrongNumArgs(interp, 1, objv, "newName argsList bodyName");
246   return TCL_ERROR;
247     }
248 
249     /*
250      * Find the Command pointer to this procedure
251      */
252     
253     fullName = Tcl_GetStringFromObj(objv[3], (int *) NULL);
254     procCmd = Tcl_FindCommand(interp, fullName, (Tcl_Namespace *) NULL,
255             TCL_LEAVE_ERR_MSG);
256     if (procCmd == NULL) {
257         return TCL_ERROR;
258     }
259 
260     cmdPtr = (Command *) procCmd;
261 
262     /*
263      * check that this is a procedure and not a builtin command:
264      * If a procedure, cmdPtr->objProc is either 0 or TclObjInterpProc,
265      * and cmdPtr->proc is either 0 or TclProcInterpProc.
266      * Also, the compile proc should be 0, but we don't check for that.
267      */
268 
269     if (((cmdPtr->objProc != NULL)
270             && (cmdPtr->objProc != TclGetObjInterpProc()))
271             || ((cmdPtr->proc != NULL)
272                     && (cmdPtr->proc != TclGetInterpProc()))) {
273         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
274     "command \"", fullName,
275     "\" is not a Tcl procedure", (char *) NULL);
276         return TCL_ERROR;
277     }
278 
279     /*
280      * it is a Tcl procedure: the client data is the Proc structure
281      */
282     
283     if (cmdPtr->objProc != NULL) {
284         procPtr = (Proc *) cmdPtr->objClientData;
285     } else if (cmdPtr->proc != NULL) {
286         procPtr = (Proc *) cmdPtr->clientData;
287     }
288 
289     if (procPtr == NULL) {
290         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
291     "procedure \"", fullName,
292     "\" does not have a Proc struct!", (char *) NULL);
293         return TCL_ERROR;
294     }
295         
296     /*
297      * create a new object, initialize our argument vector, call into Tcl
298      */
299 
300     bodyObjPtr = TclNewProcBodyObj(procPtr);
301     if (bodyObjPtr == NULL) {
302         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
303     "failed to create a procbody object for procedure \"",
304                 fullName, "\"", (char *) NULL);
305         return TCL_ERROR;
306     }
307     Tcl_IncrRefCount(bodyObjPtr);
308 
309     myobjv[0] = objv[0];
310     myobjv[1] = objv[1];
311     myobjv[2] = objv[2];
312     myobjv[3] = bodyObjPtr;
313     myobjv[4] = (Tcl_Obj *) NULL;
314 
315     result = Tcl_ProcObjCmd((ClientData) NULL, interp, objc, myobjv);
316     Tcl_DecrRefCount(bodyObjPtr);
317 
318     return result;
319 }
static int RegisterCommand (Tcl_Interp* interp, char * namespace, CONST CmdTable * cmdTablePtr) [static]

Definition at line 139 of file tclTestProcBodyObj.c.
References Tcl_CreateObjCommand(), TCL_ERROR, Tcl_Eval(), and TCL_OK.
Referenced by ProcBodyTestInitInternal().145 {
146     char buf[128];
147 
148     if (cmdTablePtr->exportIt) {
149         sprintf(buf, "namespace eval %s { namespace export %s }",
150                 namespace, cmdTablePtr->cmdName);
151         if (Tcl_Eval(interp, buf) != TCL_OK)
152             return TCL_ERROR;
153     }
154     
155     sprintf(buf, "%s::%s", namespace, cmdTablePtr->cmdName);
156     Tcl_CreateObjCommand(interp, buf, cmdTablePtr->proc, 0, 0);
157 
158     return TCL_OK;
159 }

Variable Documentation
CONST CmdTable commands[] [static]
Initial value:
{
    { procCommand,  ProcBodyTestProcObjCmd, 1 },

    { 0, 0, 0 }
}
Definition at line 61 of file tclTestProcBodyObj.c.char packageName[] = "procbodytest" [static]

Definition at line 22 of file tclTestProcBodyObj.c.
Referenced by ProcBodyTestInitInternal(), and Tcl_LoadObjCmd().char packageVersion[] = "1.0" [static]

Definition at line 23 of file tclTestProcBodyObj.c.
Referenced by ProcBodyTestInitInternal().char procCommand[] = "proc" [static]

Definition at line 29 of file tclTestProcBodyObj.c.CONST CmdTable safeCommands[] [static]
Initial value:
{
    { procCommand,  ProcBodyTestProcObjCmd, 1 },

    { 0, 0, 0 }
}
Definition at line 68 of file tclTestProcBodyObj.c.

generic/tclThread.c File Reference
#include "tclInt.h"
Classes
struct SyncObjRecord
Functions
static void RememberSyncObject _ANSI_ARGS_ ((char *objPtr, SyncObjRecord *recPtr))
VOID * Tcl_GetThreadData (Tcl_ThreadDataKey *keyPtr, int size)
VOID * TclThreadDataKeyGet (Tcl_ThreadDataKey *keyPtr)
void TclThreadDataKeySet (Tcl_ThreadDataKey *keyPtr, VOID *data)
static void RememberSyncObject (char *objPtr, SyncObjRecord *recPtr)
static void ForgetSyncObject (char *objPtr, SyncObjRecord *recPtr)
void TclRememberMutex (Tcl_Mutex *mutexPtr)
void Tcl_MutexFinalize (Tcl_Mutex *mutexPtr)
void TclRememberDataKey (Tcl_ThreadDataKey *keyPtr)
void TclRememberCondition (Tcl_Condition *condPtr)
void Tcl_ConditionFinalize (Tcl_Condition *condPtr)
void TclFinalizeThreadData ()
void TclFinalizeSynchronization ()
void Tcl_ExitThread (int status)
void Tcl_ConditionWait (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, Tcl_Time *timePtr)
void Tcl_ConditionNotify (Tcl_Condition *condPtr)
void Tcl_MutexLock (Tcl_Mutex *mutexPtr)
void Tcl_MutexUnlock (Tcl_Mutex *mutexPtr)
Variables
static SyncObjRecord keyRecord = {0, 0, NULL}
static SyncObjRecord mutexRecord = {0, 0, NULL}
static SyncObjRecord condRecord = {0, 0, NULL}

Function Documentation
static void RememberSyncObject _ANSI_ARGS_ ((char *objPtr, SyncObjRecord *recPtr)) [static]
static void ForgetSyncObject (char * objPtr, SyncObjRecord * recPtr) [static]

Definition at line 248 of file tclThread.c.
References SyncObjRecord::list, NULL, and SyncObjRecord::num.
Referenced by Tcl_ConditionFinalize(), and Tcl_MutexFinalize().251 {
252     int i;
253 
254     for (i=0 ; i<recPtr->num ; i++) {
255   if (objPtr == recPtr->list[i]) {
256       recPtr->list[i] = NULL;
257       return;
258   }
259     }
260 }
static void RememberSyncObject (char * objPtr, SyncObjRecord * recPtr) [static]

Definition at line 200 of file tclThread.c.
References ckalloc, ckfree, SyncObjRecord::list, SyncObjRecord::max, NULL, and SyncObjRecord::num.
Referenced by TclRememberCondition(), TclRememberDataKey(), and TclRememberMutex().203 {
204     char **newList;
205     int i, j;
206 
207     /*
208      * Save the pointer to the allocated object so it can be finalized.
209      * Grow the list of pointers if necessary, copying only non-NULL
210      * pointers to the new list.
211      */
212 
213     if (recPtr->num >= recPtr->max) {
214   recPtr->max += 8;
215   newList = (char **)ckalloc(recPtr->max * sizeof(char *));
216   for (i=0,j=0 ; i<recPtr->num ; i++) {
217             if (recPtr->list[i] != NULL) {
218     newList[j++] = recPtr->list[i];
219             }
220   }
221   if (recPtr->list != NULL) {
222       ckfree((char *)recPtr->list);
223   }
224   recPtr->list = newList;
225   recPtr->num = j;
226     }
227     recPtr->list[recPtr->num] = objPtr;
228     recPtr->num++;
229 }
void Tcl_ConditionFinalize (Tcl_Condition * condPtr)

Definition at line 376 of file tclThread.c.
References condRecord, and ForgetSyncObject().378 {
379 #ifdef TCL_THREADS
380     TclpFinalizeCondition(condPtr);
381 #endif
382     ForgetSyncObject((char *)condPtr, &condRecord);
383 }
void Tcl_ConditionNotify (Tcl_Condition * condPtr)

Definition at line 559 of file tclThread.c.561 {
562 }
void Tcl_ConditionWait (Tcl_Condition * condPtr, Tcl_Mutex * mutexPtr, Tcl_Time * timePtr)

Definition at line 550 of file tclThread.c.554 {
555 }
void Tcl_ExitThread (int status)

Definition at line 518 of file tclThread.c.
References Tcl_FinalizeThread(), and TclpThreadExit().520 {
521     Tcl_FinalizeThread();
522 #ifdef TCL_THREADS
523     TclpThreadExit(status);
524 #endif
525 }
VOID* Tcl_GetThreadData (Tcl_ThreadDataKey * keyPtr, int size)

Definition at line 80 of file tclThread.c.
References ckalloc, NULL, size_t(), TclRememberDataKey(), and VOID.
Referenced by Tcl_CallWhenDeleted().83 {
84     VOID *result;
85 #ifdef TCL_THREADS
86 
87     /*
88      * See if this is the first thread to init this key.
89      */
90 
91     if (*keyPtr == NULL) {
92   TclpThreadDataKeyInit(keyPtr);
93     }
94 
95     /*
96      * Initialize the key for this thread.
97      */
98 
99     result = TclpThreadDataKeyGet(keyPtr);
100     if (result == NULL) {
101   result  = (VOID *)ckalloc((size_t)size);
102   memset(result, 0, (size_t)size);
103   TclpThreadDataKeySet(keyPtr, result);
104     }
105 #else
106     if (*keyPtr == NULL) {
107   result = (VOID *)ckalloc((size_t)size);
108   memset((char *)result, 0, (size_t)size);
109   *keyPtr = (Tcl_ThreadDataKey)result;
110   TclRememberDataKey(keyPtr);
111     }
112     result = *(VOID **)keyPtr;
113 #endif
114     return result;
115 }
void Tcl_MutexFinalize (Tcl_Mutex * mutexPtr)

Definition at line 303 of file tclThread.c.
References ForgetSyncObject(), and mutexRecord.305 {
306 #ifdef TCL_THREADS
307     TclpFinalizeMutex(mutexPtr);
308 #endif
309     ForgetSyncObject((char *)mutexPtr, &mutexRecord);
310 }
void Tcl_MutexLock (Tcl_Mutex * mutexPtr)

Definition at line 566 of file tclThread.c.568 {
569 }
void Tcl_MutexUnlock (Tcl_Mutex * mutexPtr)

Definition at line 573 of file tclThread.c.575 {
576 }
void TclFinalizeSynchronization ()

Definition at line 441 of file tclThread.c.
References ckfree, keyRecord, SyncObjRecord::list, NULL, SyncObjRecord::num, and TclpMasterLock().
Referenced by Tcl_Finalize().442 {
443 #ifdef TCL_THREADS
444     Tcl_ThreadDataKey *keyPtr;
445     Tcl_Mutex *mutexPtr;
446     Tcl_Condition *condPtr;
447     int i;
448 
449     TclpMasterLock();
450     for (i=0 ; i<keyRecord.num ; i++) {
451   keyPtr = (Tcl_ThreadDataKey *)keyRecord.list[i];
452   TclpFinalizeThreadDataKey(keyPtr);
453     }
454     if (keyRecord.list != NULL) {
455   ckfree((char *)keyRecord.list);
456   keyRecord.list = NULL;
457     }
458     keyRecord.max = 0;
459     keyRecord.num = 0;
460 
461     for (i=0 ; i<mutexRecord.num ; i++) {
462   mutexPtr = (Tcl_Mutex *)mutexRecord.list[i];
463   if (mutexPtr != NULL) {
464       TclpFinalizeMutex(mutexPtr);
465   }
466     }
467     if (mutexRecord.list != NULL) {
468   ckfree((char *)mutexRecord.list);
469   mutexRecord.list = NULL;
470     }
471     mutexRecord.max = 0;
472     mutexRecord.num = 0;
473 
474     for (i=0 ; i<condRecord.num ; i++) {
475   condPtr = (Tcl_Condition *)condRecord.list[i];
476   if (condPtr != NULL) {
477       TclpFinalizeCondition(condPtr);
478   }
479     }
480     if (condRecord.list != NULL) {
481   ckfree((char *)condRecord.list);
482   condRecord.list = NULL;
483     }
484     condRecord.max = 0;
485     condRecord.num = 0;
486 
487     TclpMasterUnlock();
488 #else
489     if (keyRecord.list != NULL) {
490   ckfree((char *)keyRecord.list);
491   keyRecord.list = NULL;
492     }
493     keyRecord.max = 0;
494     keyRecord.num = 0;
495 #endif
496 }
void TclFinalizeThreadData ()

Definition at line 403 of file tclThread.c.
References ckfree, keyRecord, SyncObjRecord::list, NULL, SyncObjRecord::num, TclpMasterLock(), and TclpMasterUnlock().
Referenced by Tcl_FinalizeThread().404 {
405     int i;
406     Tcl_ThreadDataKey *keyPtr;
407 
408     TclpMasterLock();
409     for (i=0 ; i<keyRecord.num ; i++) {
410   keyPtr = (Tcl_ThreadDataKey *) keyRecord.list[i];
411 #ifdef TCL_THREADS
412   TclpFinalizeThreadData(keyPtr);
413 #else
414   if (*keyPtr != NULL) {
415       ckfree((char *)*keyPtr);
416       *keyPtr = NULL;
417   }
418 #endif
419     }
420     TclpMasterUnlock();
421 }
void TclRememberCondition (Tcl_Condition * condPtr)

Definition at line 352 of file tclThread.c.
References condRecord, and RememberSyncObject().354 {
355     RememberSyncObject((char *)condPtr, &condRecord);
356 }
void TclRememberDataKey (Tcl_ThreadDataKey * keyPtr)

Definition at line 329 of file tclThread.c.
References keyRecord, and RememberSyncObject().
Referenced by Tcl_GetThreadData().331 {
332     RememberSyncObject((char *)keyPtr, &keyRecord);
333 }
void TclRememberMutex (Tcl_Mutex * mutexPtr)

Definition at line 279 of file tclThread.c.
References mutexRecord, and RememberSyncObject().281 {
282     RememberSyncObject((char *)mutexPtr, &mutexRecord);
283 }
VOID* TclThreadDataKeyGet (Tcl_ThreadDataKey * keyPtr)

Definition at line 135 of file tclThread.c.
References VOID.
Referenced by ConsoleInit(), CreateSocket(), FileInit(), InitSockets(), InitTimer(), PipeInit(), SerialInit(), Tcl_FinalizeThread(), Tcl_MakeTcpClientChannel(), TclInitSubsystems(), TclInThreadExit(), TclpFinalizePipes(), TclpFinalizeSockets(), TcpAccept(), TcpInputProc(), TcpOutputProc(), TimerExitProc(), and WaitForSocketEvent().138 {
139 #ifdef TCL_THREADS
140     return (VOID *)TclpThreadDataKeyGet(keyPtr);
141 #else
142     char *result = *(char **)keyPtr;
143     return (VOID *)result;
144 #endif /* TCL_THREADS */
145 }
void TclThreadDataKeySet (Tcl_ThreadDataKey * keyPtr, VOID * data)

Definition at line 165 of file tclThread.c.
References NULL.169 {
170 #ifdef TCL_THREADS
171     if (*keyPtr == NULL) {
172   TclpThreadDataKeyInit(keyPtr);
173     }
174     TclpThreadDataKeySet(keyPtr, data);
175 #else
176     *keyPtr = (Tcl_ThreadDataKey)data;
177 #endif /* TCL_THREADS */
178 }

Variable Documentation
SyncObjRecord condRecord = {0, 0, NULL} [static]

Definition at line 35 of file tclThread.c.
Referenced by Tcl_ConditionFinalize(), and TclRememberCondition().SyncObjRecord keyRecord = {0, 0, NULL} [static]

Definition at line 33 of file tclThread.c.
Referenced by TclFinalizeSynchronization(), TclFinalizeThreadData(), and TclRememberDataKey().SyncObjRecord mutexRecord = {0, 0, NULL} [static]

Definition at line 34 of file tclThread.c.
Referenced by Tcl_MutexFinalize(), and TclRememberMutex().

generic/tclThreadAlloc.c File Reference
#include "tclInt.h"
Functions
void TclFinalizeThreadAlloc ()

Function Documentation
void TclFinalizeThreadAlloc ()

Definition at line 1007 of file tclThreadAlloc.c.
Referenced by Tcl_Finalize().1008 {
1009     Tcl_Panic("TclFinalizeThreadAlloc called when threaded memory allocator not in use.");
1010 }

generic/tclThreadJoin.c File Reference
#include "tclInt.h"

generic/tclThreadTest.c File Reference
#include "tclInt.h"

generic/tclTimer.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Classes
struct TimerHandler
struct AfterInfo
struct AfterAssocData
struct IdleHandler
struct ThreadSpecificData
Functions
static void AfterCleanupProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp))
static void AfterProc _ANSI_ARGS_ ((ClientData clientData))
static void FreeAfterPtr _ANSI_ARGS_ ((AfterInfo *afterPtr))
static AfterInfo *GetAfterEvent _ANSI_ARGS_ ((AfterAssocData *assocPtr, Tcl_Obj *commandPtr))
static ThreadSpecificData *InitTimer _ANSI_ARGS_ ((void))
static int TimerHandlerEventProc _ANSI_ARGS_ ((Tcl_Event *evPtr, int flags))
static void TimerCheckProc _ANSI_ARGS_ ((ClientData clientData, int flags))
static ThreadSpecificData * InitTimer ()
static void TimerExitProc (ClientData clientData)
Tcl_TimerToken Tcl_CreateTimerHandler (int milliseconds, Tcl_TimerProc *proc, ClientData clientData)
void Tcl_DeleteTimerHandler (Tcl_TimerToken token)
static void TimerSetupProc (ClientData data, int flags)
static void TimerCheckProc (ClientData data, int flags)
static int TimerHandlerEventProc (Tcl_Event *evPtr, int flags)
void Tcl_DoWhenIdle (Tcl_IdleProc *proc, ClientData clientData)
void Tcl_CancelIdleCall (Tcl_IdleProc *proc, ClientData clientData)
int TclServiceIdle ()
int Tcl_AfterObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static AfterInfo * GetAfterEvent (AfterAssocData *assocPtr, Tcl_Obj *commandPtr)
static void AfterProc (ClientData clientData)
static void FreeAfterPtr (AfterInfo *afterPtr)
static void AfterCleanupProc (ClientData clientData, Tcl_Interp *interp)
Variables
static Tcl_ThreadDataKey dataKey

Function Documentation
static void TimerCheckProc _ANSI_ARGS_ ((ClientData clientData, int flags)) [static]
static int TimerHandlerEventProc _ANSI_ARGS_ ((Tcl_Event *evPtr, int flags)) [static]
static ThreadSpecificData* InitTimer _ANSI_ARGS_ ((void)) [static]
static AfterInfo* GetAfterEvent _ANSI_ARGS_ ((AfterAssocData *assocPtr, Tcl_Obj *commandPtr)) [static]
static void FreeAfterPtr _ANSI_ARGS_ ((AfterInfo *afterPtr)) [static]
static void AfterProc _ANSI_ARGS_ ((ClientData clientData)) [static]
static void AfterCleanupProc _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp)) [static]
static void AfterCleanupProc (ClientData clientData, Tcl_Interp * interp) [static]

Definition at line 1114 of file tclTimer.c.
References AfterProc(), ckfree, AfterInfo::commandPtr, AfterAssocData::firstAfterPtr, AfterInfo::nextPtr, NULL, Tcl_CancelIdleCall(), Tcl_DecrRefCount, Tcl_DeleteTimerHandler(), and AfterInfo::token.
Referenced by Tcl_AfterObjCmd().1118 {
1119     AfterAssocData *assocPtr = (AfterAssocData *) clientData;
1120     AfterInfo *afterPtr;
1121 
1122     while (assocPtr->firstAfterPtr != NULL) {
1123   afterPtr = assocPtr->firstAfterPtr;
1124   assocPtr->firstAfterPtr = afterPtr->nextPtr;
1125   if (afterPtr->token != NULL) {
1126       Tcl_DeleteTimerHandler(afterPtr->token);
1127   } else {
1128       Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
1129   }
1130   Tcl_DecrRefCount(afterPtr->commandPtr);
1131   ckfree((char *) afterPtr);
1132     }
1133     ckfree((char *) assocPtr);
1134 }
static void AfterProc (ClientData clientData) [static]

Definition at line 1007 of file tclTimer.c.
References AfterInfo::assocPtr, ckfree, AfterInfo::commandPtr, AfterAssocData::firstAfterPtr, AfterAssocData::interp, AfterInfo::nextPtr, Tcl_AddErrorInfo(), Tcl_BackgroundError(), Tcl_DecrRefCount, TCL_EVAL_GLOBAL, Tcl_EvalEx(), Tcl_GetStringFromObj(), TCL_OK, Tcl_Preserve(), and Tcl_Release().
Referenced by AfterCleanupProc(), and Tcl_AfterObjCmd().1009 {
1010     AfterInfo *afterPtr = (AfterInfo *) clientData;
1011     AfterAssocData *assocPtr = afterPtr->assocPtr;
1012     AfterInfo *prevPtr;
1013     int result;
1014     Tcl_Interp *interp;
1015     char *script;
1016     int numBytes;
1017 
1018     /*
1019      * First remove the callback from our list of callbacks;  otherwise
1020      * someone could delete the callback while it's being executed, which
1021      * could cause a core dump.
1022      */
1023 
1024     if (assocPtr->firstAfterPtr == afterPtr) {
1025   assocPtr->firstAfterPtr = afterPtr->nextPtr;
1026     } else {
1027   for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
1028     prevPtr = prevPtr->nextPtr) {
1029       /* Empty loop body. */
1030   }
1031   prevPtr->nextPtr = afterPtr->nextPtr;
1032     }
1033 
1034     /*
1035      * Execute the callback.
1036      */
1037 
1038     interp = assocPtr->interp;
1039     Tcl_Preserve((ClientData) interp);
1040     script = Tcl_GetStringFromObj(afterPtr->commandPtr, &numBytes);
1041     result = Tcl_EvalEx(interp, script, numBytes, TCL_EVAL_GLOBAL);
1042     if (result != TCL_OK) {
1043   Tcl_AddErrorInfo(interp, "\n    (\"after\" script)");
1044   Tcl_BackgroundError(interp);
1045     }
1046     Tcl_Release((ClientData) interp);
1047     
1048     /*
1049      * Free the memory for the callback.
1050      */
1051 
1052     Tcl_DecrRefCount(afterPtr->commandPtr);
1053     ckfree((char *) afterPtr);
1054 }
static void FreeAfterPtr (AfterInfo * afterPtr) [static]

Definition at line 1076 of file tclTimer.c.
References ckfree, AfterAssocData::firstAfterPtr, AfterInfo::nextPtr, and Tcl_DecrRefCount.
Referenced by Tcl_AfterObjCmd().1078 {
1079     AfterInfo *prevPtr;
1080     AfterAssocData *assocPtr = afterPtr->assocPtr;
1081 
1082     if (assocPtr->firstAfterPtr == afterPtr) {
1083   assocPtr->firstAfterPtr = afterPtr->nextPtr;
1084     } else {
1085   for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
1086     prevPtr = prevPtr->nextPtr) {
1087       /* Empty loop body. */
1088   }
1089   prevPtr->nextPtr = afterPtr->nextPtr;
1090     }
1091     Tcl_DecrRefCount(afterPtr->commandPtr);
1092     ckfree((char *) afterPtr);
1093 }
static AfterInfo* GetAfterEvent (AfterAssocData * assocPtr, Tcl_Obj * commandPtr) [static]

Definition at line 957 of file tclTimer.c.
References AfterInfo::id, AfterInfo::nextPtr, NULL, strtoul(), and Tcl_GetString().
Referenced by Tcl_AfterObjCmd().961 {
962     char *cmdString;    /* Textual identifier for after event, such
963          * as "after#6". */
964     AfterInfo *afterPtr;
965     int id;
966     char *end;
967 
968     cmdString = Tcl_GetString(commandPtr);
969     if (strncmp(cmdString, "after#", 6) != 0) {
970   return NULL;
971     }
972     cmdString += 6;
973     id = strtoul(cmdString, &end, 10);
974     if ((end == cmdString) || (*end != 0)) {
975   return NULL;
976     }
977     for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
978       afterPtr = afterPtr->nextPtr) {
979   if (afterPtr->id == id) {
980       return afterPtr;
981   }
982     }
983     return NULL;
984 }
static ThreadSpecificData* InitTimer () [static]

Definition at line 152 of file tclTimer.c.
References dataKey, NULL, Tcl_CreateEventSource(), Tcl_CreateThreadExitHandler(), TCL_TSD_INIT, TclThreadDataKeyGet(), TimerCheckProc(), TimerExitProc(), and TimerSetupProc().
Referenced by Tcl_AfterObjCmd(), Tcl_CancelIdleCall(), Tcl_CreateTimerHandler(), Tcl_DeleteTimerHandler(), Tcl_DoWhenIdle(), TclServiceIdle(), TimerCheckProc(), TimerHandlerEventProc(), and TimerSetupProc().153 {
154     ThreadSpecificData *tsdPtr = 
155   (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
156 
157     if (tsdPtr == NULL) {
158   tsdPtr = TCL_TSD_INIT(&dataKey);
159   Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL);
160   Tcl_CreateThreadExitHandler(TimerExitProc, NULL);
161     }
162     return tsdPtr;
163 }
int Tcl_AfterObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv)

Definition at line 737 of file tclTimer.c.
References AfterCleanupProc(), ThreadSpecificData::afterId, AfterProc(), AfterInfo::assocPtr, ckalloc, AfterInfo::commandPtr, CONST, AfterAssocData::firstAfterPtr, FreeAfterPtr(), GetAfterEvent(), AfterInfo::id, InitTimer(), AfterAssocData::interp, memcmp(), AfterInfo::nextPtr, NULL, panic, Tcl_AppendElement(), Tcl_CancelIdleCall(), Tcl_ConcatObj(), Tcl_CreateTimerHandler(), Tcl_DecrRefCount, Tcl_DeleteTimerHandler(), Tcl_DoWhenIdle(), TCL_ERROR, Tcl_GetAssocData(), Tcl_GetIndexFromObj(), Tcl_GetIntFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, TCL_INTEGER_SPACE, Tcl_ListObjAppendElement(), Tcl_NewStringObj(), TCL_OK, Tcl_SetAssocData(), Tcl_SetObjResult(), Tcl_Sleep(), Tcl_WrongNumArgs(), tclIntType, AfterInfo::token, and UCHAR.742 {
743     int ms;
744     AfterInfo *afterPtr;
745     AfterAssocData *assocPtr;
746     int length;
747     char *argString;
748     int index;
749     char buf[16 + TCL_INTEGER_SPACE];
750     static CONST char *afterSubCmds[] = {
751   "cancel", "idle", "info", (char *) NULL
752     };
753     enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
754     ThreadSpecificData *tsdPtr = InitTimer();
755 
756     if (objc < 2) {
757   Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
758   return TCL_ERROR;
759     }
760 
761     /*
762      * Create the "after" information associated for this interpreter,
763      * if it doesn't already exist.  
764      */
765 
766     assocPtr = Tcl_GetAssocData( interp, "tclAfter", NULL );
767     if (assocPtr == NULL) {
768   assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData));
769   assocPtr->interp = interp;
770   assocPtr->firstAfterPtr = NULL;
771   Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc,
772     (ClientData) assocPtr);
773     }
774 
775     /*
776      * First lets see if the command was passed a number as the first argument.
777      */
778 
779     if (objv[1]->typePtr == &tclIntType) {
780   ms = (int) objv[1]->internalRep.longValue;
781   goto processInteger;
782     }
783     argString = Tcl_GetStringFromObj(objv[1], &length);
784     if (argString[0] == '+' || argString[0] == '-'
785   || isdigit(UCHAR(argString[0]))) {  /* INTL: digit */
786   if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) {
787       return TCL_ERROR;
788   }
789 processInteger:
790   if (ms < 0) {
791       ms = 0;
792   }
793   if (objc == 2) {
794       Tcl_Sleep(ms);
795       return TCL_OK;
796   }
797   afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
798   afterPtr->assocPtr = assocPtr;
799   if (objc == 3) {
800       afterPtr->commandPtr = objv[2];
801   } else {
802       afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
803   }
804   Tcl_IncrRefCount(afterPtr->commandPtr);
805   /*
806    * The variable below is used to generate unique identifiers for
807    * after commands.  This id can wrap around, which can potentially
808    * cause problems.  However, there are not likely to be problems
809    * in practice, because after commands can only be requested to
810    * about a month in the future, and wrap-around is unlikely to
811    * occur in less than about 1-10 years.  Thus it's unlikely that
812    * any old ids will still be around when wrap-around occurs.
813    */
814   afterPtr->id = tsdPtr->afterId;
815   tsdPtr->afterId += 1;
816   afterPtr->token = Tcl_CreateTimerHandler(ms, AfterProc,
817     (ClientData) afterPtr);
818   afterPtr->nextPtr = assocPtr->firstAfterPtr;
819   assocPtr->firstAfterPtr = afterPtr;
820   sprintf(buf, "after#%d", afterPtr->id);
821   Tcl_AppendResult(interp, buf, (char *) NULL);
822   return TCL_OK;
823     }
824 
825     /*
826      * If it's not a number it must be a subcommand.
827      */
828 
829     if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "argument",
830             0, &index) != TCL_OK) {
831   Tcl_AppendResult(interp, "bad argument \"", argString,
832     "\": must be cancel, idle, info, or a number",
833     (char *) NULL);
834   return TCL_ERROR;
835     }
836     switch ((enum afterSubCmds) index) {
837         case AFTER_CANCEL: {
838       Tcl_Obj *commandPtr;
839       char *command, *tempCommand;
840       int tempLength;
841 
842       if (objc < 3) {
843     Tcl_WrongNumArgs(interp, 2, objv, "id|command");
844     return TCL_ERROR;
845       }
846       if (objc == 3) {
847     commandPtr = objv[2];
848       } else {
849     commandPtr = Tcl_ConcatObj(objc-2, objv+2);;
850       }
851       command = Tcl_GetStringFromObj(commandPtr, &length);
852       for (afterPtr = assocPtr->firstAfterPtr;  afterPtr != NULL;
853         afterPtr = afterPtr->nextPtr) {
854     tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
855       &tempLength);
856     if ((length == tempLength)
857             && (memcmp((void*) command, (void*) tempCommand,
858               (unsigned) length) == 0)) {
859         break;
860     }
861       }
862       if (afterPtr == NULL) {
863     afterPtr = GetAfterEvent(assocPtr, commandPtr);
864       }
865       if (objc != 3) {
866     Tcl_DecrRefCount(commandPtr);
867       }
868       if (afterPtr != NULL) {
869     if (afterPtr->token != NULL) {
870         Tcl_DeleteTimerHandler(afterPtr->token);
871     } else {
872         Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
873     }
874     FreeAfterPtr(afterPtr);
875       }
876       break;
877   }
878   case AFTER_IDLE:
879       if (objc < 3) {
880     Tcl_WrongNumArgs(interp, 2, objv, "script script ...");
881     return TCL_ERROR;
882       }
883       afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
884       afterPtr->assocPtr = assocPtr;
885       if (objc == 3) {
886     afterPtr->commandPtr = objv[2];
887       } else {
888     afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
889       }
890       Tcl_IncrRefCount(afterPtr->commandPtr);
891       afterPtr->id = tsdPtr->afterId;
892       tsdPtr->afterId += 1;
893       afterPtr->token = NULL;
894       afterPtr->nextPtr = assocPtr->firstAfterPtr;
895       assocPtr->firstAfterPtr = afterPtr;
896       Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);
897       sprintf(buf, "after#%d", afterPtr->id);
898       Tcl_AppendResult(interp, buf, (char *) NULL);
899       break;
900   case AFTER_INFO: {
901       Tcl_Obj *resultListPtr;
902 
903       if (objc == 2) {
904     for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
905          afterPtr = afterPtr->nextPtr) {
906         if (assocPtr->interp == interp) {
907       sprintf(buf, "after#%d", afterPtr->id);
908       Tcl_AppendElement(interp, buf);
909         }
910     }
911     return TCL_OK;
912       }
913       if (objc != 3) {
914     Tcl_WrongNumArgs(interp, 2, objv, "?id?");
915     return TCL_ERROR;
916       }
917       afterPtr = GetAfterEvent(assocPtr, objv[2]);
918       if (afterPtr == NULL) {
919     Tcl_AppendResult(interp, "event \"", Tcl_GetString(objv[2]),
920       "\" doesn't exist", (char *) NULL);
921     return TCL_ERROR;
922       }
923       resultListPtr = Tcl_GetObjResult(interp);
924       Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr);
925       Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
926     (afterPtr->token == NULL) ? "idle" : "timer", -1));
927       Tcl_SetObjResult(interp, resultListPtr);
928       break;
929   }
930   default: {
931       panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");
932   }
933     }
934     return TCL_OK;
935 }
void Tcl_CancelIdleCall (Tcl_IdleProc * proc, ClientData clientData)

Definition at line 617 of file tclTimer.c.
References ckfree, IdleHandler::clientData, ThreadSpecificData::idleList, InitTimer(), ThreadSpecificData::lastIdlePtr, IdleHandler::nextPtr, NULL, and IdleHandler::proc.
Referenced by AfterCleanupProc(), BgErrorDeleteProc(), and Tcl_AfterObjCmd().620 {
621     register IdleHandler *idlePtr, *prevPtr;
622     IdleHandler *nextPtr;
623     ThreadSpecificData *tsdPtr = InitTimer();
624 
625     for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL;
626       prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) {
627   while ((idlePtr->proc == proc)
628     && (idlePtr->clientData == clientData)) {
629       nextPtr = idlePtr->nextPtr;
630       ckfree((char *) idlePtr);
631       idlePtr = nextPtr;
632       if (prevPtr == NULL) {
633     tsdPtr->idleList = idlePtr;
634       } else {
635     prevPtr->nextPtr = idlePtr;
636       }
637       if (idlePtr == NULL) {
638     tsdPtr->lastIdlePtr = prevPtr;
639     return;
640       }
641   }
642     }
643 }
Tcl_TimerToken Tcl_CreateTimerHandler (int milliseconds, Tcl_TimerProc * proc, ClientData clientData)

Definition at line 221 of file tclTimer.c.
References ckalloc, TimerHandler::clientData, ThreadSpecificData::firstTimerHandlerPtr, InitTimer(), ThreadSpecificData::lastTimerId, TimerHandler::nextPtr, NULL, TimerHandler::proc, Tcl_Time::sec, TCL_ALL_EVENTS, Tcl_GetTime(), TimerHandler::time, TimerSetupProc(), TimerHandler::token, and Tcl_Time::usec.
Referenced by ChannelTimerProc(), Tcl_AfterObjCmd(), TransformWatchProc(), and UpdateInterest().226 {
227     register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
228     Tcl_Time time;
229     ThreadSpecificData *tsdPtr;
230 
231     tsdPtr = InitTimer();
232 
233     timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler));
234 
235     /*
236      * Compute when the event should fire.
237      */
238 
239     Tcl_GetTime(&time);
240     timerHandlerPtr->time.sec = time.sec + milliseconds/1000;
241     timerHandlerPtr->time.usec = time.usec + (milliseconds%1000)*1000;
242     if (timerHandlerPtr->time.usec >= 1000000) {
243   timerHandlerPtr->time.usec -= 1000000;
244   timerHandlerPtr->time.sec += 1;
245     }
246 
247     /*
248      * Fill in other fields for the event.
249      */
250 
251     timerHandlerPtr->proc = proc;
252     timerHandlerPtr->clientData = clientData;
253     tsdPtr->lastTimerId++;
254     timerHandlerPtr->token = (Tcl_TimerToken) tsdPtr->lastTimerId;
255 
256     /*
257      * Add the event to the queue in the correct position
258      * (ordered by event firing time).
259      */
260 
261     for (tPtr2 = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL;
262       prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) {
263   if ((tPtr2->time.sec > timerHandlerPtr->time.sec)
264     || ((tPtr2->time.sec == timerHandlerPtr->time.sec)
265     && (tPtr2->time.usec > timerHandlerPtr->time.usec))) {
266       break;
267   }
268     }
269     timerHandlerPtr->nextPtr = tPtr2;
270     if (prevPtr == NULL) {
271   tsdPtr->firstTimerHandlerPtr = timerHandlerPtr;
272     } else {
273   prevPtr->nextPtr = timerHandlerPtr;
274     }
275 
276     TimerSetupProc(NULL, TCL_ALL_EVENTS);
277 
278     return timerHandlerPtr->token;
279 }
void Tcl_DeleteTimerHandler (Tcl_TimerToken token)

Definition at line 301 of file tclTimer.c.
References ckfree, ThreadSpecificData::firstTimerHandlerPtr, InitTimer(), TimerHandler::nextPtr, NULL, and TimerHandler::token.
Referenced by AfterCleanupProc(), CloseChannel(), Tcl_AfterObjCmd(), Tcl_ClearChannelHandlers(), TransformCloseProc(), TransformNotifyProc(), and TransformWatchProc().304 {
305     register TimerHandler *timerHandlerPtr, *prevPtr;
306     ThreadSpecificData *tsdPtr = InitTimer();
307 
308     if (token == NULL) {
309   return;
310     }
311 
312     for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL;
313       timerHandlerPtr != NULL; prevPtr = timerHandlerPtr,
314       timerHandlerPtr = timerHandlerPtr->nextPtr) {
315   if (timerHandlerPtr->token != token) {
316       continue;
317   }
318   if (prevPtr == NULL) {
319       tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
320   } else {
321       prevPtr->nextPtr = timerHandlerPtr->nextPtr;
322   }
323   ckfree((char *) timerHandlerPtr);
324   return;
325     }
326 }
void Tcl_DoWhenIdle (Tcl_IdleProc * proc, ClientData clientData)

Definition at line 573 of file tclTimer.c.
References ckalloc, IdleHandler::clientData, IdleHandler::generation, ThreadSpecificData::idleGeneration, ThreadSpecificData::idleList, InitTimer(), ThreadSpecificData::lastIdlePtr, IdleHandler::nextPtr, NULL, IdleHandler::proc, Tcl_Time::sec, Tcl_SetMaxBlockTime(), and Tcl_Time::usec.
Referenced by Tcl_AfterObjCmd(), and Tcl_BackgroundError().576 {
577     register IdleHandler *idlePtr;
578     Tcl_Time blockTime;
579     ThreadSpecificData *tsdPtr = InitTimer();
580 
581     idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler));
582     idlePtr->proc = proc;
583     idlePtr->clientData = clientData;
584     idlePtr->generation = tsdPtr->idleGeneration;
585     idlePtr->nextPtr = NULL;
586     if (tsdPtr->lastIdlePtr == NULL) {
587   tsdPtr->idleList = idlePtr;
588     } else {
589   tsdPtr->lastIdlePtr->nextPtr = idlePtr;
590     }
591     tsdPtr->lastIdlePtr = idlePtr;
592 
593     blockTime.sec = 0;
594     blockTime.usec = 0;
595     Tcl_SetMaxBlockTime(&blockTime);
596 }
int TclServiceIdle ()

Definition at line 666 of file tclTimer.c.
References ckfree, IdleHandler::clientData, IdleHandler::generation, ThreadSpecificData::idleGeneration, ThreadSpecificData::idleList, InitTimer(), ThreadSpecificData::lastIdlePtr, IdleHandler::nextPtr, NULL, IdleHandler::proc, Tcl_Time::sec, Tcl_SetMaxBlockTime(), and Tcl_Time::usec.
Referenced by Tcl_DoOneEvent(), and Tcl_ServiceAll().667 {
668     IdleHandler *idlePtr;
669     int oldGeneration;
670     Tcl_Time blockTime;
671     ThreadSpecificData *tsdPtr = InitTimer();
672 
673     if (tsdPtr->idleList == NULL) {
674   return 0;
675     }
676 
677     oldGeneration = tsdPtr->idleGeneration;
678     tsdPtr->idleGeneration++;
679 
680     /*
681      * The code below is trickier than it may look, for the following
682      * reasons:
683      *
684      * 1. New handlers can get added to the list while the current
685      *    one is being processed.  If new ones get added, we don't
686      *    want to process them during this pass through the list (want
687      *    to check for other work to do first).  This is implemented
688      *    using the generation number in the handler:  new handlers
689      *    will have a different generation than any of the ones currently
690      *    on the list.
691      * 2. The handler can call Tcl_DoOneEvent, so we have to remove
692      *    the handler from the list before calling it. Otherwise an
693      *    infinite loop could result.
694      * 3. Tcl_CancelIdleCall can be called to remove an element from
695      *    the list while a handler is executing, so the list could
696      *    change structure during the call.
697      */
698 
699     for (idlePtr = tsdPtr->idleList;
700       ((idlePtr != NULL)
701         && ((oldGeneration - idlePtr->generation) >= 0));
702       idlePtr = tsdPtr->idleList) {
703   tsdPtr->idleList = idlePtr->nextPtr;
704   if (tsdPtr->idleList == NULL) {
705       tsdPtr->lastIdlePtr = NULL;
706   }
707   (*idlePtr->proc)(idlePtr->clientData);
708   ckfree((char *) idlePtr);
709     }
710     if (tsdPtr->idleList) {
711   blockTime.sec = 0;
712   blockTime.usec = 0;
713   Tcl_SetMaxBlockTime(&blockTime);
714     }
715     return 1;
716 }
static void TimerCheckProc (ClientData data, int flags) [static]

Definition at line 406 of file tclTimer.c.
References ckalloc, ThreadSpecificData::firstTimerHandlerPtr, InitTimer(), Tcl_Event::proc, Tcl_Time::sec, Tcl_GetTime(), TCL_QUEUE_TAIL, Tcl_QueueEvent(), TCL_TIMER_EVENTS, TimerHandler::time, TimerHandlerEventProc(), ThreadSpecificData::timerPending, and Tcl_Time::usec.
Referenced by InitTimer(), and TimerExitProc().409 {
410     Tcl_Event *timerEvPtr;
411     Tcl_Time blockTime;
412     ThreadSpecificData *tsdPtr = InitTimer();
413 
414     if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
415   /*
416    * Compute the timeout for the next timer on the list.
417    */
418 
419   Tcl_GetTime(&blockTime);
420   blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;
421   blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -
422     blockTime.usec;
423   if (blockTime.usec < 0) {
424       blockTime.sec -= 1;
425       blockTime.usec += 1000000;
426   }
427   if (blockTime.sec < 0) {
428       blockTime.sec = 0;
429       blockTime.usec = 0;
430   }
431 
432   /*
433    * If the first timer has expired, stick an event on the queue.
434    */
435 
436   if (blockTime.sec == 0 && blockTime.usec == 0 &&
437     !tsdPtr->timerPending) {
438       tsdPtr->timerPending = 1;
439       timerEvPtr = (Tcl_Event *) ckalloc(sizeof(Tcl_Event));
440       timerEvPtr->proc = TimerHandlerEventProc;
441       Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);
442   }
443     }
444 }
static void TimerExitProc (ClientData clientData) [static]

Definition at line 183 of file tclTimer.c.
References ckfree, dataKey, ThreadSpecificData::firstTimerHandlerPtr, TimerHandler::nextPtr, NULL, Tcl_DeleteEventSource(), TclThreadDataKeyGet(), TimerCheckProc(), and TimerSetupProc().
Referenced by InitTimer().185 {
186     ThreadSpecificData *tsdPtr =
187   (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
188 
189     Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
190     if (tsdPtr != NULL) {
191   register TimerHandler *timerHandlerPtr;
192   timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
193   while (timerHandlerPtr != NULL) {
194       tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
195       ckfree((char *) timerHandlerPtr);
196       timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
197   }
198     }
199 }
static int TimerHandlerEventProc (Tcl_Event * evPtr, int flags) [static]

Definition at line 469 of file tclTimer.c.
References ckfree, TimerHandler::clientData, ThreadSpecificData::firstTimerHandlerPtr, InitTimer(), ThreadSpecificData::lastTimerId, TimerHandler::nextPtr, NULL, TimerHandler::proc, Tcl_Time::sec, Tcl_GetTime(), TCL_TIMER_EVENTS, TimerHandler::time, ThreadSpecificData::timerPending, TimerSetupProc(), TimerHandler::token, and Tcl_Time::usec.
Referenced by TimerCheckProc().473 {
474     TimerHandler *timerHandlerPtr, **nextPtrPtr;
475     Tcl_Time time;
476     int currentTimerId;
477     ThreadSpecificData *tsdPtr = InitTimer();
478 
479     /*
480      * Do nothing if timers aren't enabled.  This leaves the event on the
481      * queue, so we will get to it as soon as ServiceEvents() is called
482      * with timers enabled.
483      */
484 
485     if (!(flags & TCL_TIMER_EVENTS)) {
486   return 0;
487     }
488 
489     /*
490      * The code below is trickier than it may look, for the following
491      * reasons:
492      *
493      * 1. New handlers can get added to the list while the current
494      *    one is being processed.  If new ones get added, we don't
495      *    want to process them during this pass through the list to avoid
496      *    starving other event sources.  This is implemented using the
497      *    token number in the handler:  new handlers will have a
498      *    newer token than any of the ones currently on the list.
499      * 2. The handler can call Tcl_DoOneEvent, so we have to remove
500      *    the handler from the list before calling it. Otherwise an
501      *    infinite loop could result.
502      * 3. Tcl_DeleteTimerHandler can be called to remove an element from
503      *    the list while a handler is executing, so the list could
504      *    change structure during the call.
505      * 4. Because we only fetch the current time before entering the loop,
506      *    the only way a new timer will even be considered runnable is if
507      *    its expiration time is within the same millisecond as the
508      *    current time.  This is fairly likely on Windows, since it has
509      *    a course granularity clock.  Since timers are placed
510      *    on the queue in time order with the most recently created
511      *    handler appearing after earlier ones with the same expiration
512      *    time, we don't have to worry about newer generation timers
513      *    appearing before later ones.
514      */
515 
516     tsdPtr->timerPending = 0;
517     currentTimerId = tsdPtr->lastTimerId;
518     Tcl_GetTime(&time);
519     while (1) {
520   nextPtrPtr = &tsdPtr->firstTimerHandlerPtr;
521   timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
522   if (timerHandlerPtr == NULL) {
523       break;
524   }
525       
526   if ((timerHandlerPtr->time.sec > time.sec)
527     || ((timerHandlerPtr->time.sec == time.sec)
528       && (timerHandlerPtr->time.usec > time.usec))) {
529       break;
530   }
531 
532   /*
533    * Bail out if the next timer is of a newer generation.
534    */
535 
536   if ((currentTimerId - (int)timerHandlerPtr->token) < 0) {
537       break;
538   }
539 
540   /*
541    * Remove the handler from the queue before invoking it,
542    * to avoid potential reentrancy problems.
543    */
544 
545   (*nextPtrPtr) = timerHandlerPtr->nextPtr;
546   (*timerHandlerPtr->proc)(timerHandlerPtr->clientData);
547   ckfree((char *) timerHandlerPtr);
548     }
549     TimerSetupProc(NULL, TCL_TIMER_EVENTS);
550     return 1;
551 }
static void TimerSetupProc (ClientData data, int flags) [static]

Definition at line 347 of file tclTimer.c.
References ThreadSpecificData::firstTimerHandlerPtr, ThreadSpecificData::idleList, InitTimer(), Tcl_Time::sec, Tcl_GetTime(), TCL_IDLE_EVENTS, Tcl_SetMaxBlockTime(), TCL_TIMER_EVENTS, TimerHandler::time, ThreadSpecificData::timerPending, and Tcl_Time::usec.
Referenced by InitTimer(), Tcl_CreateTimerHandler(), TimerExitProc(), and TimerHandlerEventProc().350 {
351     Tcl_Time blockTime;
352     ThreadSpecificData *tsdPtr = InitTimer();
353 
354     if (((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList)
355       || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending)) {
356   /*
357    * There is an idle handler or a pending timer event, so just poll.
358    */
359 
360   blockTime.sec = 0;
361   blockTime.usec = 0;
362 
363     } else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
364   /*
365    * Compute the timeout for the next timer on the list.
366    */
367 
368   Tcl_GetTime(&blockTime);
369   blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;
370   blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -
371     blockTime.usec;
372   if (blockTime.usec < 0) {
373       blockTime.sec -= 1;
374       blockTime.usec += 1000000;
375   }
376   if (blockTime.sec < 0) {
377       blockTime.sec = 0;
378       blockTime.usec = 0;
379   }
380     } else {
381   return;
382     }
383   
384     Tcl_SetMaxBlockTime(&blockTime);
385 }

Variable Documentation
Tcl_ThreadDataKey dataKey [static]

Definition at line 114 of file tclTimer.c.

generic/tclUniData.c File Reference
Defines
#define OFFSET_BITS  5
#define UNICODE_CATEGORY_MASK  0X1F
#define GetCaseType(info)  (((info) & 0xE0) >> 5)
#define GetCategory(info)  ((info) & 0x1F)
#define GetDelta(info)  (((info) > 0) ? ((info) >> 22) : (~(~((info)) >> 22)))
#define GetUniCharInfo(ch)  (groups[groupMap[(pageMap[(((int)(ch)) & 0xffff) >> OFFSET_BITS] << OFFSET_BITS) | ((ch) & ((1 << OFFSET_BITS)-1))]])
Enumerations
enum { UNASSIGNED, UPPERCASE_LETTER, LOWERCASE_LETTER, TITLECASE_LETTER, MODIFIER_LETTER, OTHER_LETTER, NON_SPACING_MARK, ENCLOSING_MARK, COMBINING_SPACING_MARK, DECIMAL_DIGIT_NUMBER, LETTER_NUMBER, OTHER_NUMBER, SPACE_SEPARATOR, LINE_SEPARATOR, PARAGRAPH_SEPARATOR, CONTROL, FORMAT, PRIVATE_USE, SURROGATE, CONNECTOR_PUNCTUATION, DASH_PUNCTUATION, OPEN_PUNCTUATION, CLOSE_PUNCTUATION, INITIAL_QUOTE_PUNCTUATION, FINAL_QUOTE_PUNCTUATION, OTHER_PUNCTUATION, MATH_SYMBOL, CURRENCY_SYMBOL, MODIFIER_SYMBOL, OTHER_SYMBOL }
Variables
static unsigned char pageMap []
static unsigned char groupMap []
static int groups []

Define Documentation
#define GetCaseType(info)  (((info) & 0xE0) >> 5)

Definition at line 894 of file tclUniData.c.
Referenced by Tcl_UniCharToLower(), Tcl_UniCharToTitle(), and Tcl_UniCharToUpper().#define GetCategory(info)  ((info) & 0x1F)

Definition at line 895 of file tclUniData.c.#define GetDelta(info)  (((info) > 0) ? ((info) >> 22) : (~(~((info)) >> 22)))

Definition at line 896 of file tclUniData.c.
Referenced by Tcl_UniCharToLower(), Tcl_UniCharToTitle(), and Tcl_UniCharToUpper().#define GetUniCharInfo(ch)  (groups[groupMap[(pageMap[(((int)(ch)) & 0xffff) >> OFFSET_BITS] << OFFSET_BITS) | ((ch) & ((1 << OFFSET_BITS)-1))]])

Definition at line 903 of file tclUniData.c.
Referenced by Tcl_UniCharIsAlnum(), Tcl_UniCharIsAlpha(), Tcl_UniCharIsControl(), Tcl_UniCharIsDigit(), Tcl_UniCharIsGraph(), Tcl_UniCharIsLower(), Tcl_UniCharIsPrint(), Tcl_UniCharIsPunct(), Tcl_UniCharIsSpace(), Tcl_UniCharIsUpper(), Tcl_UniCharIsWordChar(), Tcl_UniCharToLower(), Tcl_UniCharToTitle(), and Tcl_UniCharToUpper().#define OFFSET_BITS  5

Definition at line 20 of file tclUniData.c.#define UNICODE_CATEGORY_MASK  0X1F

Definition at line 853 of file tclUniData.c.
Referenced by Tcl_UniCharIsAlnum(), Tcl_UniCharIsAlpha(), Tcl_UniCharIsControl(), Tcl_UniCharIsDigit(), Tcl_UniCharIsGraph(), Tcl_UniCharIsLower(), Tcl_UniCharIsPrint(), Tcl_UniCharIsPunct(), Tcl_UniCharIsSpace(), Tcl_UniCharIsUpper(), and Tcl_UniCharIsWordChar().
Enumeration Type Documentation
anonymous enum

Enumerator: 
UNASSIGNED  
UPPERCASE_LETTER  
LOWERCASE_LETTER  
TITLECASE_LETTER  
MODIFIER_LETTER  
OTHER_LETTER  
NON_SPACING_MARK  
ENCLOSING_MARK  
COMBINING_SPACING_MARK  
DECIMAL_DIGIT_NUMBER  
LETTER_NUMBER  
OTHER_NUMBER  
SPACE_SEPARATOR  
LINE_SEPARATOR  
PARAGRAPH_SEPARATOR  
CONTROL  
FORMAT  
PRIVATE_USE  
SURROGATE  
CONNECTOR_PUNCTUATION  
DASH_PUNCTUATION  
OPEN_PUNCTUATION  
CLOSE_PUNCTUATION  
INITIAL_QUOTE_PUNCTUATION  
FINAL_QUOTE_PUNCTUATION  
OTHER_PUNCTUATION  
MATH_SYMBOL  
CURRENCY_SYMBOL  
MODIFIER_SYMBOL  
OTHER_SYMBOL  

Definition at line 855 of file tclUniData.c.855      {
856     UNASSIGNED,
857     UPPERCASE_LETTER,
858     LOWERCASE_LETTER,
859     TITLECASE_LETTER,
860     MODIFIER_LETTER,
861     OTHER_LETTER,
862     NON_SPACING_MARK,
863     ENCLOSING_MARK,
864     COMBINING_SPACING_MARK,
865     DECIMAL_DIGIT_NUMBER,
866     LETTER_NUMBER,
867     OTHER_NUMBER,
868     SPACE_SEPARATOR,
869     LINE_SEPARATOR,
870     PARAGRAPH_SEPARATOR,
871     CONTROL,
872     FORMAT,
873     PRIVATE_USE,
874     SURROGATE,
875     CONNECTOR_PUNCTUATION,
876     DASH_PUNCTUATION,
877     OPEN_PUNCTUATION,
878     CLOSE_PUNCTUATION,
879     INITIAL_QUOTE_PUNCTUATION,
880     FINAL_QUOTE_PUNCTUATION,
881     OTHER_PUNCTUATION,
882     MATH_SYMBOL,
883     CURRENCY_SYMBOL,
884     MODIFIER_SYMBOL,
885     OTHER_SYMBOL
886 };

Variable Documentation
unsigned char groupMap[] [static]

Definition at line 391 of file tclUniData.c.int groups[] [static]
Initial value: {
    0, 15, 12, 25, 27, 21, 22, 26, 20, 9, 134217793, 28, 19, 134217858, 
    29, 2, 23, 11, 1178599554, 24, -507510654, 4194369, 4194434, -834666431, 
    973078658, -507510719, 1258291330, 880803905, 864026689, 859832385, 
    331350081, 847249473, 851443777, 868220993, -406847358, 884998209, 
    876609601, 893386817, 897581121, 914358337, 910164033, 918552641, 
    5, -234880894, 8388705, 4194499, 8388770, 331350146, -406847423, 
    -234880959, 880803970, 864026754, 859832450, 847249538, 851443842, 
    868221058, 876609666, 884998274, 893386882, 897581186, 914358402, 
    910164098, 918552706, 4, 6, -352321402, 159383617, 155189313, 
    268435521, 264241217, 159383682, 155189378, 130023554, 268435586, 
    264241282, 260046978, 239075458, 1, 197132418, 226492546, 360710274, 
    335544450, -251658175, 402653314, 335544385, 7, 201326657, 201326722, 
    16, 8, 10, 247464066, -33554302, -33554367, -310378366, -360710014, 
    -419430270, -536870782, -469761918, -528482174, -33554365, -37748606, 
    -310378431, -37748669, 155189378, -360710079, -419430335, -29359998, 
    -469761983, -29360063, -536870847, -528482239, 13, 14, -1463812031, 
    -801111999, -293601215, 67108938, 67109002, 109051997, 109052061, 
    18, 17, 8388673, 12582977, 8388738, 12583042
}
Definition at line 827 of file tclUniData.c.unsigned char pageMap[] [static]

Definition at line 28 of file tclUniData.c.

generic/tclUtf.c File Reference
#include "tclInt.h"
#include "tclUniData.c"
Defines
#define ALPHA_BITS
#define DIGIT_BITS  (1 << DECIMAL_DIGIT_NUMBER)
#define SPACE_BITS
#define CONNECTOR_BITS  (1 << CONNECTOR_PUNCTUATION)
#define PRINT_BITS
#define PUNCT_BITS
#define UNICODE_SELF  0x80
#define LINE_LENGTH  128
Functions
static int UtfCount _ANSI_ARGS_ ((int ch))
static INLINE int UtfCount (int ch)
INLINE int Tcl_UniCharToUtf (int ch, char *str)
char * Tcl_UniCharToUtfDString (CONST Tcl_UniChar *wString, int numChars, Tcl_DString *dsPtr)
int Tcl_UtfToUniChar (CONST char *str, Tcl_UniChar *chPtr)
Tcl_UniChar * Tcl_UtfToUniCharDString (CONST char *string, int length, Tcl_DString *dsPtr)
int Tcl_UtfCharComplete (CONST char *str, int len)
int Tcl_NumUtfChars (CONST char *str, int len)
CONST char * Tcl_UtfFindFirst (CONST char *string, int ch)
CONST char * Tcl_UtfFindLast (CONST char *string, int ch)
CONST char * Tcl_UtfNext (CONST char *str)
CONST char * Tcl_UtfPrev (CONST char *str, CONST char *start)
Tcl_UniChar Tcl_UniCharAtIndex (CONST char *src, int index)
CONST char * Tcl_UtfAtIndex (CONST char *src, int index)
int Tcl_UtfBackslash (CONST char *src, int *readPtr, char *dst)
int Tcl_UtfToUpper (char *str)
int Tcl_UtfToLower (char *str)
int Tcl_UtfToTitle (char *str)
int TclpUtfNcmp2 (CONST char *cs, CONST char *ct, unsigned long n)
int Tcl_UtfNcmp (CONST char *cs, CONST char *ct, unsigned long n)
int Tcl_UtfNcasecmp (CONST char *cs, CONST char *ct, unsigned long n)
Tcl_UniChar Tcl_UniCharToUpper (int ch)
Tcl_UniChar Tcl_UniCharToLower (int ch)
Tcl_UniChar Tcl_UniCharToTitle (int ch)
int Tcl_UniCharLen (CONST Tcl_UniChar *str)
int Tcl_UniCharNcmp (CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct, unsigned long n)
int Tcl_UniCharNcasecmp (CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct, unsigned long n)
int Tcl_UniCharIsAlnum (int ch)
int Tcl_UniCharIsAlpha (int ch)
int Tcl_UniCharIsControl (int ch)
int Tcl_UniCharIsDigit (int ch)
int Tcl_UniCharIsGraph (int ch)
int Tcl_UniCharIsLower (int ch)
int Tcl_UniCharIsPrint (int ch)
int Tcl_UniCharIsPunct (int ch)
int Tcl_UniCharIsSpace (int ch)
int Tcl_UniCharIsUpper (int ch)
int Tcl_UniCharIsWordChar (int ch)
int Tcl_UniCharCaseMatch (CONST Tcl_UniChar *string, CONST Tcl_UniChar *pattern, int nocase)
int TclUniCharMatch (CONST Tcl_UniChar *string, int strLen, CONST Tcl_UniChar *pattern, int ptnLen, int nocase)
Variables
static CONST unsigned char totalBytes [256]

Define Documentation
#define ALPHA_BITS
Value:((1 << UPPERCASE_LETTER) | (1 << LOWERCASE_LETTER) \
    | (1 << TITLECASE_LETTER) | (1 << MODIFIER_LETTER) | (1 << OTHER_LETTER))
Definition at line 28 of file tclUtf.c.
Referenced by Tcl_UniCharIsAlnum(), Tcl_UniCharIsAlpha(), and Tcl_UniCharIsWordChar().#define CONNECTOR_BITS  (1 << CONNECTOR_PUNCTUATION)

Definition at line 36 of file tclUtf.c.
Referenced by Tcl_UniCharIsWordChar().#define DIGIT_BITS  (1 << DECIMAL_DIGIT_NUMBER)

Definition at line 31 of file tclUtf.c.
Referenced by Tcl_UniCharIsAlnum(), and Tcl_UniCharIsWordChar().#define LINE_LENGTH  128

Referenced by Tcl_UtfBackslash().#define PRINT_BITS
Value:(ALPHA_BITS | DIGIT_BITS | SPACE_BITS | \
      (1 << NON_SPACING_MARK) | (1 << ENCLOSING_MARK) | \
      (1 << COMBINING_SPACING_MARK) | (1 << LETTER_NUMBER) | \
      (1 << OTHER_NUMBER) | (1 << CONNECTOR_PUNCTUATION) | \
      (1 << DASH_PUNCTUATION) | (1 << OPEN_PUNCTUATION) | \
      (1 << CLOSE_PUNCTUATION) | (1 << INITIAL_QUOTE_PUNCTUATION) | \
      (1 << FINAL_QUOTE_PUNCTUATION) | (1 << OTHER_PUNCTUATION) | \
      (1 << MATH_SYMBOL) | (1 << CURRENCY_SYMBOL) | \
      (1 << MODIFIER_SYMBOL) | (1 << OTHER_SYMBOL))
Definition at line 38 of file tclUtf.c.
Referenced by Tcl_UniCharIsGraph(), and Tcl_UniCharIsPrint().#define PUNCT_BITS
Value:((1 << CONNECTOR_PUNCTUATION) | \
      (1 << DASH_PUNCTUATION) | (1 << OPEN_PUNCTUATION) | \
      (1 << CLOSE_PUNCTUATION) | (1 << INITIAL_QUOTE_PUNCTUATION) | \
      (1 << FINAL_QUOTE_PUNCTUATION) | (1 << OTHER_PUNCTUATION))
Definition at line 48 of file tclUtf.c.
Referenced by Tcl_UniCharIsPunct().#define SPACE_BITS
Value:((1 << SPACE_SEPARATOR) | (1 << LINE_SEPARATOR) \
    | (1 << PARAGRAPH_SEPARATOR))
Definition at line 33 of file tclUtf.c.
Referenced by Tcl_UniCharIsSpace().#define UNICODE_SELF  0x80

Definition at line 58 of file tclUtf.c.
Referenced by Tcl_UniCharToUtf(), and UtfCount().
Function Documentation
static int UtfCount _ANSI_ARGS_ ((int ch)) [static]
int Tcl_NumUtfChars (CONST char * str, int len)

Definition at line 488 of file tclUtf.c.
References Tcl_UtfToUniChar(), TclUtfToUniChar, and UCHAR.
Referenced by AppendUtfToUnicodeRep(), FillUnicodeRep(), Tcl_FormatObjCmd(), Tcl_GetCharLength(), Tcl_StringObjCmd(), TclCompileStringCmd(), and TestNumUtfCharsCmd().492 {
493     Tcl_UniChar ch;
494     register Tcl_UniChar *chPtr = &ch;
495     register int i;
496 
497     /*
498      * The separate implementations are faster.
499      *
500      * Since this is a time-sensitive function, we also do the check for
501      * the single-byte char case specially.
502      */
503 
504     i = 0;
505     if (len < 0) {
506   while (*str != '\0') {
507       str += TclUtfToUniChar(str, chPtr);
508       i++;
509   }
510     } else {
511   register int n;
512 
513   while (len > 0) {
514       if (UCHAR(*str) < 0xC0) {
515     len--;
516     str++;
517       } else {
518     n = Tcl_UtfToUniChar(str, chPtr);
519     len -= n;
520     str += n;
521       }
522       i++;
523   }
524     }
525     return i;
526 }
Tcl_UniChar Tcl_UniCharAtIndex (CONST char * src, int index)

Definition at line 709 of file tclUtf.c.
References TclUtfToUniChar.712 {
713     Tcl_UniChar ch;
714 
715     while (index >= 0) {
716   index--;
717   src += TclUtfToUniChar(src, &ch);
718     }
719     return ch;
720 }
int Tcl_UniCharCaseMatch (CONST Tcl_UniChar * string, CONST Tcl_UniChar * pattern, int nocase)

Definition at line 1607 of file tclUtf.c.
References Tcl_UniCharToLower().1612 {
1613     Tcl_UniChar ch1, p;
1614     
1615     while (1) {
1616   p = *pattern;
1617   
1618   /*
1619    * See if we're at the end of both the pattern and the string.  If
1620    * so, we succeeded.  If we're at the end of the pattern but not at
1621    * the end of the string, we failed.
1622    */
1623   
1624   if (p == 0) {
1625       return (*string == 0);
1626   }
1627   if ((*string == 0) && (p != '*')) {
1628       return 0;
1629   }
1630 
1631   /*
1632    * Check for a "*" as the next pattern character.  It matches any
1633    * substring.  We handle this by skipping all the characters up to the
1634    * next matching one in the pattern, and then calling ourselves
1635    * recursively for each postfix of string, until either we match or we
1636    * reach the end of the string.
1637    */
1638   
1639   if (p == '*') {
1640       /*
1641        * Skip all successive *'s in the pattern
1642        */
1643       while (*(++pattern) == '*') {}
1644       p = *pattern;
1645       if (p == 0) {
1646     return 1;
1647       }
1648       if (nocase) {
1649     p = Tcl_UniCharToLower(p);
1650       }
1651       while (1) {
1652     /*
1653      * Optimization for matching - cruise through the string
1654      * quickly if the next char in the pattern isn't a special
1655      * character
1656      */
1657     if ((p != '[') && (p != '?') && (p != '\\')) {
1658         if (nocase) {
1659       while (*string && (p != *string)
1660         && (p != Tcl_UniCharToLower(*string))) {
1661           string++;
1662       }
1663         } else {
1664       while (*string && (p != *string)) { string++; }
1665         }
1666     }
1667     if (Tcl_UniCharCaseMatch(string, pattern, nocase)) {
1668         return 1;
1669     }
1670     if (*string == 0) {
1671         return 0;
1672     }
1673     string++;
1674       }
1675   }
1676 
1677   /*
1678    * Check for a "?" as the next pattern character.  It matches
1679    * any single character.
1680    */
1681 
1682   if (p == '?') {
1683       pattern++;
1684       string++;
1685       continue;
1686   }
1687 
1688   /*
1689    * Check for a "[" as the next pattern character.  It is followed
1690    * by a list of characters that are acceptable, or by a range
1691    * (two characters separated by "-").
1692    */
1693   
1694   if (p == '[') {
1695       Tcl_UniChar startChar, endChar;
1696 
1697       pattern++;
1698       ch1 = (nocase ? Tcl_UniCharToLower(*string) : *string);
1699       string++;
1700       while (1) {
1701     if ((*pattern == ']') || (*pattern == 0)) {
1702         return 0;
1703     }
1704     startChar = (nocase ? Tcl_UniCharToLower(*pattern) : *pattern);
1705     pattern++;
1706     if (*pattern == '-') {
1707         pattern++;
1708         if (*pattern == 0) {
1709       return 0;
1710         }
1711         endChar = (nocase ? Tcl_UniCharToLower(*pattern)
1712           : *pattern);
1713         pattern++;
1714         if (((startChar <= ch1) && (ch1 <= endChar))
1715           || ((endChar <= ch1) && (ch1 <= startChar))) {
1716       /*
1717        * Matches ranges of form [a-z] or [z-a].
1718        */
1719       break;
1720         }
1721     } else if (startChar == ch1) {
1722         break;
1723     }
1724       }
1725       while (*pattern != ']') {
1726     if (*pattern == 0) {
1727         pattern--;
1728         break;
1729     }
1730     pattern++;
1731       }
1732       pattern++;
1733       continue;
1734   }
1735 
1736   /*
1737    * If the next pattern character is '\', just strip off the '\'
1738    * so we do exact matching on the character that follows.
1739    */
1740 
1741   if (p == '\\') {
1742       if (*(++pattern) == '\0') {
1743     return 0;
1744       }
1745   }
1746 
1747   /*
1748    * There's no special character.  Just make sure that the next
1749    * bytes of each string match.
1750    */
1751 
1752   if (nocase) {
1753       if (Tcl_UniCharToLower(*string) != Tcl_UniCharToLower(*pattern)) {
1754     return 0;
1755       }
1756   } else if (*string != *pattern) {
1757       return 0;
1758   }
1759   string++;
1760   pattern++;
1761     }
1762 }
int Tcl_UniCharIsAlnum (int ch)

Definition at line 1324 of file tclUtf.c.
References ALPHA_BITS, DIGIT_BITS, GetUniCharInfo, and UNICODE_CATEGORY_MASK.
Referenced by Tcl_StringObjCmd().1326 {
1327     register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
1328 
1329     return (((ALPHA_BITS | DIGIT_BITS) >> category) & 1);
1330 }
int Tcl_UniCharIsAlpha (int ch)

Definition at line 1349 of file tclUtf.c.
References ALPHA_BITS, GetUniCharInfo, and UNICODE_CATEGORY_MASK.
Referenced by Tcl_StringObjCmd().1351 {
1352     register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
1353     return ((ALPHA_BITS >> category) & 1);
1354 }
int Tcl_UniCharIsControl (int ch)

Definition at line 1373 of file tclUtf.c.
References CONTROL, GetUniCharInfo, and UNICODE_CATEGORY_MASK.
Referenced by Tcl_StringObjCmd().1375 {
1376     return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == CONTROL);
1377 }
int Tcl_UniCharIsDigit (int ch)

Definition at line 1396 of file tclUtf.c.
References DECIMAL_DIGIT_NUMBER, GetUniCharInfo, and UNICODE_CATEGORY_MASK.
Referenced by Tcl_StringObjCmd().1398 {
1399     return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK)
1400       == DECIMAL_DIGIT_NUMBER);
1401 }
int Tcl_UniCharIsGraph (int ch)

Definition at line 1420 of file tclUtf.c.
References GetUniCharInfo, PRINT_BITS, and UNICODE_CATEGORY_MASK.
Referenced by Tcl_StringObjCmd().1422 {
1423     register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
1424     return (((PRINT_BITS >> category) & 1) && ((unsigned char) ch != ' '));
1425 }
int Tcl_UniCharIsLower (int ch)

Definition at line 1444 of file tclUtf.c.
References GetUniCharInfo, LOWERCASE_LETTER, and UNICODE_CATEGORY_MASK.
Referenced by DictionaryCompare(), and Tcl_StringObjCmd().1446 {
1447     return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == LOWERCASE_LETTER);
1448 }
int Tcl_UniCharIsPrint (int ch)

Definition at line 1467 of file tclUtf.c.
References GetUniCharInfo, PRINT_BITS, and UNICODE_CATEGORY_MASK.
Referenced by Tcl_StringObjCmd().1469 {
1470     register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
1471     return ((PRINT_BITS >> category) & 1);
1472 }
int Tcl_UniCharIsPunct (int ch)

Definition at line 1491 of file tclUtf.c.
References GetUniCharInfo, PUNCT_BITS, and UNICODE_CATEGORY_MASK.
Referenced by Tcl_StringObjCmd().1493 {
1494     register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
1495     return ((PUNCT_BITS >> category) & 1);
1496 }
int Tcl_UniCharIsSpace (int ch)

Definition at line 1515 of file tclUtf.c.
References GetUniCharInfo, SPACE_BITS, UCHAR, and UNICODE_CATEGORY_MASK.
Referenced by BuildCommandLine(), Tcl_ScanObjCmd(), and Tcl_StringObjCmd().1517 {
1518     register int category;
1519 
1520     /*
1521      * If the character is within the first 127 characters, just use the
1522      * standard C function, otherwise consult the Unicode table.
1523      */
1524 
1525     if (ch < 0x80) {
1526   return isspace(UCHAR(ch)); /* INTL: ISO space */
1527     } else {
1528   category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
1529   return ((SPACE_BITS >> category) & 1);
1530     }
1531 }
int Tcl_UniCharIsUpper (int ch)

Definition at line 1550 of file tclUtf.c.
References GetUniCharInfo, UNICODE_CATEGORY_MASK, and UPPERCASE_LETTER.
Referenced by DictionaryCompare(), SetBooleanFromAny(), and Tcl_StringObjCmd().1552 {
1553     return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == UPPERCASE_LETTER);
1554 }
int Tcl_UniCharIsWordChar (int ch)

Definition at line 1574 of file tclUtf.c.
References ALPHA_BITS, CONNECTOR_BITS, DIGIT_BITS, GetUniCharInfo, and UNICODE_CATEGORY_MASK.
Referenced by Tcl_StringObjCmd().1576 {
1577     register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
1578 
1579     return (((ALPHA_BITS | DIGIT_BITS | CONNECTOR_BITS) >> category) & 1);
1580 }
int Tcl_UniCharLen (CONST Tcl_UniChar * str)

Definition at line 1217 of file tclUtf.c.1219 {
1220     int len = 0;
1221     
1222     while (*str != '\0') {
1223   len++;
1224   str++;
1225     }
1226     return len;
1227 }
int Tcl_UniCharNcasecmp (CONST Tcl_UniChar * cs, CONST Tcl_UniChar * ct, unsigned long n)

Definition at line 1290 of file tclUtf.c.
References Tcl_UniCharToLower().
Referenced by Tcl_RegsubObjCmd(), and Tcl_StringObjCmd().1294 {
1295     for ( ; n != 0; n--, cs++, ct++) {
1296   if (*cs != *ct) {
1297       Tcl_UniChar lcs = Tcl_UniCharToLower(*cs);
1298       Tcl_UniChar lct = Tcl_UniCharToLower(*ct);
1299       if (lcs != lct) {
1300     return (lcs - lct);
1301       }
1302   }
1303     }
1304     return 0;
1305 }
int Tcl_UniCharNcmp (CONST Tcl_UniChar * cs, CONST Tcl_UniChar * ct, unsigned long n)

Definition at line 1247 of file tclUtf.c.
References memcmp().
Referenced by Tcl_RegsubObjCmd(), and Tcl_StringObjCmd().1251 {
1252 #ifdef WORDS_BIGENDIAN
1253     /*
1254      * We are definitely on a big-endian machine; memcmp() is safe
1255      */
1256     return memcmp(cs, ct, n*sizeof(Tcl_UniChar));
1257 
1258 #else /* !WORDS_BIGENDIAN */
1259     /*
1260      * We can't simply call memcmp() because that is not lexically correct.
1261      */
1262     for ( ; n != 0; cs++, ct++, n--) {
1263   if (*cs != *ct) {
1264       return (*cs - *ct);
1265   }
1266     }
1267     return 0;
1268 #endif /* WORDS_BIGENDIAN */
1269 }
Tcl_UniChar Tcl_UniCharToLower (int ch)

Definition at line 1151 of file tclUtf.c.
References GetCaseType, GetDelta, and GetUniCharInfo.
Referenced by allcases(), casecmp(), DictionaryCompare(), NativeStat(), range(), SetBooleanFromAny(), Tcl_RegsubObjCmd(), Tcl_StringCaseMatch(), Tcl_StringObjCmd(), Tcl_UniCharCaseMatch(), Tcl_UniCharNcasecmp(), Tcl_UtfNcasecmp(), Tcl_UtfToLower(), Tcl_UtfToTitle(), and TclUniCharMatch().1153 {
1154     int info = GetUniCharInfo(ch);
1155 
1156     if (GetCaseType(info) & 0x02) {
1157   return (Tcl_UniChar) (ch + GetDelta(info));
1158     } else {
1159   return ch;
1160     }
1161 }
Tcl_UniChar Tcl_UniCharToTitle (int ch)

Definition at line 1180 of file tclUtf.c.
References GetCaseType, GetDelta, and GetUniCharInfo.
Referenced by allcases(), range(), and Tcl_UtfToTitle().1182 {
1183     int info = GetUniCharInfo(ch);
1184     int mode = GetCaseType(info);
1185 
1186     if (mode & 0x1) {
1187   /*
1188    * Subtract or add one depending on the original case.
1189    */
1190 
1191   return (Tcl_UniChar) (ch + ((mode & 0x4) ? -1 : 1));
1192     } else if (mode == 0x4) {
1193   return (Tcl_UniChar) (ch - GetDelta(info));
1194     } else {
1195   return ch;
1196     }
1197 }
Tcl_UniChar Tcl_UniCharToUpper (int ch)

Definition at line 1122 of file tclUtf.c.
References GetCaseType, GetDelta, and GetUniCharInfo.
Referenced by allcases(), ConvertFileNameFormat(), range(), and Tcl_UtfToUpper().1124 {
1125     int info = GetUniCharInfo(ch);
1126 
1127     if (GetCaseType(info) & 0x04) {
1128   return (Tcl_UniChar) (ch - GetDelta(info));
1129     } else {
1130   return ch;
1131     }
1132 }
INLINE int Tcl_UniCharToUtf (int ch, char * str)

Definition at line 160 of file tclUtf.c.
References UNICODE_SELF.
Referenced by TableToUtfProc(), Tcl_BinaryObjCmd(), Tcl_FormatObjCmd(), Tcl_StringObjCmd(), Tcl_UniCharToUtfDString(), Tcl_UtfToLower(), Tcl_UtfToTitle(), Tcl_UtfToUpper(), TclExecuteByteCode(), TclParseBackslash(), ToUtf(), UnicodeToUtfProc(), UpdateStringOfByteArray(), UpdateStringOfString(), UtfToUtfProc(), and ValidateFormat().167 {
168     if ((ch > 0) && (ch < UNICODE_SELF)) {
169   str[0] = (char) ch;
170   return 1;
171     }
172     if (ch >= 0) {
173   if (ch <= 0x7FF) {
174       str[1] = (char) ((ch | 0x80) & 0xBF);
175       str[0] = (char) ((ch >> 6) | 0xC0);
176       return 2;
177   }
178   if (ch <= 0xFFFF) {
179   three:
180       str[2] = (char) ((ch | 0x80) & 0xBF);
181       str[1] = (char) (((ch >> 6) | 0x80) & 0xBF);
182       str[0] = (char) ((ch >> 12) | 0xE0);
183       return 3;
184   }
185 
186 #if TCL_UTF_MAX > 3
187   if (ch <= 0x1FFFFF) {
188       str[3] = (char) ((ch | 0x80) & 0xBF);
189       str[2] = (char) (((ch >> 6) | 0x80) & 0xBF);
190       str[1] = (char) (((ch >> 12) | 0x80) & 0xBF);
191       str[0] = (char) ((ch >> 18) | 0xF0);
192       return 4;
193   }
194   if (ch <= 0x3FFFFFF) {
195       str[4] = (char) ((ch | 0x80) & 0xBF);
196       str[3] = (char) (((ch >> 6) | 0x80) & 0xBF);
197       str[2] = (char) (((ch >> 12) | 0x80) & 0xBF);
198       str[1] = (char) (((ch >> 18) | 0x80) & 0xBF);
199       str[0] = (char) ((ch >> 24) | 0xF8);
200       return 5;
201   }
202   if (ch <= 0x7FFFFFFF) {
203       str[5] = (char) ((ch | 0x80) & 0xBF);
204       str[4] = (char) (((ch >> 6) | 0x80) & 0xBF);
205       str[3] = (char) (((ch >> 12) | 0x80) & 0xBF);
206       str[2] = (char) (((ch >> 18) | 0x80) & 0xBF);
207       str[1] = (char) (((ch >> 24) | 0x80) & 0xBF);
208       str[0] = (char) ((ch >> 30) | 0xFC);
209       return 6;
210   }
211 #endif
212     }
213 
214     ch = 0xFFFD;
215     goto three;
216 }
char* Tcl_UniCharToUtfDString (CONST Tcl_UniChar * wString, int numChars, Tcl_DString * dsPtr)

Definition at line 237 of file tclUtf.c.
References CONST, Tcl_DStringLength, Tcl_DStringSetLength(), Tcl_DStringValue, Tcl_UniCharToUtf(), and TCL_UTF_MAX.
Referenced by AppendUnicodeToUtfRep(), cclass(), element(), and TclpGetUserHome().244 {
245     CONST Tcl_UniChar *w, *wEnd;
246     char *p, *string;
247     int oldLength;
248 
249     /*
250      * UTF-8 string length in bytes will be <= Unicode string length *
251      * TCL_UTF_MAX.
252      */
253 
254     oldLength = Tcl_DStringLength(dsPtr);
255     Tcl_DStringSetLength(dsPtr, (oldLength + numChars + 1) * TCL_UTF_MAX);
256     string = Tcl_DStringValue(dsPtr) + oldLength;
257 
258     p = string;
259     wEnd = wString + numChars;
260     for (w = wString; w < wEnd; ) {
261   p += Tcl_UniCharToUtf(*w, p);
262   w++;
263     }
264     Tcl_DStringSetLength(dsPtr, oldLength + (p - string));
265 
266     return string;
267 }
CONST char* Tcl_UtfAtIndex (CONST char * src, int index)

Definition at line 740 of file tclUtf.c.
References TclUtfToUniChar.
Referenced by ReadChars(), Tcl_FormatObjCmd(), Tcl_RegExpRange(), and Tcl_StringObjCmd().743 {
744     Tcl_UniChar ch;
745     
746     while (index > 0) {
747   index--;
748   src += TclUtfToUniChar(src, &ch);
749     }
750     return src;
751 }
int Tcl_UtfBackslash (CONST char * src, int * readPtr, char * dst)

Definition at line 781 of file tclUtf.c.
References LINE_LENGTH, NULL, and TclParseBackslash().
Referenced by CompileSubExpr(), Tcl_Backslash(), Tcl_EvalTokensStandard(), Tcl_ScanCountedElement(), Tcl_SubstObj(), TclCompileTokens(), TclCopyAndCollapse(), and TclFindElement().788 {
789 #define LINE_LENGTH 128
790     int numRead;
791     int result;
792 
793     result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst);
794     if (numRead == LINE_LENGTH) {
795   /* We ate a whole line.  Pay the price of a strlen() */
796   result = TclParseBackslash(src, (int)strlen(src), &numRead, dst);
797     }
798     if (readPtr != NULL) {
799   *readPtr = numRead;
800     }
801     return result;
802 }
int Tcl_UtfCharComplete (CONST char * str, int len)

Definition at line 458 of file tclUtf.c.
References totalBytes.
Referenced by EscapeFromUtfProc(), GetLexeme(), TableFromUtfProc(), Tcl_ParseVarName(), TclParseBackslash(), UtfToUnicodeProc(), and UtfToUtfProc().462 {
463     int ch;
464 
465     ch = *((unsigned char *) str);
466     return len >= totalBytes[ch];
467 }
CONST char* Tcl_UtfFindFirst (CONST char * string, int ch)

Definition at line 548 of file tclUtf.c.
References find(), NULL, and TclUtfToUniChar.551 {
552     int len;
553     Tcl_UniChar find;
554     
555     while (1) {
556   len = TclUtfToUniChar(string, &find);
557   if (find == ch) {
558       return string;
559   }
560   if (*string == '\0') {
561       return NULL;
562   }
563   string += len;
564     }
565 }
CONST char* Tcl_UtfFindLast (CONST char * string, int ch)

Definition at line 588 of file tclUtf.c.
References CONST, find(), NULL, and TclUtfToUniChar.591 {
592     int len;
593     Tcl_UniChar find;
594     CONST char *last;
595   
596     last = NULL;
597     while (1) {
598   len = TclUtfToUniChar(string, &find);
599   if (find == ch) {
600       last = string;
601   }
602   if (*string == '\0') {
603       break;
604   }
605   string += len;
606     }
607     return last;
608 }
int Tcl_UtfNcasecmp (CONST char * cs, CONST char * ct, unsigned long n)

Definition at line 1080 of file tclUtf.c.
References Tcl_UniCharToLower(), and TclUtfToUniChar.
Referenced by Tcl_StringObjCmd().1084 {
1085     Tcl_UniChar ch1, ch2;
1086     while (n-- > 0) {
1087   /*
1088    * n must be interpreted as chars, not bytes.
1089    * This should be called only when both strings are of
1090    * at least n chars long (no need for \0 check)
1091    */
1092   cs += TclUtfToUniChar(cs, &ch1);
1093   ct += TclUtfToUniChar(ct, &ch2);
1094   if (ch1 != ch2) {
1095       ch1 = Tcl_UniCharToLower(ch1);
1096       ch2 = Tcl_UniCharToLower(ch2);
1097       if (ch1 != ch2) {
1098     return (ch1 - ch2);
1099       }
1100   }
1101     }
1102     return 0;
1103 }
int Tcl_UtfNcmp (CONST char * cs, CONST char * ct, unsigned long n)

Definition at line 1035 of file tclUtf.c.
References TclUtfToUniChar.
Referenced by Pkga_EqObjCmd(), and Tcl_StringObjCmd().1039 {
1040     Tcl_UniChar ch1, ch2;
1041     /*
1042      * Cannot use 'memcmp(cs, ct, n);' as byte representation of
1043      * \u0000 (the pair of bytes 0xc0,0x80) is larger than byte
1044      * representation of \u0001 (the byte 0x01.)
1045      */
1046     while (n-- > 0) {
1047   /*
1048    * n must be interpreted as chars, not bytes.
1049    * This should be called only when both strings are of
1050    * at least n chars long (no need for \0 check)
1051    */
1052   cs += TclUtfToUniChar(cs, &ch1);
1053   ct += TclUtfToUniChar(ct, &ch2);
1054   if (ch1 != ch2) {
1055       return (ch1 - ch2);
1056   }
1057     }
1058     return 0;
1059 }
CONST char* Tcl_UtfNext (CONST char * str)

Definition at line 631 of file tclUtf.c.
References TclUtfToUniChar.633 {
634     Tcl_UniChar ch;
635 
636     return str + TclUtfToUniChar(str, &ch);
637 }
CONST char* Tcl_UtfPrev (CONST char * str, CONST char * start)

Definition at line 661 of file tclUtf.c.
References CONST, and TCL_UTF_MAX.
Referenced by Tcl_StringCaseMatch(), Tcl_StringObjCmd(), and TclNeedSpace().666 {
667     CONST char *look;
668     int i, byte;
669     
670     str--;
671     look = str;
672     for (i = 0; i < TCL_UTF_MAX; i++) {
673   if (look < start) {
674       if (str < start) {
675     str = start;
676       }
677       break;
678   }
679   byte = *((unsigned char *) look);
680   if (byte < 0x80) {
681       break;
682   }
683   if (byte >= 0xC0) {
684       return look;
685   }
686   look--;
687     }
688     return str;
689 }
int Tcl_UtfToLower (char * str)

Definition at line 876 of file tclUtf.c.
References size_t(), Tcl_UniCharToLower(), Tcl_UniCharToUtf(), TclUtfToUniChar, and UtfCount().
Referenced by LookupWord(), Tcl_GetHostName(), Tcl_LoadObjCmd(), Tcl_StringObjCmd(), and TclpSetInitialEncodings().878 {
879     Tcl_UniChar ch, lowChar;
880     char *src, *dst;
881     int bytes;
882     
883     /*
884      * Iterate over the string until we hit the terminating null.
885      */
886 
887     src = dst = str;
888     while (*src) {
889   bytes = TclUtfToUniChar(src, &ch);
890   lowChar = Tcl_UniCharToLower(ch);
891 
892   /*
893    * To keep badly formed Utf strings from getting inflated by
894    * the conversion (thereby causing a segfault), only copy the
895    * lower case char to dst if its size is <= the original char.
896    */
897   
898   if (bytes < UtfCount(lowChar)) {
899       memcpy(dst, src, (size_t) bytes);
900       dst += bytes;
901   } else {
902       dst += Tcl_UniCharToUtf(lowChar, dst);
903   }
904   src += bytes;
905     }
906     *dst = '\0';
907     return (dst - str);
908 }
int Tcl_UtfToTitle (char * str)

Definition at line 930 of file tclUtf.c.
References size_t(), Tcl_UniCharToLower(), Tcl_UniCharToTitle(), Tcl_UniCharToUtf(), TclUtfToUniChar, and UtfCount().
Referenced by Tcl_StringObjCmd(), and TclGuessPackageName().932 {
933     Tcl_UniChar ch, titleChar, lowChar;
934     char *src, *dst;
935     int bytes;
936     
937     /*
938      * Capitalize the first character and then lowercase the rest of the
939      * characters until we get to a null.
940      */
941 
942     src = dst = str;
943 
944     if (*src) {
945   bytes = TclUtfToUniChar(src, &ch);
946   titleChar = Tcl_UniCharToTitle(ch);
947 
948   if (bytes < UtfCount(titleChar)) {
949       memcpy(dst, src, (size_t) bytes);
950       dst += bytes;
951   } else {
952       dst += Tcl_UniCharToUtf(titleChar, dst);
953   }
954   src += bytes;
955     }
956     while (*src) {
957   bytes = TclUtfToUniChar(src, &ch);
958   lowChar = Tcl_UniCharToLower(ch);
959 
960   if (bytes < UtfCount(lowChar)) {
961       memcpy(dst, src, (size_t) bytes);
962       dst += bytes;
963   } else {
964       dst += Tcl_UniCharToUtf(lowChar, dst);
965   }
966   src += bytes;
967     }
968     *dst = '\0';
969     return (dst - str);
970 }
int Tcl_UtfToUniChar (CONST char * str, Tcl_UniChar * chPtr)

Definition at line 296 of file tclUtf.c.
References totalBytes.
Referenced by BuildCharSet(), BuildCommandLine(), DictionaryCompare(), GetLexeme(), SetByteArrayFromAny(), Tcl_BinaryObjCmd(), Tcl_NumUtfChars(), Tcl_ParseVarName(), Tcl_PrintDouble(), Tcl_ScanObjCmd(), Tcl_StringCaseMatch(), TclParseBackslash(), UtfToUtfProc(), and ValidateFormat().300 {
301     register int byte;
302     
303     /*
304      * Unroll 1 to 3 byte UTF-8 sequences, use loop to handle longer ones.
305      */
306 
307     byte = *((unsigned char *) str);
308     if (byte < 0xC0) {
309   /*
310    * Handles properly formed UTF-8 characters between 0x01 and 0x7F.
311    * Also treats \0 and naked trail bytes 0x80 to 0xBF as valid
312    * characters representing themselves.
313    */
314 
315   *chPtr = (Tcl_UniChar) byte;
316   return 1;
317     } else if (byte < 0xE0) {
318   if ((str[1] & 0xC0) == 0x80) {
319       /*
320        * Two-byte-character lead-byte followed by a trail-byte.
321        */
322 
323       *chPtr = (Tcl_UniChar) (((byte & 0x1F) << 6) | (str[1] & 0x3F));
324       return 2;
325   }
326   /*
327    * A two-byte-character lead-byte not followed by trail-byte
328    * represents itself.
329    */
330 
331   *chPtr = (Tcl_UniChar) byte;
332   return 1;
333     } else if (byte < 0xF0) {
334   if (((str[1] & 0xC0) == 0x80) && ((str[2] & 0xC0) == 0x80)) {
335       /*
336        * Three-byte-character lead byte followed by two trail bytes.
337        */
338 
339       *chPtr = (Tcl_UniChar) (((byte & 0x0F) << 12) 
340         | ((str[1] & 0x3F) << 6) | (str[2] & 0x3F));
341       return 3;
342   }
343   /*
344    * A three-byte-character lead-byte not followed by two trail-bytes
345    * represents itself.
346    */
347 
348   *chPtr = (Tcl_UniChar) byte;
349   return 1;
350     }
351 #if TCL_UTF_MAX > 3
352     else {
353   int ch, total, trail;
354 
355   total = totalBytes[byte];
356   trail = total - 1;
357   if (trail > 0) {
358       ch = byte & (0x3F >> trail);
359       do {
360     str++;
361     if ((*str & 0xC0) != 0x80) {
362         *chPtr = byte;
363         return 1;
364     }
365     ch <<= 6;
366     ch |= (*str & 0x3F);
367     trail--;
368       } while (trail > 0);
369       *chPtr = ch;
370       return total;
371   }
372     }
373 #endif
374 
375     *chPtr = (Tcl_UniChar) byte;
376     return 1;
377 }
Tcl_UniChar* Tcl_UtfToUniCharDString (CONST char * string, int length, Tcl_DString * dsPtr)

Definition at line 399 of file tclUtf.c.
References CONST, Tcl_DStringLength, Tcl_DStringSetLength(), Tcl_DStringValue, and TclUtfToUniChar.
Referenced by AppendUtfToUnicodeRep(), CompileRegexp(), Tcl_RegExpExec(), and TclpGetUserHome().406 {
407     Tcl_UniChar *w, *wString;
408     CONST char *p, *end;
409     int oldLength;
410 
411     if (length < 0) {
412   length = strlen(string);
413     }
414 
415     /*
416      * Unicode string length in Tcl_UniChars will be <= UTF-8 string length
417      * in bytes.
418      */
419 
420     oldLength = Tcl_DStringLength(dsPtr);
421     Tcl_DStringSetLength(dsPtr,
422       (int) ((oldLength + length + 1) * sizeof(Tcl_UniChar)));
423     wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength);
424 
425     w = wString;
426     end = string + length;
427     for (p = string; p < end; ) {
428   p += TclUtfToUniChar(p, w);
429   w++;
430     }
431     *w = '\0';
432     Tcl_DStringSetLength(dsPtr,
433       (oldLength + ((char *) w - (char *) wString)));
434 
435     return wString;
436 }
int Tcl_UtfToUpper (char * str)

Definition at line 823 of file tclUtf.c.
References size_t(), Tcl_UniCharToUpper(), Tcl_UniCharToUtf(), TclUtfToUniChar, and UtfCount().
Referenced by Tcl_StringObjCmd(), and TclpFindVariable().825 {
826     Tcl_UniChar ch, upChar;
827     char *src, *dst;
828     int bytes;
829 
830     /*
831      * Iterate over the string until we hit the terminating null.
832      */
833 
834     src = dst = str;
835     while (*src) {
836         bytes = TclUtfToUniChar(src, &ch);
837   upChar = Tcl_UniCharToUpper(ch);
838 
839   /*
840    * To keep badly formed Utf strings from getting inflated by
841    * the conversion (thereby causing a segfault), only copy the
842    * upper case char to dst if its size is <= the original char.
843    */
844   
845   if (bytes < UtfCount(upChar)) {
846       memcpy(dst, src, (size_t) bytes);
847       dst += bytes;
848   } else {
849       dst += Tcl_UniCharToUtf(upChar, dst);
850   }
851   src += bytes;
852     }
853     *dst = '\0';
854     return (dst - str);
855 }
int TclpUtfNcmp2 (CONST char * cs, CONST char * ct, unsigned long n)

Definition at line 990 of file tclUtf.c.
References UCHAR.
Referenced by Tcl_StringObjCmd(), and TclExecuteByteCode().994 {
995     /*
996      * We can't simply call 'memcmp(cs, ct, n);' because we need to check
997      * for Tcl's \xC0\x80 non-utf-8 null encoding.
998      * Otherwise utf-8 lexes fine in the strcmp manner.
999      */
1000     register int result = 0;
1001 
1002     for ( ; n != 0; n--, cs++, ct++) {
1003   if (*cs != *ct) {
1004       result = UCHAR(*cs) - UCHAR(*ct);
1005       break;
1006   }
1007     }
1008     if (n && ((UCHAR(*cs) == 0xC0) || (UCHAR(*ct) == 0xC0))) {
1009   unsigned char c1, c2;
1010   c1 = ((UCHAR(*cs) == 0xC0) && (UCHAR(cs[1]) == 0x80)) ? 0 : UCHAR(*cs);
1011   c2 = ((UCHAR(*ct) == 0xC0) && (UCHAR(ct[1]) == 0x80)) ? 0 : UCHAR(*ct);
1012   result = (c1 - c2);
1013     }
1014     return result;
1015 }
int TclUniCharMatch (CONST Tcl_UniChar * string, int strLen, CONST Tcl_UniChar * pattern, int ptnLen, int nocase)

Definition at line 1787 of file tclUtf.c.
References CONST, and Tcl_UniCharToLower().
Referenced by Tcl_StringObjCmd(), and TclExecuteByteCode().1794 {
1795     CONST Tcl_UniChar *stringEnd, *patternEnd;
1796     Tcl_UniChar p;
1797 
1798     stringEnd  = string + strLen;
1799     patternEnd = pattern + ptnLen;
1800 
1801     while (1) {
1802   /*
1803    * See if we're at the end of both the pattern and the string.  If
1804    * so, we succeeded.  If we're at the end of the pattern but not at
1805    * the end of the string, we failed.
1806    */
1807 
1808   if (pattern == patternEnd) {
1809       return (string == stringEnd);
1810   }
1811   p = *pattern;
1812   if ((string == stringEnd) && (p != '*')) {
1813       return 0;
1814   }
1815 
1816   /*
1817    * Check for a "*" as the next pattern character.  It matches any
1818    * substring.  We handle this by skipping all the characters up to the
1819    * next matching one in the pattern, and then calling ourselves
1820    * recursively for each postfix of string, until either we match or we
1821    * reach the end of the string.
1822    */
1823   
1824   if (p == '*') {
1825       /*
1826        * Skip all successive *'s in the pattern
1827        */
1828       while (*(++pattern) == '*') {}
1829       if (pattern == patternEnd) {
1830     return 1;
1831       }
1832       p = *pattern;
1833       if (nocase) {
1834     p = Tcl_UniCharToLower(p);
1835       }
1836       while (1) {
1837     /*
1838      * Optimization for matching - cruise through the string
1839      * quickly if the next char in the pattern isn't a special
1840      * character
1841      */
1842     if ((p != '[') && (p != '?') && (p != '\\')) {
1843         if (nocase) {
1844       while ((string < stringEnd) && (p != *string)
1845         && (p != Tcl_UniCharToLower(*string))) {
1846           string++;
1847       }
1848         } else {
1849       while ((string < stringEnd) && (p != *string)) {
1850           string++;
1851       }
1852         }
1853     }
1854     if (TclUniCharMatch(string, stringEnd - string,
1855       pattern, patternEnd - pattern, nocase)) {
1856         return 1;
1857     }
1858     if (string == stringEnd) {
1859         return 0;
1860     }
1861     string++;
1862       }
1863   }
1864 
1865   /*
1866    * Check for a "?" as the next pattern character.  It matches
1867    * any single character.
1868    */
1869 
1870   if (p == '?') {
1871       pattern++;
1872       string++;
1873       continue;
1874   }
1875 
1876   /*
1877    * Check for a "[" as the next pattern character.  It is followed
1878    * by a list of characters that are acceptable, or by a range
1879    * (two characters separated by "-").
1880    */
1881   
1882   if (p == '[') {
1883       Tcl_UniChar ch1, startChar, endChar;
1884 
1885       pattern++;
1886       ch1 = (nocase ? Tcl_UniCharToLower(*string) : *string);
1887       string++;
1888       while (1) {
1889     if ((*pattern == ']') || (pattern == patternEnd)) {
1890         return 0;
1891     }
1892     startChar = (nocase ? Tcl_UniCharToLower(*pattern) : *pattern);
1893     pattern++;
1894     if (*pattern == '-') {
1895         pattern++;
1896         if (pattern == patternEnd) {
1897       return 0;
1898         }
1899         endChar = (nocase ? Tcl_UniCharToLower(*pattern)
1900           : *pattern);
1901         pattern++;
1902         if (((startChar <= ch1) && (ch1 <= endChar))
1903           || ((endChar <= ch1) && (ch1 <= startChar))) {
1904       /*
1905        * Matches ranges of form [a-z] or [z-a].
1906        */
1907       break;
1908         }
1909     } else if (startChar == ch1) {
1910         break;
1911     }
1912       }
1913       while (*pattern != ']') {
1914     if (pattern == patternEnd) {
1915         pattern--;
1916         break;
1917     }
1918     pattern++;
1919       }
1920       pattern++;
1921       continue;
1922   }
1923 
1924   /*
1925    * If the next pattern character is '\', just strip off the '\'
1926    * so we do exact matching on the character that follows.
1927    */
1928 
1929   if (p == '\\') {
1930       if (++pattern == patternEnd) {
1931     return 0;
1932       }
1933   }
1934 
1935   /*
1936    * There's no special character.  Just make sure that the next
1937    * bytes of each string match.
1938    */
1939 
1940   if (nocase) {
1941       if (Tcl_UniCharToLower(*string) != Tcl_UniCharToLower(*pattern)) {
1942     return 0;
1943       }
1944   } else if (*string != *pattern) {
1945       return 0;
1946   }
1947   string++;
1948   pattern++;
1949     }
1950 }
static INLINE int UtfCount (int ch) [static]

Definition at line 115 of file tclUtf.c.
References UNICODE_SELF.
Referenced by Tcl_UtfToLower(), Tcl_UtfToTitle(), and Tcl_UtfToUpper().117 {
118     if ((ch > 0) && (ch < UNICODE_SELF)) {
119   return 1;
120     }
121     if (ch <= 0x7FF) {
122   return 2;
123     }
124     if (ch <= 0xFFFF) {
125   return 3;
126     }
127 #if TCL_UTF_MAX > 3
128     if (ch <= 0x1FFFFF) {
129   return 4;
130     }
131     if (ch <= 0x3FFFFFF) {
132   return 5;
133     }
134     if (ch <= 0x7FFFFFFF) {
135   return 6;
136     }
137 #endif
138     return 3;
139 }

Variable Documentation
CONST unsigned char totalBytes[256] [static]
Initial value: {
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
    3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,

    1,1,1,1,1,1,1,1,

    1,1,1,1,

    1,1,1,1

}
Definition at line 65 of file tclUtf.c.
Referenced by Tcl_UtfCharComplete(), and Tcl_UtfToUniChar().

generic/tclUtil.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Defines
#define USE_BRACES  2
#define BRACES_UNMATCHED  4
#define LOCAL_SIZE  20
Functions
TCL_DECLARE_MUTEX (precisionMutex)
int TclFindElement (Tcl_Interp *interp, CONST char *list, int listLength, CONST char **elementPtr, CONST char **nextPtr, int *sizePtr, int *bracePtr)
int TclCopyAndCollapse (int count, CONST char *src, char *dst)
int Tcl_SplitList (Tcl_Interp *interp, CONST char *list, int *argcPtr, CONST char ***argvPtr)
int Tcl_ScanElement (CONST char *string, int *flagPtr)
int Tcl_ScanCountedElement (CONST char *string, int length, int *flagPtr)
int Tcl_ConvertElement (CONST char *src, char *dst, int flags)
int Tcl_ConvertCountedElement (CONST char *src, int length, char *dst, int flags)
char * Tcl_Merge (int argc, CONST char *CONST *argv)
char Tcl_Backslash (CONST char *src, int *readPtr)
char * Tcl_Concat (int argc, CONST char *CONST *argv)
Tcl_Obj * Tcl_ConcatObj (int objc, objv)
int Tcl_StringMatch (CONST char *string, CONST char *pattern)
int Tcl_StringCaseMatch (CONST char *string, CONST char *pattern, int nocase)
int TclMatchIsTrivial (CONST char *pattern)
void Tcl_DStringInit (Tcl_DString *dsPtr)
char * Tcl_DStringAppend (Tcl_DString *dsPtr, CONST char *string, int length)
char * Tcl_DStringAppendElement (Tcl_DString *dsPtr, CONST char *string)
void Tcl_DStringSetLength (Tcl_DString *dsPtr, int length)
void Tcl_DStringFree (Tcl_DString *dsPtr)
void Tcl_DStringResult (Tcl_Interp *interp, Tcl_DString *dsPtr)
void Tcl_DStringGetResult (Tcl_Interp *interp, Tcl_DString *dsPtr)
void Tcl_DStringStartSublist (Tcl_DString *dsPtr)
void Tcl_DStringEndSublist (Tcl_DString *dsPtr)
void Tcl_PrintDouble (Tcl_Interp *interp, double value, char *dst)
char * TclPrecTraceProc (ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags)
int TclNeedSpace (CONST char *start, CONST char *end)
int TclFormatInt (char *buffer, long n)
int TclLooksLikeInt (CONST char *bytes, int length)
int TclGetIntForIndex (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr)
static void UpdateStringOfEndOffset (Tcl_Obj *objPtr)
static int SetEndOffsetFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr)
int TclCheckBadOctal (Tcl_Interp *interp, CONST char *value)
CONST char * Tcl_GetNameOfExecutable ()
void TclpGetTime (Tcl_Time *timePtr)
Variables
char * tclExecutableName = NULL
char * tclNativeExecutableName = NULL
static char precisionString [10] = "12"
static char precisionFormat [10] = "%.12g"

Define Documentation
#define BRACES_UNMATCHED  4

Definition at line 49 of file tclUtil.c.
Referenced by Tcl_ConvertCountedElement(), and Tcl_ScanCountedElement().#define LOCAL_SIZE  20
#define USE_BRACES  2

Definition at line 48 of file tclUtil.c.
Referenced by Tcl_ConvertCountedElement(), and Tcl_ScanCountedElement().
Function Documentation
static int SetEndOffsetFromAny (Tcl_Interp* interp, Tcl_Obj* objPtr) [static]

Definition at line 2389 of file tclUtil.c.
References Tcl_ObjType::freeIntRepProc, Tcl_Obj::internalRep, Tcl_Obj::longValue, NULL, size_t(), TCL_ERROR, Tcl_GetInt(), Tcl_GetObjResult(), Tcl_GetStringFromObj(), TCL_OK, Tcl_ResetResult(), tclEndOffsetType, and Tcl_Obj::typePtr.
Referenced by TCL_DECLARE_MUTEX(), and TclGetIntForIndex().2392 {
2393     int offset;     /* Offset in the "end-offset" expression */
2394     Tcl_ObjType* oldTypePtr = objPtr->typePtr;
2395         /* Old internal rep type of the object */
2396     register char* bytes; /* String rep of the object */
2397     int length;     /* Length of the object's string rep */
2398 
2399     /* If it's already the right type, we're fine. */
2400 
2401     if (objPtr->typePtr == &tclEndOffsetType) {
2402   return TCL_OK;
2403     }
2404 
2405     /* Check for a string rep of the right form. */
2406 
2407     bytes = Tcl_GetStringFromObj(objPtr, &length);
2408     if ((*bytes != 'e') || (strncmp(bytes, "end",
2409       (size_t)((length > 3) ? 3 : length)) != 0)) {
2410   if (interp != NULL) {
2411       Tcl_ResetResult(interp);
2412       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
2413            "bad index \"", bytes,
2414            "\": must be end?-integer?",
2415            (char*) NULL);
2416   }
2417   return TCL_ERROR;
2418     }
2419 
2420     /* Convert the string rep */
2421 
2422     if (length <= 3) {
2423   offset = 0;
2424     } else if ((length > 4) && (bytes[3] == '-')) {
2425   /*
2426    * This is our limited string expression evaluator.  Pass everything
2427    * after "end-" to Tcl_GetInt, then reverse for offset.
2428    */
2429   if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) {
2430       return TCL_ERROR;
2431   }
2432   offset = -offset;
2433     } else {
2434   /*
2435    * Conversion failed.  Report the error.
2436    */
2437   if (interp != NULL) {
2438       Tcl_ResetResult(interp);
2439       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
2440            "bad index \"", bytes,
2441            "\": must be integer or end?-integer?",
2442            (char *) NULL);
2443   }
2444   return TCL_ERROR;
2445     }
2446 
2447     /*
2448      * The conversion succeeded. Free the old internal rep and set
2449      * the new one.
2450      */
2451 
2452     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
2453   oldTypePtr->freeIntRepProc(objPtr);
2454     }
2455     
2456     objPtr->internalRep.longValue = offset;
2457     objPtr->typePtr = &tclEndOffsetType;
2458 
2459     return TCL_OK;
2460 }    
char Tcl_Backslash (CONST char * src, int * readPtr)

Definition at line 928 of file tclUtil.c.
References TCL_UTF_MAX, Tcl_UtfBackslash(), and TclUtfToUniChar.933 {
934     char buf[TCL_UTF_MAX];
935     Tcl_UniChar ch;
936 
937     Tcl_UtfBackslash(src, readPtr, buf);
938     TclUtfToUniChar(buf, &ch);
939     return (char) ch;
940 }
char* Tcl_Concat (int argc, CONST char * CONST * argv)

Definition at line 962 of file tclUtil.c.
References ckalloc, CONST, element(), size_t(), UCHAR, and VOID.965 {
966     int totalSize, i;
967     char *p;
968     char *result;
969 
970     for (totalSize = 1, i = 0; i < argc; i++) {
971   totalSize += strlen(argv[i]) + 1;
972     }
973     result = (char *) ckalloc((unsigned) totalSize);
974     if (argc == 0) {
975   *result = '\0';
976   return result;
977     }
978     for (p = result, i = 0; i < argc; i++) {
979   CONST char *element;
980   int length;
981 
982   /*
983    * Clip white space off the front and back of the string
984    * to generate a neater result, and ignore any empty
985    * elements.
986    */
987 
988   element = argv[i];
989   while (isspace(UCHAR(*element))) { /* INTL: ISO space. */
990       element++;
991   }
992   for (length = strlen(element);
993     (length > 0)
994     && (isspace(UCHAR(element[length-1]))) /* INTL: ISO space. */
995     && ((length < 2) || (element[length-2] != '\\'));
996           length--) {
997       /* Null loop body. */
998   }
999   if (length == 0) {
1000       continue;
1001   }
1002   memcpy((VOID *) p, (VOID *) element, (size_t) length);
1003   p += length;
1004   *p = ' ';
1005   p++;
1006     }
1007     if (p != result) {
1008   p[-1] = 0;
1009     } else {
1010   *p = 0;
1011     }
1012     return result;
1013 }
Tcl_Obj* Tcl_ConcatObj (int objc, objv)

Definition at line 1034 of file tclUtil.c.
References Tcl_Obj::bytes, element(), NULL, tclListType, and Tcl_Obj::typePtr.
Referenced by NamespaceEvalCmd(), NamespaceInscopeCmd(), SlaveEval(), Tcl_AfterObjCmd(), Tcl_ConcatObjCmd(), Tcl_DdeObjCmd(), Tcl_EvalObjCmd(), Tcl_UplevelObjCmd(), and TestsetobjerrorcodeCmd().1037 {
1038     int allocSize, finalSize, length, elemLength, i;
1039     char *p;
1040     char *element;
1041     char *concatStr;
1042     Tcl_Obj *objPtr;
1043 
1044     /*
1045      * Check first to see if all the items are of list type.  If so,
1046      * we will concat them together as lists, and return a list object.
1047      * This is only valid when the lists have no current string
1048      * representation, since we don't know what the original type was.
1049      * An original string rep may have lost some whitespace info when
1050      * converted which could be important.
1051      */
1052     for (i = 0;  i < objc;  i++) {
1053   objPtr = objv[i];
1054   if ((objPtr->typePtr != &tclListType) || (objPtr->bytes != NULL)) {
1055       break;
1056   }
1057     }
1058     if (i == objc) {
1059   Tcl_Obj **listv;
1060   int listc;
1061 
1062   objPtr = Tcl_NewListObj(0, NULL);
1063   for (i = 0;  i < objc;  i++) {
1064       /*
1065        * Tcl_ListObjAppendList could be used here, but this saves
1066        * us a bit of type checking (since we've already done it)
1067        * Use of INT_MAX tells us to always put the new stuff on
1068        * the end.  It will be set right in Tcl_ListObjReplace.
1069        */
1070       Tcl_ListObjGetElements(NULL, objv[i], &listc, &listv);
1071       Tcl_ListObjReplace(NULL, objPtr, INT_MAX, 0, listc, listv);
1072   }
1073   return objPtr;
1074     }
1075 
1076     allocSize = 0;
1077     for (i = 0;  i < objc;  i++) {
1078   objPtr = objv[i];
1079   element = Tcl_GetStringFromObj(objPtr, &length);
1080   if ((element != NULL) && (length > 0)) {
1081       allocSize += (length + 1);
1082   }
1083     }
1084     if (allocSize == 0) {
1085   allocSize = 1;    /* enough for the NULL byte at end */
1086     }
1087 
1088     /*
1089      * Allocate storage for the concatenated result. Note that allocSize
1090      * is one more than the total number of characters, and so includes
1091      * room for the terminating NULL byte.
1092      */
1093     
1094     concatStr = (char *) ckalloc((unsigned) allocSize);
1095 
1096     /*
1097      * Now concatenate the elements. Clip white space off the front and back
1098      * to generate a neater result, and ignore any empty elements. Also put
1099      * a null byte at the end.
1100      */
1101 
1102     finalSize = 0;
1103     if (objc == 0) {
1104   *concatStr = '\0';
1105     } else {
1106   p = concatStr;
1107         for (i = 0;  i < objc;  i++) {
1108       objPtr = objv[i];
1109       element = Tcl_GetStringFromObj(objPtr, &elemLength);
1110       while ((elemLength > 0) && (UCHAR(*element) < 127)
1111         && isspace(UCHAR(*element))) { /* INTL: ISO C space. */
1112            element++;
1113      elemLength--;
1114       }
1115 
1116       /*
1117        * Trim trailing white space.  But, be careful not to trim
1118        * a space character if it is preceded by a backslash: in
1119        * this case it could be significant.
1120        */
1121 
1122       while ((elemLength > 0) && (UCHAR(element[elemLength-1]) < 127)
1123         && isspace(UCHAR(element[elemLength-1])) /* INTL: ISO C space. */
1124         && ((elemLength < 2) || (element[elemLength-2] != '\\'))) {
1125     elemLength--;
1126       }
1127       if (elemLength == 0) {
1128            continue;  /* nothing left of this element */
1129       }
1130       memcpy((VOID *) p, (VOID *) element, (size_t) elemLength);
1131       p += elemLength;
1132       *p = ' ';
1133       p++;
1134       finalSize += (elemLength + 1);
1135         }
1136         if (p != concatStr) {
1137       p[-1] = 0;
1138       finalSize -= 1; /* we overwrote the final ' ' */
1139         } else {
1140       *p = 0;
1141         }
1142     }
1143     
1144     TclNewObj(objPtr);
1145     objPtr->bytes  = concatStr;
1146     objPtr->length = finalSize;
1147     return objPtr;
1148 }
int Tcl_ConvertCountedElement (CONST char * src, int length, char * dst, int flags)

Definition at line 723 of file tclUtil.c.
References BRACES_UNMATCHED, CONST, NULL, TCL_DONT_USE_BRACES, and USE_BRACES.
Referenced by Tcl_ConvertElement(), and Tcl_DStringAppendElement().728 {
729     register char *p = dst;
730     register CONST char *lastChar;
731 
732     /*
733      * See the comment block at the beginning of the Tcl_ScanElement
734      * code for details of how this works.
735      */
736 
737     if (src && length == -1) {
738   length = strlen(src);
739     }
740     if ((src == NULL) || (length == 0)) {
741   p[0] = '{';
742   p[1] = '}';
743   p[2] = 0;
744   return 2;
745     }
746     lastChar = src + length;
747     if ((flags & USE_BRACES) && !(flags & TCL_DONT_USE_BRACES)) {
748   *p = '{';
749   p++;
750   for ( ; src != lastChar; src++, p++) {
751       *p = *src;
752   }
753   *p = '}';
754   p++;
755     } else {
756   if (*src == '{') {
757       /*
758        * Can't have a leading brace unless the whole element is
759        * enclosed in braces.  Add a backslash before the brace.
760        * Furthermore, this may destroy the balance between open
761        * and close braces, so set BRACES_UNMATCHED.
762        */
763 
764       p[0] = '\\';
765       p[1] = '{';
766       p += 2;
767       src++;
768       flags |= BRACES_UNMATCHED;
769   }
770   for (; src != lastChar; src++) {
771       switch (*src) {
772     case ']':
773     case '[':
774     case '$':
775     case ';':
776     case ' ':
777     case '\\':
778     case '"':
779         *p = '\\';
780         p++;
781         break;
782     case '{':
783     case '}':
784         /*
785          * It may not seem necessary to backslash braces, but
786          * it is.  The reason for this is that the resulting
787          * list element may actually be an element of a sub-list
788          * enclosed in braces (e.g. if Tcl_DStringStartSublist
789          * has been invoked), so there may be a brace mismatch
790          * if the braces aren't backslashed.
791          */
792 
793         if (flags & BRACES_UNMATCHED) {
794       *p = '\\';
795       p++;
796         }
797         break;
798     case '\f':
799         *p = '\\';
800         p++;
801         *p = 'f';
802         p++;
803         continue;
804     case '\n':
805         *p = '\\';
806         p++;
807         *p = 'n';
808         p++;
809         continue;
810     case '\r':
811         *p = '\\';
812         p++;
813         *p = 'r';
814         p++;
815         continue;
816     case '\t':
817         *p = '\\';
818         p++;
819         *p = 't';
820         p++;
821         continue;
822     case '\v':
823         *p = '\\';
824         p++;
825         *p = 'v';
826         p++;
827         continue;
828       }
829       *p = *src;
830       p++;
831   }
832     }
833     *p = '\0';
834     return p-dst;
835 }
int Tcl_ConvertElement (CONST char * src, char * dst, int flags)

Definition at line 691 of file tclUtil.c.
References Tcl_ConvertCountedElement().
Referenced by Tcl_AppendElement(), and Tcl_Merge().695 {
696     return Tcl_ConvertCountedElement(src, -1, dst, flags);
697 }
TCL_DECLARE_MUTEX (precisionMutex)

Definition at line 64 of file tclUtil.c.
References NULL, SetEndOffsetFromAny(), and UpdateStringOfEndOffset().82                                {
83     "end-offset",     /* name */
84     (Tcl_FreeInternalRepProc*) NULL,    /* freeIntRepProc */
85     (Tcl_DupInternalRepProc*) NULL,     /* dupIntRepProc */
86     UpdateStringOfEndOffset,    /* updateStringProc */
87     SetEndOffsetFromAny    
88 };
char* Tcl_DStringAppend (Tcl_DString * dsPtr, CONST char * string, int length)

Definition at line 1490 of file tclUtil.c.
References ckalloc, ckrealloc, CONST, size_t(), and VOID.
Referenced by ApplicationType(), BuildCommandLine(), CallVarTraces(), CmdDelProc1(), CmdDelProc2(), ComparePkgVersions(), DoRemoveJustDirectory(), ExtractWinRoot(), FindLibraries(), GetLexeme(), LoadEscapeEncoding(), MakeFolderEnvVar(), NamespaceChildrenCmd(), NativeStat(), OpenEncodingFile(), ParsePrimaryExpr(), prepareScriptData(), ResolveAddress(), SetValue(), Tcl_BadChannelOption(), Tcl_CreateNamespace(), Tcl_DStringEndSublist(), Tcl_DStringStartSublist(), Tcl_GetCwd(), Tcl_Gets(), Tcl_GlobObjCmd(), Tcl_Import(), Tcl_JoinPath(), Tcl_LoadObjCmd(), Tcl_Main(), Tcl_ProcObjCmd(), Tcl_TranslateFileName(), Tcl_VarEvalVA(), TclCompileForeachCmd(), TclCompileScript(), TclCompileTokens(), TclDoGlob(), TclGetEnv(), TclGetNamespaceForQualName(), TclGlob(), TclGuessPackageName(), tclOSAASError(), tclOSADecompileCmd(), tclOSAResultFromID(), TclpCreateProcess(), TclpDlopen(), TclpFindExecutable(), TclpFindSymbol(), TclpGetUserHome(), TclpInitLibraryPath(), TclpMatchInDirectory(), TclpObjNormalizePath(), TclpSetInitialEncodings(), TclpSetVariables(), TclRenameCommand(), TcpGetOptionProc(), TestdstringCmd(), TestReport(), TraceCommandProc(), TraceExecutionProc(), TraceVarProc(), TraverseUnixTree(), and TraverseWinTree().1497 {
1498     int newSize;
1499     char *dst;
1500     CONST char *end;
1501 
1502     if (length < 0) {
1503   length = strlen(string);
1504     }
1505     newSize = length + dsPtr->length;
1506 
1507     /*
1508      * Allocate a larger buffer for the string if the current one isn't
1509      * large enough. Allocate extra space in the new buffer so that there
1510      * will be room to grow before we have to allocate again.
1511      */
1512 
1513     if (newSize >= dsPtr->spaceAvl) {
1514   dsPtr->spaceAvl = newSize * 2;
1515   if (dsPtr->string == dsPtr->staticSpace) {
1516       char *newString;
1517 
1518       newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
1519       memcpy((VOID *) newString, (VOID *) dsPtr->string,
1520         (size_t) dsPtr->length);
1521       dsPtr->string = newString;
1522   } else {
1523       dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,
1524         (size_t) dsPtr->spaceAvl);
1525   }
1526     }
1527 
1528     /*
1529      * Copy the new string into the buffer at the end of the old
1530      * one.
1531      */
1532 
1533     for (dst = dsPtr->string + dsPtr->length, end = string+length;
1534       string < end; string++, dst++) {
1535   *dst = *string;
1536     }
1537     *dst = '\0';
1538     dsPtr->length += length;
1539     return dsPtr->string;
1540 }
char* Tcl_DStringAppendElement (Tcl_DString * dsPtr, CONST char * string)

Definition at line 1561 of file tclUtil.c.
References ckalloc, ckrealloc, NULL, size_t(), Tcl_ConvertCountedElement(), Tcl_ScanCountedElement(), TclNeedSpace(), and VOID.
Referenced by CmdTraceProc(), DelCallbackProc(), getSortedHashKeys(), SerialErrorStr(), SerialGetOptionProc(), SerialModemStatusStr(), Tcl_EvalObjv(), Tcl_GetChannelOption(), TcpGetOptionProc(), TestdstringCmd(), TestReport(), TraceCommandProc(), TraceExecutionProc(), and TraceVarProc().1565 {
1566     int newSize, flags, strSize;
1567     char *dst;
1568 
1569     strSize = ((string == NULL) ? 0 : strlen(string));
1570     newSize = Tcl_ScanCountedElement(string, strSize, &flags)
1571   + dsPtr->length + 1;
1572 
1573     /*
1574      * Allocate a larger buffer for the string if the current one isn't
1575      * large enough.  Allocate extra space in the new buffer so that there
1576      * will be room to grow before we have to allocate again.
1577      * SPECIAL NOTE: must use memcpy, not strcpy, to copy the string
1578      * to a larger buffer, since there may be embedded NULLs in the
1579      * string in some cases.
1580      */
1581 
1582     if (newSize >= dsPtr->spaceAvl) {
1583   dsPtr->spaceAvl = newSize * 2;
1584   if (dsPtr->string == dsPtr->staticSpace) {
1585       char *newString;
1586 
1587       newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
1588       memcpy((VOID *) newString, (VOID *) dsPtr->string,
1589         (size_t) dsPtr->length);
1590       dsPtr->string = newString;
1591   } else {
1592       dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,
1593         (size_t) dsPtr->spaceAvl);
1594   }
1595     }
1596 
1597     /*
1598      * Convert the new string to a list element and copy it into the
1599      * buffer at the end, with a space, if needed.
1600      */
1601 
1602     dst = dsPtr->string + dsPtr->length;
1603     if (TclNeedSpace(dsPtr->string, dst)) {
1604   *dst = ' ';
1605   dst++;
1606   dsPtr->length++;
1607     }
1608     dsPtr->length += Tcl_ConvertCountedElement(string, strSize, dst, flags);
1609     return dsPtr->string;
1610 }
void Tcl_DStringEndSublist (Tcl_DString * dsPtr)

Definition at line 1869 of file tclUtil.c.
References Tcl_DStringAppend().
Referenced by CmdTraceProc(), SerialGetOptionProc(), Tcl_GetChannelOption(), TcpGetOptionProc(), TestdstringCmd(), and TestReport().1871 {
1872     Tcl_DStringAppend(dsPtr, "}", -1);
1873 }
void Tcl_DStringFree (Tcl_DString * dsPtr)

Definition at line 1695 of file tclUtil.c.
References ckfree, and TCL_DSTRING_STATIC_SIZE.
Referenced by AppendEnvironment(), AppendSystemError(), AppendUnicodeToUtfRep(), AppendUtfToUnicodeRep(), ApplicationType(), BuildCommandLine(), CallVarTraces(), CompileRegexp(), CompileSubExpr(), ConvertFileNameFormat(), CreateSocketAddress(), DdeServerProc(), DdeSetServerName(), DeleteKey(), DeleteValue(), DoRemoveJustDirectory(), DoRenameFile(), DoTildeSubst(), EnvTraceProc(), FileRCVariables(), FormatClock(), GetFileSpecs(), GetGroupAttribute(), GetKeyNames(), GetLexeme(), GetOwnerAttribute(), GetType(), GetValue(), GetValueNames(), LoadEncodingFile(), LoadEscapeEncoding(), LoadTableEncoding(), MakeFolderEnvVar(), NamespaceChildrenCmd(), NativeCreateNativeRep(), NativeStat(), OpenEncodingFile(), OpenSubKey(), ParsePrimaryExpr(), prepareScriptData(), RecursiveDeleteKey(), SerialSetOptionProc(), SetFsPathFromAny(), SetGroupAttribute(), SetOwnerAttribute(), SetValue(), SplitWinPath(), Tcl_BadChannelOption(), Tcl_CreateNamespace(), TCL_DECLARE_MUTEX(), Tcl_EncodingObjCmd(), Tcl_EvalObjv(), Tcl_FconfigureObjCmd(), Tcl_FileObjCmd(), Tcl_FindExecutable(), Tcl_GetHostName(), Tcl_GlobObjCmd(), Tcl_Import(), Tcl_MacConvertTextResource(), Tcl_MacEvalResource(), Tcl_MacFindResource(), Tcl_Main(), Tcl_ProcObjCmd(), Tcl_PutEnv(), Tcl_RegExpExec(), Tcl_ResourceObjCmd(), Tcl_SourceRCFile(), Tcl_VarEvalVA(), TclChannelTransform(), TclCompileForeachCmd(), TclCompileScript(), TclCompileTokens(), TclCreatePipeline(), TclDoGlob(), TclFindEncodings(), TclGetEnv(), TclGetNamespaceForQualName(), TclGlob(), TclOSACompileCmd(), tclOSAExecuteCmd(), tclOSALoad(), tclOSAStore(), TclpCreateProcess(), TclpCreateTempFile(), TclpDlopen(), TclpFilesystemPathType(), TclpFindExecutable(), TclpFindSymbol(), TclpFindVariable(), TclpGetNativePathType(), TclpGetUserHome(), TclpInitLibraryPath(), TclpMatchInDirectory(), TclpNativeToNormalized(), TclpObjChdir(), TclpObjCopyDirectory(), TclpObjGetCwd(), TclpObjListVolumes(), TclpObjNormalizePath(), TclpObjRemoveDirectory(), TclpOpenFile(), TclpReadlink(), TclpSetInitialEncodings(), TclpSetVariables(), TclRenameCommand(), TclSetEnv(), TclSockGetPort(), TclUnsetEnv(), TcpGetOptionProc(), TestchmodCmd(), TestcmdtraceCmd(), TestdstringCmd(), TestOpenFileChannelProc1(), TestOpenFileChannelProc2(), TestOpenFileChannelProc3(), TestReport(), TesttranslatefilenameCmd(), TraceCommandProc(), TraceExecutionProc(), TraceVarProc(), and WinReadLinkDirectory().1697 {
1698     if (dsPtr->string != dsPtr->staticSpace) {
1699   ckfree(dsPtr->string);
1700     }
1701     dsPtr->string = dsPtr->staticSpace;
1702     dsPtr->length = 0;
1703     dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
1704     dsPtr->staticSpace[0] = '\0';
1705 }
void Tcl_DStringGetResult (Tcl_Interp * interp, Tcl_DString * dsPtr)

Definition at line 1772 of file tclUtil.c.
References ckalloc, ckfree, Interp::freeProc, NULL, Interp::result, Interp::resultSpace, TCL_DSTRING_STATIC_SIZE, TCL_DYNAMIC, Tcl_GetObjResult(), Tcl_SetResult(), TCL_VOLATILE, and TclGetString.
Referenced by TestdstringCmd().1776 {
1777     Interp *iPtr = (Interp *) interp;
1778     
1779     if (dsPtr->string != dsPtr->staticSpace) {
1780   ckfree(dsPtr->string);
1781     }
1782 
1783     /*
1784      * If the string result is empty, move the object result to the
1785      * string result, then reset the object result.
1786      */
1787 
1788     if (*(iPtr->result) == 0) {
1789   Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
1790           TCL_VOLATILE);
1791     }
1792 
1793     dsPtr->length = strlen(iPtr->result);
1794     if (iPtr->freeProc != NULL) {
1795   if (iPtr->freeProc == TCL_DYNAMIC) {
1796       dsPtr->string = iPtr->result;
1797       dsPtr->spaceAvl = dsPtr->length+1;
1798   } else {
1799       dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length+1));
1800       strcpy(dsPtr->string, iPtr->result);
1801       (*iPtr->freeProc)(iPtr->result);
1802   }
1803   dsPtr->spaceAvl = dsPtr->length+1;
1804   iPtr->freeProc = NULL;
1805     } else {
1806   if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) {
1807       dsPtr->string = dsPtr->staticSpace;
1808       dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
1809   } else {
1810       dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length + 1));
1811       dsPtr->spaceAvl = dsPtr->length + 1;
1812   }
1813   strcpy(dsPtr->string, iPtr->result);
1814     }
1815     
1816     iPtr->result = iPtr->resultSpace;
1817     iPtr->resultSpace[0] = 0;
1818 }
void Tcl_DStringInit (Tcl_DString * dsPtr)

Definition at line 1462 of file tclUtil.c.
References TCL_DSTRING_STATIC_SIZE.
Referenced by AppendEnvironment(), AppendUnicodeToUtfRep(), AppendUtfToUnicodeRep(), ApplicationType(), BuildCommandLine(), CallVarTraces(), cclass(), CmdDelProc1(), CmdDelProc2(), CompileRegexp(), CompileSubExpr(), ConvertFileNameFormat(), DdeServerProc(), DdeSetServerName(), DoRemoveJustDirectory(), element(), FileRCVariables(), FormatClock(), GetFileSpecs(), GetLexeme(), getSortedHashKeys(), GetValue(), GetValueNames(), LoadEncodingFile(), LoadEscapeEncoding(), LoadTableEncoding(), MakeFolderEnvVar(), NamespaceChildrenCmd(), OpenEncodingFile(), ParsePrimaryExpr(), prepareScriptData(), RecursiveDeleteKey(), SetFsPathFromAny(), SetValue(), SplitWinPath(), Tcl_BadChannelOption(), Tcl_CreateNamespace(), Tcl_EvalObjv(), Tcl_ExternalToUtfDString(), Tcl_FconfigureObjCmd(), Tcl_GetCwd(), Tcl_GetHostName(), Tcl_GlobObjCmd(), Tcl_Import(), Tcl_LoadObjCmd(), Tcl_Main(), Tcl_OSACmd(), Tcl_ProcObjCmd(), Tcl_RegExpExec(), Tcl_SourceRCFile(), Tcl_TranslateFileName(), Tcl_UtfToExternalDString(), Tcl_VarEvalVA(), TclChannelTransform(), TclCompileForeachCmd(), TclCompileScript(), TclCompileTokens(), TclCreatePipeline(), TclDoGlob(), TclGetEnv(), TclGetNamespaceForQualName(), TclGlob(), tclOSAASError(), tclOSADecompileCmd(), tclOSAInfoCmd(), tclOSAResultFromID(), TclpCreateProcess(), TclpDlopen(), TclpFindExecutable(), TclpFindSymbol(), TclpFindVariable(), TclpGetNativePathType(), TclpGetUserHome(), TclpInitLibraryPath(), TclpMatchInDirectory(), TclpObjNormalizePath(), TclpSetInitialEncodings(), TclpSetVariables(), TclRenameCommand(), Tcltest_Init(), TcpGetOptionProc(), TestcmdinfoCmd(), TestcmdtraceCmd(), TestdcallCmd(), TestOpenFileChannelProc1(), TestOpenFileChannelProc2(), TestOpenFileChannelProc3(), TestReport(), TraceCommandProc(), TraceExecutionProc(), and TraceVarProc().1464 {
1465     dsPtr->string = dsPtr->staticSpace;
1466     dsPtr->length = 0;
1467     dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
1468     dsPtr->staticSpace[0] = '\0';
1469 }
void Tcl_DStringResult (Tcl_Interp * interp, Tcl_DString * dsPtr)

Definition at line 1728 of file tclUtil.c.
References TCL_DSTRING_STATIC_SIZE, TCL_DYNAMIC, Tcl_ResetResult(), TCL_RESULT_SIZE, Tcl_SetResult(), and TCL_VOLATILE.
Referenced by Tcl_FconfigureObjCmd(), Tcl_OSACmd(), tclOSAASError(), TclOSACompileCmd(), tclOSADecompileCmd(), tclOSAExecuteCmd(), tclOSAInfoCmd(), tclOSAResultFromID(), TestcmdinfoCmd(), TestdcallCmd(), and TestdstringCmd().1732 {
1733     Tcl_ResetResult(interp);
1734     
1735     if (dsPtr->string != dsPtr->staticSpace) {
1736   interp->result = dsPtr->string;
1737   interp->freeProc = TCL_DYNAMIC;
1738     } else if (dsPtr->length < TCL_RESULT_SIZE) {
1739   interp->result = ((Interp *) interp)->resultSpace;
1740   strcpy(interp->result, dsPtr->string);
1741     } else {
1742   Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
1743     }
1744     
1745     dsPtr->string = dsPtr->staticSpace;
1746     dsPtr->length = 0;
1747     dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
1748     dsPtr->staticSpace[0] = '\0';
1749 }
void Tcl_DStringSetLength (Tcl_DString * dsPtr, int length)

Definition at line 1633 of file tclUtil.c.
References ckalloc, ckrealloc, size_t(), and VOID.
Referenced by ApplicationType(), DdeServerProc(), ExtractWinRoot(), FileRCVariables(), FormatClock(), GetValue(), GetValueNames(), RecursiveDeleteKey(), SetValue(), Tcl_CreateNamespace(), Tcl_ExternalToUtfDString(), Tcl_LoadObjCmd(), Tcl_UniCharToUtfDString(), Tcl_UtfToExternalDString(), Tcl_UtfToUniCharDString(), TclCompileScript(), TclDoGlob(), TclGetNamespaceForQualName(), TclGuessPackageName(), TclpFindExecutable(), TclpFindSymbol(), TclpFindVariable(), TclpMatchInDirectory(), TclpReadlink(), TcpGetOptionProc(), TraverseUnixTree(), and TraverseWinTree().1636 {
1637     int newsize;
1638 
1639     if (length < 0) {
1640   length = 0;
1641     }
1642     if (length >= dsPtr->spaceAvl) {
1643   /*
1644    * There are two interesting cases here.  In the first case, the user
1645    * may be trying to allocate a large buffer of a specific size.  It
1646    * would be wasteful to overallocate that buffer, so we just allocate
1647    * enough for the requested size plus the trailing null byte.  In the
1648    * second case, we are growing the buffer incrementally, so we need
1649    * behavior similar to Tcl_DStringAppend.  The requested length will
1650    * usually be a small delta above the current spaceAvl, so we'll end up
1651    * doubling the old size.  This won't grow the buffer quite as quickly,
1652    * but it should be close enough.
1653    */
1654 
1655   newsize = dsPtr->spaceAvl * 2;
1656   if (length < newsize) {
1657       dsPtr->spaceAvl = newsize;
1658   } else {
1659       dsPtr->spaceAvl = length + 1;
1660   }
1661   if (dsPtr->string == dsPtr->staticSpace) {
1662       char *newString;
1663 
1664       newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
1665       memcpy((VOID *) newString, (VOID *) dsPtr->string,
1666         (size_t) dsPtr->length);
1667       dsPtr->string = newString;
1668   } else {
1669       dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,
1670         (size_t) dsPtr->spaceAvl);
1671   }
1672     }
1673     dsPtr->length = length;
1674     dsPtr->string[length] = 0;
1675 }
void Tcl_DStringStartSublist (Tcl_DString * dsPtr)

Definition at line 1839 of file tclUtil.c.
References Tcl_DStringAppend(), and TclNeedSpace().
Referenced by CmdTraceProc(), SerialGetOptionProc(), Tcl_GetChannelOption(), TcpGetOptionProc(), TestdstringCmd(), and TestReport().1841 {
1842     if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) {
1843   Tcl_DStringAppend(dsPtr, " {", -1);
1844     } else {
1845   Tcl_DStringAppend(dsPtr, "{", -1);
1846     }
1847 }
CONST char* Tcl_GetNameOfExecutable ()

Definition at line 2544 of file tclUtil.c.
References tclExecutableName.
Referenced by InfoNameOfExecutableCmd().2545 {
2546     return tclExecutableName;
2547 }
char* Tcl_Merge (int argc, CONST char * CONST * argv)

Definition at line 859 of file tclUtil.c.
References ckalloc, ckfree, LOCAL_SIZE, Tcl_ConvertElement(), and Tcl_ScanElement().
Referenced by AsyncHandlerProc(), Tcl_Main(), and TestpanicCmd().862 {
863 #   define LOCAL_SIZE 20
864     int localFlags[LOCAL_SIZE], *flagPtr;
865     int numChars;
866     char *result;
867     char *dst;
868     int i;
869 
870     /*
871      * Pass 1: estimate space, gather flags.
872      */
873 
874     if (argc <= LOCAL_SIZE) {
875   flagPtr = localFlags;
876     } else {
877   flagPtr = (int *) ckalloc((unsigned) argc*sizeof(int));
878     }
879     numChars = 1;
880     for (i = 0; i < argc; i++) {
881   numChars += Tcl_ScanElement(argv[i], &flagPtr[i]) + 1;
882     }
883 
884     /*
885      * Pass two: copy into the result area.
886      */
887 
888     result = (char *) ckalloc((unsigned) numChars);
889     dst = result;
890     for (i = 0; i < argc; i++) {
891   numChars = Tcl_ConvertElement(argv[i], dst, flagPtr[i]);
892   dst += numChars;
893   *dst = ' ';
894   dst++;
895     }
896     if (dst == result) {
897   *dst = 0;
898     } else {
899   dst[-1] = 0;
900     }
901 
902     if (flagPtr != localFlags) {
903   ckfree((char *) flagPtr);
904     }
905     return result;
906 }
void Tcl_PrintDouble (Tcl_Interp * interp, double value, char * dst)

Definition at line 1896 of file tclUtil.c.
References precisionFormat, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_UtfToUniChar(), and UCHAR.
Referenced by Tcl_ExprString(), TestlinkCmd(), and UpdateStringOfDouble().1904 {
1905     char *p, c;
1906     Tcl_UniChar ch;
1907 
1908     Tcl_MutexLock(&precisionMutex);
1909     sprintf(dst, precisionFormat, value);
1910     Tcl_MutexUnlock(&precisionMutex);
1911 
1912     /*
1913      * If the ASCII result looks like an integer, add ".0" so that it
1914      * doesn't look like an integer anymore.  This prevents floating-point
1915      * values from being converted to integers unintentionally.
1916      * Check for ASCII specifically to speed up the function.
1917      */
1918 
1919     for (p = dst; *p != 0; ) {
1920   if (UCHAR(*p) < 0x80) {
1921       c = *p++;
1922   } else {
1923       p += Tcl_UtfToUniChar(p, &ch);
1924       c = UCHAR(ch);
1925   }
1926   if ((c == '.') || isalpha(UCHAR(c))) {  /* INTL: ISO only. */
1927       return;
1928   }
1929     }
1930     p[0] = '.';
1931     p[1] = '0';
1932     p[2] = 0;
1933 }
int Tcl_ScanCountedElement (CONST char * string, int length, int * flagPtr)

Definition at line 557 of file tclUtil.c.
References BRACES_UNMATCHED, CONST, NULL, TCL_DONT_USE_BRACES, Tcl_UtfBackslash(), and USE_BRACES.
Referenced by Tcl_DStringAppendElement(), Tcl_ScanElement(), and UpdateStringOfList().562 {
563     int flags, nestingLevel;
564     register CONST char *p, *lastChar;
565 
566     /*
567      * This procedure and Tcl_ConvertElement together do two things:
568      *
569      * 1. They produce a proper list, one that will yield back the
570      * argument strings when evaluated or when disassembled with
571      * Tcl_SplitList.  This is the most important thing.
572      * 
573      * 2. They try to produce legible output, which means minimizing the
574      * use of backslashes (using braces instead).  However, there are
575      * some situations where backslashes must be used (e.g. an element
576      * like "{abc": the leading brace will have to be backslashed.
577      * For each element, one of three things must be done:
578      *
579      * (a) Use the element as-is (it doesn't contain any special
580      * characters).  This is the most desirable option.
581      *
582      * (b) Enclose the element in braces, but leave the contents alone.
583      * This happens if the element contains embedded space, or if it
584      * contains characters with special interpretation ($, [, ;, or \),
585      * or if it starts with a brace or double-quote, or if there are
586      * no characters in the element.
587      *
588      * (c) Don't enclose the element in braces, but add backslashes to
589      * prevent special interpretation of special characters.  This is a
590      * last resort used when the argument would normally fall under case
591      * (b) but contains unmatched braces.  It also occurs if the last
592      * character of the argument is a backslash or if the element contains
593      * a backslash followed by newline.
594      *
595      * The procedure figures out how many bytes will be needed to store
596      * the result (actually, it overestimates). It also collects information
597      * about the element in the form of a flags word.
598      *
599      * Note: list elements produced by this procedure and
600      * Tcl_ConvertCountedElement must have the property that they can be
601      * enclosing in curly braces to make sub-lists.  This means, for
602      * example, that we must not leave unmatched curly braces in the
603      * resulting list element.  This property is necessary in order for
604      * procedures like Tcl_DStringStartSublist to work.
605      */
606 
607     nestingLevel = 0;
608     flags = 0;
609     if (string == NULL) {
610   string = "";
611     }
612     if (length == -1) {
613   length = strlen(string);
614     }
615     lastChar = string + length;
616     p = string;
617     if ((p == lastChar) || (*p == '{') || (*p == '"')) {
618   flags |= USE_BRACES;
619     }
620     for ( ; p < lastChar; p++) {
621   switch (*p) {
622       case '{':
623     nestingLevel++;
624     break;
625       case '}':
626     nestingLevel--;
627     if (nestingLevel < 0) {
628         flags |= TCL_DONT_USE_BRACES|BRACES_UNMATCHED;
629     }
630     break;
631       case '[':
632       case '$':
633       case ';':
634       case ' ':
635       case '\f':
636       case '\n':
637       case '\r':
638       case '\t':
639       case '\v':
640     flags |= USE_BRACES;
641     break;
642       case '\\':
643     if ((p+1 == lastChar) || (p[1] == '\n')) {
644         flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
645     } else {
646         int size;
647 
648         Tcl_UtfBackslash(p, &size, NULL);
649         p += size-1;
650         flags |= USE_BRACES;
651     }
652     break;
653   }
654     }
655     if (nestingLevel != 0) {
656   flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
657     }
658     *flagPtr = flags;
659 
660     /*
661      * Allow enough space to backslash every character plus leave
662      * two spaces for braces.
663      */
664 
665     return 2*(p-string) + 2;
666 }
int Tcl_ScanElement (CONST char * string, int * flagPtr)

Definition at line 523 of file tclUtil.c.
References Tcl_ScanCountedElement().
Referenced by Tcl_AppendElement(), and Tcl_Merge().527 {
528     return Tcl_ScanCountedElement(string, -1, flagPtr);
529 }
int Tcl_SplitList (Tcl_Interp * interp, CONST char * list, int * argcPtr, CONST char *** argvPtr)

Definition at line 417 of file tclUtil.c.
References ckalloc, ckfree, CONST, element(), next(), NULL, size_t(), TCL_ERROR, TCL_OK, Tcl_SetResult(), TCL_STATIC, TclCopyAndCollapse(), TclFindElement(), UCHAR, and VOID.
Referenced by ComparePkgVersions(), LoadEscapeEncoding(), SerialSetOptionProc(), Tcl_BadChannelOption(), Tcl_CaseObjCmd(), Tcl_OpenObjCmd(), Tcl_SetChannelOption(), TclCompileForeachCmd(), TclCreateProc(), and TclGetOpenMode().425 {
426     CONST char **argv;
427     CONST char *l;
428     char *p;
429     int length, size, i, result, elSize, brace;
430     CONST char *element;
431 
432     /*
433      * Figure out how much space to allocate.  There must be enough
434      * space for both the array of pointers and also for a copy of
435      * the list.  To estimate the number of pointers needed, count
436      * the number of space characters in the list.
437      */
438 
439     for (size = 2, l = list; *l != 0; l++) {
440   if (isspace(UCHAR(*l))) { /* INTL: ISO space. */
441       size++;
442       /* Consecutive space can only count as a single list delimiter */
443       while (1) {
444     char next = *(l + 1);
445     if (next == '\0') {
446         break;
447     }
448     ++l;
449     if (isspace(UCHAR(next))) {
450         continue;
451     }
452     break;
453       }
454   }
455     }
456     length = l - list;
457     argv = (CONST char **) ckalloc((unsigned)
458       ((size * sizeof(char *)) + length + 1));
459     for (i = 0, p = ((char *) argv) + size*sizeof(char *);
460       *list != 0;  i++) {
461   CONST char *prevList = list;
462   
463   result = TclFindElement(interp, list, length, &element,
464         &list, &elSize, &brace);
465   length -= (list - prevList);
466   if (result != TCL_OK) {
467       ckfree((char *) argv);
468       return result;
469   }
470   if (*element == 0) {
471       break;
472   }
473   if (i >= size) {
474       ckfree((char *) argv);
475       if (interp != NULL) {
476     Tcl_SetResult(interp, "internal error in Tcl_SplitList",
477       TCL_STATIC);
478       }
479       return TCL_ERROR;
480   }
481   argv[i] = p;
482   if (brace) {
483       memcpy((VOID *) p, (VOID *) element, (size_t) elSize);
484       p += elSize;
485       *p = 0;
486       p++;
487   } else {
488       TclCopyAndCollapse(elSize, element, p);
489       p += elSize+1;
490   }
491     }
492 
493     argv[i] = NULL;
494     *argvPtr = argv;
495     *argcPtr = i;
496     return TCL_OK;
497 }
int Tcl_StringCaseMatch (CONST char * string, CONST char * pattern, int nocase)

Definition at line 1199 of file tclUtil.c.
References CONST, Tcl_UniCharToLower(), Tcl_UtfPrev(), Tcl_UtfToUniChar(), TclUtfToUniChar, and UCHAR.
Referenced by Tcl_StringMatch(), TclExecuteByteCode(), and TclpMatchInDirectory().1204 {
1205     int p, charLen;
1206     CONST char *pstart = pattern;
1207     Tcl_UniChar ch1, ch2;
1208     
1209     while (1) {
1210   p = *pattern;
1211   
1212   /*
1213    * See if we're at the end of both the pattern and the string.  If
1214    * so, we succeeded.  If we're at the end of the pattern but not at
1215    * the end of the string, we failed.
1216    */
1217   
1218   if (p == '\0') {
1219       return (*string == '\0');
1220   }
1221   if ((*string == '\0') && (p != '*')) {
1222       return 0;
1223   }
1224 
1225   /*
1226    * Check for a "*" as the next pattern character.  It matches
1227    * any substring.  We handle this by calling ourselves
1228    * recursively for each postfix of string, until either we
1229    * match or we reach the end of the string.
1230    */
1231   
1232   if (p == '*') {
1233       /*
1234        * Skip all successive *'s in the pattern
1235        */
1236       while (*(++pattern) == '*') {}
1237       p = *pattern;
1238       if (p == '\0') {
1239     return 1;
1240       }
1241       /*
1242        * This is a special case optimization for single-byte utf.
1243        */
1244       if (UCHAR(*pattern) < 0x80) {
1245     ch2 = (Tcl_UniChar)
1246         (nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
1247       } else {
1248     Tcl_UtfToUniChar(pattern, &ch2);
1249     if (nocase) {
1250         ch2 = Tcl_UniCharToLower(ch2);
1251     }
1252       }
1253       while (1) {
1254     /*
1255      * Optimization for matching - cruise through the string
1256      * quickly if the next char in the pattern isn't a special
1257      * character
1258      */
1259     if ((p != '[') && (p != '?') && (p != '\\')) {
1260         if (nocase) {
1261       while (*string) {
1262           charLen = TclUtfToUniChar(string, &ch1);
1263           if (ch2==ch1 || ch2==Tcl_UniCharToLower(ch1)) {
1264         break;
1265           }
1266           string += charLen;
1267       }
1268         } else {
1269       /*
1270        * There's no point in trying to make this code
1271        * shorter, as the number of bytes you want to
1272        * compare each time is non-constant.
1273        */
1274       while (*string) {
1275           charLen = TclUtfToUniChar(string, &ch1);
1276           if (ch2 == ch1) {
1277         break;
1278           }
1279           string += charLen;
1280       }
1281         }
1282     }
1283     if (Tcl_StringCaseMatch(string, pattern, nocase)) {
1284         return 1;
1285     }
1286     if (*string == '\0') {
1287         return 0;
1288     }
1289     string += TclUtfToUniChar(string, &ch1);
1290       }
1291   }
1292 
1293   /*
1294    * Check for a "?" as the next pattern character.  It matches
1295    * any single character.
1296    */
1297 
1298   if (p == '?') {
1299       pattern++;
1300       string += TclUtfToUniChar(string, &ch1);
1301       continue;
1302   }
1303 
1304   /*
1305    * Check for a "[" as the next pattern character.  It is followed
1306    * by a list of characters that are acceptable, or by a range
1307    * (two characters separated by "-").
1308    */
1309 
1310   if (p == '[') {
1311       Tcl_UniChar startChar, endChar;
1312 
1313       pattern++;
1314       if (UCHAR(*string) < 0x80) {
1315     ch1 = (Tcl_UniChar)
1316         (nocase ? tolower(UCHAR(*string)) : UCHAR(*string));
1317     string++;
1318       } else {
1319     string += Tcl_UtfToUniChar(string, &ch1);
1320     if (nocase) {
1321         ch1 = Tcl_UniCharToLower(ch1);
1322     }
1323       }
1324       while (1) {
1325     if ((*pattern == ']') || (*pattern == '\0')) {
1326         return 0;
1327     }
1328     if (UCHAR(*pattern) < 0x80) {
1329         startChar = (Tcl_UniChar)
1330       (nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
1331         pattern++;
1332     } else {
1333         pattern += Tcl_UtfToUniChar(pattern, &startChar);
1334         if (nocase) {
1335       startChar = Tcl_UniCharToLower(startChar);
1336         }
1337     }
1338     if (*pattern == '-') {
1339         pattern++;
1340         if (*pattern == '\0') {
1341       return 0;
1342         }
1343         if (UCHAR(*pattern) < 0x80) {
1344       endChar = (Tcl_UniChar)
1345           (nocase ? tolower(UCHAR(*pattern))
1346             : UCHAR(*pattern));
1347       pattern++;
1348         } else {
1349       pattern += Tcl_UtfToUniChar(pattern, &endChar);
1350       if (nocase) {
1351           endChar = Tcl_UniCharToLower(endChar);
1352       }
1353         }
1354         if (((startChar <= ch1) && (ch1 <= endChar))
1355           || ((endChar <= ch1) && (ch1 <= startChar))) {
1356       /*
1357        * Matches ranges of form [a-z] or [z-a].
1358        */
1359 
1360       break;
1361         }
1362     } else if (startChar == ch1) {
1363         break;
1364     }
1365       }
1366       while (*pattern != ']') {
1367     if (*pattern == '\0') {
1368         pattern = Tcl_UtfPrev(pattern, pstart);
1369         break;
1370     }
1371     pattern++;
1372       }
1373       pattern++;
1374       continue;
1375   }
1376 
1377   /*
1378    * If the next pattern character is '\', just strip off the '\'
1379    * so we do exact matching on the character that follows.
1380    */
1381 
1382   if (p == '\\') {
1383       pattern++;
1384       if (*pattern == '\0') {
1385     return 0;
1386       }
1387   }
1388 
1389   /*
1390    * There's no special character.  Just make sure that the next
1391    * bytes of each string match.
1392    */
1393 
1394   string  += TclUtfToUniChar(string, &ch1);
1395   pattern += TclUtfToUniChar(pattern, &ch2);
1396   if (nocase) {
1397       if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
1398     return 0;
1399       }
1400   } else if (ch1 != ch2) {
1401       return 0;
1402   }
1403     }
1404 }
int Tcl_StringMatch (CONST char * string, CONST char * pattern)

Definition at line 1170 of file tclUtil.c.
References Tcl_StringCaseMatch().
Referenced by AppendLocals(), GetKeyNames(), getSortedHashKeys(), GetValueNames(), InfoCommandsCmd(), InfoGlobalsCmd(), InfoProcsCmd(), InfoVarsCmd(), NamespaceChildrenCmd(), Tcl_ArrayObjCmd(), Tcl_CaseObjCmd(), Tcl_ForgetImport(), Tcl_GetChannelNamesEx(), Tcl_Import(), Tcl_ListMathFuncs(), Tcl_LsearchObjCmd(), Tcl_SwitchObjCmd(), and TclpMatchInDirectory().1174 {
1175     return Tcl_StringCaseMatch(string, pattern, 0);
1176 }
int TclCheckBadOctal (Tcl_Interp * interp, CONST char * value)

Definition at line 2480 of file tclUtil.c.
References CONST, NULL, and UCHAR.
Referenced by IllegalExprOperandType(), SetIntOrWideFromAny(), SetWideIntFromAny(), Tcl_GetInt(), TclGetIntForIndex(), TclGetLong(), and VerifyExprObjType().2485 {
2486     register CONST char *p = value;
2487 
2488     /*
2489      * A frequent mistake is invalid octal values due to an unwanted
2490      * leading zero. Try to generate a meaningful error message.
2491      */
2492 
2493     while (isspace(UCHAR(*p))) {  /* INTL: ISO space. */
2494   p++;
2495     }
2496     if (*p == '+' || *p == '-') {
2497   p++;
2498     }
2499     if (*p == '0') {
2500   while (isdigit(UCHAR(*p))) {  /* INTL: digit. */
2501       p++;
2502   }
2503   while (isspace(UCHAR(*p))) {  /* INTL: ISO space. */
2504       p++;
2505   }
2506   if (*p == '\0') {
2507       /* Reached end of string */
2508       if (interp != NULL) {
2509     /*
2510      * Don't reset the result here because we want this result
2511      * to be added to an existing error message as extra info.
2512      */
2513     Tcl_AppendResult(interp, " (looks like invalid octal number)",
2514       (char *) NULL);
2515       }
2516       return 1;
2517   }
2518     }
2519     return 0;
2520 }
int TclCopyAndCollapse (int count, CONST char * src, char * dst)

Definition at line 359 of file tclUtil.c.
References Tcl_UtfBackslash().
Referenced by SetListFromAny(), and Tcl_SplitList().363 {
364     register char c;
365     int numRead;
366     int newCount = 0;
367     int backslashCount;
368 
369     for (c = *src;  count > 0;  src++, c = *src, count--) {
370   if (c == '\\') {
371       backslashCount = Tcl_UtfBackslash(src, &numRead, dst);
372       dst += backslashCount;
373       newCount += backslashCount;
374       src += numRead-1;
375       count -= numRead-1;
376   } else {
377       *dst = c;
378       dst++;
379       newCount++;
380   }
381     }
382     *dst = 0;
383     return newCount;
384 }
int TclFindElement (Tcl_Interp * interp, CONST char * list, int listLength, CONST char ** elementPtr, CONST char ** nextPtr, int * sizePtr, int * bracePtr)

Definition at line 126 of file tclUtil.c.
References CONST, NULL, TCL_ERROR, TCL_OK, Tcl_SetResult(), TCL_STATIC, Tcl_UtfBackslash(), TCL_VOLATILE, and UCHAR.
Referenced by SetListFromAny(), and Tcl_SplitList().145 {
146     CONST char *p = list;
147     CONST char *elemStart;  /* Points to first byte of first element. */
148     CONST char *limit;    /* Points just after list's last byte. */
149     int openBraces = 0;   /* Brace nesting level during parse. */
150     int inQuotes = 0;
151     int size = 0;   /* lint. */
152     int numChars;
153     CONST char *p2;
154     
155     /*
156      * Skim off leading white space and check for an opening brace or
157      * quote. We treat embedded NULLs in the list as bytes belonging to
158      * a list element.
159      */
160 
161     limit = (list + listLength);
162     while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */
163   p++;
164     }
165     if (p == limit) {   /* no element found */
166   elemStart = limit;
167   goto done;
168     }
169 
170     if (*p == '{') {
171   openBraces = 1;
172   p++;
173     } else if (*p == '"') {
174   inQuotes = 1;
175   p++;
176     }
177     elemStart = p;
178     if (bracePtr != 0) {
179   *bracePtr = openBraces;
180     }
181 
182     /*
183      * Find element's end (a space, close brace, or the end of the string).
184      */
185 
186     while (p < limit) {
187   switch (*p) {
188 
189       /*
190        * Open brace: don't treat specially unless the element is in
191        * braces. In this case, keep a nesting count.
192        */
193 
194       case '{':
195     if (openBraces != 0) {
196         openBraces++;
197     }
198     break;
199 
200       /*
201        * Close brace: if element is in braces, keep nesting count and
202        * quit when the last close brace is seen.
203        */
204 
205       case '}':
206     if (openBraces > 1) {
207         openBraces--;
208     } else if (openBraces == 1) {
209         size = (p - elemStart);
210         p++;
211         if ((p >= limit)
212           || isspace(UCHAR(*p))) { /* INTL: ISO space. */
213       goto done;
214         }
215 
216         /*
217          * Garbage after the closing brace; return an error.
218          */
219         
220         if (interp != NULL) {
221       char buf[100];
222       
223       p2 = p;
224       while ((p2 < limit)
225         && (!isspace(UCHAR(*p2))) /* INTL: ISO space. */
226               && (p2 < p+20)) {
227           p2++;
228       }
229       sprintf(buf,
230         "list element in braces followed by \"%.*s\" instead of space",
231         (int) (p2-p), p);
232       Tcl_SetResult(interp, buf, TCL_VOLATILE);
233         }
234         return TCL_ERROR;
235     }
236     break;
237 
238       /*
239        * Backslash:  skip over everything up to the end of the
240        * backslash sequence.
241        */
242 
243       case '\\': {
244     Tcl_UtfBackslash(p, &numChars, NULL);
245     p += (numChars - 1);
246     break;
247       }
248 
249       /*
250        * Space: ignore if element is in braces or quotes; otherwise
251        * terminate element.
252        */
253 
254       case ' ':
255       case '\f':
256       case '\n':
257       case '\r':
258       case '\t':
259       case '\v':
260     if ((openBraces == 0) && !inQuotes) {
261         size = (p - elemStart);
262         goto done;
263     }
264     break;
265 
266       /*
267        * Double-quote: if element is in quotes then terminate it.
268        */
269 
270       case '"':
271     if (inQuotes) {
272         size = (p - elemStart);
273         p++;
274         if ((p >= limit)
275           || isspace(UCHAR(*p))) { /* INTL: ISO space */
276       goto done;
277         }
278 
279         /*
280          * Garbage after the closing quote; return an error.
281          */
282         
283         if (interp != NULL) {
284       char buf[100];
285       
286       p2 = p;
287       while ((p2 < limit)
288         && (!isspace(UCHAR(*p2))) /* INTL: ISO space */
289          && (p2 < p+20)) {
290           p2++;
291       }
292       sprintf(buf,
293         "list element in quotes followed by \"%.*s\" %s",
294         (int) (p2-p), p, "instead of space");
295       Tcl_SetResult(interp, buf, TCL_VOLATILE);
296         }
297         return TCL_ERROR;
298     }
299     break;
300   }
301   p++;
302     }
303 
304 
305     /*
306      * End of list: terminate element.
307      */
308 
309     if (p == limit) {
310   if (openBraces != 0) {
311       if (interp != NULL) {
312     Tcl_SetResult(interp, "unmatched open brace in list",
313       TCL_STATIC);
314       }
315       return TCL_ERROR;
316   } else if (inQuotes) {
317       if (interp != NULL) {
318     Tcl_SetResult(interp, "unmatched open quote in list",
319       TCL_STATIC);
320       }
321       return TCL_ERROR;
322   }
323   size = (p - elemStart);
324     }
325 
326     done:
327     while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */
328   p++;
329     }
330     *elementPtr = elemStart;
331     *nextPtr = p;
332     if (sizePtr != 0) {
333   *sizePtr = size;
334     }
335     return TCL_OK;
336 }
int TclFormatInt (char * buffer, long n)

Definition at line 2138 of file tclUtil.c.
Referenced by AcceptCallbackProc(), AsyncHandlerProc(), DelCallbackProc(), SortCompare(), Tcl_ArrayObjCmd(), Tcl_FormatObjCmd(), Tcl_GetChannelOption(), Tcl_Main(), TclCleanupChildren(), TclGetAndDetachPids(), TclPrecTraceProc(), TclRegisterLiteral(), TcpGetOptionProc(), TestasyncCmd(), TestChannelCmd(), TestdstringCmd(), TestfilehandlerCmd(), TestlinkCmd(), TestobjCmd(), UpdateStringOfEndOffset(), and UpdateStringOfInt().2142 {
2143     long intVal;
2144     int i;
2145     int numFormatted, j;
2146     char *digits = "0123456789";
2147 
2148     /*
2149      * Check first whether "n" is zero.
2150      */
2151 
2152     if (n == 0) {
2153   buffer[0] = '0';
2154   buffer[1] = 0;
2155   return 1;
2156     }
2157 
2158     /*
2159      * Check whether "n" is the maximum negative value. This is
2160      * -2^(m-1) for an m-bit word, and has no positive equivalent;
2161      * negating it produces the same value.
2162      */
2163 
2164     if (n == -n) {
2165   sprintf(buffer, "%ld", n);
2166   return strlen(buffer);
2167     }
2168 
2169     /*
2170      * Generate the characters of the result backwards in the buffer.
2171      */
2172 
2173     intVal = (n < 0? -n : n);
2174     i = 0;
2175     buffer[0] = '\0';
2176     do {
2177   i++;
2178   buffer[i] = digits[intVal % 10];
2179   intVal = intVal/10;
2180     } while (intVal > 0);
2181     if (n < 0) {
2182   i++;
2183   buffer[i] = '-';
2184     }
2185     numFormatted = i;
2186 
2187     /*
2188      * Now reverse the characters.
2189      */
2190 
2191     for (j = 0;  j < i;  j++, i--) {
2192   char tmp = buffer[i];
2193   buffer[i] = buffer[j];
2194   buffer[j] = tmp;
2195     }
2196     return numFormatted;
2197 }
int TclGetIntForIndex (Tcl_Interp * interp, Tcl_Obj * objPtr, int endValue, int * indexPtr)

Definition at line 2279 of file tclUtil.c.
References Tcl_Obj::internalRep, Tcl_Obj::longValue, NULL, SetEndOffsetFromAny(), TCL_ERROR, Tcl_GetIntFromObj(), Tcl_GetObjResult(), Tcl_GetString(), TCL_OK, Tcl_ResetResult(), and TclCheckBadOctal().
Referenced by Tcl_LinsertObjCmd(), Tcl_LrangeObjCmd(), Tcl_LreplaceObjCmd(), Tcl_LsearchObjCmd(), Tcl_LsortObjCmd(), Tcl_StringObjCmd(), TclExecuteByteCode(), TclLindexFlat(), TclLindexList(), TclLsetFlat(), and TclLsetList().2289 {
2290     if (Tcl_GetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) {
2291   return TCL_OK;
2292     }
2293 
2294     if (SetEndOffsetFromAny(NULL, objPtr) == TCL_OK) {
2295   /*
2296    * If the object is already an offset from the end of the
2297    * list, or can be converted to one, use it.
2298    */
2299 
2300   *indexPtr = endValue + objPtr->internalRep.longValue;
2301 
2302     } else {
2303   /*
2304    * Report a parse error.
2305    */
2306 
2307   if (interp != NULL) {
2308       char *bytes = Tcl_GetString(objPtr);
2309       /*
2310        * The result might not be empty; this resets it which
2311        * should be both a cheap operation, and of little problem
2312        * because this is an error-generation path anyway.
2313        */
2314       Tcl_ResetResult(interp);
2315       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
2316            "bad index \"", bytes,
2317            "\": must be integer or end?-integer?",
2318            (char *) NULL);
2319       if (!strncmp(bytes, "end-", 3)) {
2320     bytes += 3;
2321       }
2322       TclCheckBadOctal(interp, bytes);
2323   }
2324 
2325   return TCL_ERROR;
2326     }
2327       
2328     return TCL_OK;
2329 }
int TclLooksLikeInt (CONST char * bytes, int length)

Definition at line 2221 of file tclUtil.c.
References CONST, NULL, TclParseInteger(), and UCHAR.
Referenced by Tcl_StringObjCmd(), TclCompileIncrCmd(), TclExecuteByteCode(), TclRegisterLiteral(), and VerifyExprObjType().2227 {
2228     register CONST char *p;
2229 
2230     if ((bytes == NULL) && (length > 0)) {
2231   Tcl_Panic("TclLooksLikeInt: cannot scan %d bytes from NULL", length);
2232     }
2233 
2234     if (length < 0) {
2235         length = (bytes? strlen(bytes) : 0);
2236     }
2237 
2238     p = bytes;
2239     while (length && isspace(UCHAR(*p))) { /* INTL: ISO space. */
2240   length--; p++;
2241     }
2242     if (length == 0) {
2243         return 0;
2244     }
2245     if ((*p == '+') || (*p == '-')) {
2246         p++; length--;
2247     }
2248 
2249     return (0 != TclParseInteger(p, length));
2250 }
int TclMatchIsTrivial (CONST char * pattern)

Definition at line 1425 of file tclUtil.c.
References CONST.
Referenced by InfoCommandsCmd(), InfoGlobalsCmd(), InfoProcsCmd(), and InfoVarsCmd().1427 {
1428     CONST char *p = pattern;
1429 
1430     while (1) {
1431   switch (*p++) {
1432   case '\0':
1433       return 1;
1434   case '*':
1435   case '?':
1436   case '[':
1437   case '\\':
1438       return 0;
1439   }
1440     }
1441 }
int TclNeedSpace (CONST char * start, CONST char * end)

Definition at line 2047 of file tclUtil.c.
References Tcl_UtfPrev().
Referenced by Tcl_AppendElement(), Tcl_DStringAppendElement(), and Tcl_DStringStartSublist().2051 {
2052     /*
2053      * A space is needed unless either
2054      * (a) we're at the start of the string, or
2055      */
2056     if (end == start) {
2057   return 0;
2058     }
2059 
2060     /*
2061      * (b) we're at the start of a nested list-element, quoted with an
2062      *     open curly brace; we can be nested arbitrarily deep, so long
2063      *     as the first curly brace starts an element, so backtrack over
2064      *     open curly braces that are trailing characters of the string; and
2065      */
2066 
2067     end = Tcl_UtfPrev(end, start);
2068     while (*end == '{') {
2069   if (end == start) {
2070       return 0;
2071   }
2072   end = Tcl_UtfPrev(end, start);
2073     }
2074 
2075     /*
2076      * (c) the trailing character of the string is already a list-element
2077      *     separator (according to TclFindElement); that is, one of these
2078      *     characters:
2079      *      \u0009  \t  TAB
2080      *      \u000A  \n  NEWLINE
2081      *      \u000B  \v  VERTICAL TAB
2082      *      \u000C  \f  FORM FEED
2083      *      \u000D  \r  CARRIAGE RETURN
2084      *      \u0020    SPACE
2085      *     with the condition that the penultimate character is not a
2086      *     backslash.
2087      */
2088 
2089     if (*end > 0x20) {
2090   /*
2091    * Performance tweak.  All ASCII spaces are <= 0x20. So get
2092    * a quick answer for most characters before comparing against
2093    * all spaces in the switch below.
2094    *
2095    * NOTE: Remove this if other Unicode spaces ever get accepted
2096    * as list-element separators.
2097    */
2098   return 1;
2099     }
2100     switch (*end) {
2101   case ' ':
2102         case '\t':
2103         case '\n':
2104         case '\r':
2105         case '\v':
2106         case '\f':
2107       if ((end == start) || (end[-1] != '\\')) {
2108     return 0;
2109       }
2110     }
2111     return 1;
2112 }
void TclpGetTime (Tcl_Time* timePtr)

Definition at line 2569 of file tclUtil.c.
References Tcl_GetTime().
Referenced by SerialGetMilliseconds().2571 {
2572     Tcl_GetTime(timePtr);
2573 }
char* TclPrecTraceProc (ClientData clientData, Tcl_Interp * interp, CONST char * name1, CONST char * name2, int flags)

Definition at line 1957 of file tclUtil.c.
References CONST, NULL, precisionFormat, precisionString, strtoul(), Tcl_GetVar2(), TCL_GLOBAL_ONLY, TCL_INTERP_DESTROYED, Tcl_IsSafe(), TCL_MAX_PREC, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_SetVar2(), TCL_TRACE_DESTROYED, TCL_TRACE_READS, TCL_TRACE_UNSETS, TCL_TRACE_WRITES, Tcl_TraceVar2(), and TclFormatInt().1963 {
1964     CONST char *value;
1965     char *end;
1966     int prec;
1967 
1968     /*
1969      * If the variable is unset, then recreate the trace.
1970      */
1971 
1972     if (flags & TCL_TRACE_UNSETS) {
1973   if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
1974       Tcl_TraceVar2(interp, name1, name2,
1975         TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
1976         |TCL_TRACE_UNSETS, TclPrecTraceProc, clientData);
1977   }
1978   return (char *) NULL;
1979     }
1980 
1981     /*
1982      * When the variable is read, reset its value from our shared
1983      * value.  This is needed in case the variable was modified in
1984      * some other interpreter so that this interpreter's value is
1985      * out of date.
1986      */
1987 
1988     Tcl_MutexLock(&precisionMutex);
1989 
1990     if (flags & TCL_TRACE_READS) {
1991   Tcl_SetVar2(interp, name1, name2, precisionString,
1992     flags & TCL_GLOBAL_ONLY);
1993   Tcl_MutexUnlock(&precisionMutex);
1994   return (char *) NULL;
1995     }
1996 
1997     /*
1998      * The variable is being written.  Check the new value and disallow
1999      * it if it isn't reasonable or if this is a safe interpreter (we
2000      * don't want safe interpreters messing up the precision of other
2001      * interpreters).
2002      */
2003 
2004     if (Tcl_IsSafe(interp)) {
2005   Tcl_SetVar2(interp, name1, name2, precisionString,
2006     flags & TCL_GLOBAL_ONLY);
2007   Tcl_MutexUnlock(&precisionMutex);
2008   return "can't modify precision from a safe interpreter";
2009     }
2010     value = Tcl_GetVar2(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
2011     if (value == NULL) {
2012   value = "";
2013     }
2014     prec = strtoul(value, &end, 10);
2015     if ((prec <= 0) || (prec > TCL_MAX_PREC) || (prec > 100) ||
2016       (end == value) || (*end != 0)) {
2017   Tcl_SetVar2(interp, name1, name2, precisionString,
2018     flags & TCL_GLOBAL_ONLY);
2019   Tcl_MutexUnlock(&precisionMutex);
2020   return "improper value for precision";
2021     }
2022     TclFormatInt(precisionString, prec);
2023     sprintf(precisionFormat, "%%.%dg", prec);
2024     Tcl_MutexUnlock(&precisionMutex);
2025     return (char *) NULL;
2026 }
static void UpdateStringOfEndOffset (Tcl_Obj* objPtr) [static]

Definition at line 2353 of file tclUtil.c.
References ckalloc, TCL_INTEGER_SPACE, and TclFormatInt().
Referenced by TCL_DECLARE_MUTEX().2355 {
2356     char buffer[TCL_INTEGER_SPACE + sizeof("end") + 1];
2357     register int len;
2358 
2359     strcpy(buffer, "end");
2360     len = sizeof("end") - 1;
2361     if (objPtr->internalRep.longValue != 0) {
2362   buffer[len++] = '-';
2363   len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue));
2364     }
2365     objPtr->bytes = ckalloc((unsigned) (len+1));
2366     strcpy(objPtr->bytes, buffer);
2367     objPtr->length = len;
2368 }

Variable Documentation
char precisionFormat[10] = "%.12g" [static]

Definition at line 61 of file tclUtil.c.
Referenced by Tcl_PrintDouble(), and TclPrecTraceProc().char precisionString[10] = "12" [static]

Definition at line 58 of file tclUtil.c.
Referenced by TclPrecTraceProc().char* tclExecutableName = NULL

Definition at line 27 of file tclUtil.c.
Referenced by Tcl_Finalize(), Tcl_FindExecutable(), Tcl_GetNameOfExecutable(), TclInitSubsystems(), TclpDlopen(), TclpFindExecutable(), and TestfindexecutableCmd().char* tclNativeExecutableName = NULL

Definition at line 28 of file tclUtil.c.
Referenced by Tcl_Finalize(), TclpFindExecutable(), and TestfindexecutableCmd().

generic/tclVar.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Defines
#define VAR_NAME_BUF_SIZE  26
#define LOOKUP_FOR_UPVAR  0x40000
Functions
static int CallVarTraces _ANSI_ARGS_ ((Interp *iPtr, Var *arrayPtr, Var *varPtr, CONST char *part1, CONST char *part2, int flags, CONST int leaveErrMsg))
static void CleanupVar _ANSI_ARGS_ ((Var *varPtr, Var *arrayPtr))
static void DeleteSearches _ANSI_ARGS_ ((Var *arrayVarPtr))
static void DeleteArray _ANSI_ARGS_ ((Interp *iPtr, CONST char *arrayName, Var *varPtr, int flags))
static void DisposeTraceResult _ANSI_ARGS_ ((int flags, char *result))
static int ObjMakeUpvar _ANSI_ARGS_ ((Tcl_Interp *interp, CallFrame *framePtr, Tcl_Obj *otherP1Ptr, CONST char *otherP2, CONST int otherFlags, CONST char *myName, int myFlags, int index))
static Var *NewVar _ANSI_ARGS_ ((void))
static ArraySearch *ParseSearchId _ANSI_ARGS_ ((Tcl_Interp *interp, CONST Var *varPtr, CONST char *varName, Tcl_Obj *handleObj))
static void VarErrMsg _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, CONST char *operation, CONST char *reason))
static int SetArraySearchObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
static void UnsetVarStruct _ANSI_ARGS_ ((Var *varPtr, Var *arrayPtr, Interp *iPtr, CONST char *part1, CONST char *part2, int flags))
Var *TclLookupSimpleVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, CONST int create, CONST char **errMsgPtr, int *indexPtr))
int TclObjUnsetVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *part1Ptr, CONST char *part2, int flags))
Var * TclLookupVar (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, CONST char *msg, int createPart1, int createPart2, Var **arrayPtrPtr)
Var * TclObjLookupVar (Tcl_Interp *interp, Tcl_Obj *part1Ptr, CONST char *part2, int flags, CONST char *msg, CONST int createPart1, CONST int createPart2, Var **arrayPtrPtr)
Var * TclLookupSimpleVar (Tcl_Interp *interp, CONST char *varName, int flags, CONST int create, CONST char **errMsgPtr, int *indexPtr)
Var * TclLookupArrayElement (Tcl_Interp *interp, CONST char *arrayName, CONST char *elName, CONST int flags, CONST char *msg, CONST int createArray, CONST int createElem, Var *arrayPtr)
CONST char * Tcl_GetVar (Tcl_Interp *interp, CONST char *varName, int flags)
CONST char * Tcl_GetVar2 (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags)
Tcl_Obj * Tcl_GetVar2Ex (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags)
Tcl_Obj * Tcl_ObjGetVar2 (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags)
Tcl_Obj * TclPtrGetVar (Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, CONST char *part1, CONST char *part2, CONST int flags)
int Tcl_SetObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
CONST char * Tcl_SetVar (Tcl_Interp *interp, CONST char *varName, CONST char *newValue, int flags)
CONST char * Tcl_SetVar2 (Tcl_Interp *interp, CONST char *part1, CONST char *part2, CONST char *newValue, int flags)
Tcl_Obj * Tcl_SetVar2Ex (Tcl_Interp *interp, CONST char *part1, CONST char *part2, Tcl_Obj *newValuePtr, int flags)
Tcl_Obj * Tcl_ObjSetVar2 (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags)
Tcl_Obj * TclPtrSetVar (Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, CONST char *part1, CONST char *part2, Tcl_Obj *newValuePtr, CONST int flags)
Tcl_Obj * TclIncrVar2 (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, long incrAmount, int flags)
Tcl_Obj * TclPtrIncrVar (Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, CONST char *part1, CONST char *part2, CONST long incrAmount, CONST int flags)
int Tcl_UnsetVar (Tcl_Interp *interp, CONST char *varName, int flags)
int Tcl_UnsetVar2 (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags)
int TclObjUnsetVar2 (Tcl_Interp *interp, Tcl_Obj *part1Ptr, CONST char *part2, int flags)
static void UnsetVarStruct (Var *varPtr, Var *arrayPtr, Interp *iPtr, CONST char *part1, CONST char *part2, int flags)
int Tcl_TraceVar (Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData)
int Tcl_TraceVar2 (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData)
void Tcl_UntraceVar (Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData)
void Tcl_UntraceVar2 (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData)
ClientData Tcl_VarTraceInfo (Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *proc, ClientData prevClientData)
ClientData Tcl_VarTraceInfo2 (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *proc, ClientData prevClientData)
int Tcl_UnsetObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_AppendObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_LappendObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_ArrayObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int TclArraySet (Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj)
static int ObjMakeUpvar (Tcl_Interp *interp, CallFrame *framePtr, Tcl_Obj *otherP1Ptr, CONST char *otherP2, CONST int otherFlags, CONST char *myName, int myFlags, int index)
int Tcl_UpVar (Tcl_Interp *interp, CONST char *frameName, CONST char *varName, CONST char *localName, int flags)
int Tcl_UpVar2 (Tcl_Interp *interp, CONST char *frameName, CONST char *part1, CONST char *part2, CONST char *localName, int flags)
void Tcl_GetVariableFullName (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr)
int Tcl_GlobalObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_VariableObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Tcl_UpvarObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static void DisposeTraceResult (int flags, char *result)
static int CallVarTraces (Interp *iPtr, Var *arrayPtr, Var *varPtr, CONST char *part1, CONST char *part2, int flags, CONST int leaveErrMsg)
static Var * NewVar ()
static int SetArraySearchObj (Tcl_Interp *interp, Tcl_Obj *objPtr)
static ArraySearch * ParseSearchId (Tcl_Interp *interp, CONST Var *varPtr, CONST char *varName, Tcl_Obj *handleObj)
static void DeleteSearches (Var *arrayVarPtr)
void TclDeleteNamespaceVars (Namespace *nsPtr)
void TclDeleteVars (Interp *iPtr, Tcl_HashTable *tablePtr)
void TclDeleteCompiledLocalVars (Interp *iPtr, CallFrame *framePtr)
static void DeleteArray (Interp *iPtr, CONST char *arrayName, Var *varPtr, int flags)
static void CleanupVar (Var *varPtr, Var *arrayPtr)
static void VarErrMsg (Tcl_Interp *interp, CONST char *part1, CONST char *part2, CONST char *operation, CONST char *reason)
Var * TclVarTraceExists (Tcl_Interp *interp, CONST char *varName)
static void FreeLocalVarName (Tcl_Obj *objPtr)
static void DupLocalVarName (Tcl_Obj *srcPtr, Tcl_Obj *dupPtr)
static void UpdateLocalVarName (Tcl_Obj *objPtr)
static void FreeNsVarName (Tcl_Obj *objPtr)
static void DupNsVarName (Tcl_Obj *srcPtr, Tcl_Obj *dupPtr)
static void FreeParsedVarName (Tcl_Obj *objPtr)
static void DupParsedVarName (Tcl_Obj *srcPtr, Tcl_Obj *dupPtr)
static void UpdateParsedVarName (Tcl_Obj *objPtr)
Variables
static CONST char * noSuchVar = "no such variable"
static CONST char * isArray = "variable is array"
static CONST char * needArray = "variable isn't array"
static CONST char * noSuchElement = "no such element in array"
static CONST char * danglingElement
static CONST char * danglingVar
static CONST char * badNamespace = "parent namespace doesn't exist"
static CONST char * missingName = "missing variable name"
static CONST char * isArrayElement = "name refers to an element in an array"
static Tcl_FreeInternalRepProc FreeLocalVarName
static Tcl_DupInternalRepProc DupLocalVarName
static Tcl_UpdateStringProc UpdateLocalVarName
static Tcl_FreeInternalRepProc FreeNsVarName
static Tcl_DupInternalRepProc DupNsVarName
static Tcl_FreeInternalRepProc FreeParsedVarName
static Tcl_DupInternalRepProc DupParsedVarName
static Tcl_UpdateStringProc UpdateParsedVarName
static Tcl_ObjType tclLocalVarNameType
static Tcl_ObjType tclNsVarNameType
static Tcl_ObjType tclParsedVarNameType
Tcl_ObjType tclArraySearchType

Define Documentation
#define LOOKUP_FOR_UPVAR  0x40000

Definition at line 621 of file tclVar.c.
Referenced by ObjMakeUpvar(), and TclLookupSimpleVar().#define VAR_NAME_BUF_SIZE  26

Referenced by TclLookupVar().
Function Documentation
int TclObjUnsetVar2 _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *part1Ptr, CONST char *part2, int flags))
Var* TclLookupSimpleVar _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *varName, int flags, CONST int create, CONST char **errMsgPtr, int *indexPtr))
static void UnsetVarStruct _ANSI_ARGS_ ((Var *varPtr, Var *arrayPtr, Interp *iPtr, CONST char *part1, CONST char *part2, int flags)) [static]
static int SetArraySearchObj _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr)) [static]
static void VarErrMsg _ANSI_ARGS_ ((Tcl_Interp *interp, CONST char *part1, CONST char *part2, CONST char *operation, CONST char *reason)) [static]
static ArraySearch* ParseSearchId _ANSI_ARGS_ ((Tcl_Interp *interp, CONST Var *varPtr, CONST char *varName, Tcl_Obj *handleObj)) [static]
static Var* NewVar _ANSI_ARGS_ ((void)) [static]
static int ObjMakeUpvar _ANSI_ARGS_ ((Tcl_Interp *interp, CallFrame *framePtr, Tcl_Obj *otherP1Ptr, CONST char *otherP2, CONST int otherFlags, CONST char *myName, int myFlags, int index)) [static]
static void DisposeTraceResult _ANSI_ARGS_ ((int flags, char *result)) [static]
static void DeleteArray _ANSI_ARGS_ ((Interp *iPtr, CONST char *arrayName, Var *varPtr, int flags)) [static]
static void DeleteSearches _ANSI_ARGS_ ((Var *arrayVarPtr)) [static]
static void CleanupVar _ANSI_ARGS_ ((Var *varPtr, Var *arrayPtr)) [static]
static int CallVarTraces _ANSI_ARGS_ ((Interp *iPtr, Var *arrayPtr, Var *varPtr, CONST char *part1, CONST char *part2, int flags, CONST int leaveErrMsg)) [static]
static int CallVarTraces (Interp * iPtr, Var * arrayPtr, Var * varPtr, CONST char * part1, CONST char * part2, int flags, CONST int leaveErrMsg) [static]

Definition at line 4166 of file tclVar.c.
References CONST, DisposeTraceResult(), ERR_ALREADY_LOGGED, ERR_IN_PROGRESS, ERROR_CODE_SET, VarTrace::flags, VarTrace::nextPtr, ActiveVarTrace::nextPtr, ActiveVarTrace::nextTracePtr, Tcl_Obj::refCount, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, TCL_ERROR, Tcl_GetString(), TCL_OK, Tcl_Preserve(), Tcl_Release(), TCL_TRACE_ARRAY, TCL_TRACE_DESTROYED, TCL_TRACE_READS, TCL_TRACE_RESULT_OBJECT, TCL_TRACE_UNSETS, TCL_TRACE_WRITES, VAR_TRACE_ACTIVE, VarErrMsg(), ActiveVarTrace::varPtr, and varPtr.
Referenced by DeleteArray(), Tcl_ArrayObjCmd(), TclDeleteVars(), TclPtrGetVar(), TclPtrSetVar(), TclVarTraceExists(), and UnsetVarStruct().4175                                                        :
4176          * indicates what's happening to variable,
4177          * plus other stuff like TCL_GLOBAL_ONLY,
4178          * TCL_NAMESPACE_ONLY, and
4179          * TCL_INTERP_DESTROYED. */
4180     CONST int leaveErrMsg;  /* If true, and one of the traces indicates an
4181          * error, then leave an error message and stack
4182          * trace information in *iPTr. */
4183 {
4184     register VarTrace *tracePtr;
4185     ActiveVarTrace active;
4186     char *result;
4187     CONST char *openParen, *p;
4188     Tcl_DString nameCopy;
4189     int copiedName;
4190     int code = TCL_OK;
4191     int disposeFlags = 0;
4192     int saveErrFlags = iPtr->flags 
4193       & (ERR_IN_PROGRESS | ERR_ALREADY_LOGGED | ERROR_CODE_SET);
4194 
4195     /*
4196      * If there are already similar trace procedures active for the
4197      * variable, don't call them again.
4198      */
4199 
4200     if (varPtr->flags & VAR_TRACE_ACTIVE) {
4201   return code;
4202     }
4203     varPtr->flags |= VAR_TRACE_ACTIVE;
4204     varPtr->refCount++;
4205     if (arrayPtr != NULL) {
4206   arrayPtr->refCount++;
4207     }
4208 
4209     /*
4210      * If the variable name hasn't been parsed into array name and
4211      * element, do it here.  If there really is an array element,
4212      * make a copy of the original name so that NULLs can be
4213      * inserted into it to separate the names (can't modify the name
4214      * string in place, because the string might get used by the
4215      * callbacks we invoke).
4216      */
4217 
4218     copiedName = 0;
4219     if (part2 == NULL) {
4220   for (p = part1; *p ; p++) {
4221       if (*p == '(') {
4222     openParen = p;
4223     do {
4224         p++;
4225     } while (*p != '\0');
4226     p--;
4227     if (*p == ')') {
4228         int offset = (openParen - part1);
4229         char *newPart1;
4230         Tcl_DStringInit(&nameCopy);
4231         Tcl_DStringAppend(&nameCopy, part1, (p-part1));
4232         newPart1 = Tcl_DStringValue(&nameCopy);
4233         newPart1[offset] = 0;
4234         part1 = newPart1;
4235         part2 = newPart1 + offset + 1;
4236         copiedName = 1;
4237     }
4238     break;
4239       }
4240   }
4241     }
4242 
4243     /*
4244      * Invoke traces on the array containing the variable, if relevant.
4245      */
4246 
4247     result = NULL;
4248     active.nextPtr = iPtr->activeVarTracePtr;
4249     iPtr->activeVarTracePtr = &active;
4250     Tcl_Preserve((ClientData) iPtr);
4251     if (arrayPtr != NULL && !(arrayPtr->flags & VAR_TRACE_ACTIVE)) {
4252   active.varPtr = arrayPtr;
4253   for (tracePtr = arrayPtr->tracePtr;  tracePtr != NULL;
4254        tracePtr = active.nextTracePtr) {
4255       active.nextTracePtr = tracePtr->nextPtr;
4256       if (!(tracePtr->flags & flags)) {
4257     continue;
4258       }
4259       Tcl_Preserve((ClientData) tracePtr);
4260       result = (*tracePtr->traceProc)(tracePtr->clientData,
4261         (Tcl_Interp *) iPtr, part1, part2, flags);
4262       if (result != NULL) {
4263     if (flags & TCL_TRACE_UNSETS) {
4264         /* Ignore errors in unset traces */
4265         DisposeTraceResult(tracePtr->flags, result);
4266     } else {
4267               disposeFlags = tracePtr->flags;
4268         code = TCL_ERROR;
4269     }
4270       }
4271       Tcl_Release((ClientData) tracePtr);
4272       if (code == TCL_ERROR) {
4273     goto done;
4274       }
4275   }
4276     }
4277 
4278     /*
4279      * Invoke traces on the variable itself.
4280      */
4281 
4282     if (flags & TCL_TRACE_UNSETS) {
4283   flags |= TCL_TRACE_DESTROYED;
4284     }
4285     active.varPtr = varPtr;
4286     for (tracePtr = varPtr->tracePtr; tracePtr != NULL;
4287    tracePtr = active.nextTracePtr) {
4288   active.nextTracePtr = tracePtr->nextPtr;
4289   if (!(tracePtr->flags & flags)) {
4290       continue;
4291   }
4292   Tcl_Preserve((ClientData) tracePtr);
4293   result = (*tracePtr->traceProc)(tracePtr->clientData,
4294     (Tcl_Interp *) iPtr, part1, part2, flags);
4295   if (result != NULL) {
4296       if (flags & TCL_TRACE_UNSETS) {
4297     /* Ignore errors in unset traces */
4298     DisposeTraceResult(tracePtr->flags, result);
4299       } else {
4300     disposeFlags = tracePtr->flags;
4301     code = TCL_ERROR;
4302       }
4303   }
4304   Tcl_Release((ClientData) tracePtr);
4305   if (code == TCL_ERROR) {
4306       goto done;
4307   }
4308     }
4309 
4310     /*
4311      * Restore the variable's flags, remove the record of our active
4312      * traces, and then return.
4313      */
4314 
4315     done:
4316     if (code == TCL_OK) {
4317   iPtr->flags |= saveErrFlags;
4318     }
4319     if (code == TCL_ERROR) {
4320   if (leaveErrMsg) {
4321       CONST char *type = "";
4322       switch (flags&(TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_ARRAY)) {
4323     case TCL_TRACE_READS: {
4324         type = "read";
4325         break;
4326     }
4327     case TCL_TRACE_WRITES: {
4328         type = "set";
4329         break;
4330     }
4331     case TCL_TRACE_ARRAY: {
4332         type = "trace array";
4333         break;
4334     }
4335       }
4336       if (disposeFlags & TCL_TRACE_RESULT_OBJECT) {
4337     VarErrMsg((Tcl_Interp *) iPtr, part1, part2, type,
4338       Tcl_GetString((Tcl_Obj *) result));
4339       } else {
4340     VarErrMsg((Tcl_Interp *) iPtr, part1, part2, type, result);
4341       }
4342   }
4343   DisposeTraceResult(disposeFlags,result);
4344     }
4345 
4346     if (arrayPtr != NULL) {
4347   arrayPtr->refCount--;
4348     }
4349     if (copiedName) {
4350   Tcl_DStringFree(&nameCopy);
4351     }
4352     varPtr->flags &= ~VAR_TRACE_ACTIVE;
4353     varPtr->refCount--;
4354     iPtr->activeVarTracePtr = active.nextPtr;
4355     Tcl_Release((ClientData) iPtr);
4356     return code;
4357 }

static void CleanupVar (Var * varPtr, Var * arrayPtr) [static]

Definition at line 5012 of file tclVar.c.
References ckfree, Tcl_DeleteHashEntry(), TclIsVarUndefined, and VAR_IN_HASHTABLE.
Referenced by FreeNsVarName(), ObjMakeUpvar(), Tcl_UntraceVar2(), TclDeleteNamespaceVars(), TclObjUnsetVar2(), TclPtrGetVar(), TclPtrSetVar(), and TclVarTraceExists().5018 {
5019     if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0)
5020       && (varPtr->tracePtr == NULL)
5021       && (varPtr->flags & VAR_IN_HASHTABLE)) {
5022   if (varPtr->hPtr != NULL) {
5023       Tcl_DeleteHashEntry(varPtr->hPtr);
5024   }
5025   ckfree((char *) varPtr);
5026     }
5027     if (arrayPtr != NULL) {
5028   if (TclIsVarUndefined(arrayPtr) && (arrayPtr->refCount == 0)
5029     && (arrayPtr->tracePtr == NULL)
5030           && (arrayPtr->flags & VAR_IN_HASHTABLE)) {
5031       if (arrayPtr->hPtr != NULL) {
5032     Tcl_DeleteHashEntry(arrayPtr->hPtr);
5033       }
5034       ckfree((char *) arrayPtr);
5035   }
5036     }
5037 }
static void DeleteArray (Interp * iPtr, CONST char * arrayName, Var * varPtr, int flags) [static]

Definition at line 4922 of file tclVar.c.
References CallVarTraces(), ckfree, DeleteSearches(), Var::flags, Var::hPtr, ActiveVarTrace::nextPtr, VarTrace::nextPtr, ActiveVarTrace::nextTracePtr, NULL, Var::objPtr, Var::refCount, Tcl_DeleteHashTable(), TCL_DYNAMIC, Tcl_EventuallyFree(), Tcl_FirstHashEntry(), Tcl_GetHashKey, Tcl_GetHashValue, Tcl_NextHashEntry(), TclDecrRefCount, TclIsVarScalar, TclSetVarScalar, TclSetVarUndefined, Var::tracePtr, Var::value, VAR_NAMESPACE_VAR, VAR_TRACE_ACTIVE, ActiveVarTrace::varPtr, and varPtr.
Referenced by TclDeleteVars(), and UnsetVarStruct().4927                                                        :
4928            * TCL_TRACE_UNSETS and sometimes
4929            * TCL_INTERP_DESTROYED,
4930            * TCL_NAMESPACE_ONLY, or
4931            * TCL_GLOBAL_ONLY. */
4932 {
4933     Tcl_HashSearch search;
4934     register Tcl_HashEntry *hPtr;
4935     register Var *elPtr;
4936     ActiveVarTrace *activePtr;
4937     Tcl_Obj *objPtr;
4938 
4939     DeleteSearches(varPtr);
4940     for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
4941    hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
4942   elPtr = (Var *) Tcl_GetHashValue(hPtr);
4943   if (TclIsVarScalar(elPtr) && (elPtr->value.objPtr != NULL)) {
4944       objPtr = elPtr->value.objPtr;
4945       TclDecrRefCount(objPtr);
4946       elPtr->value.objPtr = NULL;
4947   }
4948   elPtr->hPtr = NULL;
4949   if (elPtr->tracePtr != NULL) {
4950       elPtr->flags &= ~VAR_TRACE_ACTIVE;
4951       CallVarTraces(iPtr, (Var *) NULL, elPtr, arrayName,
4952         Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), flags,
4953         /* leaveErrMsg */ 0);
4954       while (elPtr->tracePtr != NULL) {
4955     VarTrace *tracePtr = elPtr->tracePtr;
4956     elPtr->tracePtr = tracePtr->nextPtr;
4957     Tcl_EventuallyFree((ClientData) tracePtr,TCL_DYNAMIC);
4958       }
4959       for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
4960      activePtr = activePtr->nextPtr) {
4961     if (activePtr->varPtr == elPtr) {
4962         activePtr->nextTracePtr = NULL;
4963     }
4964       }
4965   }
4966   TclSetVarUndefined(elPtr);
4967   TclSetVarScalar(elPtr);
4968 
4969   /*
4970    * Even though array elements are not supposed to be namespace
4971    * variables, some combinations of [upvar] and [variable] may
4972    * create such beasts - see [Bug 604239]. This is necessary to
4973    * avoid leaking the corresponding Var struct, and is otherwise
4974    * harmless. 
4975    */
4976 
4977   if (elPtr->flags & VAR_NAMESPACE_VAR) {
4978       elPtr->flags &= ~VAR_NAMESPACE_VAR;
4979       elPtr->refCount--;
4980   }
4981   if (elPtr->refCount == 0) {
4982       ckfree((char *) elPtr); /* element Vars are VAR_IN_HASHTABLE */
4983   }
4984     }
4985     Tcl_DeleteHashTable(varPtr->value.tablePtr);
4986     ckfree((char *) varPtr->value.tablePtr);
4987 }

static void DeleteSearches (Var * arrayVarPtr) [static]

Definition at line 4561 of file tclVar.c.
References ckfree, and ArraySearch::nextPtr.
Referenced by DeleteArray(), TclLookupArrayElement(), and UnsetVarStruct().4564 {
4565     ArraySearch *searchPtr;
4566 
4567     while (arrayVarPtr->searchPtr != NULL) {
4568   searchPtr = arrayVarPtr->searchPtr;
4569   arrayVarPtr->searchPtr = searchPtr->nextPtr;
4570   ckfree((char *) searchPtr);
4571     }
4572 }
static void DisposeTraceResult (int flags, char * result) [static]

Definition at line 4128 of file tclVar.c.
References ckfree, Tcl_DecrRefCount, TCL_TRACE_RESULT_DYNAMIC, and TCL_TRACE_RESULT_OBJECT.
Referenced by CallVarTraces().4133 {
4134     if (flags & TCL_TRACE_RESULT_DYNAMIC) {
4135   ckfree(result);
4136     } else if (flags & TCL_TRACE_RESULT_OBJECT) {
4137   Tcl_DecrRefCount((Tcl_Obj *) result);
4138     }
4139 }
static void DupLocalVarName (Tcl_Obj * srcPtr, Tcl_Obj * dupPtr) [static]

Definition at line 5165 of file tclVar.c.
References Tcl_Obj::internalRep, Proc::refCount, tclLocalVarNameType, Tcl_Obj::twoPtrValue, Tcl_Obj::typePtr, and VOID.5168 {
5169     register Proc *procPtr = (Proc *) srcPtr->internalRep.twoPtrValue.ptr1;
5170 
5171     dupPtr->internalRep.twoPtrValue.ptr1 = (VOID *) procPtr;
5172     dupPtr->internalRep.twoPtrValue.ptr2 = srcPtr->internalRep.twoPtrValue.ptr2;
5173     procPtr->refCount++;
5174     dupPtr->typePtr = &tclLocalVarNameType;
5175 }
static void DupNsVarName (Tcl_Obj * srcPtr, Tcl_Obj * dupPtr) [static]

Definition at line 5237 of file tclVar.c.
References Tcl_Obj::internalRep, Tcl_Obj::refCount, tclNsVarNameType, Tcl_Obj::twoPtrValue, Tcl_Obj::typePtr, varPtr, and VOID.5240 {
5241     Namespace *nsPtr = (Namespace *) srcPtr->internalRep.twoPtrValue.ptr1;
5242     register Var *varPtr = (Var *) srcPtr->internalRep.twoPtrValue.ptr2;
5243 
5244     dupPtr->internalRep.twoPtrValue.ptr1 =  (VOID *) nsPtr;
5245     dupPtr->internalRep.twoPtrValue.ptr2 = (VOID *) varPtr;
5246     varPtr->refCount++;
5247     dupPtr->typePtr = &tclNsVarNameType;
5248 }
static void DupParsedVarName (Tcl_Obj * srcPtr, Tcl_Obj * dupPtr) [static]

Definition at line 5276 of file tclVar.c.
References ckalloc, Tcl_Obj::internalRep, Tcl_IncrRefCount, tclParsedVarNameType, Tcl_Obj::twoPtrValue, Tcl_Obj::typePtr, and VOID.5279 {
5280     register Tcl_Obj *arrayPtr =
5281       (Tcl_Obj *) srcPtr->internalRep.twoPtrValue.ptr1;
5282     register char *elem = (char *) srcPtr->internalRep.twoPtrValue.ptr2;
5283     char *elemCopy;
5284     unsigned int elemLen;
5285 
5286     if (arrayPtr != NULL) {
5287   Tcl_IncrRefCount(arrayPtr);
5288   elemLen = strlen(elem);
5289   elemCopy = ckalloc(elemLen+1);
5290   memcpy(elemCopy, elem, elemLen);
5291   *(elemCopy + elemLen) = '\0';
5292   elem = elemCopy;
5293     }
5294 
5295     dupPtr->internalRep.twoPtrValue.ptr1 = (VOID *) arrayPtr;
5296     dupPtr->internalRep.twoPtrValue.ptr2 = (VOID *) elem;
5297     dupPtr->typePtr = &tclParsedVarNameType;
5298 }
static void FreeLocalVarName (Tcl_Obj * objPtr) [static]

Definition at line 5154 of file tclVar.c.
References Tcl_Obj::internalRep, Proc::refCount, TclProcCleanupProc(), and Tcl_Obj::twoPtrValue.5156 {
5157     register Proc *procPtr = (Proc *) objPtr->internalRep.twoPtrValue.ptr1;
5158     procPtr->refCount--;
5159     if (procPtr->refCount <= 0) {
5160   TclProcCleanupProc(procPtr);
5161     }
5162 }
static void FreeNsVarName (Tcl_Obj * objPtr) [static]

Definition at line 5218 of file tclVar.c.
References CleanupVar(), Tcl_Obj::internalRep, Var::refCount, Tcl_Obj::refCount, TclIsVarLink, TclIsVarUndefined, Tcl_Obj::twoPtrValue, and varPtr.5220 {
5221     register Var *varPtr = (Var *) objPtr->internalRep.twoPtrValue.ptr2;
5222 
5223     varPtr->refCount--;
5224     if (TclIsVarUndefined(varPtr) && (varPtr->refCount <= 0)) {
5225   if (TclIsVarLink(varPtr)) {
5226       Var *linkPtr = varPtr->value.linkPtr;
5227       linkPtr->refCount--;
5228       if (TclIsVarUndefined(linkPtr) && (linkPtr->refCount <= 0)) {
5229     CleanupVar(linkPtr, (Var *) NULL);
5230       }
5231   }
5232   CleanupVar(varPtr, NULL);
5233     }
5234 }
static void FreeParsedVarName (Tcl_Obj * objPtr) [static]

Definition at line 5262 of file tclVar.c.
References ckfree, and TclDecrRefCount.5264 {
5265     register Tcl_Obj *arrayPtr =
5266       (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr1;
5267     register char *elem = (char *) objPtr->internalRep.twoPtrValue.ptr2;
5268     
5269     if (arrayPtr != NULL) {
5270   TclDecrRefCount(arrayPtr);
5271   ckfree(elem);
5272     }
5273 }
static Var* NewVar () [static]

Definition at line 4381 of file tclVar.c.
References ckalloc, Tcl_Obj::refCount, VAR_IN_HASHTABLE, VAR_SCALAR, VAR_UNDEFINED, and varPtr.
Referenced by TclLookupArrayElement(), and TclLookupSimpleVar().4382 {
4383     register Var *varPtr;
4384 
4385     varPtr = (Var *) ckalloc(sizeof(Var));
4386     varPtr->value.objPtr = NULL;
4387     varPtr->name = NULL;
4388     varPtr->nsPtr = NULL;
4389     varPtr->hPtr = NULL;
4390     varPtr->refCount = 0;
4391     varPtr->tracePtr = NULL;
4392     varPtr->searchPtr = NULL;
4393     varPtr->flags = (VAR_SCALAR | VAR_UNDEFINED | VAR_IN_HASHTABLE);
4394     return varPtr;
4395 }
static int ObjMakeUpvar (Tcl_Interp * interp, CallFrame * framePtr, Tcl_Obj * otherP1Ptr, CONST char * otherP2, CONST int otherFlags, CONST char * myName, int myFlags, int index) [static]

Definition at line 3548 of file tclVar.c.
References CleanupVar(), CallFrame::compiledLocals, CONST, CallFrame::isProcCallFrame, LOOKUP_FOR_UPVAR, Var::nsPtr, panic, Var::refCount, strstr(), TCL_ERROR, TCL_GLOBAL_ONLY, TCL_LEAVE_ERR_MSG, TCL_NAMESPACE_ONLY, TCL_OK, Tcl_SetResult(), TCL_STATIC, TclClearVarUndefined, TclIsVarLink, TclIsVarUndefined, TclLookupSimpleVar(), TclObjLookupVar(), TclSetVarLink, VarErrMsg(), Interp::varFramePtr, and varPtr.
Referenced by Tcl_GlobalObjCmd(), Tcl_UpVar2(), Tcl_UpvarObjCmd(), and Tcl_VariableObjCmd().3555                                                                      :
3556          * indicates scope of "other" variable. */
3557     CONST char *myName;   /* Name of variable which will refer to
3558          * otherP1/otherP2. Must be a scalar. */
3559     int myFlags;    /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
3560          * indicates scope of myName. */
3561     int index;                  /* If the variable to be linked is an indexed
3562          * scalar, this is its index. Otherwise, -1. */
3563 {
3564     Interp *iPtr = (Interp *) interp;
3565     Var *otherPtr, *varPtr, *arrayPtr;
3566     CallFrame *varFramePtr;
3567     CONST char *errMsg;
3568 
3569     /*
3570      * Find "other" in "framePtr". If not looking up other in just the
3571      * current namespace, temporarily replace the current var frame
3572      * pointer in the interpreter in order to use TclObjLookupVar.
3573      */
3574 
3575     varFramePtr = iPtr->varFramePtr;
3576     if (!(otherFlags & TCL_NAMESPACE_ONLY)) {
3577   iPtr->varFramePtr = framePtr;
3578     }
3579     otherPtr = TclObjLookupVar(interp, otherP1Ptr, otherP2,
3580       (otherFlags | TCL_LEAVE_ERR_MSG), "access",
3581             /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
3582     if (!(otherFlags & TCL_NAMESPACE_ONLY)) {
3583   iPtr->varFramePtr = varFramePtr;
3584     }
3585     if (otherPtr == NULL) {
3586   return TCL_ERROR;
3587     }
3588 
3589     if (index >= 0) {
3590   if (!varFramePtr->isProcCallFrame) {
3591       panic("ObjMakeUpvar called with an index outside from a proc.\n");
3592   }
3593   varPtr = &(varFramePtr->compiledLocals[index]);
3594     } else {
3595   /*
3596    * Check that we are not trying to create a namespace var linked to
3597    * a local variable in a procedure. If we allowed this, the local
3598    * variable in the shorter-lived procedure frame could go away
3599    * leaving the namespace var's reference invalid.
3600    */
3601   
3602   if (((otherP2 ? arrayPtr->nsPtr : otherPtr->nsPtr) == NULL) 
3603       && ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
3604     || (varFramePtr == NULL)
3605     || !varFramePtr->isProcCallFrame
3606     || (strstr(myName, "::") != NULL))) {
3607       Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
3608         myName, "\": upvar won't create namespace variable that ",
3609         "refers to procedure variable", (char *) NULL);
3610       return TCL_ERROR;
3611   }
3612   
3613   /*
3614    * Lookup and eventually create the new variable. Set the flag bit
3615    * LOOKUP_FOR_UPVAR to indicate the special resolution rules for 
3616    * upvar purposes: 
3617    *   - Bug #696893 - variable is either proc-local or in the current
3618    *     namespace; never follow the second (global) resolution path 
3619    *   - Bug #631741 - do not use special namespace or interp resolvers
3620    */
3621   
3622   varPtr = TclLookupSimpleVar(interp, myName, (myFlags | LOOKUP_FOR_UPVAR), 
3623           /* create */ 1, &errMsg, &index);
3624   if (varPtr == NULL) {
3625       VarErrMsg(interp, myName, NULL, "create", errMsg);
3626       return TCL_ERROR;
3627   }
3628     }
3629 
3630     if (varPtr == otherPtr) {
3631   Tcl_SetResult((Tcl_Interp *) iPtr,
3632           "can't upvar from variable to itself", TCL_STATIC);
3633   return TCL_ERROR;
3634     }
3635 
3636     if (varPtr->tracePtr != NULL) {
3637   Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
3638           "\" has traces: can't use for upvar", (char *) NULL);
3639   return TCL_ERROR;
3640     } else if (!TclIsVarUndefined(varPtr)) {
3641   /*
3642    * The variable already existed. Make sure this variable "varPtr"
3643    * isn't the same as "otherPtr" (avoid circular links). Also, if
3644    * it's not an upvar then it's an error. If it is an upvar, then
3645    * just disconnect it from the thing it currently refers to.
3646    */
3647 
3648   if (TclIsVarLink(varPtr)) {
3649       Var *linkPtr = varPtr->value.linkPtr;
3650       if (linkPtr == otherPtr) {
3651     return TCL_OK;
3652       }
3653       linkPtr->refCount--;
3654       if (TclIsVarUndefined(linkPtr)) {
3655     CleanupVar(linkPtr, (Var *) NULL);
3656       }
3657   } else {
3658       Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
3659         "\" already exists", (char *) NULL);
3660       return TCL_ERROR;
3661   }
3662     }
3663     TclSetVarLink(varPtr);
3664     TclClearVarUndefined(varPtr);
3665     varPtr->value.linkPtr = otherPtr;
3666     otherPtr->refCount++;
3667     return TCL_OK;
3668 }

static ArraySearch* ParseSearchId (Tcl_Interp * interp, CONST Var * varPtr, CONST char * varName, Tcl_Obj * handleObj) [static]

Definition at line 4484 of file tclVar.c.
References ArraySearch::id, Tcl_Obj::internalRep, ArraySearch::nextPtr, size_t(), Tcl_ConvertToType(), Tcl_GetString(), TCL_OK, tclArraySearchType, and Tcl_Obj::twoPtrValue.
Referenced by Tcl_ArrayObjCmd().4493 {
4494     register char *string;
4495     register size_t offset;
4496     int id;
4497     ArraySearch *searchPtr;
4498 
4499     /*
4500      * Parse the id.
4501      */
4502     if (Tcl_ConvertToType(interp, handleObj, &tclArraySearchType) != TCL_OK) {
4503   return NULL;
4504     }
4505     /*
4506      * Cast is safe, since always came from an int in the first place.
4507      */
4508     id = (int)(((char*)handleObj->internalRep.twoPtrValue.ptr1) -
4509          ((char*)NULL));
4510     string = Tcl_GetString(handleObj);
4511     offset = (((char*)handleObj->internalRep.twoPtrValue.ptr2) -
4512         ((char*)NULL));
4513     /*
4514      * This test cannot be placed inside the Tcl_Obj machinery, since
4515      * it is dependent on the variable context.
4516      */
4517     if (strcmp(string+offset, varName) != 0) {
4518   Tcl_AppendResult(interp, "search identifier \"", string,
4519     "\" isn't for variable \"", varName, "\"", (char *) NULL);
4520   return NULL;
4521     }
4522 
4523     /*
4524      * Search through the list of active searches on the interpreter
4525      * to see if the desired one exists.
4526      *
4527      * Note that we cannot store the searchPtr directly in the Tcl_Obj
4528      * as that would run into trouble when DeleteSearches() was called
4529      * so we must scan this list every time.
4530      */
4531 
4532     for (searchPtr = varPtr->searchPtr; searchPtr != NULL;
4533    searchPtr = searchPtr->nextPtr) {
4534   if (searchPtr->id == id) {
4535       return searchPtr;
4536   }
4537     }
4538     Tcl_AppendResult(interp, "couldn't find search \"", string, "\"",
4539       (char *) NULL);
4540     return NULL;
4541 }
static int SetArraySearchObj (Tcl_Interp * interp, Tcl_Obj * objPtr) [static]

Definition at line 4419 of file tclVar.c.
References Tcl_ObjType::freeIntRepProc, Tcl_Obj::internalRep, size_t(), strtoul(), TCL_ERROR, Tcl_GetString(), TCL_OK, tclArraySearchType, Tcl_Obj::twoPtrValue, Tcl_Obj::typePtr, and VOID.4422 {
4423     char *string;
4424     char *end;
4425     int id;
4426     size_t offset;
4427 
4428     /*
4429      * Get the string representation. Make it up-to-date if necessary.
4430      */
4431 
4432     string = Tcl_GetString(objPtr);
4433 
4434     /*
4435      * Parse the id into the three parts separated by dashes.
4436      */
4437     if ((string[0] != 's') || (string[1] != '-')) {
4438   syntax:
4439   Tcl_AppendResult(interp, "illegal search identifier \"", string,
4440     "\"", (char *) NULL);
4441   return TCL_ERROR;
4442     }
4443     id = strtoul(string+2, &end, 10);
4444     if ((end == (string+2)) || (*end != '-')) {
4445   goto syntax;
4446     }
4447     /*
4448      * Can't perform value check in this context, so place reference
4449      * to place in string to use for the check in the object instead.
4450      */
4451     end++;
4452     offset = end - string;
4453 
4454     if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) {
4455   objPtr->typePtr->freeIntRepProc(objPtr);
4456     }
4457     objPtr->typePtr = &tclArraySearchType;
4458     objPtr->internalRep.twoPtrValue.ptr1 = (VOID *)(((char *)NULL)+id);
4459     objPtr->internalRep.twoPtrValue.ptr2 = (VOID *)(((char *)NULL)+offset);
4460     return TCL_OK;
4461 }
int Tcl_AppendObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 2665 of file tclVar.c.
References TCL_APPEND_VALUE, TCL_ERROR, TCL_LEAVE_ERR_MSG, Tcl_ObjGetVar2(), TCL_OK, Tcl_SetObjResult(), Tcl_WrongNumArgs(), TclGetString, TclObjLookupVar(), TclPtrSetVar(), and varPtr.2670 {
2671     Var *varPtr, *arrayPtr;
2672     char *part1;
2673 
2674     register Tcl_Obj *varValuePtr = NULL;
2675               /* Initialized to avoid compiler
2676                  * warning. */
2677     int i;
2678 
2679     if (objc < 2) {
2680   Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
2681   return TCL_ERROR;
2682     }
2683 
2684     if (objc == 2) {
2685   varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
2686   if (varValuePtr == NULL) {
2687       return TCL_ERROR;
2688   }
2689     } else {
2690   varPtr = TclObjLookupVar(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
2691     "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
2692   part1 = TclGetString(objv[1]);
2693   if (varPtr == NULL) {
2694       return TCL_ERROR;
2695   }
2696   for (i = 2;  i < objc;  i++) {    
2697       /*
2698        * Note that we do not need to increase the refCount of
2699        * the Var pointers: should a trace delete the variable,
2700        * the return value of TclPtrSetVar will be NULL, and we 
2701        * will not access the variable again.
2702        */
2703 
2704       varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL, 
2705               objv[i], (TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG));
2706       if (varValuePtr == NULL) {
2707     return TCL_ERROR;
2708       }
2709   }
2710     }
2711     Tcl_SetObjResult(interp, varValuePtr);
2712     return TCL_OK;
2713 }
int Tcl_ArrayObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 2921 of file tclVar.c.
References CallVarTraces(), ckalloc, ckfree, CONST, ArraySearch::id, ArraySearch::nextEntry, ArraySearch::nextPtr, ParseSearchId(), Tcl_Obj::refCount, ArraySearch::search, Tcl_DecrRefCount, TCL_ERROR, Tcl_FirstHashEntry(), Tcl_GetHashKey, Tcl_GetHashValue, Tcl_GetIndexFromObj(), Tcl_GetObjResult(), Tcl_GetString(), TCL_GLOBAL_ONLY, Tcl_HashStats(), Tcl_IncrRefCount, TCL_INTEGER_SPACE, TCL_LEAVE_ERR_MSG, Tcl_ListObjAppendElement(), Tcl_ListObjGetElements(), TCL_NAMESPACE_ONLY, Tcl_NewObj(), Tcl_NewStringObj(), Tcl_NextHashEntry(), Tcl_ObjGetVar2(), TCL_OK, Tcl_RegExpMatch(), Tcl_SetIntObj(), Tcl_SetObjResult(), Tcl_SetResult(), Tcl_SetStringObj(), TCL_STATIC, Tcl_StringMatch(), TCL_TRACE_ARRAY, Tcl_WrongNumArgs(), TclArraySet(), TclFormatInt(), TclGetString, TclIsVarArray, TclIsVarUndefined, TclObjLookupVar(), TclObjUnsetVar2(), ArraySearch::varPtr, and varPtr.2926 {
2927     /*
2928      * The list of constants below should match the arrayOptions string array
2929      * below.
2930      */
2931 
2932     enum {ARRAY_ANYMORE, ARRAY_DONESEARCH,  ARRAY_EXISTS, ARRAY_GET,
2933     ARRAY_NAMES, ARRAY_NEXTELEMENT, ARRAY_SET, ARRAY_SIZE,
2934     ARRAY_STARTSEARCH, ARRAY_STATISTICS, ARRAY_UNSET}; 
2935     static CONST char *arrayOptions[] = {
2936   "anymore", "donesearch", "exists", "get", "names", "nextelement",
2937   "set", "size", "startsearch", "statistics", "unset", (char *) NULL
2938     };
2939 
2940     Interp *iPtr = (Interp *) interp;
2941     Var *varPtr, *arrayPtr;
2942     Tcl_HashEntry *hPtr;
2943     Tcl_Obj *resultPtr, *varNamePtr;
2944     int notArray;
2945     char *varName;
2946     int index, result;
2947 
2948 
2949     if (objc < 3) {
2950   Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?arg ...?");
2951   return TCL_ERROR;
2952     }
2953 
2954     if (Tcl_GetIndexFromObj(interp, objv[1], arrayOptions, "option",
2955       0, &index) != TCL_OK) {
2956       return TCL_ERROR;
2957     }
2958 
2959     /*
2960      * Locate the array variable
2961      */
2962     
2963     varNamePtr = objv[2];
2964     varName = TclGetString(varNamePtr);
2965     varPtr = TclObjLookupVar(interp, varNamePtr, NULL, /*flags*/ 0,
2966             /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
2967 
2968     /*
2969      * Special array trace used to keep the env array in sync for
2970      * array names, array get, etc.
2971      */
2972 
2973     if (varPtr != NULL && varPtr->tracePtr != NULL
2974       && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
2975   if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, varName, NULL,
2976     (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
2977     TCL_TRACE_ARRAY), /* leaveErrMsg */ 1)) {
2978       return TCL_ERROR;
2979   }
2980     }
2981 
2982     /*
2983      * Verify that it is indeed an array variable. This test comes after
2984      * the traces - the variable may actually become an array as an effect 
2985      * of said traces.
2986      */
2987 
2988     notArray = 0;
2989     if ((varPtr == NULL) || !TclIsVarArray(varPtr)
2990       || TclIsVarUndefined(varPtr)) {
2991   notArray = 1;
2992     }
2993 
2994     /*
2995      * We have to wait to get the resultPtr until here because
2996      * CallVarTraces can affect the result.
2997      */
2998 
2999     resultPtr = Tcl_GetObjResult(interp);
3000 
3001     switch (index) {
3002         case ARRAY_ANYMORE: {
3003       ArraySearch *searchPtr;
3004       
3005       if (objc != 4) {
3006           Tcl_WrongNumArgs(interp, 2, objv, 
3007                         "arrayName searchId");
3008     return TCL_ERROR;
3009       }
3010       if (notArray) {
3011           goto error;
3012       }
3013       searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]);
3014       if (searchPtr == NULL) {
3015           return TCL_ERROR;
3016       }
3017       while (1) {
3018           Var *varPtr2;
3019 
3020     if (searchPtr->nextEntry != NULL) {
3021         varPtr2 = (Var *) Tcl_GetHashValue(searchPtr->nextEntry);
3022         if (!TclIsVarUndefined(varPtr2)) {
3023             break;
3024         }
3025     }
3026     searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search);
3027     if (searchPtr->nextEntry == NULL) {
3028         Tcl_SetIntObj(resultPtr, 0);
3029         return TCL_OK;
3030     }
3031       }
3032       Tcl_SetIntObj(resultPtr, 1);
3033       break;
3034   }
3035         case ARRAY_DONESEARCH: {
3036       ArraySearch *searchPtr, *prevPtr;
3037 
3038       if (objc != 4) {
3039           Tcl_WrongNumArgs(interp, 2, objv, 
3040                         "arrayName searchId");
3041     return TCL_ERROR;
3042       }
3043       if (notArray) {
3044           goto error;
3045       }
3046       searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]);
3047       if (searchPtr == NULL) {
3048           return TCL_ERROR;
3049       }
3050       if (varPtr->searchPtr == searchPtr) {
3051           varPtr->searchPtr = searchPtr->nextPtr;
3052       } else {
3053           for (prevPtr = varPtr->searchPtr;  ;
3054          prevPtr = prevPtr->nextPtr) {
3055         if (prevPtr->nextPtr == searchPtr) {
3056             prevPtr->nextPtr = searchPtr->nextPtr;
3057       break;
3058         }
3059     }
3060       }
3061       ckfree((char *) searchPtr);
3062       break;
3063   }
3064         case ARRAY_EXISTS: {
3065       if (objc != 3) {
3066           Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
3067           return TCL_ERROR;
3068       }
3069       Tcl_SetIntObj(resultPtr, !notArray);
3070       break;
3071   }
3072         case ARRAY_GET: {
3073       Tcl_HashSearch search;
3074       Var *varPtr2;
3075       char *pattern = NULL;
3076       char *name;
3077       Tcl_Obj *namePtr, *valuePtr, *nameLstPtr, *tmpResPtr, **namePtrPtr;
3078       int i, count;
3079       
3080       if ((objc != 3) && (objc != 4)) {
3081           Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
3082     return TCL_ERROR;
3083       }
3084       if (notArray) {
3085           return TCL_OK;
3086       }
3087       if (objc == 4) {
3088           pattern = TclGetString(objv[3]);
3089       }
3090 
3091       /*
3092        * Store the array names in a new object.
3093        */
3094 
3095       nameLstPtr = Tcl_NewObj();
3096       Tcl_IncrRefCount(nameLstPtr);
3097 
3098       for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
3099      hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
3100           varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
3101     if (TclIsVarUndefined(varPtr2)) {
3102         continue;
3103     }
3104     name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
3105     if ((objc == 4) && !Tcl_StringMatch(name, pattern)) {
3106         continue; /* element name doesn't match pattern */
3107     }
3108     
3109     namePtr = Tcl_NewStringObj(name, -1);
3110     result = Tcl_ListObjAppendElement(interp, nameLstPtr,
3111             namePtr);
3112     if (result != TCL_OK) {
3113         Tcl_DecrRefCount(namePtr); /* free unneeded name obj */
3114         Tcl_DecrRefCount(nameLstPtr);
3115         return result;
3116     }
3117       }
3118 
3119       /*
3120        * Make sure the Var structure of the array is not removed by
3121        * a trace while we're working.
3122        */
3123 
3124       varPtr->refCount++;
3125 
3126       /*
3127        * Get the array values corresponding to each element name 
3128        */
3129 
3130       tmpResPtr = Tcl_NewObj();
3131       result = Tcl_ListObjGetElements(interp, nameLstPtr,
3132         &count, &namePtrPtr);
3133       if (result != TCL_OK) {
3134     goto errorInArrayGet;
3135       }
3136       
3137       for (i = 0; i < count; i++) { 
3138     namePtr = *namePtrPtr++;
3139     valuePtr = Tcl_ObjGetVar2(interp, objv[2], namePtr,
3140                   TCL_LEAVE_ERR_MSG);
3141     if (valuePtr == NULL) {
3142         /*
3143          * Some trace played a trick on us; we need to diagnose to
3144          * adapt our behaviour: was the array element unset, or did
3145          * the modification modify the complete array?
3146          */
3147 
3148         if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
3149       /*
3150        * The array itself looks OK, the variable was
3151        * undefined: forget it.
3152        */
3153       
3154       continue;
3155         } else {
3156       result = TCL_ERROR;
3157       goto errorInArrayGet;
3158         }
3159     }
3160     result = Tcl_ListObjAppendElement(interp, tmpResPtr, namePtr);
3161     if (result != TCL_OK) {
3162         goto errorInArrayGet;
3163     }
3164     result = Tcl_ListObjAppendElement(interp, tmpResPtr, valuePtr);
3165     if (result != TCL_OK) {
3166         goto errorInArrayGet;
3167     }
3168       }
3169       varPtr->refCount--;
3170       Tcl_SetObjResult(interp, tmpResPtr);
3171       Tcl_DecrRefCount(nameLstPtr);
3172       break;
3173 
3174       errorInArrayGet:
3175       varPtr->refCount--;
3176       Tcl_DecrRefCount(nameLstPtr);
3177       Tcl_DecrRefCount(tmpResPtr); /* free unneeded temp result obj */
3178       return result;
3179   }
3180         case ARRAY_NAMES: {
3181       Tcl_HashSearch search;
3182       Var *varPtr2;
3183       char *pattern = NULL;
3184       char *name;
3185       Tcl_Obj *namePtr;
3186       int mode, matched = 0;
3187       static CONST char *options[] = {
3188     "-exact", "-glob", "-regexp", (char *) NULL
3189       };
3190       enum options { OPT_EXACT, OPT_GLOB, OPT_REGEXP };
3191 
3192       mode = OPT_GLOB;
3193       
3194       if ((objc < 3) || (objc > 5)) {
3195             Tcl_WrongNumArgs(interp, 2, objv,
3196       "arrayName ?mode? ?pattern?");
3197     return TCL_ERROR;
3198       }
3199       if (notArray) {
3200           return TCL_OK;
3201       }
3202       if (objc == 4) {
3203           pattern = Tcl_GetString(objv[3]);
3204       } else if (objc == 5) {
3205     pattern = Tcl_GetString(objv[4]);
3206     if (Tcl_GetIndexFromObj(interp, objv[3], options, "option",
3207       0, &mode) != TCL_OK) {
3208         return TCL_ERROR;
3209     }
3210       }           
3211       for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
3212      hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
3213           varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
3214     if (TclIsVarUndefined(varPtr2)) {
3215         continue;
3216     }
3217     name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
3218     if (objc > 3) {
3219         switch ((enum options) mode) {
3220       case OPT_EXACT:
3221           matched = (strcmp(name, pattern) == 0);
3222           break;
3223       case OPT_GLOB:
3224           matched = Tcl_StringMatch(name, pattern);
3225           break;
3226       case OPT_REGEXP:
3227           matched = Tcl_RegExpMatch(interp, name,
3228             pattern);
3229           if (matched < 0) {
3230         return TCL_ERROR;
3231           }
3232           break;
3233         }
3234         if (matched == 0) {
3235       continue;
3236         }
3237     }
3238     
3239     namePtr = Tcl_NewStringObj(name, -1);
3240     result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr);
3241     if (result != TCL_OK) {
3242         Tcl_DecrRefCount(namePtr); /* free unneeded name obj */
3243         return result;
3244     }
3245       }
3246       break;
3247   }
3248         case ARRAY_NEXTELEMENT: {
3249       ArraySearch *searchPtr;
3250       Tcl_HashEntry *hPtr;
3251       
3252       if (objc != 4) {
3253           Tcl_WrongNumArgs(interp, 2, objv, 
3254                         "arrayName searchId");
3255     return TCL_ERROR;
3256       }
3257       if (notArray) {
3258             goto error;
3259       }
3260       searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]);
3261       if (searchPtr == NULL) {
3262           return TCL_ERROR;
3263       }
3264       while (1) {
3265           Var *varPtr2;
3266 
3267     hPtr = searchPtr->nextEntry;
3268     if (hPtr == NULL) {
3269         hPtr = Tcl_NextHashEntry(&searchPtr->search);
3270         if (hPtr == NULL) {
3271             return TCL_OK;
3272         }
3273     } else {
3274         searchPtr->nextEntry = NULL;
3275     }
3276     varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
3277     if (!TclIsVarUndefined(varPtr2)) {
3278         break;
3279     }
3280       }
3281       Tcl_SetStringObj(resultPtr,
3282               Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), -1);
3283       break;
3284   }
3285         case ARRAY_SET: {
3286       if (objc != 4) {
3287           Tcl_WrongNumArgs(interp, 2, objv, "arrayName list");
3288     return TCL_ERROR;
3289       }
3290       return(TclArraySet(interp, objv[2], objv[3]));
3291   }
3292         case ARRAY_SIZE: {
3293       Tcl_HashSearch search;
3294       Var *varPtr2;
3295       int size;
3296 
3297       if (objc != 3) {
3298           Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
3299     return TCL_ERROR;
3300       }
3301       size = 0;
3302       if (!notArray) {
3303           for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, 
3304                         &search);
3305          hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
3306         varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
3307         if (TclIsVarUndefined(varPtr2)) {
3308             continue;
3309         }
3310         size++;
3311     }
3312       }
3313       Tcl_SetIntObj(resultPtr, size);
3314       break;
3315   }
3316         case ARRAY_STARTSEARCH: {
3317       ArraySearch *searchPtr;
3318 
3319       if (objc != 3) {
3320           Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
3321     return TCL_ERROR;
3322       }
3323       if (notArray) {
3324           goto error;
3325       }
3326       searchPtr = (ArraySearch *) ckalloc(sizeof(ArraySearch));
3327       if (varPtr->searchPtr == NULL) {
3328           searchPtr->id = 1;
3329     Tcl_AppendStringsToObj(resultPtr, "s-1-", varName,
3330             (char *) NULL);
3331       } else {
3332           char string[TCL_INTEGER_SPACE];
3333 
3334     searchPtr->id = varPtr->searchPtr->id + 1;
3335     TclFormatInt(string, searchPtr->id);
3336     Tcl_AppendStringsToObj(resultPtr, "s-", string, "-", varName,
3337       (char *) NULL);
3338       }
3339       searchPtr->varPtr = varPtr;
3340       searchPtr->nextEntry = Tcl_FirstHashEntry(varPtr->value.tablePtr,
3341         &searchPtr->search);
3342       searchPtr->nextPtr = varPtr->searchPtr;
3343       varPtr->searchPtr = searchPtr;
3344       break;
3345   }
3346 
3347   case ARRAY_STATISTICS: {
3348       CONST char *stats;
3349 
3350       if (notArray) {
3351     goto error;
3352       }
3353 
3354       stats = Tcl_HashStats(varPtr->value.tablePtr);
3355       if (stats != NULL) {
3356     Tcl_SetStringObj(Tcl_GetObjResult(interp), stats, -1);
3357     ckfree((void *)stats);
3358       } else {
3359     Tcl_SetResult(interp, "error reading array statistics",
3360       TCL_STATIC);
3361     return TCL_ERROR;
3362       }
3363       break;
3364         }
3365   
3366   case ARRAY_UNSET: {
3367       Tcl_HashSearch search;
3368       Var *varPtr2;
3369       char *pattern = NULL;
3370       char *name;
3371           
3372       if ((objc != 3) && (objc != 4)) {
3373     Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
3374     return TCL_ERROR;
3375       }
3376       if (notArray) {
3377     return TCL_OK;
3378       }
3379       if (objc == 3) {
3380     /*
3381      * When no pattern is given, just unset the whole array
3382      */
3383     if (TclObjUnsetVar2(interp, varNamePtr, NULL, 0)
3384       != TCL_OK) {
3385         return TCL_ERROR;
3386     }
3387       } else {
3388     pattern = Tcl_GetString(objv[3]);
3389     for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr,
3390       &search);
3391          hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
3392         varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
3393         if (TclIsVarUndefined(varPtr2)) {
3394       continue;
3395         }
3396         name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
3397         if (Tcl_StringMatch(name, pattern) &&
3398           (TclObjUnsetVar2(interp, varNamePtr, name, 0)
3399             != TCL_OK)) {
3400       return TCL_ERROR;
3401         }
3402     }
3403       }
3404       break;
3405   }
3406     }
3407     return TCL_OK;
3408 
3409     error:
3410     Tcl_AppendStringsToObj(resultPtr, "\"", varName, "\" isn't an array",
3411       (char *) NULL);
3412     return TCL_ERROR;
3413 }
CONST char* Tcl_GetVar (Tcl_Interp * interp, CONST char * varName, int flags)

Definition at line 1012 of file tclVar.c.
References Tcl_GetVar2().
Referenced by GetTimesCmd(), InfoLibraryCmd(), InfoPatchLevelCmd(), InfoTclVersionCmd(), Tcl_BackgroundError(), and Tcl_SourceRCFile().1019 {
1020     return Tcl_GetVar2(interp, varName, (char *) NULL, flags);
1021 }
CONST char* Tcl_GetVar2 (Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags)

Definition at line 1047 of file tclVar.c.
References Tcl_GetVar2Ex(), and TclGetString.
Referenced by EnvTraceProc(), FormatClock(), Tcl_GetVar(), TclPrecTraceProc(), TclpSetVariables(), and TestsetCmd().1057 {
1058     Tcl_Obj *objPtr;
1059 
1060     objPtr = Tcl_GetVar2Ex(interp, part1, part2, flags);
1061     if (objPtr == NULL) {
1062   return NULL;
1063     }
1064     return TclGetString(objPtr);
1065 }
Tcl_Obj* Tcl_GetVar2Ex (Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags)

Definition at line 1091 of file tclVar.c.
References TCL_TRACE_READS, TclLookupVar(), TclPtrGetVar(), and varPtr.
Referenced by DdeServerProc(), ExecuteRemoteObject(), Prompt(), Tcl_DdeObjCmd(), Tcl_EvalTokensStandard(), Tcl_GetVar2(), Tcl_Main(), TclTeardownNamespace(), Tcltest_Init(), and TclTransferResult().1100 {
1101     Var *varPtr, *arrayPtr;
1102 
1103     /*
1104      * We need a special flag check to see if we want to create part 1,
1105      * because commands like lappend require read traces to trigger for
1106      * previously non-existent values.
1107      */
1108     varPtr = TclLookupVar(interp, part1, part2, flags, "read",
1109             /*createPart1*/ (flags & TCL_TRACE_READS),
1110       /*createPart2*/ 1, &arrayPtr);
1111     if (varPtr == NULL) {
1112   return NULL;
1113     }
1114 
1115     return TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
1116 }
void Tcl_GetVariableFullName (Tcl_Interp * interp, Tcl_Var variable, Tcl_Obj * objPtr)

Definition at line 3778 of file tclVar.c.
References Interp::globalNsPtr, Tcl_AppendToObj(), Tcl_GetHashKey, TclIsVarArrayElement, and varPtr.
Referenced by InfoVarsCmd(), NamespaceWhichCmd(), TclDeleteNamespaceVars(), TclDeleteVars(), and TestgetvarfullnameCmd().3784 {
3785     Interp *iPtr = (Interp *) interp;
3786     register Var *varPtr = (Var *) variable;
3787     char *name;
3788 
3789     /*
3790      * Add the full name of the containing namespace (if any), followed by
3791      * the "::" separator, then the variable name.
3792      */
3793 
3794     if (varPtr != NULL) {
3795   if (!TclIsVarArrayElement(varPtr)) {
3796       if (varPtr->nsPtr != NULL) {
3797     Tcl_AppendToObj(objPtr, varPtr->nsPtr->fullName, -1);
3798     if (varPtr->nsPtr != iPtr->globalNsPtr) {
3799         Tcl_AppendToObj(objPtr, "::", 2);
3800     }
3801       }
3802       if (varPtr->name != NULL) {
3803     Tcl_AppendToObj(objPtr, varPtr->name, -1);
3804       } else if (varPtr->hPtr != NULL) {
3805     name = Tcl_GetHashKey(varPtr->hPtr->tablePtr, varPtr->hPtr);
3806     Tcl_AppendToObj(objPtr, name, -1);
3807       }
3808   }
3809     }
3810 }
int Tcl_GlobalObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 3830 of file tclVar.c.
References CallFrame::isProcCallFrame, NULL, ObjMakeUpvar(), TCL_ERROR, TCL_GLOBAL_ONLY, TCL_OK, Tcl_WrongNumArgs(), TclGetString, and Interp::varFramePtr.3835 {
3836     Interp *iPtr = (Interp *) interp;
3837     register Tcl_Obj *objPtr;
3838     char *varName;
3839     register char *tail;
3840     int result, i;
3841 
3842     if (objc < 2) {
3843   Tcl_WrongNumArgs(interp, 1, objv, "varName ?varName ...?");
3844   return TCL_ERROR;
3845     }
3846 
3847     /*
3848      * If we are not executing inside a Tcl procedure, just return.
3849      */
3850     
3851     if ((iPtr->varFramePtr == NULL)
3852       || !iPtr->varFramePtr->isProcCallFrame) {
3853   return TCL_OK;
3854     }
3855 
3856     for (i = 1;  i < objc;  i++) {
3857   /*
3858    * Make a local variable linked to its counterpart in the global ::
3859    * namespace.
3860    */
3861   
3862   objPtr = objv[i];
3863   varName = TclGetString(objPtr);
3864 
3865   /*
3866    * The variable name might have a scope qualifier, but the name for
3867          * the local "link" variable must be the simple name at the tail.
3868    */
3869 
3870   for (tail = varName;  *tail != '\0';  tail++) {
3871       /* empty body */
3872   }
3873         while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) {
3874             tail--;
3875   }
3876         if ((*tail == ':') && (tail > varName)) {
3877             tail++;
3878   }
3879 
3880   /*
3881    * Link to the variable "varName" in the global :: namespace.
3882    */
3883   
3884   result = ObjMakeUpvar(interp, (CallFrame *) NULL,
3885     objPtr, NULL, /*otherFlags*/ TCL_GLOBAL_ONLY,
3886           /*myName*/ tail, /*myFlags*/ 0, -1);
3887   if (result != TCL_OK) {
3888       return result;
3889   }
3890     }
3891     return TCL_OK;
3892 }
int Tcl_LappendObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 2734 of file tclVar.c.
References ckalloc, ckfree, List::elemCount, List::elements, Tcl_Obj::internalRep, List::maxElemCount, NULL, Var::refCount, Tcl_Obj::refCount, Tcl_ObjType::setFromAnyProc, size_t(), Tcl_DecrRefCount, Tcl_DuplicateObj(), TCL_ERROR, Tcl_IncrRefCount, Tcl_InvalidateStringRep(), Tcl_IsShared, TCL_LEAVE_ERR_MSG, Tcl_ListObjLength(), Tcl_NewObj(), Tcl_ObjGetVar2(), Tcl_ObjSetVar2(), TCL_OK, Tcl_SetObjResult(), TCL_TRACE_READS, Tcl_WrongNumArgs(), TclGetString, tclListType, TclObjLookupVar(), TclPtrGetVar(), TclPtrSetVar(), Tcl_Obj::twoPtrValue, Tcl_Obj::typePtr, varPtr, and VOID.2739 {
2740     Tcl_Obj *varValuePtr, *newValuePtr;
2741     register List *listRepPtr;
2742     register Tcl_Obj **elemPtrs;
2743     int numElems, numRequired, createdNewObj, i, j;
2744     Var *varPtr, *arrayPtr;
2745     char *part1;
2746 
2747     if (objc < 2) {
2748   Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
2749   return TCL_ERROR;
2750     }
2751     if (objc == 2) {
2752   newValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL, 0);
2753   if (newValuePtr == NULL) {
2754       /*
2755        * The variable doesn't exist yet. Just create it with an empty
2756        * initial value.
2757        */
2758       
2759       varValuePtr = Tcl_NewObj();
2760       Tcl_IncrRefCount(varValuePtr);
2761       newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, varValuePtr,
2762         TCL_LEAVE_ERR_MSG);
2763       Tcl_DecrRefCount(varValuePtr);
2764       if (newValuePtr == NULL) {
2765     return TCL_ERROR;
2766       }
2767   } else {
2768       int result;
2769       
2770       result = Tcl_ListObjLength(interp, newValuePtr, &numElems);
2771       if (result != TCL_OK) {
2772     return result;
2773       }
2774   }     
2775     } else {
2776   /*
2777    * We have arguments to append. We used to call Tcl_SetVar2 to
2778    * append each argument one at a time to ensure that traces were run
2779    * for each append step. We now append the arguments all at once
2780    * because it's faster. Note that a read trace and a write trace for
2781    * the variable will now each only be called once. Also, if the
2782    * variable's old value is unshared we modify it directly, otherwise
2783    * we create a new copy to modify: this is "copy on write".
2784    *
2785    * Use the TCL_TRACE_READS flag to ensure that if we have an
2786    * array with no elements set yet, but with a read trace on it,
2787    * we will create the variable and get read traces triggered.
2788    * Note that you have to protect the variable pointers around
2789    * the TclPtrGetVar call to insure that they remain valid 
2790    * even if the variable was undefined and unused.
2791    */
2792 
2793   varPtr = TclObjLookupVar(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
2794     "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
2795   if (varPtr == NULL) {
2796       return TCL_ERROR;
2797   }
2798   varPtr->refCount++;
2799   if (arrayPtr != NULL) {
2800       arrayPtr->refCount++;
2801   }
2802   part1 = TclGetString(objv[1]);
2803   varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, NULL, 
2804           (TCL_TRACE_READS | TCL_LEAVE_ERR_MSG));
2805   varPtr->refCount--;
2806   if (arrayPtr != NULL) {
2807       arrayPtr->refCount--;
2808   }
2809 
2810   createdNewObj = 0;
2811   if (varValuePtr == NULL) {
2812       /*
2813        * We couldn't read the old value: either the var doesn't yet
2814        * exist or it's an array element.  If it's new, we will try to
2815        * create it with Tcl_ObjSetVar2 below.
2816        */
2817       
2818       varValuePtr = Tcl_NewObj();
2819       createdNewObj = 1;
2820   } else if (Tcl_IsShared(varValuePtr)) { 
2821       varValuePtr = Tcl_DuplicateObj(varValuePtr);
2822       createdNewObj = 1;
2823   }
2824 
2825   /*
2826    * Convert the variable's old value to a list object if necessary.
2827    */
2828 
2829   if (varValuePtr->typePtr != &tclListType) {
2830       int result = tclListType.setFromAnyProc(interp, varValuePtr);
2831       if (result != TCL_OK) {
2832     if (createdNewObj) {
2833         Tcl_DecrRefCount(varValuePtr); /* free unneeded obj. */
2834     }
2835     return result;
2836       }
2837   }
2838   listRepPtr = (List *) varValuePtr->internalRep.twoPtrValue.ptr1;
2839   elemPtrs = listRepPtr->elements;
2840   numElems = listRepPtr->elemCount;
2841 
2842   /*
2843    * If there is no room in the current array of element pointers,
2844    * allocate a new, larger array and copy the pointers to it.
2845    */
2846   
2847   numRequired = numElems + (objc-2);
2848   if (numRequired > listRepPtr->maxElemCount) {
2849       int newMax = (2 * numRequired);
2850       Tcl_Obj **newElemPtrs = (Tcl_Obj **)
2851     ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
2852       
2853       memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
2854         (size_t) (numElems * sizeof(Tcl_Obj *)));
2855       listRepPtr->maxElemCount = newMax;
2856       listRepPtr->elements = newElemPtrs;
2857       ckfree((char *) elemPtrs);
2858       elemPtrs = newElemPtrs;
2859   }
2860 
2861   /*
2862    * Insert the new elements at the end of the list.
2863    */
2864 
2865   for (i = 2, j = numElems;  i < objc;  i++, j++) {
2866             elemPtrs[j] = objv[i];
2867             Tcl_IncrRefCount(objv[i]);
2868         }
2869   listRepPtr->elemCount = numRequired;
2870 
2871   /*
2872    * Invalidate and free any old string representation since it no
2873    * longer reflects the list's internal representation.
2874    */
2875 
2876   Tcl_InvalidateStringRep(varValuePtr);
2877 
2878   /*
2879    * Now store the list object back into the variable. If there is an
2880    * error setting the new value, decrement its ref count if it
2881    * was new and we didn't create the variable.
2882    */
2883   
2884   Tcl_IncrRefCount(varValuePtr);
2885   newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL, 
2886               varValuePtr, TCL_LEAVE_ERR_MSG);  
2887   Tcl_DecrRefCount(varValuePtr);
2888   if (newValuePtr == NULL) {
2889       return TCL_ERROR;
2890   }
2891     }
2892 
2893     /*
2894      * Set the interpreter's object result to refer to the variable's value
2895      * object.
2896      */
2897 
2898     Tcl_SetObjResult(interp, newValuePtr);
2899     return TCL_OK;
2900 }
Tcl_Obj* Tcl_ObjGetVar2 (Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, int flags)

Definition at line 1142 of file tclVar.c.
References Tcl_GetString(), TCL_TRACE_READS, TclObjLookupVar(), TclPtrGetVar(), and varPtr.
Referenced by LinkTraceProc(), Tcl_AppendObjCmd(), Tcl_ArrayObjCmd(), Tcl_LappendObjCmd(), Tcl_LsetObjCmd(), and Tcl_SetObjCmd().1153 {
1154     Var *varPtr, *arrayPtr;
1155     char *part1, *part2;
1156 
1157     part1 = Tcl_GetString(part1Ptr);
1158     part2 = ((part2Ptr == NULL) ? NULL : Tcl_GetString(part2Ptr));
1159     
1160     /*
1161      * We need a special flag check to see if we want to create part 1,
1162      * because commands like lappend require read traces to trigger for
1163      * previously non-existent values.
1164      */
1165     varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read",
1166             /*createPart1*/ (flags & TCL_TRACE_READS),
1167       /*createPart2*/ 1, &arrayPtr);
1168     if (varPtr == NULL) {
1169   return NULL;
1170     }
1171 
1172     return TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
1173 }
Tcl_Obj* Tcl_ObjSetVar2 (Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, Tcl_Obj * newValuePtr, int flags)

Definition at line 1498 of file tclVar.c.
References Tcl_GetString(), TclGetString, TclObjLookupVar(), TclPtrSetVar(), and varPtr.
Referenced by InfoDefaultCmd(), LinkTraceProc(), Tcl_AddObjErrorInfo(), Tcl_BinaryObjCmd(), Tcl_CatchObjCmd(), Tcl_ForeachObjCmd(), Tcl_GetsObjCmd(), Tcl_LappendObjCmd(), Tcl_LinkVar(), Tcl_LsetObjCmd(), Tcl_RegexpObjCmd(), Tcl_RegsubObjCmd(), Tcl_ScanObjCmd(), Tcl_SetObjCmd(), Tcl_StringObjCmd(), Tcl_UpdateLinkedVar(), TclUpdateReturnInfo(), and TestregexpObjCmd().1508                                                                :
1509          * any of TCL_GLOBAL_ONLY,
1510          * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
1511          * TCL_LIST_ELEMENT, or TCL_LEAVE_ERR_MSG. */
1512 {
1513     Var *varPtr, *arrayPtr;
1514     char *part1, *part2;
1515 
1516     part1 = TclGetString(part1Ptr);
1517     part2 = ((part2Ptr == NULL) ? NULL : Tcl_GetString(part2Ptr));    
1518 
1519     varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "set",
1520       /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
1521     if (varPtr == NULL) {
1522   return NULL;
1523     }
1524 
1525     return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, 
1526             newValuePtr, flags);
1527 }

int Tcl_SetObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 1279 of file tclVar.c.
References TCL_ERROR, TCL_LEAVE_ERR_MSG, Tcl_ObjGetVar2(), Tcl_ObjSetVar2(), TCL_OK, Tcl_SetObjResult(), and Tcl_WrongNumArgs().1284 {
1285     Tcl_Obj *varValueObj;
1286 
1287     if (objc == 2) {
1288   varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
1289   if (varValueObj == NULL) {
1290       return TCL_ERROR;
1291   }
1292   Tcl_SetObjResult(interp, varValueObj);
1293   return TCL_OK;
1294     } else if (objc == 3) {
1295 
1296   varValueObj = Tcl_ObjSetVar2(interp, objv[1], NULL, objv[2],
1297     TCL_LEAVE_ERR_MSG);
1298   if (varValueObj == NULL) {
1299       return TCL_ERROR;
1300   }
1301   Tcl_SetObjResult(interp, varValueObj);
1302   return TCL_OK;
1303     } else {
1304   Tcl_WrongNumArgs(interp, 1, objv, "varName ?newValue?");
1305   return TCL_ERROR;
1306     }
1307 }
CONST char* Tcl_SetVar (Tcl_Interp * interp, CONST char * varName, CONST char * newValue, int flags)

Definition at line 1334 of file tclVar.c.
References Tcl_SetVar2().
Referenced by GetTimesCmd(), HandleBgErrors(), SlaveCreate(), StaticInitProc(), Tcl_AppInit(), Tcl_Main(), TclpSetVariables(), and TestregexpObjCmd().1339                                                                :
1340          * any of TCL_GLOBAL_ONLY,
1341          * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
1342          * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */
1343 {
1344     return Tcl_SetVar2(interp, varName, (char *) NULL, newValue, flags);
1345 }

CONST char* Tcl_SetVar2 (Tcl_Interp * interp, CONST char * part1, CONST char * part2, CONST char * newValue, int flags)

Definition at line 1375 of file tclVar.c.
References Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_NewStringObj(), Tcl_SetVar2Ex(), and TclGetString.
Referenced by EnvTraceProc(), FormatClock(), Tcl_SetErrorCodeVA(), Tcl_SetVar(), TclPrecTraceProc(), TclpSetVariables(), and TestsetCmd().1384                                                                            :
1385          * any of TCL_GLOBAL_ONLY,
1386          * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
1387          * TCL_LIST_ELEMENT, or TCL_LEAVE_ERR_MSG */
1388 {
1389     register Tcl_Obj *valuePtr;
1390     Tcl_Obj *varValuePtr;
1391 
1392     /*
1393      * Create an object holding the variable's new value and use
1394      * Tcl_SetVar2Ex to actually set the variable.
1395      */
1396 
1397     valuePtr = Tcl_NewStringObj(newValue, -1);
1398     Tcl_IncrRefCount(valuePtr);
1399 
1400     varValuePtr = Tcl_SetVar2Ex(interp, part1, part2, valuePtr, flags);
1401     Tcl_DecrRefCount(valuePtr); /* done with the object */
1402     
1403     if (varValuePtr == NULL) {
1404   return NULL;
1405     }
1406     return TclGetString(varValuePtr);
1407 }

Tcl_Obj* Tcl_SetVar2Ex (Tcl_Interp * interp, CONST char * part1, CONST char * part2, Tcl_Obj * newValuePtr, int flags)

Definition at line 1448 of file tclVar.c.
References TclLookupVar(), TclPtrSetVar(), and varPtr.
Referenced by Tcl_ErrorObjCmd(), Tcl_Init(), Tcl_Main(), Tcl_SetObjErrorCode(), Tcl_SetVar2(), TclpSetVariables(), TclTeardownNamespace(), Tcltest_Init(), and TclTransferResult().1456                                                                :
1457          * any of TCL_GLOBAL_ONLY,
1458          * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
1459          * TCL_LIST_ELEMENT or TCL_LEAVE_ERR_MSG. */
1460 {
1461     Var *varPtr, *arrayPtr;
1462 
1463     varPtr = TclLookupVar(interp, part1, part2, flags, "set",
1464       /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
1465     if (varPtr == NULL) {
1466   return NULL;
1467     }
1468 
1469     return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, 
1470             newValuePtr, flags);
1471 }

int Tcl_TraceVar (Tcl_Interp * interp, CONST char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)

Definition at line 2230 of file tclVar.c.
References Tcl_TraceVar2().
Referenced by LinkTraceProc(), Tcl_LinkVar(), and Tcl_VwaitObjCmd().2242 {
2243     return Tcl_TraceVar2(interp, varName, (char *) NULL, 
2244       flags, proc, clientData);
2245 }
int Tcl_TraceVar2 (Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)

Definition at line 2269 of file tclVar.c.
References ckalloc, VarTrace::clientData, VarTrace::flags, VarTrace::nextPtr, panic, TCL_ERROR, TCL_GLOBAL_ONLY, TCL_LEAVE_ERR_MSG, TCL_NAMESPACE_ONLY, TCL_OK, TCL_TRACE_ARRAY, TCL_TRACE_OLD_STYLE, TCL_TRACE_READS, TCL_TRACE_RESULT_DYNAMIC, TCL_TRACE_RESULT_OBJECT, TCL_TRACE_UNSETS, TCL_TRACE_WRITES, TclLookupVar(), VarTrace::traceProc, and varPtr.
Referenced by Tcl_TraceVar(), and TclPrecTraceProc().2283 {
2284     Var *varPtr, *arrayPtr;
2285     register VarTrace *tracePtr;
2286     int flagMask;
2287     
2288     /* 
2289      * We strip 'flags' down to just the parts which are relevant to
2290      * TclLookupVar, to avoid conflicts between trace flags and
2291      * internal namespace flags such as 'FIND_ONLY_NS'.  This can
2292      * now occur since we have trace flags with values 0x1000 and higher.
2293      */
2294     flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
2295     varPtr = TclLookupVar(interp, part1, part2,
2296       (flags & flagMask) | TCL_LEAVE_ERR_MSG,
2297       "trace", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
2298     if (varPtr == NULL) {
2299   return TCL_ERROR;
2300     }
2301 
2302     /*
2303      * Check for a nonsense flag combination.  Note that this is a
2304      * panic() because there should be no code path that ever sets
2305      * both flags.
2306      */
2307     if ((flags&TCL_TRACE_RESULT_DYNAMIC) && (flags&TCL_TRACE_RESULT_OBJECT)) {
2308   panic("bad result flag combination");
2309     }
2310 
2311     /*
2312      * Set up trace information.
2313      */
2314 
2315     flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | 
2316   TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
2317 #ifndef TCL_REMOVE_OBSOLETE_TRACES
2318     flagMask |= TCL_TRACE_OLD_STYLE;
2319 #endif
2320     tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace));
2321     tracePtr->traceProc   = proc;
2322     tracePtr->clientData  = clientData;
2323     tracePtr->flags   = flags & flagMask;
2324     tracePtr->nextPtr   = varPtr->tracePtr;
2325     varPtr->tracePtr    = tracePtr;
2326     return TCL_OK;
2327 }
int Tcl_UnsetObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 2595 of file tclVar.c.
References TCL_ERROR, TCL_LEAVE_ERR_MSG, TCL_OK, Tcl_WrongNumArgs(), TclGetString, and TclObjUnsetVar2().2600 {
2601     register int i, flags = TCL_LEAVE_ERR_MSG;
2602     register char *name;
2603 
2604     if (objc < 1) {
2605   Tcl_WrongNumArgs(interp, 1, objv,
2606     "?-nocomplain? ?--? ?varName varName ...?");
2607   return TCL_ERROR;
2608     } else if (objc == 1) {
2609   /*
2610    * Do nothing if no arguments supplied, so as to match
2611    * command documentation.
2612    */
2613   return TCL_OK;
2614     }
2615 
2616     /*
2617      * Simple, restrictive argument parsing.  The only options are --
2618      * and -nocomplain (which must come first and be given exactly to
2619      * be an option).
2620      */
2621     i = 1;
2622     name = TclGetString(objv[i]);
2623     if (name[0] == '-') {
2624   if (strcmp("-nocomplain", name) == 0) {
2625       i++;
2626       if (i == objc) {
2627     return TCL_OK;
2628       }
2629       flags = 0;
2630       name = TclGetString(objv[i]);
2631   }
2632   if (strcmp("--", name) == 0) {
2633       i++;
2634   }
2635     }
2636 
2637     for (; i < objc;  i++) {
2638   if ((TclObjUnsetVar2(interp, objv[i], NULL, flags) != TCL_OK)
2639     && (flags == TCL_LEAVE_ERR_MSG)) {
2640       return TCL_ERROR;
2641   }
2642     }
2643     return TCL_OK;
2644 }
int Tcl_UnsetVar (Tcl_Interp * interp, CONST char * varName, int flags)

Definition at line 1914 of file tclVar.c.
References Tcl_UnsetVar2().
Referenced by Tcl_MakeSafe().1923 {
1924     return Tcl_UnsetVar2(interp, varName, (char *) NULL, flags);
1925 }
int Tcl_UnsetVar2 (Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags)

Definition at line 1949 of file tclVar.c.
References Tcl_IncrRefCount, Tcl_NewStringObj(), TclDecrRefCount, and TclObjUnsetVar2().
Referenced by FormatClock(), Tcl_MakeSafe(), and Tcl_UnsetVar().1957 {
1958     int result;
1959     Tcl_Obj *part1Ptr;
1960 
1961     part1Ptr = Tcl_NewStringObj(part1, -1);
1962     Tcl_IncrRefCount(part1Ptr);
1963     result = TclObjUnsetVar2(interp, part1Ptr, part2, flags);
1964     TclDecrRefCount(part1Ptr);
1965 
1966     return result;
1967 }
void Tcl_UntraceVar (Tcl_Interp * interp, CONST char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)

Definition at line 2348 of file tclVar.c.
References Tcl_UntraceVar2().
Referenced by Tcl_UnlinkVar(), and Tcl_VwaitObjCmd().2359 {
2360     Tcl_UntraceVar2(interp, varName, (char *) NULL, flags, proc, clientData);
2361 }
void Tcl_UntraceVar2 (Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)

Definition at line 2382 of file tclVar.c.
References Interp::activeVarTracePtr, CleanupVar(), VarTrace::clientData, VarTrace::flags, ActiveVarTrace::nextPtr, VarTrace::nextPtr, ActiveVarTrace::nextTracePtr, TCL_DYNAMIC, Tcl_EventuallyFree(), TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, TCL_TRACE_ARRAY, TCL_TRACE_OLD_STYLE, TCL_TRACE_READS, TCL_TRACE_RESULT_DYNAMIC, TCL_TRACE_RESULT_OBJECT, TCL_TRACE_UNSETS, TCL_TRACE_WRITES, TclIsVarUndefined, TclLookupVar(), VarTrace::traceProc, and varPtr.
Referenced by Tcl_UntraceVar(), and TclTraceVariableObjCmd().2395 {
2396     register VarTrace *tracePtr;
2397     VarTrace *prevPtr;
2398     Var *varPtr, *arrayPtr;
2399     Interp *iPtr = (Interp *) interp;
2400     ActiveVarTrace *activePtr;
2401     int flagMask;
2402     
2403     /*
2404      * Set up a mask to mask out the parts of the flags that we are not
2405      * interested in now.
2406      */
2407     flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
2408     varPtr = TclLookupVar(interp, part1, part2, flags & flagMask,
2409       /*msg*/ (char *) NULL,
2410       /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
2411     if (varPtr == NULL) {
2412   return;
2413     }
2414 
2415 
2416     /*
2417      * Set up a mask to mask out the parts of the flags that we are not
2418      * interested in now.
2419      */
2420     flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
2421   TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT; 
2422 #ifndef TCL_REMOVE_OBSOLETE_TRACES
2423     flagMask |= TCL_TRACE_OLD_STYLE;
2424 #endif
2425     flags &= flagMask;
2426     for (tracePtr = varPtr->tracePtr, prevPtr = NULL;  ;
2427    prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
2428   if (tracePtr == NULL) {
2429       return;
2430   }
2431   if ((tracePtr->traceProc == proc) && (tracePtr->flags == flags)
2432     && (tracePtr->clientData == clientData)) {
2433       break;
2434   }
2435     }
2436 
2437     /*
2438      * The code below makes it possible to delete traces while traces
2439      * are active: it makes sure that the deleted trace won't be
2440      * processed by CallVarTraces.
2441      */
2442 
2443     for (activePtr = iPtr->activeVarTracePtr;  activePtr != NULL;
2444    activePtr = activePtr->nextPtr) {
2445   if (activePtr->nextTracePtr == tracePtr) {
2446       activePtr->nextTracePtr = tracePtr->nextPtr;
2447   }
2448     }
2449     if (prevPtr == NULL) {
2450   varPtr->tracePtr = tracePtr->nextPtr;
2451     } else {
2452   prevPtr->nextPtr = tracePtr->nextPtr;
2453     }
2454     Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
2455 
2456     /*
2457      * If this is the last trace on the variable, and the variable is
2458      * unset and unused, then free up the variable.
2459      */
2460 
2461     if (TclIsVarUndefined(varPtr)) {
2462   CleanupVar(varPtr, (Var *) NULL);
2463     }
2464 }
int Tcl_UpVar (Tcl_Interp * interp, CONST char * frameName, CONST char * varName, CONST char * localName, int flags)

Definition at line 3692 of file tclVar.c.
References Tcl_UpVar2().
Referenced by TestupvarCmd().3701                                                                :
3702          * indicates scope of localName. */
3703 {
3704     return Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags);
3705 }

int Tcl_UpVar2 (Tcl_Interp * interp, CONST char * frameName, CONST char * part1, CONST char * part2, CONST char * localName, int flags)

Definition at line 3729 of file tclVar.c.
References ObjMakeUpvar(), TCL_ERROR, Tcl_IncrRefCount, Tcl_NewStringObj(), TclDecrRefCount, and TclGetFrame().
Referenced by Tcl_UpVar(), and TestupvarCmd().3738                                                                :
3739          * indicates scope of localName. */
3740 {
3741     int result;
3742     CallFrame *framePtr;
3743     Tcl_Obj *part1Ptr;
3744 
3745     if (TclGetFrame(interp, frameName, &framePtr) == -1) {
3746   return TCL_ERROR;
3747     }
3748 
3749     part1Ptr = Tcl_NewStringObj(part1, -1);
3750     Tcl_IncrRefCount(part1Ptr);
3751     result = ObjMakeUpvar(interp, framePtr, part1Ptr, part2, 0,
3752       localName, flags, -1);
3753     TclDecrRefCount(part1Ptr);
3754 
3755     return result;
3756 }

int Tcl_UpvarObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 4059 of file tclVar.c.
References ObjMakeUpvar(), TCL_ERROR, TCL_OK, Tcl_WrongNumArgs(), TclGetFrame(), and TclGetString.4064 {
4065     CallFrame *framePtr;
4066     char *frameSpec, *localName;
4067     int result;
4068 
4069     if (objc < 3) {
4070   upvarSyntax:
4071   Tcl_WrongNumArgs(interp, 1, objv,
4072     "?level? otherVar localVar ?otherVar localVar ...?");
4073   return TCL_ERROR;
4074     }
4075 
4076     /*
4077      * Find the call frame containing each of the "other variables" to be
4078      * linked to. 
4079      */
4080 
4081     frameSpec = TclGetString(objv[1]);
4082     result = TclGetFrame(interp, frameSpec, &framePtr);
4083     if (result == -1) {
4084   return TCL_ERROR;
4085     }
4086     objc -= result+1;
4087     if ((objc & 1) != 0) {
4088   goto upvarSyntax;
4089     }
4090     objv += result+1;
4091 
4092     /*
4093      * Iterate over each (other variable, local variable) pair.
4094      * Divide the other variable name into two parts, then call
4095      * MakeUpvar to do all the work of linking it to the local variable.
4096      */
4097 
4098     for ( ;  objc > 0;  objc -= 2, objv += 2) {
4099   localName = TclGetString(objv[1]);
4100   result = ObjMakeUpvar(interp, framePtr, /* othervarName */ objv[0],
4101     NULL, 0, /* myVarName */ localName, /*flags*/ 0, -1);
4102   if (result != TCL_OK) {
4103       return TCL_ERROR;
4104   }
4105     }
4106     return TCL_OK;
4107 }
int Tcl_VariableObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv)

Definition at line 3930 of file tclVar.c.
References isArrayElement, CallFrame::isProcCallFrame, NULL, ObjMakeUpvar(), Tcl_Obj::refCount, TCL_ERROR, TCL_LEAVE_ERR_MSG, TCL_NAMESPACE_ONLY, TCL_OK, Tcl_WrongNumArgs(), TclGetString, TclObjLookupVar(), TclPtrSetVar(), VAR_NAMESPACE_VAR, VarErrMsg(), Interp::varFramePtr, and varPtr.3935 {
3936     Interp *iPtr = (Interp *) interp;
3937     char *varName, *tail, *cp;
3938     Var *varPtr, *arrayPtr;
3939     Tcl_Obj *varValuePtr;
3940     int i, result;
3941     Tcl_Obj *varNamePtr;
3942 
3943     if (objc < 2) {
3944   Tcl_WrongNumArgs(interp, 1, objv, "?name value...? name ?value?");
3945   return TCL_ERROR;
3946     }
3947 
3948     for (i = 1;  i < objc;  i = i+2) {
3949   /*
3950    * Look up each variable in the current namespace context, creating
3951    * it if necessary.
3952    */
3953   
3954   varNamePtr = objv[i];
3955   varName = TclGetString(varNamePtr);
3956   varPtr = TclObjLookupVar(interp, varNamePtr, NULL,
3957                 (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "define",
3958                 /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);
3959   
3960         if (arrayPtr != NULL) {
3961             /*
3962              * Variable cannot be an element in an array.  If arrayPtr is
3963              * non-null, it is, so throw up an error and return.
3964              */
3965             VarErrMsg(interp, varName, NULL, "define", isArrayElement);
3966             return TCL_ERROR;
3967         }
3968 
3969   if (varPtr == NULL) {
3970       return TCL_ERROR;
3971   }
3972 
3973   /*
3974    * Mark the variable as a namespace variable and increment its 
3975    * reference count so that it will persist until its namespace is
3976    * destroyed or until the variable is unset.
3977    */
3978 
3979   if (!(varPtr->flags & VAR_NAMESPACE_VAR)) {
3980       varPtr->flags |= VAR_NAMESPACE_VAR;
3981       varPtr->refCount++;
3982   }
3983 
3984   /*
3985    * If a value was specified, set the variable to that value.
3986    * Otherwise, if the variable is new, leave it undefined.
3987    * (If the variable already exists and no value was specified,
3988    * leave its value unchanged; just create the local link if
3989    * we're in a Tcl procedure).
3990    */
3991 
3992   if (i+1 < objc) { /* a value was specified */
3993       varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, varName, NULL,
3994         objv[i+1], (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG));
3995       if (varValuePtr == NULL) {
3996     return TCL_ERROR;
3997       }
3998   }
3999 
4000   /*
4001    * If we are executing inside a Tcl procedure, create a local
4002    * variable linked to the new namespace variable "varName".
4003    */
4004 
4005   if ((iPtr->varFramePtr != NULL)
4006           && iPtr->varFramePtr->isProcCallFrame) {
4007       /*
4008        * varName might have a scope qualifier, but the name for the
4009        * local "link" variable must be the simple name at the tail.
4010        *
4011        * Locate tail in one pass: drop any prefix after two *or more*
4012        * consecutive ":" characters).
4013        */
4014 
4015       for (tail = cp = varName;  *cp != '\0'; ) {
4016     if (*cp++ == ':') {
4017         while (*cp == ':') {
4018       tail = ++cp;
4019         }
4020     }
4021       }
4022       
4023       /*
4024        * Create a local link "tail" to the variable "varName" in the
4025        * current namespace.
4026        */
4027       
4028       result = ObjMakeUpvar(interp, (CallFrame *) NULL,
4029         /*otherP1*/ varNamePtr, /*otherP2*/ NULL,
4030                     /*otherFlags*/ TCL_NAMESPACE_ONLY,
4031         /*myName*/ tail, /*myFlags*/ 0, -1);
4032       if (result != TCL_OK) {
4033     return result;
4034       }
4035   }
4036     }
4037     return TCL_OK;
4038 }
ClientData Tcl_VarTraceInfo (Tcl_Interp * interp, CONST char * varName, int flags, Tcl_VarTraceProc * proc, ClientData prevClientData)

Definition at line 2493 of file tclVar.c.
References Tcl_VarTraceInfo2().
Referenced by Tcl_TraceObjCmd(), Tcl_UnlinkVar(), Tcl_UpdateLinkedVar(), and TclTraceVariableObjCmd().2505 {
2506     return Tcl_VarTraceInfo2(interp, varName, (char *) NULL,
2507       flags, proc, prevClientData);
2508 }
ClientData Tcl_VarTraceInfo2 (Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * proc, ClientData prevClientData)

Definition at line 2528 of file tclVar.c.
References VarTrace::clientData, VarTrace::nextPtr, TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, TclLookupVar(), VarTrace::traceProc, and varPtr.
Referenced by Tcl_VarTraceInfo().2542 {
2543     register VarTrace *tracePtr;
2544     Var *varPtr, *arrayPtr;
2545 
2546     varPtr = TclLookupVar(interp, part1, part2,
2547       flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY),
2548       /*msg*/ (char *) NULL,
2549       /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
2550     if (varPtr == NULL) {
2551   return NULL;
2552     }
2553 
2554     /*
2555      * Find the relevant trace, if any, and return its clientData.
2556      */
2557 
2558     tracePtr = varPtr->tracePtr;
2559     if (prevClientData != NULL) {
2560   for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
2561       if ((tracePtr->clientData == prevClientData)
2562         && (tracePtr->traceProc == proc)) {
2563     tracePtr = tracePtr->nextPtr;
2564     break;
2565       }
2566   }
2567     }
2568     for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
2569   if (tracePtr->traceProc == proc) {
2570       return tracePtr->clientData;
2571   }
2572     }
2573     return NULL;
2574 }
int TclArraySet (Tcl_Interp * interp, Tcl_Obj * arrayNameObj, Tcl_Obj * arrayElemObj)

Definition at line 3434 of file tclVar.c.
References ckalloc, needArray, Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), Tcl_GetStringFromObj(), Tcl_InitHashTable(), TCL_LEAVE_ERR_MSG, Tcl_ListObjGetElements(), TCL_OK, Tcl_ResetResult(), TCL_STRING_KEYS, TclClearVarUndefined, TclGetString, TclIsVarArray, TclIsVarArrayElement, TclIsVarUndefined, TclLookupArrayElement(), TclObjLookupVar(), TclPtrSetVar(), TclSetVarArray, VarErrMsg(), and varPtr.
Referenced by Tcl_ArrayObjCmd().3439 {
3440     Var *varPtr, *arrayPtr;
3441     Tcl_Obj **elemPtrs;
3442     int result, elemLen, i, nameLen;
3443     char *varName, *p;
3444     
3445     varName = Tcl_GetStringFromObj(arrayNameObj, &nameLen);
3446     p = varName + nameLen - 1;
3447     if (*p == ')') {
3448   while (--p >= varName) {
3449       if (*p == '(') {
3450     VarErrMsg(interp, varName, NULL, "set", needArray);
3451     return TCL_ERROR;
3452       }
3453   }
3454     }
3455 
3456     varPtr = TclObjLookupVar(interp, arrayNameObj, NULL,
3457       /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1,
3458       /*createPart2*/ 0, &arrayPtr);
3459     if (varPtr == NULL) {
3460   return TCL_ERROR;
3461     }
3462 
3463     if (arrayElemObj != NULL) {
3464   result = Tcl_ListObjGetElements(interp, arrayElemObj,
3465     &elemLen, &elemPtrs);
3466   if (result != TCL_OK) {
3467       return result;
3468   }
3469   if (elemLen & 1) {
3470       Tcl_ResetResult(interp);
3471       Tcl_AppendToObj(Tcl_GetObjResult(interp),
3472         "list must have an even number of elements", -1);
3473       return TCL_ERROR;
3474   }
3475   if (elemLen > 0) {
3476       /*
3477        * We needn't worry about traces invalidating arrayPtr:
3478        * should that be the case, TclPtrSetVar will return NULL
3479        * so that we break out of the loop and return an error.
3480        */
3481 
3482       for (i = 0;  i < elemLen;  i += 2) {
3483     char *part2 = TclGetString(elemPtrs[i]);
3484     Var *elemVarPtr = TclLookupArrayElement(interp, varName, 
3485                         part2, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr);
3486     if ((elemVarPtr == NULL) ||
3487             (TclPtrSetVar(interp, elemVarPtr, varPtr, varName,
3488        part2, elemPtrs[i+1], TCL_LEAVE_ERR_MSG) == NULL)) {
3489         result = TCL_ERROR;
3490         break;
3491     }
3492       }
3493       return result;
3494   }
3495     }
3496     
3497     /*
3498      * The list is empty make sure we have an array, or create
3499      * one if necessary.
3500      */
3501     
3502     if (varPtr != NULL) {
3503   if (!TclIsVarUndefined(varPtr) && TclIsVarArray(varPtr)) {
3504       /*
3505        * Already an array, done.
3506        */
3507       
3508       return TCL_OK;
3509   }
3510   if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
3511       /*
3512        * Either an array element, or a scalar: lose!
3513        */
3514       
3515       VarErrMsg(interp, varName, (char *)NULL, "array set", needArray);
3516       return TCL_ERROR;
3517   }
3518     }
3519     TclSetVarArray(varPtr);
3520     TclClearVarUndefined(varPtr);
3521     varPtr->value.tablePtr =
3522   (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
3523     Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
3524     return TCL_OK;
3525 }
void TclDeleteCompiledLocalVars (Interp * iPtr, CallFrame * framePtr)

Definition at line 4818 of file tclVar.c.
References ckfree, CallFrame::compiledLocals, Var::flags, Var::hPtr, Var::linkPtr, CallFrame::numCompiledLocals, Var::refCount, Tcl_DeleteHashEntry(), TCL_TRACE_UNSETS, TclIsVarLink, TclIsVarUndefined, Var::tracePtr, Var::value, VAR_IN_HASHTABLE, and varPtr.
Referenced by Tcl_PopCallFrame().4823 {
4824     register Var *varPtr;
4825     int flags;      /* Flags passed to trace procedures. */
4826     Var *linkPtr;
4827     ActiveVarTrace *activePtr;
4828     int numLocals, i;
4829 
4830     flags = TCL_TRACE_UNSETS;
4831     numLocals = framePtr->numCompiledLocals;
4832     varPtr = framePtr->compiledLocals;
4833     for (i = 0;  i < numLocals;  i++) {
4834   /*
4835    * For global/upvar variables referenced in procedures, decrement
4836    * the reference count on the variable referred to, and free
4837    * the referenced variable if it's no longer needed. Don't delete
4838    * the hash entry for the other variable if it's in the same table
4839    * as us: this will happen automatically later on.
4840    */
4841 
4842   if (TclIsVarLink(varPtr)) {
4843       linkPtr = varPtr->value.linkPtr;
4844       linkPtr->refCount--;
4845       if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr)
4846         && (linkPtr->tracePtr == NULL)
4847         && (linkPtr->flags & VAR_IN_HASHTABLE)) {
4848     if (linkPtr->hPtr == NULL) {
4849         ckfree((char *) linkPtr);
4850     } else {
4851         Tcl_DeleteHashEntry(linkPtr->hPtr);
4852         ckfree((char *) linkPtr);
4853     }
4854       }
4855   }
4856 
4857   /*
4858    * Invoke traces on the variable that is being deleted. Then delete
4859    * the variable's trace records.
4860    */
4861 
4862   if (varPtr->tracePtr != NULL) {
4863       CallVarTraces(iPtr, (Var *) NULL, varPtr, varPtr->name, NULL,
4864         flags, /* leaveErrMsg */ 0);
4865       while (varPtr->tracePtr != NULL) {
4866     VarTrace *tracePtr = varPtr->tracePtr;
4867     varPtr->tracePtr = tracePtr->nextPtr;
4868     Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
4869       }
4870       for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
4871      activePtr = activePtr->nextPtr) {
4872     if (activePtr->varPtr == varPtr) {
4873         activePtr->nextTracePtr = NULL;
4874     }
4875       }
4876   }
4877 
4878         /*
4879    * Now if the variable is an array, delete its element hash table.
4880    * Otherwise, if it's a scalar variable, decrement the ref count
4881    * of its value.
4882    */
4883       
4884   if (TclIsVarArray(varPtr) && (varPtr->value.tablePtr != NULL)) {
4885       DeleteArray(iPtr, varPtr->name, varPtr, flags);
4886   }
4887   if (TclIsVarScalar(varPtr) && (varPtr->value.objPtr != NULL)) {
4888       TclDecrRefCount(varPtr->value.objPtr);
4889       varPtr->value.objPtr = NULL;
4890   }
4891   varPtr->hPtr = NULL;
4892   varPtr->tracePtr = NULL;
4893   TclSetVarUndefined(varPtr);
4894   TclSetVarScalar(varPtr);
4895   varPtr++;
4896     }
4897 }
void TclDeleteNamespaceVars (Namespace * nsPtr)

Definition at line 4593 of file tclVar.c.
References CleanupVar(), Interp::globalNsPtr, VarTrace::nextPtr, Tcl_Obj::refCount, Tcl_DecrRefCount, Tcl_DeleteHashEntry(), Tcl_DeleteHashTable(), TCL_DYNAMIC, Tcl_EventuallyFree(), Tcl_FirstHashEntry(), Tcl_GetCurrentNamespace(), Tcl_GetHashValue, Tcl_GetString(), Tcl_GetVariableFullName(), TCL_GLOBAL_ONLY, Tcl_IncrRefCount, TCL_INTERP_DESTROYED, Tcl_InterpDeleted(), TCL_NAMESPACE_ONLY, Tcl_NewObj(), TclSetVarScalar, TclSetVarUndefined, UnsetVarStruct(), and varPtr.
Referenced by Tcl_DeleteNamespace(), and TclTeardownNamespace().4595 {
4596     Tcl_HashTable *tablePtr = &nsPtr->varTable;
4597     Tcl_Interp *interp = nsPtr->interp;
4598     Interp *iPtr = (Interp *)interp;
4599     Tcl_HashSearch search;
4600     Tcl_HashEntry *hPtr;
4601     int flags = 0;
4602     Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
4603 
4604     /*
4605      * Determine what flags to pass to the trace callback procedures.
4606      */
4607 
4608     if (nsPtr == iPtr->globalNsPtr) {
4609   flags = TCL_GLOBAL_ONLY;
4610     } else if (nsPtr == currNsPtr) {
4611   flags = TCL_NAMESPACE_ONLY;
4612     }
4613     if (Tcl_InterpDeleted(interp)) {
4614   flags |= TCL_INTERP_DESTROYED;
4615     }
4616 
4617     for (hPtr = Tcl_FirstHashEntry(tablePtr, &search);  hPtr != NULL;
4618    hPtr = Tcl_FirstHashEntry(tablePtr, &search)) {
4619   register Var *varPtr = (Var *) Tcl_GetHashValue(hPtr);
4620   Tcl_Obj *objPtr = Tcl_NewObj();
4621   varPtr->refCount++; /* Make sure we get to remove from hash */
4622   Tcl_IncrRefCount(objPtr); 
4623   Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
4624   UnsetVarStruct(varPtr, NULL, iPtr, Tcl_GetString(objPtr), NULL, flags);
4625   Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
4626   varPtr->refCount--;
4627 
4628   /* Remove the variable from the table and force it undefined
4629    * in case an unset trace brought it back from the dead */
4630   Tcl_DeleteHashEntry(hPtr);
4631   varPtr->hPtr = NULL;
4632   TclSetVarUndefined(varPtr);
4633   TclSetVarScalar(varPtr);
4634   while (varPtr->tracePtr != NULL) {
4635       VarTrace *tracePtr = varPtr->tracePtr;
4636       varPtr->tracePtr = tracePtr->nextPtr;
4637       Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
4638   }
4639   CleanupVar(varPtr, NULL);
4640     }
4641     Tcl_DeleteHashTable(tablePtr);
4642 }
void TclDeleteVars (Interp * iPtr, Tcl_HashTable * tablePtr)

Definition at line 4667 of file tclVar.c.
References CallVarTraces(), ckfree, DeleteArray(), Var::flags, Var::hPtr, ActiveVarTrace::nextPtr, VarTrace::nextPtr, ActiveVarTrace::nextTracePtr, NULL, Tcl_Obj::refCount, Var::refCount, Tcl_HashEntry::tablePtr, Tcl_DecrRefCount, Tcl_DeleteHashEntry(), Tcl_DeleteHashTable(), TCL_DYNAMIC, Tcl_EventuallyFree(), Tcl_FirstHashEntry(), Tcl_GetCurrentNamespace(), Tcl_GetHashKey, Tcl_GetHashValue, Tcl_GetString(), Tcl_GetVariableFullName(), TCL_GLOBAL_ONLY, Tcl_IncrRefCount, TCL_INTERP_DESTROYED, Tcl_InterpDeleted(), TCL_NAMESPACE_ONLY, Tcl_NewObj(), Tcl_NextHashEntry(), TCL_TRACE_UNSETS, TclDecrRefCount, TclIsVarArray, TclIsVarLink, TclIsVarScalar, TclIsVarUndefined, TclSetVarScalar, TclSetVarUndefined, Var::tracePtr, VAR_IN_HASHTABLE, VAR_NAMESPACE_VAR, ActiveVarTrace::varPtr, varPtr, and Namespace::varTable.
Referenced by Tcl_PopCallFrame().4671 {
4672     Tcl_Interp *interp = (Tcl_Interp *) iPtr;
4673     Tcl_HashSearch search;
4674     Tcl_HashEntry *hPtr;
4675     register Var *varPtr;
4676     Var *linkPtr;
4677     int flags;
4678     ActiveVarTrace *activePtr;
4679     Tcl_Obj *objPtr;
4680     Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
4681 
4682     /*
4683      * Determine what flags to pass to the trace callback procedures.
4684      */
4685 
4686     flags = TCL_TRACE_UNSETS;
4687     if (tablePtr == &iPtr->globalNsPtr->varTable) {
4688   flags |= TCL_GLOBAL_ONLY;
4689     } else if (tablePtr == &currNsPtr->varTable) {
4690   flags |= TCL_NAMESPACE_ONLY;
4691     }
4692     if (Tcl_InterpDeleted(interp)) {
4693   flags |= TCL_INTERP_DESTROYED;
4694     }
4695 
4696     for (hPtr = Tcl_FirstHashEntry(tablePtr, &search);  hPtr != NULL;
4697    hPtr = Tcl_NextHashEntry(&search)) {
4698   varPtr = (Var *) Tcl_GetHashValue(hPtr);
4699 
4700   /*
4701    * For global/upvar variables referenced in procedures, decrement
4702    * the reference count on the variable referred to, and free
4703    * the referenced variable if it's no longer needed. Don't delete
4704    * the hash entry for the other variable if it's in the same table
4705    * as us: this will happen automatically later on.
4706    */
4707 
4708   if (TclIsVarLink(varPtr)) {
4709       linkPtr = varPtr->value.linkPtr;
4710       linkPtr->refCount--;
4711       if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr)
4712         && (linkPtr->tracePtr == NULL)
4713         && (linkPtr->flags & VAR_IN_HASHTABLE)) {
4714     if (linkPtr->hPtr == NULL) {
4715         ckfree((char *) linkPtr);
4716     } else if (linkPtr->hPtr->tablePtr != tablePtr) {
4717         Tcl_DeleteHashEntry(linkPtr->hPtr);
4718         ckfree((char *) linkPtr);
4719     }
4720       }
4721   }
4722 
4723   /*
4724    * Invoke traces on the variable that is being deleted, then
4725    * free up the variable's space (no need to free the hash entry
4726    * here, unless we're dealing with a global variable: the
4727    * hash entries will be deleted automatically when the whole
4728    * table is deleted). Note that we give CallVarTraces the variable's
4729    * fully-qualified name so that any called trace procedures can
4730    * refer to these variables being deleted.
4731    */
4732 
4733   if (varPtr->tracePtr != NULL) {
4734       objPtr = Tcl_NewObj();
4735       Tcl_IncrRefCount(objPtr); /* until done with traces */
4736       Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
4737       CallVarTraces(iPtr, (Var *) NULL, varPtr, Tcl_GetString(objPtr),
4738         NULL, flags, /* leaveErrMsg */ 0);
4739       Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
4740 
4741       while (varPtr->tracePtr != NULL) {
4742     VarTrace *tracePtr = varPtr->tracePtr;
4743     varPtr->tracePtr = tracePtr->nextPtr;
4744     Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
4745       }
4746       for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
4747      activePtr = activePtr->nextPtr) {
4748     if (activePtr->varPtr == varPtr) {
4749         activePtr->nextTracePtr = NULL;
4750     }
4751       }
4752   }
4753       
4754   if (TclIsVarArray(varPtr)) {
4755       DeleteArray(iPtr, Tcl_GetHashKey(tablePtr, hPtr), varPtr,
4756               flags);
4757       varPtr->value.tablePtr = NULL;
4758   }
4759   if (TclIsVarScalar(varPtr) && (varPtr->value.objPtr != NULL)) {
4760       objPtr = varPtr->value.objPtr;
4761       TclDecrRefCount(objPtr);
4762       varPtr->value.objPtr = NULL;
4763   }
4764   varPtr->hPtr = NULL;
4765   varPtr->tracePtr = NULL;
4766   TclSetVarUndefined(varPtr);
4767   TclSetVarScalar(varPtr);
4768 
4769   /*
4770    * If the variable was a namespace variable, decrement its 
4771    * reference count. We are in the process of destroying its
4772    * namespace so that namespace will no longer "refer" to the
4773    * variable.
4774    */
4775 
4776   if (varPtr->flags & VAR_NAMESPACE_VAR) {
4777       varPtr->flags &= ~VAR_NAMESPACE_VAR;
4778       varPtr->refCount--;
4779   }
4780 
4781   /*
4782    * Recycle the variable's memory space if there aren't any upvar's
4783    * pointing to it. If there are upvars to this variable, then the
4784    * variable will get freed when the last upvar goes away.
4785    */
4786 
4787   if (varPtr->refCount == 0) {
4788       ckfree((char *) varPtr); /* this Var must be VAR_IN_HASHTABLE */
4789   }
4790     }
4791     Tcl_DeleteHashTable(tablePtr);
4792 }
Tcl_Obj* TclIncrVar2 (Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, long incrAmount, int flags)

Definition at line 1757 of file tclVar.c.
References Tcl_AddObjErrorInfo(), TclGetString, TclObjLookupVar(), TclPtrIncrVar(), and varPtr.
Referenced by Tcl_IncrObjCmd().1767                                                                             :
1768          * any of TCL_GLOBAL_ONLY,
1769          * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
1770          * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */
1771 {
1772     Var *varPtr, *arrayPtr;
1773     char *part1, *part2;
1774 
1775     part1 = TclGetString(part1Ptr);
1776     part2 = ((part2Ptr == NULL)? NULL : TclGetString(part2Ptr));
1777 
1778     varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read",
1779       0, 1, &arrayPtr);
1780     if (varPtr == NULL) {
1781   Tcl_AddObjErrorInfo(interp,
1782     "\n    (reading value of variable to increment)", -1);
1783   return NULL;
1784     }
1785     return TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2,
1786       incrAmount, flags);
1787 }

Var* TclLookupArrayElement (Tcl_Interp * interp, CONST char * arrayName, CONST char * elName, CONST int flags, CONST char * msg, CONST int createArray, CONST int createElem, Var * arrayPtr)

Definition at line 908 of file tclVar.c.
References ckalloc, danglingVar, DeleteSearches(), Var::flags, Var::hPtr, needArray, NewVar(), noSuchElement, noSuchVar, Var::nsPtr, Var::searchPtr, Var::tablePtr, Tcl_CreateHashEntry, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_InitHashTable(), TCL_LEAVE_ERR_MSG, Tcl_SetHashValue, TCL_STRING_KEYS, TclClearVarUndefined, TclIsVarArray, TclIsVarArrayElement, TclIsVarUndefined, TclSetVarArray, TclSetVarArrayElement, Var::value, VAR_IN_HASHTABLE, VarErrMsg(), and varPtr.
Referenced by TclArraySet(), TclExecuteByteCode(), TclLookupVar(), and TclObjLookupVar().924 {
925     Tcl_HashEntry *hPtr;
926     int new;
927     Var *varPtr;
928 
929     /*
930      * We're dealing with an array element. Make sure the variable is an
931      * array and look up the element (create the element if desired).
932      */
933 
934     if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
935   if (!createArray) {
936       if (flags & TCL_LEAVE_ERR_MSG) {
937     VarErrMsg(interp, arrayName, elName, msg, noSuchVar);
938       }
939       return NULL;
940   }
941 
942   /*
943    * Make sure we are not resurrecting a namespace variable from a
944    * deleted namespace!
945    */
946   if ((arrayPtr->flags & VAR_IN_HASHTABLE) && (arrayPtr->hPtr == NULL)) {
947       if (flags & TCL_LEAVE_ERR_MSG) {
948     VarErrMsg(interp, arrayName, elName, msg, danglingVar);
949       }
950       return NULL;
951   }
952 
953   TclSetVarArray(arrayPtr);
954   TclClearVarUndefined(arrayPtr);
955   arrayPtr->value.tablePtr =
956       (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
957   Tcl_InitHashTable(arrayPtr->value.tablePtr, TCL_STRING_KEYS);
958     } else if (!TclIsVarArray(arrayPtr)) {
959   if (flags & TCL_LEAVE_ERR_MSG) {
960       VarErrMsg(interp, arrayName, elName, msg, needArray);
961   }
962   return NULL;
963     }
964 
965     if (createElem) {
966   hPtr = Tcl_CreateHashEntry(arrayPtr->value.tablePtr, elName, &new);
967   if (new) {
968       if (arrayPtr->searchPtr != NULL) {
969     DeleteSearches(arrayPtr);
970       }
971       varPtr = NewVar();
972       Tcl_SetHashValue(hPtr, varPtr);
973       varPtr->hPtr = hPtr;
974       varPtr->nsPtr = arrayPtr->nsPtr;
975       TclSetVarArrayElement(varPtr);
976   }
977     } else {
978   hPtr = Tcl_FindHashEntry(arrayPtr->value.tablePtr, elName);
979   if (hPtr == NULL) {
980       if (flags & TCL_LEAVE_ERR_MSG) {
981     VarErrMsg(interp, arrayName, elName, msg, noSuchElement);
982       }
983       return NULL;
984   }
985     }
986     return (Var *) Tcl_GetHashValue(hPtr);
987 }
Var* TclLookupSimpleVar (Tcl_Interp * interp, CONST char * varName, int flags, CONST int create, CONST char ** errMsgPtr, int * indexPtr)

Definition at line 665 of file tclVar.c.
References badNamespace, ckalloc, CallFrame::compiledLocals, CONST, Proc::firstLocalPtr, Interp::globalNsPtr, CallFrame::isProcCallFrame, LOOKUP_FOR_UPVAR, missingName, Var::name, CompiledLocal::nameLength, NewVar(), CompiledLocal::nextPtr, ResolverScheme::nextPtr, noSuchVar, CallFrame::nsPtr, Proc::numCompiledLocals, CallFrame::procPtr, Interp::resolverPtr, strstr(), TCL_CONTINUE, Tcl_CreateHashEntry, Tcl_FindHashEntry, Tcl_FindNamespaceVar(), Tcl_GetHashValue, TCL_GLOBAL_ONLY, Tcl_InitHashTable(), TCL_LEAVE_ERR_MSG, TCL_NAMESPACE_ONLY, TCL_OK, Tcl_SetHashValue, TCL_STRING_KEYS, TclGetNamespaceForQualName(), TclIsVarTemporary, Interp::varFramePtr, varPtr, ResolverScheme::varResProc, Namespace::varResProc, Namespace::varTable, and CallFrame::varTablePtr.
Referenced by ObjMakeUpvar(), TclLookupVar(), and TclObjLookupVar().677 {    
678     Interp *iPtr = (Interp *) interp;
679     CallFrame *varFramePtr = iPtr->varFramePtr;
680         /* Points to the procedure call frame whose
681          * variables are currently in use. Same as
682          * the current procedure's frame, if any,
683          * unless an "uplevel" is executing. */
684     Tcl_HashTable *tablePtr;  /* Points to the hashtable, if any, in which
685          * to look up the variable. */
686     Tcl_Var var;                /* Used to search for global names. */
687     Var *varPtr;    /* Points to the Var structure returned for
688          * the variable. */
689     Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
690     ResolverScheme *resPtr;
691     Tcl_HashEntry *hPtr;
692     int new, i, result;
693 
694     varPtr = NULL;
695     varNsPtr = NULL;    /* set non-NULL if a nonlocal variable */
696     *indexPtr = -3;
697 
698     if ((flags & TCL_GLOBAL_ONLY) || iPtr->varFramePtr == NULL) {
699         cxtNsPtr = iPtr->globalNsPtr;
700     } else {
701         cxtNsPtr = iPtr->varFramePtr->nsPtr;
702     }
703 
704     /*
705      * If this namespace has a variable resolver, then give it first
706      * crack at the variable resolution.  It may return a Tcl_Var
707      * value, it may signal to continue onward, or it may signal
708      * an error.
709      */
710 
711     if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) 
712       && !(flags & LOOKUP_FOR_UPVAR)) {
713         resPtr = iPtr->resolverPtr;
714 
715         if (cxtNsPtr->varResProc) {
716             result = (*cxtNsPtr->varResProc)(interp, varName,
717         (Tcl_Namespace *) cxtNsPtr, flags, &var);
718         } else {
719             result = TCL_CONTINUE;
720         }
721 
722         while (result == TCL_CONTINUE && resPtr) {
723             if (resPtr->varResProc) {
724                 result = (*resPtr->varResProc)(interp, varName,
725       (Tcl_Namespace *) cxtNsPtr, flags, &var);
726             }
727             resPtr = resPtr->nextPtr;
728         }
729 
730         if (result == TCL_OK) {
731             varPtr = (Var *) var;
732       return varPtr;
733         } else if (result != TCL_CONTINUE) {
734       return NULL;
735         }
736     }
737 
738     /*
739      * Look up varName. Look it up as either a namespace variable or as a
740      * local variable in a procedure call frame (varFramePtr).
741      * Interpret varName as a namespace variable if:
742      *    1) so requested by a TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY flag,
743      *    2) there is no active frame (we're at the global :: scope),
744      *    3) the active frame was pushed to define the namespace context
745      *       for a "namespace eval" or "namespace inscope" command,
746      *    4) the name has namespace qualifiers ("::"s).
747      * Otherwise, if varName is a local variable, search first in the
748      * frame's array of compiler-allocated local variables, then in its
749      * hashtable for runtime-created local variables.
750      *
751      * If create and the variable isn't found, create the variable and,
752      * if necessary, create varFramePtr's local var hashtable.
753      */
754 
755     if (((flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) != 0)
756       || (varFramePtr == NULL)
757       || !varFramePtr->isProcCallFrame
758       || (strstr(varName, "::") != NULL)) {
759   CONST char *tail;
760   int lookGlobal;
761   
762   lookGlobal = (flags & TCL_GLOBAL_ONLY) 
763       || (cxtNsPtr == iPtr->globalNsPtr)
764       || ((*varName == ':') && (*(varName+1) == ':'));
765   if (lookGlobal) {
766       *indexPtr = -1;
767       flags = (flags | TCL_GLOBAL_ONLY) & ~(TCL_NAMESPACE_ONLY|LOOKUP_FOR_UPVAR);
768   } else {
769       if (flags & LOOKUP_FOR_UPVAR) {
770     flags = (flags | TCL_NAMESPACE_ONLY) & ~LOOKUP_FOR_UPVAR;
771       }
772       if (flags & TCL_NAMESPACE_ONLY) {
773     *indexPtr = -2;
774       }
775   } 
776 
777   /*
778    * Don't pass TCL_LEAVE_ERR_MSG, we may yet create the variable,
779    * or otherwise generate our own error!
780    */
781   var = Tcl_FindNamespaceVar(interp, varName, (Tcl_Namespace *) cxtNsPtr,
782     flags & ~TCL_LEAVE_ERR_MSG);
783   if (var != (Tcl_Var) NULL) {
784             varPtr = (Var *) var;
785         }
786   if (varPtr == NULL) {
787       if (create) {   /* var wasn't found so create it  */
788     TclGetNamespaceForQualName(interp, varName, cxtNsPtr,
789       flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
790     if (varNsPtr == NULL) {
791         *errMsgPtr = badNamespace;
792         return NULL;
793     }
794     if (tail == NULL) {
795         *errMsgPtr = missingName;
796         return NULL;
797     }
798     hPtr = Tcl_CreateHashEntry(&varNsPtr->varTable, tail, &new);
799     varPtr = NewVar();
800     Tcl_SetHashValue(hPtr, varPtr);
801     varPtr->hPtr = hPtr;
802     varPtr->nsPtr = varNsPtr;
803     if ((lookGlobal)  || (varNsPtr == NULL)) {
804         /*
805          * The variable was created starting from the global
806          * namespace: a global reference is returned even if 
807          * it wasn't explicitly requested.
808          */
809         *indexPtr = -1;
810     } else {
811         *indexPtr = -2;
812     }
813       } else {    /* var wasn't found and not to create it */
814     *errMsgPtr = noSuchVar;
815     return NULL;
816       }
817   }
818     } else {      /* local var: look in frame varFramePtr */
819   Proc *procPtr = varFramePtr->procPtr;
820   int localCt = procPtr->numCompiledLocals;
821   CompiledLocal *localPtr = procPtr->firstLocalPtr;
822   Var *localVarPtr = varFramePtr->compiledLocals;
823   int varNameLen = strlen(varName);
824   
825   for (i = 0;  i < localCt;  i++) {
826       if (!TclIsVarTemporary(localPtr)) {
827     register char *localName = localVarPtr->name;
828     if ((varName[0] == localName[0])
829             && (varNameLen == localPtr->nameLength)
830             && (strcmp(varName, localName) == 0)) {
831         *indexPtr = i;
832         return localVarPtr;
833     }
834       }
835       localVarPtr++;
836       localPtr = localPtr->nextPtr;
837   }
838   tablePtr = varFramePtr->varTablePtr;
839   if (create) {
840       if (tablePtr == NULL) {
841     tablePtr = (Tcl_HashTable *)
842         ckalloc(sizeof(Tcl_HashTable));
843     Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
844     varFramePtr->varTablePtr = tablePtr;
845       }
846       hPtr = Tcl_CreateHashEntry(tablePtr, varName, &new);
847       if (new) {
848     varPtr = NewVar();
849     Tcl_SetHashValue(hPtr, varPtr);
850     varPtr->hPtr = hPtr;
851     varPtr->nsPtr = NULL; /* a local variable */
852       } else {
853     varPtr = (Var *) Tcl_GetHashValue(hPtr);
854       }
855   } else {
856       hPtr = NULL;
857       if (tablePtr != NULL) {
858     hPtr = Tcl_FindHashEntry(tablePtr, varName);
859       }
860       if (hPtr == NULL) {
861     *errMsgPtr = noSuchVar;
862     return NULL;
863       }
864       varPtr = (Var *) Tcl_GetHashValue(hPtr);
865   }
866     }
867     return varPtr;
868 }
Var* TclLookupVar (Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, CONST char * msg, int createPart1, int createPart2, Var ** arrayPtrPtr)

Definition at line 185 of file tclVar.c.
References ckalloc, ckfree, CONST, needArray, TCL_LEAVE_ERR_MSG, TclIsVarLink, TclLookupArrayElement(), TclLookupSimpleVar(), VAR_NAME_BUF_SIZE, VarErrMsg(), and varPtr.
Referenced by Tcl_GetVar2Ex(), Tcl_SetVar2Ex(), Tcl_TraceVar2(), Tcl_UntraceVar2(), Tcl_VarTraceInfo2(), TclTraceVariableObjCmd(), and TclVarTraceExists().208 {
209     Var *varPtr;
210     CONST char *elName;   /* Name of array element or NULL; may be
211          * same as part2, or may be openParen+1. */
212     int openParen, closeParen;
213                                 /* If this procedure parses a name into
214          * array and index, these are the offsets to 
215          * the parens around the index.  Otherwise 
216          * they are -1. */
217     register CONST char *p;
218     CONST char *errMsg = NULL;
219     int index;
220 #define VAR_NAME_BUF_SIZE 26
221     char buffer[VAR_NAME_BUF_SIZE];
222     char *newVarName = buffer;
223 
224     varPtr = NULL;
225     *arrayPtrPtr = NULL;
226     openParen = closeParen = -1;
227 
228     /*
229      * Parse part1 into array name and index.
230      * Always check if part1 is an array element name and allow it only if
231      * part2 is not given.   
232      * (if one does not care about creating array elements that can't be used
233      *  from tcl, and prefer slightly better performance, one can put
234      *  the following in an   if (part2 == NULL) { ... } block and remove
235      *  the part2's test and error reporting  or move that code in array set)
236      */
237 
238     elName = part2;
239     for (p = part1; *p ; p++) {
240   if (*p == '(') {
241       openParen = p - part1;
242       do {
243     p++;
244       } while (*p != '\0');
245       p--;
246       if (*p == ')') {
247     if (part2 != NULL) {
248         if (flags & TCL_LEAVE_ERR_MSG) {
249       VarErrMsg(interp, part1, part2, msg, needArray);
250         }
251         return NULL;
252     }
253     closeParen = p - part1;
254       } else {
255     openParen = -1;
256       }
257       break;
258   }
259     }
260     if (openParen != -1) {
261   if (closeParen >= VAR_NAME_BUF_SIZE) {
262       newVarName = ckalloc((unsigned int) (closeParen+1));
263   }
264   memcpy(newVarName, part1, (unsigned int) closeParen);
265   newVarName[openParen] = '\0';
266   newVarName[closeParen] = '\0';
267   part1 = newVarName;
268   elName = newVarName + openParen + 1;
269     }
270 
271     varPtr = TclLookupSimpleVar(interp, part1, flags, 
272             createPart1, &errMsg, &index);
273     if (varPtr == NULL) {
274   if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
275       VarErrMsg(interp, part1, elName, msg, errMsg);
276   }
277     } else {
278   while (TclIsVarLink(varPtr)) {
279       varPtr = varPtr->value.linkPtr;
280   }
281   if (elName != NULL) {
282       *arrayPtrPtr = varPtr;
283       varPtr = TclLookupArrayElement(interp, part1, elName, flags, 
284         msg, createPart1, createPart2, varPtr);
285   }
286     }
287     if (newVarName != buffer) {
288   ckfree(newVarName);
289     }
290 
291     return varPtr;
292   
293 #undef VAR_NAME_BUF_SIZE
294 }
Var* TclObjLookupVar (Tcl_Interp * interp, Tcl_Obj * part1Ptr, CONST char * part2, int flags, CONST char * msg, CONST int createPart1, CONST int createPart2, Var ** arrayPtrPtr)

Definition at line 337 of file tclVar.c.
References ckalloc, CallFrame::compiledLocals, CONST, Tcl_ObjType::freeIntRepProc, Interp::globalNsPtr, Tcl_Obj::internalRep, CallFrame::isProcCallFrame, needArray, CallFrame::nsPtr, CallFrame::procPtr, Tcl_Obj::refCount, Proc::refCount, Interp::resolverPtr, Tcl_GetStringFromObj(), TCL_GLOBAL_ONLY, Tcl_IncrRefCount, TCL_LEAVE_ERR_MSG, TCL_NAMESPACE_ONLY, Tcl_NewStringObj(), TclGetString, TclIsVarLink, tclLocalVarNameType, TclLookupArrayElement(), TclLookupSimpleVar(), tclNsVarNameType, tclParsedVarNameType, Tcl_Obj::twoPtrValue, Tcl_Obj::typePtr, VAR_UNDEFINED, VarErrMsg(), Interp::varFramePtr, varPtr, Namespace::varResProc, and VOID.
Referenced by ObjMakeUpvar(), Tcl_AppendObjCmd(), Tcl_ArrayObjCmd(), Tcl_LappendObjCmd(), Tcl_ObjGetVar2(), Tcl_ObjSetVar2(), Tcl_VariableObjCmd(), TclArraySet(), TclExecuteByteCode(), TclIncrVar2(), and TclObjUnsetVar2().360 {
361     Interp *iPtr = (Interp *) interp;
362     register Var *varPtr; /* Points to the variable's in-frame Var
363          * structure. */
364     char *part1;
365     int index, len1, len2;
366     int parsed = 0;
367     Tcl_Obj *objPtr;
368     Tcl_ObjType *typePtr = part1Ptr->typePtr;
369     CONST char *errMsg = NULL;
370     CallFrame *varFramePtr = iPtr->varFramePtr;
371     Namespace *nsPtr;
372 
373     /*
374      * If part1Ptr is a tclParsedVarNameType, separate it into the 
375      * pre-parsed parts.
376      */
377 
378     *arrayPtrPtr = NULL;
379     if (typePtr == &tclParsedVarNameType) {
380   if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) {
381       if (part2 != NULL) {
382     /*
383      * ERROR: part1Ptr is already an array element, cannot 
384      * specify a part2.
385      */
386 
387     if (flags & TCL_LEAVE_ERR_MSG) {
388         part1 = TclGetString(part1Ptr);
389         VarErrMsg(interp, part1, part2, msg, needArray);
390     }
391     return NULL;
392       }
393       part2 = (char *) part1Ptr->internalRep.twoPtrValue.ptr2;
394       part1Ptr = (Tcl_Obj *) part1Ptr->internalRep.twoPtrValue.ptr1;
395       typePtr = part1Ptr->typePtr;
396   }
397   parsed = 1;
398     }
399     part1 = Tcl_GetStringFromObj(part1Ptr, &len1);    
400 
401     nsPtr = ((varFramePtr == NULL)? iPtr->globalNsPtr : varFramePtr->nsPtr);
402     if (nsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
403   goto doParse;
404     }
405     
406     if (typePtr == &tclLocalVarNameType) {
407   Proc *procPtr = (Proc *) part1Ptr->internalRep.twoPtrValue.ptr1;
408   int localIndex = (int) part1Ptr->internalRep.twoPtrValue.ptr2;
409   int useLocal;
410 
411   useLocal = ((varFramePtr != NULL) && varFramePtr->isProcCallFrame
412           && !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)));
413   if (useLocal && (procPtr == varFramePtr->procPtr)) {
414       /*
415        * part1Ptr points to an indexed local variable of the
416        * correct procedure: use the cached value.
417        */
418       
419       varPtr = &(varFramePtr->compiledLocals[localIndex]);
420       goto donePart1;
421   }
422   goto doneParsing;
423     } else if (typePtr == &tclNsVarNameType) {
424   Namespace *cachedNsPtr;
425   int useGlobal, useReference;
426 
427   varPtr = (Var *) part1Ptr->internalRep.twoPtrValue.ptr2;
428   cachedNsPtr = (Namespace *) part1Ptr->internalRep.twoPtrValue.ptr1;
429   useGlobal = (cachedNsPtr == iPtr->globalNsPtr) 
430       && ((flags & TCL_GLOBAL_ONLY) 
431     || ((*part1 == ':') && (*(part1+1) == ':'))
432     || (varFramePtr == NULL) 
433     || (!varFramePtr->isProcCallFrame 
434         && (nsPtr == iPtr->globalNsPtr)));
435   useReference = useGlobal || ((cachedNsPtr == nsPtr) 
436           && ((flags & TCL_NAMESPACE_ONLY) 
437         || (varFramePtr && !varFramePtr->isProcCallFrame 
438       && !(flags & TCL_GLOBAL_ONLY)
439       /* careful: an undefined ns variable could
440        * be hiding a valid global reference. */
441       && !(varPtr->flags & VAR_UNDEFINED))));
442   if (useReference && (varPtr->hPtr != NULL)) {
443       /*
444        * A straight global or namespace reference, use it. It isn't 
445        * so simple to deal with 'implicit' namespace references, i.e., 
446        * those where the reference could be to either a namespace 
447        * or a global variable. Those we lookup again.
448        *
449        * If (varPtr->hPtr == NULL), this might be a reference to a
450        * variable in a deleted namespace, kept alive by e.g. part1Ptr.
451        * We could conceivably be so unlucky that a new namespace was
452        * created at the same address as the deleted one, so to be 
453        * safe we test for a valid hPtr.
454        */
455       goto donePart1;
456   }
457   goto doneParsing;
458     }
459 
460     doParse:
461     if (!parsed && (*(part1 + len1 - 1) == ')')) {
462   /*
463    * part1Ptr is possibly an unparsed array element.
464    */
465   register int i;
466   char *newPart2;
467   len2 = -1;
468   for (i = 0; i < len1; i++) {
469       if (*(part1 + i) == '(') {
470     if (part2 != NULL) {
471         if (flags & TCL_LEAVE_ERR_MSG) {
472       VarErrMsg(interp, part1, part2, msg, needArray);
473         }
474     }     
475 
476     /*
477      * part1Ptr points to an array element; first copy 
478      * the element name to a new string part2.
479      */
480 
481     part2 = part1 + i + 1;
482     len2 = len1 - i - 2;
483     len1 = i;
484 
485     newPart2 = ckalloc((unsigned int) (len2+1));
486     memcpy(newPart2, part2, (unsigned int) len2);
487     *(newPart2+len2) = '\0';
488     part2 = newPart2;
489 
490     /*
491      * Free the internal rep of the original part1Ptr, now
492      * renamed objPtr, and set it to tclParsedVarNameType.
493      */
494 
495     objPtr = part1Ptr;
496     if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
497         typePtr->freeIntRepProc(objPtr);
498     }
499     objPtr->typePtr = &tclParsedVarNameType;
500 
501     /*
502      * Define a new string object to hold the new part1Ptr, i.e., 
503      * the array name. Set the internal rep of objPtr, reset
504      * typePtr and part1 to contain the references to the
505      * array name.
506      */
507 
508     part1Ptr = Tcl_NewStringObj(part1, len1);
509     Tcl_IncrRefCount(part1Ptr);
510 
511     objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) part1Ptr;
512     objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) part2;    
513 
514     typePtr = part1Ptr->typePtr;
515     part1 = TclGetString(part1Ptr);
516     break;
517       }
518   }
519     }
520     
521     doneParsing:
522     /*
523      * part1Ptr is not an array element; look it up, and convert 
524      * it to one of the cached types if possible.
525      */
526 
527     if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
528   typePtr->freeIntRepProc(part1Ptr);
529   part1Ptr->typePtr = NULL;
530     }
531 
532     varPtr = TclLookupSimpleVar(interp, part1, flags, 
533             createPart1, &errMsg, &index);
534     if (varPtr == NULL) {
535   if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
536       VarErrMsg(interp, part1, part2, msg, errMsg);
537   }
538   return NULL;
539     }
540 
541     /*
542      * Cache the newly found variable if possible.
543      */
544 
545     if (index >= 0) {
546         /*
547    * An indexed local variable.
548    */
549 
550   Proc *procPtr = ((Interp *) interp)->varFramePtr->procPtr;
551 
552   part1Ptr->typePtr = &tclLocalVarNameType;
553   procPtr->refCount++;
554   part1Ptr->internalRep.twoPtrValue.ptr1 = (VOID *) procPtr;
555   part1Ptr->internalRep.twoPtrValue.ptr2 = (VOID *) index;
556 #if 0
557     /*
558      * TEMPORARYLY DISABLED tclNsVarNameType
559      *
560      * This optimisation will hopefully be turned back on soon.
561      *      Miguel Sofer, 2004-05-22
562      */
563 
564     } else if (index > -3) {
565   /*
566    * A cacheable namespace or global variable.
567    */
568   Namespace *nsPtr;
569     
570   nsPtr = ((index == -1)? iPtr->globalNsPtr : varFramePtr->nsPtr);
571   varPtr->refCount++;
572   part1Ptr->typePtr = &tclNsVarNameType;
573   part1Ptr->internalRep.twoPtrValue.ptr1 = (VOID *) nsPtr;
574   part1Ptr->internalRep.twoPtrValue.ptr2 = (VOID *) varPtr;
575 #endif
576     } else {
577   /*
578    * At least mark part1Ptr as already parsed.
579    */
580   part1Ptr->typePtr = &tclParsedVarNameType;
581   part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
582   part1Ptr->internalRep.twoPtrValue.ptr2 = NULL;
583     }
584     
585     donePart1:
586 #if 0
587     if (varPtr == NULL) {
588   if (flags & TCL_LEAVE_ERR_MSG) {
589       part1 = TclGetString(part1Ptr);
590       VarErrMsg(interp, part1, part2, msg, 
591         "Cached variable reference is NULL.");
592   }
593   return NULL;
594     }
595 #endif
596     while (TclIsVarLink(varPtr)) {
597   varPtr = varPtr->value.linkPtr;
598     }
599 
600     if (part2 != NULL) {
601   /*
602    * Array element sought: look it up.
603    */
604 
605   part1 = TclGetString(part1Ptr);
606   *arrayPtrPtr = varPtr;
607   varPtr = TclLookupArrayElement(interp, part1, part2, 
608                 flags, msg, createPart1, createPart2, varPtr);
609     }
610     return varPtr;
611 }
int TclObjUnsetVar2 (Tcl_Interp * interp, Tcl_Obj * part1Ptr, CONST char * part2, int flags)

Definition at line 1992 of file tclVar.c.
References CleanupVar(), Tcl_ObjType::freeIntRepProc, noSuchElement, noSuchVar, Tcl_Obj::refCount, TCL_ERROR, TCL_LEAVE_ERR_MSG, TCL_OK, TclGetString, TclIsVarUndefined, tclNsVarNameType, TclObjLookupVar(), Tcl_Obj::typePtr, UnsetVarStruct(), VarErrMsg(), and varPtr.
Referenced by Tcl_ArrayObjCmd(), Tcl_UnsetObjCmd(), and Tcl_UnsetVar2().2000 {
2001     Var *varPtr;
2002     Interp *iPtr = (Interp *) interp;
2003     Var *arrayPtr;
2004     int result;
2005     char *part1;
2006 
2007     part1 = TclGetString(part1Ptr);
2008     varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "unset",
2009       /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
2010     if (varPtr == NULL) {
2011   return TCL_ERROR;
2012     }
2013  
2014     result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
2015 
2016     /*
2017      * Keep the variable alive until we're done with it. We used to
2018      * increase/decrease the refCount for each operation, making it
2019      * hard to find [Bug 735335] - caused by unsetting the variable
2020      * whose value was the variable's name.
2021      */
2022     
2023     varPtr->refCount++;
2024 
2025     UnsetVarStruct(varPtr, arrayPtr, iPtr, part1, part2, flags);
2026 
2027     /*
2028      * It's an error to unset an undefined variable.
2029      */
2030   
2031     if (result != TCL_OK) {
2032   if (flags & TCL_LEAVE_ERR_MSG) {
2033       VarErrMsg(interp, part1, part2, "unset", 
2034         ((arrayPtr == NULL) ? noSuchVar : noSuchElement));
2035   }
2036     }
2037 
2038     /*
2039      * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType 
2040      * keeping a reference. This removes some additional exteriorisations of
2041      * [Bug 736729], but may be a good thing independently of the bug.
2042      */
2043 
2044     if (part1Ptr->typePtr == &tclNsVarNameType) {
2045   part1Ptr->typePtr->freeIntRepProc(part1Ptr);
2046   part1Ptr->typePtr = NULL;
2047     }
2048 
2049     /*
2050      * Finally, if the variable is truly not in use then free up its Var
2051      * structure and remove it from its hash table, if any. The ref count of
2052      * its value object, if any, was decremented above.
2053      */
2054 
2055     varPtr->refCount--;
2056     CleanupVar(varPtr, arrayPtr);
2057     return result;
2058 }
Tcl_Obj* TclPtrGetVar (Tcl_Interp * interp, Var * varPtr, Var * arrayPtr, CONST char * part1, CONST char * part2, CONST int flags)

Definition at line 1199 of file tclVar.c.
References CallVarTraces(), CleanupVar(), CONST, isArray, noSuchElement, noSuchVar, TCL_ERROR, TCL_GLOBAL_ONLY, TCL_LEAVE_ERR_MSG, TCL_NAMESPACE_ONLY, TCL_TRACE_READS, TclIsVarArray, TclIsVarScalar, TclIsVarUndefined, Var::tracePtr, and VarErrMsg().
Referenced by Tcl_GetVar2Ex(), Tcl_LappendObjCmd(), Tcl_ObjGetVar2(), TclExecuteByteCode(), and TclPtrIncrVar().1211 {
1212     Interp *iPtr = (Interp *) interp;
1213     CONST char *msg;
1214 
1215     /*
1216      * Invoke any traces that have been set for the variable.
1217      */
1218 
1219     if ((varPtr->tracePtr != NULL)
1220       || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
1221   if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
1222     (flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY))
1223     | TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) {
1224       goto errorReturn;
1225   }
1226     }
1227 
1228     /*
1229      * Return the element if it's an existing scalar variable.
1230      */
1231     
1232     if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
1233   return varPtr->value.objPtr;
1234     }
1235     
1236     if (flags & TCL_LEAVE_ERR_MSG) {
1237   if (TclIsVarUndefined(varPtr) && (arrayPtr != NULL)
1238           && !TclIsVarUndefined(arrayPtr)) {
1239       msg = noSuchElement;
1240   } else if (TclIsVarArray(varPtr)) {
1241       msg = isArray;
1242   } else {
1243       msg = noSuchVar;
1244   }
1245   VarErrMsg(interp, part1, part2, "read", msg);
1246     }
1247 
1248     /*
1249      * An error. If the variable doesn't exist anymore and no-one's using
1250      * it, then free up the relevant structures and hash table entries.
1251      */
1252 
1253     errorReturn:
1254     if (TclIsVarUndefined(varPtr)) {
1255   CleanupVar(varPtr, arrayPtr);
1256     }
1257     return NULL;
1258 }
Tcl_Obj* TclPtrIncrVar (Tcl_Interp * interp, Var * varPtr, Var * arrayPtr, CONST char * part1, CONST char * part2, CONST long incrAmount, CONST int flags)

Definition at line 1816 of file tclVar.c.
References Tcl_Obj::internalRep, LONG_MAX, LONG_MIN, Tcl_Obj::longValue, Tcl_AddObjErrorInfo(), Tcl_DecrRefCount, Tcl_DuplicateObj(), Tcl_GetWideIntFromObj(), Tcl_IsShared, Tcl_LongAsWide, TCL_OK, Tcl_SetIntObj(), Tcl_SetLongObj(), Tcl_SetWideIntObj(), Tcl_WideAsLong, TclGetWide, tclIntType, TclPtrGetVar(), TclPtrSetVar(), tclWideIntType, Tcl_Obj::typePtr, and varPtr.
Referenced by TclExecuteByteCode(), and TclIncrVar2().1828                                                                             :
1829          * any of TCL_GLOBAL_ONLY,
1830          * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
1831          * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */
1832 {
1833     register Tcl_Obj *varValuePtr;
1834     int createdNewObj;    /* Set 1 if var's value object is shared
1835          * so we must increment a copy (i.e. copy
1836          * on write). */
1837     long i;
1838 
1839     varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
1840 
1841     if (varValuePtr == NULL) {
1842   Tcl_AddObjErrorInfo(interp,
1843     "\n    (reading value of variable to increment)", -1);
1844   return NULL;
1845     }
1846 
1847     /*
1848      * Increment the variable's value. If the object is unshared we can
1849      * modify it directly, otherwise we must create a new copy to modify:
1850      * this is "copy on write". Then free the variable's old string
1851      * representation, if any, since it will no longer be valid.
1852      */
1853 
1854     createdNewObj = 0;
1855     if (Tcl_IsShared(varValuePtr)) {
1856   varValuePtr = Tcl_DuplicateObj(varValuePtr);
1857   createdNewObj = 1;
1858     }
1859     if (varValuePtr->typePtr == &tclWideIntType) {
1860   Tcl_WideInt wide;
1861   TclGetWide(wide,varValuePtr);
1862   Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount));
1863     } else if (varValuePtr->typePtr == &tclIntType) {
1864   i = varValuePtr->internalRep.longValue;
1865   Tcl_SetIntObj(varValuePtr, i + incrAmount);
1866     } else {
1867   /*
1868    * Not an integer or wide internal-rep...
1869    */
1870   Tcl_WideInt wide;
1871   if (Tcl_GetWideIntFromObj(interp, varValuePtr, &wide) != TCL_OK) {
1872       if (createdNewObj) {
1873     Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */
1874       }
1875       return NULL;
1876   }
1877   if (wide <= Tcl_LongAsWide(LONG_MAX)
1878     && wide >= Tcl_LongAsWide(LONG_MIN)) {
1879       Tcl_SetLongObj(varValuePtr, Tcl_WideAsLong(wide) + incrAmount);
1880   } else {
1881       Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount));
1882   }
1883     }
1884 
1885     /*
1886      * Store the variable's new value and run any write traces.
1887      */
1888     
1889     return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
1890       varValuePtr, flags);
1891 }

Tcl_Obj* TclPtrSetVar (Tcl_Interp * interp, Var * varPtr, Var * arrayPtr, CONST char * part1, CONST char * part2, Tcl_Obj * newValuePtr, CONST int flags)

Definition at line 1557 of file tclVar.c.
References CallVarTraces(), cleanup(), CleanupVar(), danglingElement, danglingVar, Interp::emptyObjPtr, isArray, TCL_APPEND_VALUE, Tcl_AppendObjToObj(), Tcl_DecrRefCount, Tcl_DuplicateObj(), TCL_ERROR, TCL_GLOBAL_ONLY, Tcl_IncrRefCount, Tcl_IsShared, TCL_LEAVE_ERR_MSG, TCL_LIST_ELEMENT, Tcl_ListObjAppendElement(), TCL_NAMESPACE_ONLY, TCL_OK, TCL_TRACE_READS, TCL_TRACE_WRITES, TclClearVarUndefined, TclDecrRefCount, TclIsVarArray, TclIsVarArrayElement, TclIsVarScalar, TclIsVarUndefined, TclNewObj, TclSetVarScalar, TclSetVarUndefined, Var::tracePtr, VAR_IN_HASHTABLE, and VarErrMsg().
Referenced by Tcl_AppendObjCmd(), Tcl_LappendObjCmd(), Tcl_ObjSetVar2(), Tcl_SetVar2Ex(), Tcl_VariableObjCmd(), TclArraySet(), TclExecuteByteCode(), and TclPtrIncrVar().1569 {
1570     Interp *iPtr = (Interp *) interp;
1571     Tcl_Obj *oldValuePtr;
1572     Tcl_Obj *resultPtr = NULL;
1573     int result;
1574 
1575     /*
1576      * If the variable is in a hashtable and its hPtr field is NULL, then we
1577      * may have an upvar to an array element where the array was deleted
1578      * or an upvar to a namespace variable whose namespace was deleted.
1579      * Generate an error (allowing the variable to be reset would screw up
1580      * our storage allocation and is meaningless anyway).
1581      */
1582 
1583     if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
1584   if (flags & TCL_LEAVE_ERR_MSG) {
1585       if (TclIsVarArrayElement(varPtr)) {
1586     VarErrMsg(interp, part1, part2, "set", danglingElement);
1587       } else {
1588     VarErrMsg(interp, part1, part2, "set", danglingVar);
1589       }
1590   }
1591   return NULL;
1592     }
1593 
1594     /*
1595      * It's an error to try to set an array variable itself.
1596      */
1597 
1598     if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
1599   if (flags & TCL_LEAVE_ERR_MSG) {
1600       VarErrMsg(interp, part1, part2, "set", isArray);
1601   }
1602   return NULL;
1603     }
1604 
1605     /*
1606      * Invoke any read traces that have been set for the variable if it
1607      * is requested; this is only done in the core when lappending.
1608      */
1609 
1610     if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL) 
1611       || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) {
1612   if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
1613     TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) {
1614       return NULL;
1615   }
1616     }
1617 
1618     /*
1619      * Set the variable's new value. If appending, append the new value to
1620      * the variable, either as a list element or as a string. Also, if
1621      * appending, then if the variable's old value is unshared we can modify
1622      * it directly, otherwise we must create a new copy to modify: this is
1623      * "copy on write".
1624      */
1625 
1626     if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) {
1627   TclSetVarUndefined(varPtr);
1628     }
1629     oldValuePtr = varPtr->value.objPtr;
1630     if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
1631   if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) {
1632       Tcl_DecrRefCount(oldValuePtr);     /* discard old value */
1633       varPtr->value.objPtr = NULL;
1634       oldValuePtr = NULL;
1635   }
1636   if (flags & TCL_LIST_ELEMENT) {        /* append list element */
1637       if (oldValuePtr == NULL) {
1638     TclNewObj(oldValuePtr);
1639     varPtr->value.objPtr = oldValuePtr;
1640     Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */
1641       } else if (Tcl_IsShared(oldValuePtr)) {
1642     varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
1643     Tcl_DecrRefCount(oldValuePtr);
1644     oldValuePtr = varPtr->value.objPtr;
1645     Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */
1646       }
1647       result = Tcl_ListObjAppendElement(interp, oldValuePtr,
1648         newValuePtr);
1649       if (result != TCL_OK) {
1650     return NULL;
1651       }
1652   } else {                   /* append string */
1653       /*
1654        * We append newValuePtr's bytes but don't change its ref count.
1655        */
1656 
1657       if (oldValuePtr == NULL) {
1658     varPtr->value.objPtr = newValuePtr;
1659     Tcl_IncrRefCount(newValuePtr);
1660       } else {
1661     if (Tcl_IsShared(oldValuePtr)) {   /* append to copy */
1662         varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
1663         TclDecrRefCount(oldValuePtr);
1664         oldValuePtr = varPtr->value.objPtr;
1665         Tcl_IncrRefCount(oldValuePtr); /* since var is ref */
1666     }
1667     Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
1668       }
1669   }
1670     } else if (newValuePtr != oldValuePtr) {
1671   /*
1672    * In this case we are replacing the value, so we don't need to
1673    * do more than swap the objects.
1674    */
1675 
1676   varPtr->value.objPtr = newValuePtr;
1677   Tcl_IncrRefCount(newValuePtr);      /* var is another ref */
1678   if (oldValuePtr != NULL) {
1679       TclDecrRefCount(oldValuePtr);   /* discard old value */
1680   }
1681     }
1682     TclSetVarScalar(varPtr);
1683     TclClearVarUndefined(varPtr);
1684     if (arrayPtr != NULL) {
1685   TclClearVarUndefined(arrayPtr);
1686     }
1687 
1688     /*
1689      * Invoke any write traces for the variable.
1690      */
1691 
1692     if ((varPtr->tracePtr != NULL)
1693       || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
1694   if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
1695           (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
1696     | TCL_TRACE_WRITES, (flags & TCL_LEAVE_ERR_MSG))) {
1697       goto cleanup;
1698   }
1699     }
1700 
1701     /*
1702      * Return the variable's value unless the variable was changed in some
1703      * gross way by a trace (e.g. it was unset and then recreated as an
1704      * array). 
1705      */
1706 
1707     if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
1708   return varPtr->value.objPtr;
1709     }
1710 
1711     /*
1712      * A trace changed the value in some gross way. Return an empty string
1713      * object.
1714      */
1715     
1716     resultPtr = iPtr->emptyObjPtr;
1717 
1718     /*
1719      * If the variable doesn't exist anymore and no-one's using it, then
1720      * free up the relevant structures and hash table entries.
1721      */
1722 
1723     cleanup:
1724     if (TclIsVarUndefined(varPtr)) {
1725   CleanupVar(varPtr, arrayPtr);
1726     }
1727     return resultPtr;
1728 }
Var* TclVarTraceExists (Tcl_Interp * interp, CONST char * varName)

Definition at line 5094 of file tclVar.c.
References CallVarTraces(), CleanupVar(), TCL_TRACE_READS, TclIsVarUndefined, TclLookupVar(), Var::tracePtr, and varPtr.
Referenced by InfoExistsCmd().5097 {
5098     Var *varPtr;
5099     Var *arrayPtr;
5100 
5101     /*
5102      * The choice of "create" flag values is delicate here, and
5103      * matches the semantics of GetVar.  Things are still not perfect,
5104      * however, because if you do "info exists x" you get a varPtr
5105      * and therefore trigger traces.  However, if you do 
5106      * "info exists x(i)", then you only get a varPtr if x is already
5107      * known to be an array.  Otherwise you get NULL, and no trace
5108      * is triggered.  This matches Tcl 7.6 semantics.
5109      */
5110 
5111     varPtr = TclLookupVar(interp, varName, (char *) NULL,
5112             0, "access", /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
5113 
5114     if (varPtr == NULL) {
5115   return NULL;
5116     }
5117 
5118     if ((varPtr->tracePtr != NULL)
5119       || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
5120   CallVarTraces((Interp *)interp, arrayPtr, varPtr, varName, NULL,
5121     TCL_TRACE_READS, /* leaveErrMsg */ 0);
5122     }
5123 
5124     /*
5125      * If the variable doesn't exist anymore and no-one's using
5126      * it, then free up the relevant structures and hash table entries.
5127      */
5128 
5129     if (TclIsVarUndefined(varPtr)) {
5130   CleanupVar(varPtr, arrayPtr);
5131   return NULL;
5132     }
5133 
5134     return varPtr;
5135 }
static void UnsetVarStruct (Var * varPtr, Var * arrayPtr, Interp * iPtr, CONST char * part1, CONST char * part2, int flags) [static]

Definition at line 2080 of file tclVar.c.
References Interp::activeVarTracePtr, CallVarTraces(), ckfree, DeleteArray(), DeleteSearches(), Var::flags, Var::hPtr, ActiveVarTrace::nextPtr, VarTrace::nextPtr, ActiveVarTrace::nextTracePtr, Var::objPtr, Var::refCount, Var::searchPtr, Tcl_DeleteHashEntry(), TCL_DYNAMIC, Tcl_EventuallyFree(), TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, TCL_TRACE_UNSETS, TclDecrRefCount, TclIsVarArray, TclIsVarLink, TclIsVarScalar, TclIsVarUndefined, TclSetVarScalar, TclSetVarUndefined, Var::tracePtr, Var::value, VAR_IN_HASHTABLE, VAR_NAMESPACE_VAR, VAR_TRACE_ACTIVE, and ActiveVarTrace::varPtr.
Referenced by TclDeleteNamespaceVars(), and TclObjUnsetVar2().2087 {
2088     Var dummyVar;
2089     Var *dummyVarPtr;
2090     ActiveVarTrace *activePtr;
2091 
2092     if ((arrayPtr != NULL) && (arrayPtr->searchPtr != NULL)) {
2093   DeleteSearches(arrayPtr);
2094     }
2095 
2096     /*
2097      * For global/upvar variables referenced in procedures, decrement
2098      * the reference count on the variable referred to, and free
2099      * the referenced variable if it's no longer needed. 
2100      */
2101 
2102     if (TclIsVarLink(varPtr)) {
2103   Var *linkPtr = varPtr->value.linkPtr;
2104   linkPtr->refCount--;
2105   if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr)
2106     && (linkPtr->tracePtr == NULL)
2107     && (linkPtr->flags & VAR_IN_HASHTABLE)) {
2108       if (linkPtr->hPtr != NULL) {
2109     Tcl_DeleteHashEntry(linkPtr->hPtr);
2110       }
2111       ckfree((char *) linkPtr);
2112   }
2113     }
2114 
2115     /*
2116      * The code below is tricky, because of the possibility that
2117      * a trace procedure might try to access a variable being
2118      * deleted. To handle this situation gracefully, do things
2119      * in three steps:
2120      * 1. Copy the contents of the variable to a dummy variable
2121      *    structure, and mark the original Var structure as undefined.
2122      * 2. Invoke traces and clean up the variable, using the dummy copy.
2123      * 3. If at the end of this the original variable is still
2124      *    undefined and has no outstanding references, then delete
2125      *    it (but it could have gotten recreated by a trace).
2126      */
2127 
2128     dummyVar = *varPtr;
2129     TclSetVarUndefined(varPtr);
2130     TclSetVarScalar(varPtr);
2131     varPtr->value.objPtr = NULL; /* dummyVar points to any value object */
2132     varPtr->tracePtr = NULL;
2133     varPtr->searchPtr = NULL;
2134 
2135     /*
2136      * Call trace procedures for the variable being deleted. Then delete
2137      * its traces. Be sure to abort any other traces for the variable
2138      * that are still pending. Special tricks:
2139      * 1. We need to increment varPtr's refCount around this: CallVarTraces
2140      *    will use dummyVar so it won't increment varPtr's refCount itself.
2141      * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to
2142      *    call unset traces even if other traces are pending.
2143      */
2144 
2145     if ((dummyVar.tracePtr != NULL)
2146       || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
2147   dummyVar.flags &= ~VAR_TRACE_ACTIVE;
2148   CallVarTraces(iPtr, arrayPtr, &dummyVar, part1, part2,
2149     (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
2150     | TCL_TRACE_UNSETS, /* leaveErrMsg */ 0);
2151   while (dummyVar.tracePtr != NULL) {
2152       VarTrace *tracePtr = dummyVar.tracePtr;
2153       dummyVar.tracePtr = tracePtr->nextPtr;
2154       Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
2155   }
2156   for (activePtr = iPtr->activeVarTracePtr;  activePtr != NULL;
2157        activePtr = activePtr->nextPtr) {
2158       if (activePtr->varPtr == varPtr) {
2159     activePtr->nextTracePtr = NULL;
2160       }
2161   }
2162     }
2163 
2164     /*
2165      * If the variable is an array, delete all of its elements. This must be
2166      * done after calling the traces on the array, above (that's the way
2167      * traces are defined). If it is a scalar, "discard" its object
2168      * (decrement the ref count of its object, if any).
2169      */
2170 
2171     dummyVarPtr = &dummyVar;
2172     if (TclIsVarArray(dummyVarPtr) && !TclIsVarUndefined(dummyVarPtr)) {
2173   /*
2174    * Deleting the elements of the array may cause traces to be fired
2175    * on those elements.  Before deleting them, bump the reference count
2176    * of the array, so that if those trace procs make a global or upvar
2177    * link to the array, the array is not deleted when the call stack
2178    * gets popped (we will delete the array ourselves later in this
2179    * function).
2180    *
2181    * Bumping the count can lead to the odd situation that elements of the
2182    * array are being deleted when the array still exists, but since the
2183    * array is about to be removed anyway, that shouldn't really matter.
2184    */
2185   DeleteArray(iPtr, part1, dummyVarPtr,
2186     (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) 
2187     | TCL_TRACE_UNSETS);
2188   /* Decr ref count */
2189     }
2190     if (TclIsVarScalar(dummyVarPtr)
2191       && (dummyVarPtr->value.objPtr != NULL)) {
2192   Tcl_Obj *objPtr = dummyVarPtr->value.objPtr;
2193   TclDecrRefCount(objPtr);
2194   dummyVarPtr->value.objPtr = NULL;
2195     }
2196 
2197     /*
2198      * If the variable was a namespace variable, decrement its reference count.
2199      */
2200     
2201     if (varPtr->flags & VAR_NAMESPACE_VAR) {
2202   varPtr->flags &= ~VAR_NAMESPACE_VAR;
2203   varPtr->refCount--;
2204     }
2205 
2206 }
static void UpdateLocalVarName (Tcl_Obj * objPtr) [static]

Definition at line 5178 of file tclVar.c.
References ckalloc, Proc::firstLocalPtr, Tcl_Obj::internalRep, CompiledLocal::name, CompiledLocal::nameLength, CompiledLocal::nextPtr, and Tcl_Obj::twoPtrValue.5180 {
5181     Proc *procPtr = (Proc *) objPtr->internalRep.twoPtrValue.ptr1;
5182     unsigned int index = (unsigned int) objPtr->internalRep.twoPtrValue.ptr2;
5183     CompiledLocal *localPtr = procPtr->firstLocalPtr;
5184     unsigned int nameLen;
5185 
5186     if (localPtr == NULL) {
5187   goto emptyName;
5188     }
5189     while (index--) {
5190   localPtr = localPtr->nextPtr;
5191   if (localPtr == NULL) {
5192       goto emptyName;
5193   }
5194     }
5195 
5196     nameLen = (unsigned int) localPtr->nameLength;
5197     objPtr->bytes = ckalloc(nameLen + 1);
5198     memcpy(objPtr->bytes, localPtr->name, nameLen + 1);
5199     objPtr->length = nameLen;
5200     return;
5201 
5202     emptyName:
5203     objPtr->bytes = ckalloc(1);
5204     *(objPtr->bytes) = '\0';
5205     objPtr->length = 0;
5206 }
static void UpdateParsedVarName (Tcl_Obj * objPtr) [static]

Definition at line 5301 of file tclVar.c.
References ckalloc, panic, and Tcl_GetStringFromObj().5303 {
5304     Tcl_Obj *arrayPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr1;
5305     char *part2 = (char *) objPtr->internalRep.twoPtrValue.ptr2;
5306     char *part1, *p;
5307     int len1, len2, totalLen;
5308 
5309     if (arrayPtr == NULL) {
5310   /*
5311    * This is a parsed scalar name: what is it
5312    * doing here?
5313    */
5314   panic("ERROR: scalar parsedVarName without a string rep.\n");
5315     }
5316     part1 = Tcl_GetStringFromObj(arrayPtr, &len1);
5317     len2 = strlen(part2);
5318   
5319     totalLen = len1 + len2 + 2;
5320     p = ckalloc((unsigned int) totalLen + 1);
5321     objPtr->bytes = p;
5322     objPtr->length = totalLen;
5323 
5324     memcpy(p, part1, (unsigned int) len1);
5325     p += len1;
5326     *p++ = '(';
5327     memcpy(p, part2, (unsigned int) len2);
5328     p += len2;
5329     *p++ = ')';
5330     *p   = '\0';
5331 }
static void VarErrMsg (Tcl_Interp * interp, CONST char * part1, CONST char * part2, CONST char * operation, CONST char * reason) [static]

Definition at line 5058 of file tclVar.c.
References Tcl_ResetResult().
Referenced by CallVarTraces(), ObjMakeUpvar(), Tcl_VariableObjCmd(), TclArraySet(), TclLookupArrayElement(), TclLookupVar(), TclObjLookupVar(), TclObjUnsetVar2(), TclPtrGetVar(), and TclPtrSetVar().5065 {
5066     Tcl_ResetResult(interp);
5067     Tcl_AppendResult(interp, "can't ", operation, " \"", part1,
5068       (char *) NULL);
5069     if (part2 != NULL) {
5070         Tcl_AppendResult(interp, "(", part2, ")", (char *) NULL);
5071     }
5072     Tcl_AppendResult(interp, "\": ", reason, (char *) NULL);
5073 }

Variable Documentation
CONST char* badNamespace = "parent namespace doesn't exist" [static]

Definition at line 38 of file tclVar.c.
Referenced by TclLookupSimpleVar().CONST char* danglingElement [static]
Initial value:
        "upvar refers to element in deleted array"
Definition at line 34 of file tclVar.c.
Referenced by TclPtrSetVar().CONST char* danglingVar [static]
Initial value:  
        "upvar refers to variable in deleted namespace"
Definition at line 36 of file tclVar.c.
Referenced by TclLookupArrayElement(), and TclPtrSetVar().Tcl_DupInternalRepProc DupLocalVarName [static]

Definition at line 85 of file tclVar.c.Tcl_DupInternalRepProc DupNsVarName [static]

Definition at line 88 of file tclVar.c.Tcl_DupInternalRepProc DupParsedVarName [static]

Definition at line 90 of file tclVar.c.Tcl_FreeInternalRepProc FreeLocalVarName [static]

Definition at line 84 of file tclVar.c.Tcl_FreeInternalRepProc FreeNsVarName [static]

Definition at line 87 of file tclVar.c.Tcl_FreeInternalRepProc FreeParsedVarName [static]

Definition at line 89 of file tclVar.c.CONST char* isArray = "variable is array" [static]

Definition at line 31 of file tclVar.c.
Referenced by TclPtrGetVar(), and TclPtrSetVar().CONST char* isArrayElement = "name refers to an element in an array" [static]

Definition at line 40 of file tclVar.c.
Referenced by Tcl_VariableObjCmd().CONST char* missingName = "missing variable name" [static]

Definition at line 39 of file tclVar.c.
Referenced by TclLookupSimpleVar().CONST char* needArray = "variable isn't array" [static]

Definition at line 32 of file tclVar.c.
Referenced by TclArraySet(), TclLookupArrayElement(), TclLookupVar(), and TclObjLookupVar().CONST char* noSuchElement = "no such element in array" [static]

Definition at line 33 of file tclVar.c.
Referenced by TclLookupArrayElement(), TclObjUnsetVar2(), and TclPtrGetVar().CONST char* noSuchVar = "no such variable" [static]

Definition at line 30 of file tclVar.c.
Referenced by TclLookupArrayElement(), TclLookupSimpleVar(), TclObjUnsetVar2(), and TclPtrGetVar().Tcl_ObjType tclArraySearchType
Initial value: {
    "array search",
    NULL, NULL, NULL, SetArraySearchObj
}
Definition at line 140 of file tclVar.c.
Referenced by ParseSearchId(), SetArraySearchObj(), and TclInitObjSubsystem().Tcl_ObjType tclLocalVarNameType [static]
Initial value: {
    "localVarName",
    FreeLocalVarName, DupLocalVarName, UpdateLocalVarName, NULL
}
Definition at line 114 of file tclVar.c.
Referenced by DupLocalVarName(), and TclObjLookupVar().Tcl_ObjType tclNsVarNameType [static]
Initial value: {
    "namespaceVarName",
    FreeNsVarName, DupNsVarName, NULL, NULL
}
Definition at line 119 of file tclVar.c.
Referenced by DupNsVarName(), TclObjLookupVar(), and TclObjUnsetVar2().Tcl_ObjType tclParsedVarNameType [static]
Initial value: {
    "parsedVarName",
    FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, NULL
}
Definition at line 124 of file tclVar.c.
Referenced by DupParsedVarName(), and TclObjLookupVar().Tcl_UpdateStringProc UpdateLocalVarName [static]

Definition at line 86 of file tclVar.c.Tcl_UpdateStringProc UpdateParsedVarName [static]

Definition at line 91 of file tclVar.c.

mac/MW_TclAppleScriptHeader.h File Reference
#include "MW_TclAppleScriptHeader68K"

mac/MW_TclBuildLibHeader.h File Reference
#include "MW_TclBuildLibHeader68K"

mac/MW_TclHeader.h File Reference
#include "MW_TclHeader68K"

mac/MW_TclHeaderCommon.h File Reference
#include "tclMacCommonPch.h"
#include "tcl.h"
#include "tclMac.h"
#include "tclInt.h"
#include <MoreFiles.h>
#include <MoreFilesExtras.h>
#include <FSpCompat.h>
#include <FileCopy.h>
#include <FullPath.h>
#include <IterateDirectory.h>
#include <MoreDesktopMgr.h>
#include <DirectoryCopy.h>
#include <Search.h>
Defines
#define TCL_STORAGE_CLASS  DLLIMPORT

Define Documentation
#define TCL_STORAGE_CLASS  DLLIMPORT

Definition at line 31 of file MW_TclHeaderCommon.h.

mac/MW_TclStaticHeader.h File Reference
#include "MW_TclStaticHeader68K"

mac/MW_TclTestHeader.h File Reference
#include "MW_TclTestHeader68K"

mac/tclMac.h File Reference
#include "tcl.h"
#include <Types.h>
#include <Files.h>
#include <Events.h>
#include "tclPlatDecls.h"
Typedefs
typedef int Tcl_MacConvertEventPtr _ANSI_ARGS_ ((EventRecord *eventPtr))

Typedef Documentation
typedef int Tcl_MacConvertEventPtr _ANSI_ARGS_((EventRecord *eventPtr))

Definition at line 24 of file tclMac.h.

mac/tclMacAlloc.c File Reference
#include "tclInt.h"
#include "tclMacInt.h"
#include <Memory.h>
#include <Gestalt.h>
#include <stdlib.h>
#include <string.h>
Classes
struct listEl
Defines
#define MEMORY_ALL_SYS  1
#define MEMORY_DONT_USE_TEMPMEM  2
#define TOOLBOX_SPACE  (512 * 1024)
Typedefs
typedef listEl ListEl
Functions
static pascal void CleanUpExitProc _ANSI_ARGS_ ((void))
void ConfigureMemory _ANSI_ARGS_ ((int flags))
VOID * TclpSysRealloc (VOID *oldPtr, unsigned int size)
VOID * TclpSysAlloc (long size, int isBin)
void TclpSysFree (void *ptr)
static pascal void CleanUpExitProc ()
void FreeAllMemory ()
void ConfigureMemory (int flags)
Variables
static int memoryFlags = 0
static Handle toolGuardHandle = NULL
static int tclUseMemTracking = 0
static size_t tclExtraHdlSize = 0
static ListEl * systemMemory = NULL
static ListEl * appMemory = NULL

Define Documentation
#define MEMORY_ALL_SYS  1

Definition at line 32 of file tclMacAlloc.c.
Referenced by TclpSysAlloc().#define MEMORY_DONT_USE_TEMPMEM  2

Definition at line 34 of file tclMacAlloc.c.
Referenced by TclpSysAlloc().#define TOOLBOX_SPACE  (512 * 1024)

Definition at line 40 of file tclMacAlloc.c.
Referenced by TclpSysAlloc().
Typedef Documentation
typedef struct listEl  ListEl

Function Documentation
void ConfigureMemory _ANSI_ARGS_ ((int flags))
static pascal void CleanUpExitProc _ANSI_ARGS_ ((void)) [static]
static pascal void CleanUpExitProc () [static]

Definition at line 337 of file tclMacAlloc.c.
References listEl::memoryHandle, listEl::next, NULL, systemMemory, and tclUseMemTracking.
Referenced by InitSockets(), and TclpSysAlloc().338 {
339     ListEl * memRecord;
340 
341     if(tclUseMemTracking) {
342     /* Only need to do this when tracking memory */
343     while (systemMemory != NULL) {
344   memRecord = systemMemory;
345   systemMemory = memRecord->next;
346   DisposeHandle(memRecord->memoryHandle);
347     }
348     }
349 }
void ConfigureMemory (int flags)

Definition at line 408 of file tclMacAlloc.c.
References memoryFlags.410 {
411     memoryFlags = flags;
412 }
void FreeAllMemory ()

Definition at line 370 of file tclMacAlloc.c.
References appMemory, listEl::memoryHandle, listEl::next, NULL, systemMemory, and tclUseMemTracking.371 {
372     ListEl * memRecord;
373 
374   if(tclUseMemTracking) {
375   /* Only need to do this when tracking memory */
376     while (systemMemory != NULL) {
377   memRecord = systemMemory;
378   systemMemory = memRecord->next;
379   DisposeHandle(memRecord->memoryHandle);
380     }
381     while (appMemory != NULL) {
382   memRecord = appMemory;
383   appMemory = memRecord->next;
384   DisposeHandle(memRecord->memoryHandle);
385   }
386     }
387 }
VOID* TclpSysAlloc (long size, int isBin)

Definition at line 160 of file tclMacAlloc.c.
References appMemory, CleanUpExitProc(), initialized, MEMORY_ALL_SYS, MEMORY_DONT_USE_TEMPMEM, memoryFlags, listEl::memoryHandle, listEl::next, NULL, listEl::prec, systemMemory, tclExtraHdlSize, TclMacInstallExitToShellPatch(), tclUseMemTracking, TOOLBOX_SPACE, and toolGuardHandle.163 {
164     Handle hand = NULL;
165     ListEl * newMemoryRecord;
166   int isSysMem = 0;
167   static int initialized=0;
168   
169   if (!initialized) {
170   long response = 0;
171   OSErr err = noErr;
172   int useTempMem = 0;
173   
174   /* Check if we can use temporary memory */
175   initialized=1;
176   err = Gestalt(gestaltOSAttr, &response);
177   if (err == noErr) {
178       useTempMem = response & (1 << gestaltRealTempMemory);
179   }
180   tclUseMemTracking = !useTempMem || (memoryFlags & MEMORY_DONT_USE_TEMPMEM);
181   if(tclUseMemTracking) {
182       tclExtraHdlSize = sizeof(ListEl);
183       /*
184        * We are allocating memory directly from the system
185        * heap. We need to install an exit handle 
186        * to ensure the memory is cleaned up.
187        */
188       TclMacInstallExitToShellPatch(CleanUpExitProc);
189   }
190   }
191 
192     if (!(memoryFlags & MEMORY_ALL_SYS)) {
193 
194       /*
195        * If the guard handle has been purged, throw it away and try
196        * to allocate it again.
197        */
198 
199       if ((toolGuardHandle != NULL) && (*toolGuardHandle == NULL)) {
200           DisposeHandle(toolGuardHandle);
201           toolGuardHandle = NULL;
202       }
203 
204       /*
205        * If we have never allocated the guard handle, or it was purged
206        * and thrown away, then try to allocate it again.
207        */
208 
209       if (toolGuardHandle == NULL) {
210           toolGuardHandle = NewHandle(TOOLBOX_SPACE);
211           if (toolGuardHandle != NULL) {
212             HLock(toolGuardHandle);
213             HPurge(toolGuardHandle);
214           }
215       }
216 
217   /*
218    * If we got the handle, lock it and do our allocation.
219    */
220 
221       if (toolGuardHandle != NULL) {
222           HLock(toolGuardHandle);
223       hand = NewHandle(size + tclExtraHdlSize);
224       HUnlock(toolGuardHandle);
225   }
226     }
227     if (hand == NULL) {
228   /*
229    * Ran out of memory in application space.  Lets try to get
230    * more memory from system.  Otherwise, we return NULL to
231    * denote failure.
232    */
233   if(!tclUseMemTracking) {
234     /* Use Temporary Memory instead of System Heap when available */
235     OSErr err;
236     isBin = 1; /* always HLockHi TempMemHandles */
237     hand = TempNewHandle(size + tclExtraHdlSize,&err);
238     if(err!=noErr) { hand=NULL; }
239   } else {
240   /* Use system heap when tracking memory */
241   isSysMem=1;
242   isBin = 0;
243   hand = NewHandleSys(size + tclExtraHdlSize);
244   }
245   }
246   if (hand == NULL) {
247       return NULL;
248   }
249     if (isBin) {
250   HLockHi(hand);
251     } else {
252   HLock(hand);
253     }
254   if(tclUseMemTracking) {
255   /* Only need to do this when tracking memory */
256   newMemoryRecord = (ListEl *) *hand;
257   newMemoryRecord->memoryHandle = hand;
258   newMemoryRecord->prec = NULL;
259   if(isSysMem) {
260   newMemoryRecord->next = systemMemory;
261   systemMemory = newMemoryRecord;
262   } else {
263   newMemoryRecord->next = appMemory;
264   appMemory = newMemoryRecord;
265   }
266   if(newMemoryRecord->next!=NULL) {
267   newMemoryRecord->next->prec=newMemoryRecord;
268   }
269   }
270   
271     return (*hand + tclExtraHdlSize);
272 }
void TclpSysFree (void * ptr)

Definition at line 291 of file tclMacAlloc.c.
References appMemory, listEl::memoryHandle, listEl::next, NULL, listEl::prec, systemMemory, tclExtraHdlSize, and tclUseMemTracking.293 {
294   if(tclUseMemTracking) {
295     /* Only need to do this when tracking memory */
296     ListEl *memRecord;
297 
298     memRecord = (ListEl *) ((Ptr) ptr - tclExtraHdlSize);
299     /* Remove current record from linked list */
300     if(memRecord->next!=NULL) {
301       memRecord->next->prec=memRecord->prec;
302     }
303     if(memRecord->prec!=NULL) {
304       memRecord->prec->next=memRecord->next;
305     }
306     if(memRecord==appMemory) {
307       appMemory=memRecord->next;
308     } else if(memRecord==systemMemory) {
309       systemMemory=memRecord->next;
310     }
311     DisposeHandle(memRecord->memoryHandle);
312   } else {
313     DisposeHandle(RecoverHandle((Ptr) ptr));
314   }
315 }
VOID* TclpSysRealloc (VOID * oldPtr, unsigned int size)

Definition at line 107 of file tclMacAlloc.c.
References listEl::memoryHandle, NULL, tclExtraHdlSize, TclpSysAlloc, TclpSysFree, and tclUseMemTracking.110 {
111     Handle hand;
112     void *newPtr;
113     int maxsize;
114     OSErr err;
115 
116   if (tclUseMemTracking) {
117     hand = ((ListEl *) ((Ptr) oldPtr - tclExtraHdlSize))->memoryHandle;
118     } else {
119     hand = RecoverHandle((Ptr) oldPtr);
120   }
121     maxsize = GetHandleSize(hand) - sizeof(Handle);
122     if (maxsize < size) {
123     HUnlock(hand);
124     SetHandleSize(hand,size + tclExtraHdlSize);
125     err = MemError();
126     HLock(hand);
127     if(err==noErr){
128       newPtr=(*hand + tclExtraHdlSize);
129     } else {
130   newPtr = TclpSysAlloc(size, 1);
131   if(newPtr!=NULL) {
132   memmove(newPtr, oldPtr, maxsize);
133   TclpSysFree(oldPtr);
134   }
135   }
136     } else {
137   newPtr = oldPtr;
138     }
139     return newPtr;
140 }

Variable Documentation
ListEl* appMemory = NULL [static]

Definition at line 77 of file tclMacAlloc.c.
Referenced by FreeAllMemory(), TclpSysAlloc(), and TclpSysFree().int memoryFlags = 0 [static]

Definition at line 42 of file tclMacAlloc.c.
Referenced by ConfigureMemory(), and TclpSysAlloc().ListEl* systemMemory = NULL [static]

Definition at line 76 of file tclMacAlloc.c.
Referenced by CleanUpExitProc(), FreeAllMemory(), TclpSysAlloc(), and TclpSysFree().size_t tclExtraHdlSize = 0 [static]

Definition at line 60 of file tclMacAlloc.c.
Referenced by TclpSysAlloc(), TclpSysFree(), and TclpSysRealloc().int tclUseMemTracking = 0 [static]

Definition at line 54 of file tclMacAlloc.c.
Referenced by CleanUpExitProc(), FreeAllMemory(), TclpSysAlloc(), TclpSysFree(), and TclpSysRealloc().Handle toolGuardHandle = NULL [static]

Definition at line 43 of file tclMacAlloc.c.
Referenced by TclpSysAlloc().

mac/tclMacAppInit.c File Reference
#include "tcl.h"
#include "tclInt.h"
#include "tclPort.h"
#include "tclMac.h"
#include "tclMacInt.h"
Functions
static int MacintoshInit _ANSI_ARGS_ ((void))
void main (int argc, char **argv)
int Tcl_AppInit (Tcl_Interp *interp)
static int MacintoshInit ()

Function Documentation
static int MacintoshInit _ANSI_ARGS_ ((void)) [static]
static int MacintoshInit () [static]

Definition at line 172 of file tclMacAppInit.c.
References TCL_MAC_68K_STACK_GROWTH, Tcl_MacSetEventProc(), and TCL_OK.
Referenced by main().173 {
174 #if GENERATING68K && !GENERATINGCFM
175     SetApplLimit(GetApplLimit() - (TCL_MAC_68K_STACK_GROWTH));
176 #endif
177     MaxApplZone();
178 
179 #if defined(THINK_C)
180 
181     /* Set options for Think C console package */
182     /* The console package calls the Mac init calls */
183     console_options.pause_atexit = 0;
184     console_options.title = "\pTcl Interpreter";
185     
186 #elif defined(__MWERKS__)
187 
188     /* Set options for CodeWarrior SIOUX package */
189     SIOUXSettings.autocloseonquit = true;
190     SIOUXSettings.showstatusline = true;
191     SIOUXSettings.asktosaveonclose = false;
192     SIOUXSettings.wasteusetempmemory = true;    
193     InstallConsole(0);
194     SIOUXSetTitle("\pTcl Interpreter");
195     
196 #elif defined(applec)
197 
198     /* Init packages used by MPW SIOW package */
199     InitGraf((Ptr)&qd.thePort);
200     InitFonts();
201     InitWindows();
202     InitMenus();
203     TEInit();
204     InitDialogs(nil);
205     InitCursor();
206     
207 #endif
208 
209     Tcl_MacSetEventProc((Tcl_MacConvertEventPtr) SIOUXHandleOneEvent);
210     
211     /* No problems with initialization */
212     return TCL_OK;
213 }
void main (int argc, char ** argv)

Definition at line 61 of file tclMacAppInit.c.
References MacintoshInit(), NULL, Tcl_AppInit(), Tcl_Exit(), Tcl_Main(), and TCL_OK.64 {
65     char *newArgv[2];
66     
67     if (MacintoshInit()  != TCL_OK) {
68   Tcl_Exit(1);
69     }
70 
71     argc = 1;
72     newArgv[0] = "tclsh";
73     newArgv[1] = NULL;
74     Tcl_Main(argc, newArgv, Tcl_AppInit);
75 }
int Tcl_AppInit (Tcl_Interp * interp)

Definition at line 97 of file tclMacAppInit.c.
References NULL, Procbodytest_Init(), Procbodytest_SafeInit(), TCL_ERROR, TCL_GLOBAL_ONLY, Tcl_Init(), TCL_OK, Tcl_SetVar(), Tcl_StaticPackage(), TclObjTest_Init(), and Tcltest_Init().
Referenced by main().99 {
100     if (Tcl_Init(interp) == TCL_ERROR) {
101   return TCL_ERROR;
102     }
103 
104 #ifdef TCL_TEST
105     if (Tcltest_Init(interp) == TCL_ERROR) {
106   return TCL_ERROR;
107     }
108     Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
109             (Tcl_PackageInitProc *) NULL);
110     if (TclObjTest_Init(interp) == TCL_ERROR) {
111   return TCL_ERROR;
112     }
113     if (Procbodytest_Init(interp) == TCL_ERROR) {
114   return TCL_ERROR;
115     }
116     Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
117             Procbodytest_SafeInit);
118 #endif /* TCL_TEST */
119 
120     /*
121      * Call the init procedures for included packages.  Each call should
122      * look like this:
123      *
124      * if (Mod_Init(interp) == TCL_ERROR) {
125      *     return TCL_ERROR;
126      * }
127      *
128      * where "Mod" is the name of the module.
129      */
130 
131     /*
132      * Call Tcl_CreateCommand for application-specific commands, if
133      * they weren't already created by the init procedures called above.
134      * Each call would loo like this:
135      *
136      * Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
137      */
138 
139     /*
140      * Specify a user-specific startup script to invoke if the application
141      * is run interactively.  On the Mac we can specifiy either a TEXT resource
142      * which contains the script or the more UNIX like file location
143      * may also used.  (I highly recommend using the resource method.)
144      */
145 
146     Tcl_SetVar(interp, "tcl_rcRsrcName", "tclshrc", TCL_GLOBAL_ONLY);
147     /* Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); */
148 
149     return TCL_OK;
150 }

mac/tclMacBOAAppInit.c File Reference
#include "tcl.h"
#include "tclInt.h"
#include "tclPort.h"
#include "tclMac.h"
#include "tclMacInt.h"
#include <Fonts.h>
#include <Windows.h>
#include <Dialogs.h>
#include <Menus.h>
#include <Aliases.h>
#include <LowMem.h>
#include <AppleEvents.h>
#include <SegLoad.h>
#include <ToolUtils.h>
Functions
void TkMacInitAppleEvents (Tcl_Interp *interp)
int HandleHighLevelEvents (EventRecord *eventPtr)
static int MacintoshInit _ANSI_ARGS_ ((void))
void main (int argc, char **argv)
int Tcl_AppInit (Tcl_Interp *interp)
static int MacintoshInit ()

Function Documentation
static int MacintoshInit _ANSI_ARGS_ ((void)) [static]
int HandleHighLevelEvents (EventRecord * eventPtr)

Definition at line 245 of file tclMacBOAAppInit.c.
Referenced by MacintoshInit().247 {
248     int eventFound = false;
249     
250     if (eventPtr->what == kHighLevelEvent) {
251   AEProcessAppleEvent(eventPtr);
252         eventFound = true;
253     } else if (eventPtr->what == nullEvent) {
254         eventFound = true;
255     }
256     return eventFound;    
257 }
static int MacintoshInit () [static]

Definition at line 211 of file tclMacBOAAppInit.c.
References HandleHighLevelEvents(), TCL_MAC_68K_STACK_GROWTH, Tcl_MacSetEventProc(), and TCL_OK.212 {
213     THz theZone = GetZone();
214     SysEnvRec   sys;
215 
216     
217     /*
218      * There is a bug in systems earlier that 7.5.5, where a second BOA will
219      * get a corrupted heap.  This is the fix from TechNote 1070
220      */
221      
222     SysEnvirons(1, &sys);
223 
224     if (sys.systemVersion < 0x0755)
225     {
226         if ( LMGetHeapEnd() != theZone->bkLim) {
227             LMSetHeapEnd(theZone->bkLim);
228         }
229     }
230     
231 #if GENERATING68K && !GENERATINGCFM
232     SetApplLimit(GetApplLimit() - (TCL_MAC_68K_STACK_GROWTH));
233 #endif
234     MaxApplZone();
235 
236     InitGraf((Ptr)&qd.thePort);
237             
238     /* No problems with initialization */
239     Tcl_MacSetEventProc(HandleHighLevelEvents);
240 
241     return TCL_OK;
242 }
void main (int argc, char ** argv)

Definition at line 72 of file tclMacBOAAppInit.c.
References MacintoshInit(), NULL, Tcl_AppInit(), Tcl_Exit(), Tcl_Main(), and TCL_OK.75 {
76     char *newArgv[3];
77     
78     if (MacintoshInit()  != TCL_OK) {
79   Tcl_Exit(1);
80     }
81 
82     argc = 2;
83     newArgv[0] = "tclsh";
84     newArgv[1] = "bgScript.tcl";
85     newArgv[2] = NULL;
86     Tcl_Main(argc, newArgv, Tcl_AppInit);
87 }
int Tcl_AppInit (Tcl_Interp * interp)

Definition at line 109 of file tclMacBOAAppInit.c.
References NULL, TCL_ERROR, TCL_GLOBAL_ONLY, Tcl_Init(), TCL_OK, Tcl_OpenFileChannel(), Tcl_RegisterChannel(), Tcl_SetChannelOption(), Tcl_SetStdChannel(), Tcl_SetVar(), Tcl_StaticPackage(), TCL_STDERR, TCL_STDIN, TCL_STDOUT, TclObjTest_Init(), Tcltest_Init(), and TkMacInitAppleEvents().111 {
112     Tcl_Channel tempChan;
113     
114     if (Tcl_Init(interp) == TCL_ERROR) {
115   return TCL_ERROR;
116     }
117 
118 #ifdef TCL_TEST
119     if (Tcltest_Init(interp) == TCL_ERROR) {
120   return TCL_ERROR;
121     }
122     Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
123             (Tcl_PackageInitProc *) NULL);
124     if (TclObjTest_Init(interp) == TCL_ERROR) {
125   return TCL_ERROR;
126     }
127 #endif /* TCL_TEST */
128 
129     /*
130      * Call the init procedures for included packages.  Each call should
131      * look like this:
132      *
133      * if (Mod_Init(interp) == TCL_ERROR) {
134      *     return TCL_ERROR;
135      * }
136      *
137      * where "Mod" is the name of the module.
138      */
139 
140     /*
141      * Call Tcl_CreateCommand for application-specific commands, if
142      * they weren't already created by the init procedures called above.
143      * Each call would loo like this:
144      *
145      * Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
146      */
147 
148     /*
149      * Specify a user-specific startup script to invoke if the application
150      * is run interactively.  On the Mac we can specifiy either a TEXT resource
151      * which contains the script or the more UNIX like file location
152      * may also used.  (I highly recommend using the resource method.)
153      */
154 
155     Tcl_SetVar(interp, "tcl_rcRsrcName", "tclshrc", TCL_GLOBAL_ONLY);
156 
157     /* Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); */
158 
159     /*
160      * We have to support at least the quit Apple Event. 
161      */
162     
163     TkMacInitAppleEvents(interp);
164     
165     /* 
166      * Open a file channel to put stderr, stdin, stdout... 
167      */
168     
169     tempChan = Tcl_OpenFileChannel(interp, ":temp.in", "a+", 0);
170     Tcl_SetStdChannel(tempChan,TCL_STDIN);
171     Tcl_RegisterChannel(interp, tempChan);
172     Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
173     Tcl_SetChannelOption(NULL, tempChan, "-buffering", "line");
174 
175     tempChan = Tcl_OpenFileChannel(interp, ":temp.out", "a+", 0);
176     Tcl_SetStdChannel(tempChan,TCL_STDOUT);
177     Tcl_RegisterChannel(interp, tempChan);
178     Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
179     Tcl_SetChannelOption(NULL, tempChan, "-buffering", "line");
180 
181     tempChan = Tcl_OpenFileChannel(interp, ":temp.err", "a+", 0);
182     Tcl_SetStdChannel(tempChan,TCL_STDERR);
183     Tcl_RegisterChannel(interp, tempChan);
184     Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
185     Tcl_SetChannelOption(NULL, tempChan, "-buffering", "none");
186    
187     
188     return TCL_OK;
189 }
void TkMacInitAppleEvents (Tcl_Interp * interp)

Referenced by Tcl_AppInit().

mac/tclMacBOAMain.c File Reference
#include "tcl.h"
#include "tclInt.h"
#include "tclMacInt.h"
#include <Resources.h>
#include <Notification.h>
#include <Strings.h>
Functions
EXTERN int Tcl_LinkVar ()
int isatty _ANSI_ARGS_ ((int fd))
char *strcpy _ANSI_ARGS_ ((char *dst, CONST char *src))
void TclMacDoNotification (char *mssg)
void TclMacNotificationResponse (NMRecPtr nmRec)
int Tcl_MacBGNotifyObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv)
void Tcl_Main (int argc, char **argv, Tcl_AppInitProc *appInitProc)
int Tcl_MacBGNotifyObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj **objv)
Variables
int NotificationIsDone = 0
int(*) tclDummyLinkVarPtr () = Tcl_LinkVar
static Tcl_Interp * interp

Function Documentation
char* strcpy _ANSI_ARGS_ ((char *dst, CONST char *src))
int isatty _ANSI_ARGS_ ((int fd))
EXTERN int Tcl_LinkVar ()
int Tcl_MacBGNotifyObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj ** objv)

Definition at line 285 of file tclMacBOAMain.c.
References TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), TCL_OK, Tcl_WrongNumArgs(), and TclMacDoNotification().290 {
291     Tcl_Obj *resultPtr;
292     
293     resultPtr = Tcl_GetObjResult(interp);
294     
295     if ( objc != 2 ) {
296         Tcl_WrongNumArgs(interp, 1, objv, "message");
297         return TCL_ERROR;
298     }
299     
300     TclMacDoNotification(Tcl_GetString(objv[1]));
301     return TCL_OK;
302            
303 }
int Tcl_MacBGNotifyObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *const * objv)

Referenced by Tcl_Main().void Tcl_Main (int argc, char ** argv, Tcl_AppInitProc * appInitProc)

Definition at line 81 of file tclMacBOAMain.c.
References ckfree, NULL, Tcl_CreateInterp(), Tcl_CreateObjCommand(), Tcl_DecrRefCount, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, Tcl_Eval(), Tcl_EvalFile(), Tcl_FindExecutable(), Tcl_GetStringResult(), TCL_GLOBAL_ONLY, Tcl_InitMemory, Tcl_MacBGNotifyObjCmd(), Tcl_MacEvalResource(), Tcl_Merge(), TCL_OK, Tcl_SetVar(), TclFormatInt(), and TclMacDoNotification().89 {
90     Tcl_Obj *prompt1NamePtr = NULL;
91     Tcl_Obj *prompt2NamePtr = NULL;
92     Tcl_Obj *commandPtr = NULL;
93     char buffer[1000], *args, *fileName;
94     int code, tty;
95     int exitCode = 0;
96 
97     Tcl_FindExecutable(argv[0]);
98     interp = Tcl_CreateInterp();
99     Tcl_InitMemory(interp);
100 
101     /*
102      * Make command-line arguments available in the Tcl variables "argc"
103      * and "argv".  If the first argument doesn't start with a "-" then
104      * strip it off and use it as the name of a script file to process.
105      */
106 
107     fileName = NULL;
108     if ((argc > 1) && (argv[1][0] != '-')) {
109   fileName = argv[1];
110   argc--;
111   argv++;
112     }
113     args = Tcl_Merge(argc-1, argv+1);
114     Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
115     ckfree(args);
116     TclFormatInt(buffer, argc-1);
117     Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);
118     Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
119       TCL_GLOBAL_ONLY);
120 
121     /*
122      * Set the "tcl_interactive" variable.
123      */
124 
125     tty = isatty(0);
126     Tcl_SetVar(interp, "tcl_interactive",
127       ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
128     
129     /*
130      * Invoke application-specific initialization.
131      */
132 
133     if ((*appInitProc)(interp) != TCL_OK) {
134   Tcl_DString errStr;
135 
136   Tcl_DStringInit(&errStr);
137   Tcl_DStringAppend(&errStr,
138     "application-specific initialization failed: \n", -1);
139   Tcl_DStringAppend(&errStr, Tcl_GetStringResult(interp), -1);
140   Tcl_DStringAppend(&errStr, "\n", 1);
141   TclMacDoNotification(Tcl_DStringValue(&errStr));
142   Tcl_DStringFree(&errStr);
143   goto done;
144     }
145 
146     /*
147      * Install the BGNotify command:
148      */
149     
150     if ( Tcl_CreateObjCommand(interp, "bgnotify", Tcl_MacBGNotifyObjCmd, NULL,
151              (Tcl_CmdDeleteProc *) NULL) == NULL) {
152         goto done;
153     }
154     
155     /*
156      * If a script file was specified then just source that file
157      * and quit.  In this Mac BG Application version, we will try the
158      * resource fork first, then the file system second...
159      */
160 
161     if (fileName != NULL) {
162         Str255 resName;
163         Handle resource;
164         
165         strcpy((char *) resName + 1, fileName);
166         resName[0] = strlen(fileName);
167         resource = GetNamedResource('TEXT',resName);
168         if (resource != NULL) {
169             code = Tcl_MacEvalResource(interp, fileName, -1, NULL);
170         } else {
171             code = Tcl_EvalFile(interp, fileName);
172         }
173         
174   if (code != TCL_OK) {
175             Tcl_DString errStr;
176             
177             Tcl_DStringInit(&errStr);
178             Tcl_DStringAppend(&errStr, " Error sourcing resource or file: ", -1);
179             Tcl_DStringAppend(&errStr, fileName, -1);
180             Tcl_DStringAppend(&errStr, "\n\nError was: ", -1);
181             Tcl_DStringAppend(&errStr, Tcl_GetStringResult(interp), -1);
182             TclMacDoNotification(Tcl_DStringValue(&errStr));
183       Tcl_DStringFree(&errStr);
184         }
185   goto done;
186     }
187 
188 
189     /*
190      * Rather than calling exit, invoke the "exit" command so that
191      * users can replace "exit" with some other command to do additional
192      * cleanup on exit.  The Tcl_Eval call should never return.
193      */
194 
195     done:
196     if (commandPtr != NULL) {
197   Tcl_DecrRefCount(commandPtr);
198     }
199     if (prompt1NamePtr != NULL) {
200   Tcl_DecrRefCount(prompt1NamePtr);
201     }
202     if (prompt2NamePtr != NULL) {
203   Tcl_DecrRefCount(prompt2NamePtr);
204     }
205     sprintf(buffer, "exit %d", exitCode);
206     Tcl_Eval(interp, buffer);
207 }
void TclMacDoNotification (char * mssg)

Definition at line 224 of file tclMacBOAMain.c.
References NotificationIsDone, NULL, and TclMacNotificationResponse().
Referenced by Tcl_MacBGNotifyObjCmd(), and Tcl_Main().226 {
227     NMRec errorNot;
228     EventRecord *theEvent = NULL;
229     OSErr err;
230     char *ptr;
231     
232     errorNot.qType = nmType;
233     errorNot.nmMark = 0;
234     errorNot.nmIcon = 0;
235     errorNot.nmSound = (Handle) -1;
236 
237     for ( ptr = mssg; *ptr != '\0'; ptr++) {
238         if (*ptr == '\n') {
239             *ptr = '\r';
240         }
241     }
242         
243     c2pstr(mssg);
244     errorNot.nmStr = (StringPtr) mssg;
245 
246     errorNot.nmResp = NewNMProc(TclMacNotificationResponse);
247     errorNot.nmRefCon = SetCurrentA5();
248     
249     NotificationIsDone = 0;
250     
251     /*
252      * Cycle while waiting for the user to click on the
253      * notification box.  Don't take any events off the event queue,
254      * since we want Tcl to do this but we want to block till the notification
255      * has been handled...
256      */
257     
258     err = NMInstall(&errorNot);
259     if (err == noErr) { 
260         while (!NotificationIsDone) {
261             WaitNextEvent(0, theEvent, 20, NULL);
262         }
263         NMRemove(&errorNot);
264     }
265       
266     p2cstr((unsigned char *) mssg);
267 }
void TclMacNotificationResponse (NMRecPtr nmRec)

Definition at line 270 of file tclMacBOAMain.c.
References NotificationIsDone.
Referenced by TclMacDoNotification().272 {
273     int curA5;
274     
275     curA5 = SetCurrentA5();
276     SetA5(nmRec->nmRefCon);
277     
278     NotificationIsDone = 1;
279     
280     SetA5(curA5);
281     
282 }

Variable Documentation
Tcl_Interp* interp [static]

Definition at line 50 of file tclMacBOAMain.c.int NotificationIsDone = 0

Definition at line 26 of file tclMacBOAMain.c.
Referenced by TclMacDoNotification(), and TclMacNotificationResponse().int(*) tclDummyLinkVarPtr() = Tcl_LinkVar

Definition at line 36 of file tclMacBOAMain.c.

mac/tclMacChan.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include "tclMacInt.h"
#include <Aliases.h>
#include <Errors.h>
#include <Files.h>
#include <Gestalt.h>
#include <Processes.h>
#include <Strings.h>
#include <FSpCompat.h>
#include <MoreFiles.h>
#include <MoreFilesExtras.h>
#include "tclIO.h"
Classes
struct FileState
struct ThreadSpecificData
struct FileEvent
Defines
#define TCL_FILE_CREATOR  'MPW '
Typedefs
typedef void TclGetStdChannelsProc _ANSI_ARGS_ ((Tcl_Channel *stdinPtr, Tcl_Channel *stdoutPtr, Tcl_Channel *stderrPtr))
Functions
static int CommonGetHandle _ANSI_ARGS_ ((ClientData instanceData, int direction, ClientData *handlePtr))
static void CommonWatch _ANSI_ARGS_ ((ClientData instanceData, int mask))
static void FileChannelExitHandler _ANSI_ARGS_ ((ClientData clientData))
static void FileCheckProc _ANSI_ARGS_ ((ClientData clientData, int flags))
static int FileClose _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp))
static int FileEventProc _ANSI_ARGS_ ((Tcl_Event *evPtr, int flags))
static ThreadSpecificData *FileInit _ANSI_ARGS_ ((void))
static int FileInput _ANSI_ARGS_ ((ClientData instanceData, char *buf, int toRead, int *errorCode))
static int FileOutput _ANSI_ARGS_ ((ClientData instanceData, CONST char *buf, int toWrite, int *errorCode))
static int FileSeek _ANSI_ARGS_ ((ClientData instanceData, long offset, int mode, int *errorCode))
static Tcl_Channel OpenFileChannel _ANSI_ARGS_ ((CONST char *fileName, int mode, int permissions, int *errorCodePtr))
static ThreadSpecificData * FileInit ()
static void FileChannelExitHandler (ClientData clientData)
void FileSetupProc (ClientData data, int flags)
static void FileCheckProc (ClientData data, int flags)
static int FileEventProc (Tcl_Event *evPtr, int flags)
static int StdIOBlockMode (ClientData instanceData, int mode)
static int StdIOClose (ClientData instanceData, Tcl_Interp *interp)
static int CommonGetHandle (ClientData instanceData, int direction, ClientData *handlePtr)
int StdIOInput (ClientData instanceData, char *buf, int bufSize, int *errorCode)
static int StdIOOutput (ClientData instanceData, CONST char *buf, int toWrite, int *errorCode)
static int StdIOSeek (ClientData instanceData, long offset, int mode, int *errorCodePtr)
int Tcl_PidObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST *objv)
Tcl_Channel TclpGetDefaultStdChannel (int type)
Tcl_Channel TclpOpenFileChannel (Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions)
static Tcl_Channel OpenFileChannel (CONST char *fileName, int mode, int permissions, int *errorCodePtr)
Tcl_Channel Tcl_MakeFileChannel (ClientData handle, int mode)
static int FileBlockMode (ClientData instanceData, int mode)
static int FileClose (ClientData instanceData, Tcl_Interp *interp)
int FileInput (ClientData instanceData, char *buffer, int bufSize, int *errorCodePtr)
static int FileOutput (ClientData instanceData, CONST char *buffer, int toWrite, int *errorCodePtr)
static int FileSeek (ClientData instanceData, long offset, int mode, int *errorCodePtr)
static void CommonWatch (ClientData instanceData, int mask)
static void FileThreadActionProc (ClientData instanceData, int action)
Variables
static Tcl_ThreadDataKey dataKey
static Tcl_ChannelType consoleChannelType
static Tcl_ChannelType fileChannelType
TclGetStdChannelsProc getStdChannelsProc = NULL

Define Documentation
#define TCL_FILE_CREATOR  'MPW '

Definition at line 33 of file tclMacChan.c.
Referenced by OpenFileChannel().
Typedef Documentation
typedef void TclGetStdChannelsProc _ANSI_ARGS_((Tcl_Channel *stdinPtr,Tcl_Channel *stdoutPtr, Tcl_Channel *stderrPtr))

Definition at line 173 of file tclMacChan.c.
Function Documentation
static Tcl_Channel OpenFileChannel _ANSI_ARGS_ ((CONST char *fileName, int mode, int permissions, int *errorCodePtr)) [static]
static int FileSeek _ANSI_ARGS_ ((ClientData instanceData, long offset, int mode, int *errorCode)) [static]
static int FileOutput _ANSI_ARGS_ ((ClientData instanceData, CONST char *buf, int toWrite, int *errorCode)) [static]
static int FileInput _ANSI_ARGS_ ((ClientData instanceData, char *buf, int toRead, int *errorCode)) [static]
static ThreadSpecificData* FileInit _ANSI_ARGS_ ((void)) [static]
static int FileEventProc _ANSI_ARGS_ ((Tcl_Event *evPtr, int flags)) [static]
static int FileClose _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp)) [static]
static void FileCheckProc _ANSI_ARGS_ ((ClientData clientData, int flags)) [static]
static void FileChannelExitHandler _ANSI_ARGS_ ((ClientData clientData)) [static]
static void CommonWatch _ANSI_ARGS_ ((ClientData instanceData, int mask)) [static]
static int CommonGetHandle _ANSI_ARGS_ ((ClientData instanceData, int direction, ClientData *handlePtr)) [static]
static int CommonGetHandle (ClientData instanceData, int direction, ClientData * handlePtr) [static]

Definition at line 478 of file tclMacChan.c.
References TCL_ERROR, TCL_OK, TCL_READABLE, and TCL_WRITABLE.482 {
483     if ((direction == TCL_READABLE) || (direction == TCL_WRITABLE)) {
484   *handlePtr = (ClientData) ((FileState*)instanceData)->fileRef;
485   return TCL_OK;
486     }
487     return TCL_ERROR;
488 }
static void CommonWatch (ClientData instanceData, int mask) [static]

Definition at line 1210 of file tclMacChan.c.
References Tcl_SetMaxBlockTime(), and FileState::watchMask.1215 {
1216     FileState *infoPtr = (FileState *) instanceData;
1217     Tcl_Time blockTime = { 0, 0 };
1218 
1219     infoPtr->watchMask = mask;
1220     if (infoPtr->watchMask) {
1221   Tcl_SetMaxBlockTime(&blockTime);
1222     }
1223 }
static int FileBlockMode (ClientData instanceData, int mode) [static]

Definition at line 967 of file tclMacChan.c.970 {
971     return 0;
972 }
static void FileChannelExitHandler (ClientData clientData) [static]

Definition at line 227 of file tclMacChan.c.
References FileCheckProc(), FileSetupProc(), NULL, and Tcl_DeleteEventSource().
Referenced by FileInit().229 {
230     Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
231 }
static void FileCheckProc (ClientData data, int flags) [static]

Definition at line 294 of file tclMacChan.c.
References ckalloc, dataKey, FileEventProc(), ThreadSpecificData::firstFilePtr, FileEvent::header, FileEvent::infoPtr, FileState::nextPtr, NULL, FileState::pending, Tcl_Event::proc, TCL_FILE_EVENTS, TCL_QUEUE_TAIL, Tcl_QueueEvent(), TCL_TSD_INIT, and FileState::watchMask.
Referenced by FileChannelExitHandler(), and FileInit().297 {
298     FileEvent *evPtr;
299     FileState *infoPtr;
300     int sentMsg = 0;
301     Tcl_Time blockTime = { 0, 0 };
302     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
303 
304     if (!(flags & TCL_FILE_EVENTS)) {
305   return;
306     }
307     
308     /*
309      * Queue events for any ready files that don't already have events
310      * queued (caused by persistent states that won't generate WinSock
311      * events).
312      */
313 
314     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
315       infoPtr = infoPtr->nextPtr) {
316   if (infoPtr->watchMask && !infoPtr->pending) {
317       infoPtr->pending = 1;
318       evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
319       evPtr->header.proc = FileEventProc;
320       evPtr->infoPtr = infoPtr;
321       Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
322   }
323     }
324 }
static int FileClose (ClientData instanceData, Tcl_Interp * interp) [static]

Definition at line 991 of file tclMacChan.c.
References ckfree, errno, FileState::fileRef, NULL, panic, Tcl_SetErrno(), TclMacOSErrorToPosixError(), and FileState::volumeRef.994 {
995     FileState *fileState = (FileState *) instanceData;
996     int errorCode = 0;
997     OSErr err;
998 
999     err = FSClose(fileState->fileRef);
1000     FlushVol(NULL, fileState->volumeRef);
1001     if (err != noErr) {
1002   errorCode = errno = TclMacOSErrorToPosixError(err);
1003   panic("error during file close");
1004     }
1005 
1006     ckfree((char *) fileState);
1007     Tcl_SetErrno(errorCode);
1008     return errorCode;
1009 }
static int FileEventProc (Tcl_Event * evPtr, int flags) [static]

Definition at line 347 of file tclMacChan.c.
References dataKey, FileState::fileChan, ThreadSpecificData::firstFilePtr, FileEvent::infoPtr, FileState::nextPtr, NULL, FileState::pending, TCL_FILE_EVENTS, Tcl_NotifyChannel(), TCL_TSD_INIT, and FileState::watchMask.
Referenced by FileCheckProc().351 {
352     FileEvent *fileEvPtr = (FileEvent *)evPtr;
353     FileState *infoPtr;
354     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
355 
356     if (!(flags & TCL_FILE_EVENTS)) {
357   return 0;
358     }
359 
360     /*
361      * Search through the list of watched files for the one whose handle
362      * matches the event.  We do this rather than simply dereferencing
363      * the handle in the event so that files can be deleted while the
364      * event is in the queue.
365      */
366 
367     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
368       infoPtr = infoPtr->nextPtr) {
369   if (fileEvPtr->infoPtr == infoPtr) {
370       infoPtr->pending = 0;
371       Tcl_NotifyChannel(infoPtr->fileChan, infoPtr->watchMask);
372       break;
373   }
374     }
375     return 1;
376 }
static ThreadSpecificData* FileInit () [static]

Definition at line 196 of file tclMacChan.c.
References dataKey, FileChannelExitHandler(), FileCheckProc(), FileSetupProc(), ThreadSpecificData::firstFilePtr, Tcl_CreateEventSource(), Tcl_CreateThreadExitHandler(), TCL_TSD_INIT, and TclThreadDataKeyGet().
Referenced by OpenFileChannel(), TclWinFlushDirtyChannels(), and TclWinOpenFileChannel().197 {
198     ThreadSpecificData *tsdPtr =
199   (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
200     if (tsdPtr == NULL) {
201   tsdPtr = TCL_TSD_INIT(&dataKey);
202   tsdPtr->firstFilePtr = NULL;
203   Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
204   Tcl_CreateThreadExitHandler(FileChannelExitHandler, NULL);
205     }
206     return tsdPtr;
207 }
int FileInput (ClientData instanceData, char * buffer, int bufSize, int * errorCodePtr)

Definition at line 1030 of file tclMacChan.c.
References EACCES, EINVAL, EIO, errno, and FileState::fileRef.1036 {
1037     FileState *fileState = (FileState *) instanceData;
1038     OSErr err;
1039     long length = bufSize;
1040 
1041     *errorCodePtr = 0;
1042     errno = 0;
1043     err = FSRead(fileState->fileRef, &length, buffer);
1044     if ((err == noErr) || (err == eofErr)) {
1045   return length;
1046     } else {
1047   switch (err) {
1048       case ioErr:
1049     *errorCodePtr = errno = EIO;
1050       case afpAccessDenied:
1051     *errorCodePtr = errno = EACCES;
1052       default:
1053     *errorCodePtr = errno = EINVAL;
1054   }
1055         return -1;  
1056     }
1057     *errorCodePtr = errno;
1058     return -1;
1059 }
static int FileOutput (ClientData instanceData, CONST char * buffer, int toWrite, int * errorCodePtr) [static]

Definition at line 1080 of file tclMacChan.c.
References FileState::appendMode, errno, FileState::fileRef, FileSeek(), SEEK_END, and TclMacOSErrorToPosixError().1085 {
1086     FileState *fileState = (FileState *) instanceData;
1087     long length = toWrite;
1088     OSErr err;
1089 
1090     *errorCodePtr = 0;
1091     errno = 0;
1092     
1093     if (fileState->appendMode == true) {
1094   FileSeek(instanceData, 0, SEEK_END, errorCodePtr);
1095   *errorCodePtr = 0;
1096     }
1097     
1098     err = FSWrite(fileState->fileRef, &length, buffer);
1099     if (err == noErr) {
1100   err = FlushFile(fileState->fileRef);
1101     } else {
1102   *errorCodePtr = errno = TclMacOSErrorToPosixError(err);
1103   return -1;
1104     }
1105     return length;
1106 }
static int FileSeek (ClientData instanceData, long offset, int mode, int * errorCodePtr) [static]

Definition at line 1127 of file tclMacChan.c.
References errno, FileState::fileRef, NULL, SEEK_CUR, SEEK_END, SEEK_SET, and TclMacOSErrorToPosixError().
Referenced by FileOutput().1132 {
1133     FileState *fileState = (FileState *) instanceData;
1134     IOParam pb;
1135     OSErr err;
1136 
1137     *errorCodePtr = 0;
1138     pb.ioCompletion = NULL;
1139     pb.ioRefNum = fileState->fileRef;
1140     if (mode == SEEK_SET) {
1141   pb.ioPosMode = fsFromStart;
1142     } else if (mode == SEEK_END) {
1143   pb.ioPosMode = fsFromLEOF;
1144     } else if (mode == SEEK_CUR) {
1145   err = PBGetFPosSync((ParmBlkPtr) &pb);
1146   if (pb.ioResult == noErr) {
1147       if (offset == 0) {
1148     return pb.ioPosOffset;
1149       }
1150       offset += pb.ioPosOffset;
1151   }
1152   pb.ioPosMode = fsFromStart;
1153     }
1154     pb.ioPosOffset = offset;
1155     err = PBSetFPosSync((ParmBlkPtr) &pb);
1156     if (pb.ioResult == noErr){
1157   return pb.ioPosOffset;
1158     } else if (pb.ioResult == eofErr) {
1159   long currentEOF, newEOF;
1160   long buffer, i, length;
1161   
1162   err = PBGetEOFSync((ParmBlkPtr) &pb);
1163   currentEOF = (long) pb.ioMisc;
1164   if (mode == SEEK_SET) {
1165       newEOF = offset;
1166   } else if (mode == SEEK_END) {
1167       newEOF = offset + currentEOF;
1168   } else if (mode == SEEK_CUR) {
1169       err = PBGetFPosSync((ParmBlkPtr) &pb);
1170       newEOF = offset + pb.ioPosOffset;
1171   }
1172   
1173   /*
1174    * Write 0's to the new EOF.
1175    */
1176   pb.ioPosOffset = 0;
1177   pb.ioPosMode = fsFromLEOF;
1178   err = PBGetFPosSync((ParmBlkPtr) &pb);
1179   length = 1;
1180   buffer = 0;
1181   for (i = 0; i < (newEOF - currentEOF); i++) {
1182       err = FSWrite(fileState->fileRef, &length, &buffer);
1183   }
1184   err = PBGetFPosSync((ParmBlkPtr) &pb);
1185   if (pb.ioResult == noErr){
1186       return pb.ioPosOffset;
1187   }
1188     }
1189     *errorCodePtr = errno = TclMacOSErrorToPosixError(err);
1190     return -1;
1191 }
void FileSetupProc (ClientData data, int flags)

Definition at line 251 of file tclMacChan.c.
References dataKey, ThreadSpecificData::firstFilePtr, FileState::nextPtr, NULL, TCL_FILE_EVENTS, Tcl_SetMaxBlockTime(), TCL_TSD_INIT, and FileState::watchMask.
Referenced by FileChannelExitHandler(), and FileInit().254 {
255     FileState *infoPtr;
256     Tcl_Time blockTime = { 0, 0 };
257     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
258 
259     if (!(flags & TCL_FILE_EVENTS)) {
260   return;
261     }
262     
263     /*
264      * Check to see if there is a ready file.  If so, poll.
265      */
266 
267     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
268       infoPtr = infoPtr->nextPtr) {
269   if (infoPtr->watchMask) {
270       Tcl_SetMaxBlockTime(&blockTime);
271       break;
272   }
273     }
274 }
static void FileThreadActionProc (ClientData instanceData, int action) [static]

Definition at line 1242 of file tclMacChan.c.
References dataKey, ThreadSpecificData::firstFilePtr, FileState::nextPtr, NULL, panic, TCL_CHANNEL_THREAD_INSERT, and TCL_TSD_INIT.
Referenced by FileCloseProc().1245 {
1246     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1247     FileState *infoPtr = (FileState *) instanceData;
1248 
1249     if (action == TCL_CHANNEL_THREAD_INSERT) {
1250   infoPtr->nextPtr = tsdPtr->firstFilePtr;
1251   tsdPtr->firstFilePtr = infoPtr;
1252     } else {
1253   FileState **nextPtrPtr;
1254   int removed = 0;
1255 
1256   for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
1257        nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
1258       if ((*nextPtrPtr) == infoPtr) {
1259           (*nextPtrPtr) = infoPtr->nextPtr;
1260     removed = 1;
1261     break;
1262       }
1263   }
1264 
1265   /*
1266    * This could happen if the channel was created in one thread
1267    * and then moved to another without updating the thread
1268    * local data in each thread.
1269    */
1270 
1271   if (!removed) {
1272       panic("file info ptr not on thread channel list");
1273   }
1274     }
1275 }
static Tcl_Channel OpenFileChannel (CONST char * fileName, int mode, int permissions, int * errorCodePtr) [static]

Definition at line 801 of file tclMacChan.c.
References ckalloc, ckfree, EEXIST, EFAULT, errno, fileChannelType, FileInit(), ThreadSpecificData::firstFilePtr, FSpLocationFromPath(), NULL, SEEK_END, Tcl_Close(), Tcl_CreateChannel(), TCL_FILE_CREATOR, TCL_INTEGER_SPACE, TCL_READABLE, Tcl_Seek(), Tcl_SetErrno(), TCL_WRITABLE, TclMacOSErrorToPosixError(), and FileState::volumeRef.
Referenced by TclpOpenFileChannel().808 {
809     int channelPermissions;
810     Tcl_Channel chan;
811     char macPermision;
812     FSSpec fileSpec;
813     OSErr err;
814     short fileRef;
815     FileState *fileState;
816     char channelName[16 + TCL_INTEGER_SPACE];
817     ThreadSpecificData *tsdPtr;
818     
819     tsdPtr = FileInit();
820 
821     /*
822      * Note we use fsRdWrShPerm instead of fsRdWrPerm which allows shared
823      * writes on a file.  This isn't common on a mac but is common with 
824      * Windows and UNIX and the feature is used by Tcl.
825      */
826 
827     switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
828   case O_RDWR:
829       channelPermissions = (TCL_READABLE | TCL_WRITABLE);
830       macPermision = fsRdWrShPerm;
831       break;
832   case O_WRONLY:
833       /*
834        * Mac's fsRdPerm permission actually defaults to fsRdWrPerm because
835        * the Mac OS doesn't realy support write only access.  We explicitly
836        * set the permission fsRdWrShPerm so that we can have shared write
837        * access.
838        */
839       channelPermissions = TCL_WRITABLE;
840       macPermision = fsRdWrShPerm;
841       break;
842   case O_RDONLY:
843   default:
844       channelPermissions = TCL_READABLE;
845       macPermision = fsRdPerm;
846       break;
847     }
848      
849     err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
850     if ((err != noErr) && (err != fnfErr)) {
851   *errorCodePtr = errno = TclMacOSErrorToPosixError(err);
852   Tcl_SetErrno(errno);
853   return NULL;
854     }
855 
856     if ((err == fnfErr) && (mode & O_CREAT)) {
857   err = HCreate(fileSpec.vRefNum, fileSpec.parID, fileSpec.name, TCL_FILE_CREATOR, 'TEXT');
858   if (err != noErr) {
859       *errorCodePtr = errno = TclMacOSErrorToPosixError(err);
860       Tcl_SetErrno(errno);
861       return NULL;
862   }
863     } else if ((mode & O_CREAT) && (mode & O_EXCL)) {
864         *errorCodePtr = errno = EEXIST;
865   Tcl_SetErrno(errno);
866         return NULL;
867     }
868 
869     err = HOpenDF(fileSpec.vRefNum, fileSpec.parID, fileSpec.name, macPermision, &fileRef);
870     if (err != noErr) {
871   *errorCodePtr = errno = TclMacOSErrorToPosixError(err);
872   Tcl_SetErrno(errno);
873   return NULL;
874     }
875 
876     if (mode & O_TRUNC) {
877   SetEOF(fileRef, 0);
878     }
879     
880     sprintf(channelName, "file%d", (int) fileRef);
881     fileState = (FileState *) ckalloc((unsigned) sizeof(FileState));
882     chan = Tcl_CreateChannel(&fileChannelType, channelName, 
883   (ClientData) fileState, channelPermissions);
884     if (chan == (Tcl_Channel) NULL) {
885   *errorCodePtr = errno = EFAULT;
886   Tcl_SetErrno(errno);
887   FSClose(fileRef);
888   ckfree((char *) fileState);
889         return NULL;
890     }
891 
892     fileState->fileChan = chan;
893     fileState->nextPtr = tsdPtr->firstFilePtr;
894     tsdPtr->firstFilePtr = fileState;
895     fileState->volumeRef = fileSpec.vRefNum;
896     fileState->fileRef = fileRef;
897     fileState->pending = 0;
898     fileState->watchMask = 0;
899     if (mode & O_APPEND) {
900   fileState->appendMode = true;
901     } else {
902   fileState->appendMode = false;
903     }
904         
905     if ((mode & O_APPEND) || (mode & O_APPEND)) {
906         if (Tcl_Seek(chan, 0, SEEK_END) < 0) {
907       *errorCodePtr = errno = EFAULT;
908       Tcl_SetErrno(errno);
909             Tcl_Close(NULL, chan);
910             FSClose(fileRef);
911             ckfree((char *) fileState);
912             return NULL;
913         }
914     }
915     
916     return chan;
917 }
static int StdIOBlockMode (ClientData instanceData, int mode) [static]

Definition at line 395 of file tclMacChan.c.
References EFAULT, and TCL_MODE_NONBLOCKING.398 {
399     /*
400      * Do not allow putting stdin, stdout or stderr into nonblocking mode.
401      */
402     
403     if (mode == TCL_MODE_NONBLOCKING) {
404   return EFAULT;
405     }
406     
407     return 0;
408 }
static int StdIOClose (ClientData instanceData, Tcl_Interp * interp) [static]

Definition at line 427 of file tclMacChan.c.
References dataKey, errno, NULL, panic, ThreadSpecificData::stderrChannel, ThreadSpecificData::stdinChannel, ThreadSpecificData::stdoutChannel, TCL_TSD_INIT, and TclInThreadExit().430 {
431     int fd, errorCode = 0;
432     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
433 
434     /*
435      * Invalidate the stdio cache if necessary.  Note that we assume that
436      * the stdio file and channel pointers will become invalid at the same
437      * time.
438      * Do not close standard channels while in thread-exit.
439      */
440 
441     fd = (int) ((FileState*)instanceData)->fileRef;
442     if (!TclInThreadExit()) {
443   if (fd == 0) {
444       tsdPtr->stdinChannel = NULL;
445   } else if (fd == 1) {
446       tsdPtr->stdoutChannel = NULL;
447   } else if (fd == 2) {
448       tsdPtr->stderrChannel = NULL;
449   } else {
450       panic("recieved invalid std file");
451   }
452     
453   if (close(fd) < 0) {
454       errorCode = errno;
455   }
456     }
457     return errorCode;
458 }
int StdIOInput (ClientData instanceData, char * buf, int bufSize, int * errorCode)

Definition at line 509 of file tclMacChan.c.
References errno, and size_t().515 {
516     int fd;
517     int bytesRead;      /* How many bytes were read? */
518 
519     *errorCode = 0;
520     errno = 0;
521     fd = (int) ((FileState*)instanceData)->fileRef;
522     bytesRead = read(fd, buf, (size_t) bufSize);
523     if (bytesRead > -1) {
524         return bytesRead;
525     }
526     *errorCode = errno;
527     return -1;
528 }
static int StdIOOutput (ClientData instanceData, CONST char * buf, int toWrite, int * errorCode) [static]

Definition at line 549 of file tclMacChan.c.
References errno, and size_t().554 {
555     int written;
556     int fd;
557 
558     *errorCode = 0;
559     errno = 0;
560     fd = (int) ((FileState*)instanceData)->fileRef;
561     written = write(fd, (void*)buf, (size_t) toWrite);
562     if (written > -1) {
563         return written;
564     }
565     *errorCode = errno;
566     return -1;
567 }
static int StdIOSeek (ClientData instanceData, long offset, int mode, int * errorCodePtr) [static]

Definition at line 588 of file tclMacChan.c.
References errno.593 {
594     int newLoc;
595     int fd;
596 
597     *errorCodePtr = 0;
598     fd = (int) ((FileState*)instanceData)->fileRef;
599     newLoc = lseek(fd, offset, mode);
600     if (newLoc > -1) {
601         return newLoc;
602     }
603     *errorCodePtr = errno;
604     return -1;
605 }
Tcl_Channel Tcl_MakeFileChannel (ClientData handle, int mode)

Definition at line 936 of file tclMacChan.c.
References NULL.
Referenced by PipeClose2Proc(), PipeCloseProc(), and TclpGetDefaultStdChannel().940 {
941     /*
942      * Not implemented yet.
943      */
944 
945     return NULL;
946 }
int Tcl_PidObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, Tcl_Obj *CONST * objv)

Definition at line 626 of file tclMacChan.c.
References NULL, TCL_ERROR, Tcl_GetChannel(), Tcl_GetObjResult(), Tcl_GetString(), TCL_OK, Tcl_SetStringObj(), and Tcl_WrongNumArgs().631 {
632     ProcessSerialNumber psn;
633     char buf[20]; 
634     Tcl_Channel chan;
635     Tcl_Obj *resultPtr;
636 
637     if (objc > 2) {
638         Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
639         return TCL_ERROR;
640     }
641     if (objc == 1) {
642         resultPtr = Tcl_GetObjResult(interp);
643   GetCurrentProcess(&psn);
644   sprintf(buf, "0x%08x%08x", psn.highLongOfPSN, psn.lowLongOfPSN);
645         Tcl_SetStringObj(resultPtr, buf, -1);
646     } else {
647         chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]),
648                 NULL);
649         if (chan == (Tcl_Channel) NULL) {
650             return TCL_ERROR;
651         } 
652   /*
653    * We can't create pipelines on the Mac so
654    * this will always return an empty list.
655    */
656     }
657     
658     return TCL_OK;
659 }
Tcl_Channel TclpGetDefaultStdChannel (int type)

Definition at line 679 of file tclMacChan.c.
References ckalloc, consoleChannelType, NULL, panic, Tcl_CreateChannel(), TCL_INTEGER_SPACE, TCL_READABLE, Tcl_SetChannelOption(), TCL_STDERR, TCL_STDIN, TCL_STDOUT, and TCL_WRITABLE.
Referenced by Tcl_GetStdChannel().681 {
682     Tcl_Channel channel = NULL;
683     int fd = 0;     /* Initializations needed to prevent */
684     int mode = 0;   /* compiler warning (used before set). */
685     char *bufMode = NULL;
686     char channelName[16 + TCL_INTEGER_SPACE];
687     int channelPermissions;
688     FileState *fileState;
689 
690     /*
691      * If the channels were not created yet, create them now and
692      * store them in the static variables.
693      */
694 
695     switch (type) {
696   case TCL_STDIN:
697       fd = 0;
698       channelPermissions = TCL_READABLE;
699       bufMode = "line";
700       break;
701   case TCL_STDOUT:
702       fd = 1;
703       channelPermissions = TCL_WRITABLE;
704       bufMode = "line";
705       break;
706   case TCL_STDERR:
707       fd = 2;
708       channelPermissions = TCL_WRITABLE;
709       bufMode = "none";
710       break;
711   default:
712       panic("TclGetDefaultStdChannel: Unexpected channel type");
713       break;
714     }
715 
716     sprintf(channelName, "console%d", (int) fd);
717     fileState = (FileState *) ckalloc((unsigned) sizeof(FileState));
718     channel = Tcl_CreateChannel(&consoleChannelType, channelName,
719       (ClientData) fileState, channelPermissions);
720     fileState->fileChan = channel;
721     fileState->fileRef = fd;
722 
723     /*
724      * Set up the normal channel options for stdio handles.
725      */
726 
727     Tcl_SetChannelOption(NULL, channel, "-translation", "cr");
728     Tcl_SetChannelOption(NULL, channel, "-buffering", bufMode);
729     
730     return channel;
731 }
Tcl_Channel TclpOpenFileChannel (Tcl_Interp * interp, Tcl_Obj * pathPtr, int mode, int permissions)

Definition at line 752 of file tclMacChan.c.
References CONST, NULL, OpenFileChannel(), Tcl_FSGetNativePath(), Tcl_GetString(), Tcl_PosixError(), and Tcl_SetErrno().
Referenced by PretendTclpOpenFileChannel(), TCL_DECLARE_MUTEX(), and TestReportOpenFileChannel().760 {
761     Tcl_Channel chan;
762     CONST char *native;
763     int errorCode;
764     
765     native = Tcl_FSGetNativePath(pathPtr);
766     if (native == NULL) {
767   return NULL;
768     }
769     chan = OpenFileChannel(native, mode, permissions, &errorCode);
770 
771     if (chan == NULL) {
772   Tcl_SetErrno(errorCode);
773   if (interp != (Tcl_Interp *) NULL) {
774             Tcl_AppendResult(interp, "couldn't open \"", 
775            Tcl_GetString(pathPtr), "\": ",
776            Tcl_PosixError(interp), (char *) NULL);
777         }
778   return NULL;
779     }
780     
781     return chan;
782 }

Variable Documentation
Tcl_ChannelType consoleChannelType [static]
Initial value: {
    "file",     
    TCL_CHANNEL_VERSION_4,  
    StdIOClose,     
    StdIOInput,     
    StdIOOutput,    
    StdIOSeek,      
    NULL,     
    NULL,     
    CommonWatch,    
    CommonGetHandle   
    NULL,     
    StdIOBlockMode,   
    NULL,     
    NULL,     
    NULL,     
    NULL,           
}
Definition at line 126 of file tclMacChan.c.
Referenced by TclpGetDefaultStdChannel(), and TclWinOpenConsoleChannel().Tcl_ThreadDataKey dataKey [static]

Definition at line 61 of file tclMacChan.c.Tcl_ChannelType fileChannelType [static]
Initial value: {
    "file",     
    TCL_CHANNEL_VERSION_4,  
    FileClose,      
    FileInput,      
    FileOutput,     
    FileSeek,     
    NULL,     
    NULL,     
    CommonWatch,    
    CommonGetHandle   
    NULL,     
    FileBlockMode,    
    NULL,     
    NULL,     
    NULL,     
    FileThreadActionProc,       
}
Definition at line 149 of file tclMacChan.c.
Referenced by OpenFileChannel(), Tcl_GetOpenFile(), Tcl_MakeFileChannel(), TclpGetDefaultStdChannel(), TclpOpenFileChannel(), and TclWinOpenFileChannel().TclGetStdChannelsProc getStdChannelsProc = NULL

Definition at line 176 of file tclMacChan.c.

mac/tclMacCommonPch.h File Reference
#include <UseDLLPrefix.h>
Defines
#define MAC_TCL

Define Documentation
#define MAC_TCL

Definition at line 49 of file tclMacCommonPch.h.

mac/tclMacDNR.c File Reference
#include <dnr.c>

mac/tclMacEnv.c File Reference
#include <Gestalt.h>
#include <Folders.h>
#include <TextUtils.h>
#include <Resources.h>
#include <string.h>
#include "tcl.h"
#include "tclInt.h"
#include "tclMacInt.h"
#include "tclPort.h"
Defines
#define kMaxEnvStringSize  255
#define kMaxEnvVarSize  100
#define kLoginnameTag  "LOGIN="
#define kUsernameTag  "USER="
#define kDefaultDirTag  "HOME="
#define kPrefsFile  "Tcl Environment Variables"
#define REZ_ENV  "\pTcl Environment Variables"
Functions
static char **RezRCVariables _ANSI_ARGS_ ((void))
static char *MakeFolderEnvVar _ANSI_ARGS_ ((char *prefixTag, long whichFolder))
static char ** RezRCVariables ()
static char ** FileRCVariables ()
static char * MakeFolderEnvVar (char *prefixTag, long whichFolder)
static char ** PathVariables ()
static char ** SystemVariables ()
int TclMacCreateEnv ()
static char * GetUserName ()
Variables
char ** environ = NULL

Define Documentation
#define kDefaultDirTag  "HOME="

Definition at line 29 of file tclMacEnv.c.
Referenced by SystemVariables().#define kLoginnameTag  "LOGIN="

Definition at line 27 of file tclMacEnv.c.
Referenced by SystemVariables().#define kMaxEnvStringSize  255

Definition at line 25 of file tclMacEnv.c.#define kMaxEnvVarSize  100

Definition at line 26 of file tclMacEnv.c.
Referenced by FileRCVariables().#define kPrefsFile  "Tcl Environment Variables"

Definition at line 37 of file tclMacEnv.c.
Referenced by FileRCVariables(), and TclMacCreateEnv().#define kUsernameTag  "USER="

Definition at line 28 of file tclMacEnv.c.
Referenced by SystemVariables().#define REZ_ENV  "\pTcl Environment Variables"

Definition at line 44 of file tclMacEnv.c.
Referenced by RezRCVariables(), and TclMacCreateEnv().
Function Documentation
static char* MakeFolderEnvVar _ANSI_ARGS_ ((char *prefixTag, long whichFolder)) [static]
static char** RezRCVariables _ANSI_ARGS_ ((void)) [static]
static char** FileRCVariables () [static]

Definition at line 142 of file tclMacEnv.c.
References ckalloc, FSpFindFolder(), FSpPathFromLocation(), kMaxEnvVarSize, kPrefsFile, Tcl_DString::length, NULL, Tcl_DString::string, Tcl_Close(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringSetLength(), Tcl_Gets(), Tcl_OpenFileChannel(), and void().
Referenced by TclMacCreateEnv().143 {
144     char *prefsFolder = NULL;
145     char *tempPtr = NULL;
146     char **fileEnv = NULL;
147     FILE *thePrefsFile = NULL;
148     int i;
149     FSSpec prefDir;
150     OSErr err;
151     Handle theString = NULL;
152     Tcl_Channel chan;
153     int size;
154     Tcl_DString lineRead;
155   
156     err = FSpFindFolder(kOnSystemDisk, kPreferencesFolderType, 
157       kDontCreateFolder, &prefDir);
158     if (err != noErr) {
159   return NULL;
160     }
161     err = FSpPathFromLocation(&prefDir, &size, &theString);
162     if (err != noErr) {
163   return NULL;
164     }
165     (void) Munger(theString, size, NULL, 0, kPrefsFile, strlen(kPrefsFile));
166 
167     HLock(theString);
168     chan = Tcl_OpenFileChannel(NULL, *theString, "r", 0);
169     HUnlock(theString);
170     DisposeHandle(theString);
171     if (chan == NULL) {
172   return NULL;
173     }
174 
175     /*
176      * We found a env file.  Let start parsing it.
177      */
178     fileEnv = (char **) ckalloc((kMaxEnvVarSize + 1) * sizeof(char *));
179 
180     i = 0;
181     Tcl_DStringInit(&lineRead);
182     while (Tcl_Gets(chan, &lineRead) != -1) {
183   /*
184    * First strip off new line char
185    */
186   if (lineRead.string[lineRead.length-1] == '\n') {
187       lineRead.string[lineRead.length-1] = '\0';
188   }
189   if (lineRead.string[0] == '\0' || lineRead.string[0] == '#') {
190       /*
191        * skip empty lines or commented lines
192        */
193       Tcl_DStringSetLength(&lineRead, 0);
194       continue;
195   }
196     
197   tempPtr = (char *) ckalloc(lineRead.length + 1);
198   strcpy(tempPtr, lineRead.string);
199   fileEnv[i++] = tempPtr;
200   Tcl_DStringSetLength(&lineRead, 0);
201     }
202   
203     fileEnv[i] = NULL;
204     Tcl_Close(NULL, chan);
205     Tcl_DStringFree(&lineRead);
206   
207     return fileEnv;
208 }
static char* GetUserName () [static]

Definition at line 516 of file tclMacEnv.c.
References NULL.
Referenced by SystemVariables(), and TclpSetVariables().517 {
518     static char buf[33];
519     short refnum;
520     Handle h;
521   
522     refnum = CurResFile();
523     UseResFile(0);
524     h = GetResource('STR ', -16096);
525     UseResFile(refnum);
526     if (h == NULL) {
527   return NULL;
528     }
529     
530     HLock(h);
531     strncpy(buf, (*h)+1, **h);
532     buf[**h] = '\0';
533     HUnlock(h);
534     ReleaseResource(h);
535     return(buf[0] ? buf : NULL);
536 }
static char* MakeFolderEnvVar (char * prefixTag, long whichFolder) [static]

Definition at line 232 of file tclMacEnv.c.
References ckalloc, FSpFindFolder(), FSpPathFromLocation(), Tcl_DString::length, NULL, Tcl_DString::staticSpace, Tcl_DString::string, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), TCL_PLATFORM_MAC, and tclPlatform.
Referenced by PathVariables().235 {
236     char * thePath = NULL;
237     char * result = NULL;
238     OSErr theErr = noErr;
239     Handle theString = NULL;
240     FSSpec theFolder;
241     int size;
242     Tcl_DString pathStr;
243     Tcl_DString tagPathStr;
244     
245     Tcl_DStringInit(&pathStr);
246     theErr = FSpFindFolder(kOnSystemDisk, whichFolder, 
247       kDontCreateFolder, &theFolder);
248     if (theErr == noErr) {
249   theErr = FSpPathFromLocation(&theFolder, &size, &theString);
250     
251   HLock(theString);
252   tclPlatform = TCL_PLATFORM_MAC;
253   Tcl_DStringAppend(&pathStr, *theString, -1);
254   HUnlock(theString);
255   DisposeHandle(theString);
256     
257   Tcl_DStringInit(&tagPathStr);
258   Tcl_DStringAppend(&tagPathStr, prefixTag, strlen(prefixTag));
259   Tcl_DStringAppend(&tagPathStr, pathStr.string, pathStr.length);
260   Tcl_DStringFree(&pathStr);
261   
262   /*
263    * Make sure the path ends with a ':'
264    */
265   if (tagPathStr.string[tagPathStr.length - 1] != ':') {
266       Tcl_DStringAppend(&tagPathStr, ":", 1);
267   }
268 
269   /*
270    * Don't free tagPathStr - rather make sure it's allocated
271    * and return it as the result.
272    */
273   if (tagPathStr.string == tagPathStr.staticSpace) {
274       result = (char *) ckalloc(tagPathStr.length + 1);
275       strcpy(result, tagPathStr.string);
276   } else {
277       result = tagPathStr.string;
278   }
279     } else {
280   result = (char *) ckalloc(strlen(prefixTag) + 1);
281   strcpy(result, prefixTag);
282     }
283   
284     return result;
285 }
static char** PathVariables () [static]

Definition at line 306 of file tclMacEnv.c.
References ckalloc, MakeFolderEnvVar(), and NULL.
Referenced by TclMacCreateEnv().307 {
308     int i = 0;
309     char **sysEnv;
310     char *thePath = NULL;
311     
312     sysEnv = (char **) ckalloc((12) * sizeof(char *));
313 
314     sysEnv[i++] = MakeFolderEnvVar("PREF_FOLDER=", kPreferencesFolderType);
315     sysEnv[i++] = MakeFolderEnvVar("SYS_FOLDER=", kSystemFolderType);
316     sysEnv[i++] = MakeFolderEnvVar("TEMP=", kTemporaryFolderType);
317     sysEnv[i++] = MakeFolderEnvVar("APPLE_M_FOLDER=", kAppleMenuFolderType);
318     sysEnv[i++] = MakeFolderEnvVar("CP_FOLDER=", kControlPanelFolderType);
319     sysEnv[i++] = MakeFolderEnvVar("DESK_FOLDER=", kDesktopFolderType);
320     sysEnv[i++] = MakeFolderEnvVar("EXT_FOLDER=", kExtensionFolderType);
321     sysEnv[i++] = MakeFolderEnvVar("PRINT_MON_FOLDER=",
322       kPrintMonitorDocsFolderType);
323     sysEnv[i++] = MakeFolderEnvVar("SHARED_TRASH_FOLDER=",
324       kWhereToEmptyTrashFolderType);
325     sysEnv[i++] = MakeFolderEnvVar("TRASH_FOLDER=", kTrashFolderType);
326     sysEnv[i++] = MakeFolderEnvVar("START_UP_FOLDER=", kStartupFolderType);
327     sysEnv[i++] = NULL;
328   
329     return sysEnv;
330 }
static char** RezRCVariables () [static]

Definition at line 82 of file tclMacEnv.c.
References ckalloc, NULL, and REZ_ENV.
Referenced by TclMacCreateEnv().83 {
84     Handle envStrs = NULL;
85     char** rezEnv = NULL;
86     short int numStrs;
87 
88     envStrs = GetNamedResource('STR#', REZ_ENV);
89     if (envStrs == NULL) return NULL;
90     numStrs = *((short *) (*envStrs));
91   
92     rezEnv = (char **) ckalloc((numStrs + 1) * sizeof(char *));
93 
94     if (envStrs != NULL) {
95   ResType theType;
96   Str255 theName;
97   short theID, index = 1;
98   int i = 0;
99   char* string;
100   
101   GetResInfo(envStrs, &theID, &theType, theName);
102   for(;;) {
103       GetIndString(theName, theID, index++);
104       if (theName[0] == '\0') break;
105       string = (char *) ckalloc(theName[0] + 2);
106       strncpy(string, (char *) theName + 1, theName[0]);
107       string[theName[0]] = '\0';
108       rezEnv[i++] = string;
109   }
110   ReleaseResource(envStrs);
111     
112   rezEnv[i] = NULL;
113   return rezEnv;
114     }
115   
116     return NULL;
117 }
static char** SystemVariables () [static]

Definition at line 349 of file tclMacEnv.c.
References ckalloc, FSpGetDefaultDir(), FSpPathFromLocation(), GetUserName(), kDefaultDirTag, kLoginnameTag, kUsernameTag, and NULL.
Referenced by TclMacCreateEnv().350 {
351     int i = 0;
352     char ** sysEnv;
353     char * thePath = NULL;
354     Handle theString = NULL;
355     FSSpec currentDir;
356     int size;
357     
358     sysEnv = (char **) ckalloc((4) * sizeof(char *));
359 
360     /*
361      * Get user name from chooser.  It will be assigned to both
362      * the USER and LOGIN environment variables.
363      */
364     thePath = GetUserName();
365     if (thePath != NULL) {
366   sysEnv[i] = (char *) ckalloc(strlen(kLoginnameTag) + strlen(thePath) + 1);
367   strcpy(sysEnv[i], kLoginnameTag);
368   strcpy(sysEnv[i]+strlen(kLoginnameTag), thePath);
369   i++;
370   sysEnv[i] = (char *) ckalloc(strlen(kUsernameTag) + strlen(thePath) + 1);
371   strcpy(sysEnv[i], kUsernameTag);
372   strcpy(sysEnv[i]+strlen(kUsernameTag), thePath);
373   i++;
374     }
375 
376     /*
377      * Get 'home' directory
378      */
379 #ifdef kDefaultDirTag
380     FSpGetDefaultDir(&currentDir);
381     FSpPathFromLocation(&currentDir, &size, &theString);
382     HLock(theString);
383     sysEnv[i] = (char *) ckalloc(strlen(kDefaultDirTag) + size + 4);
384     strcpy(sysEnv[i], kDefaultDirTag);
385     strncpy(sysEnv[i]+strlen(kDefaultDirTag) , *theString, size);
386     if (sysEnv[i][strlen(kDefaultDirTag) + size - 1] != ':') {
387   sysEnv[i][strlen(kDefaultDirTag) + size] = ':';
388   sysEnv[i][strlen(kDefaultDirTag) + size + 1] = '\0';
389     } else {
390   sysEnv[i][strlen(kDefaultDirTag) + size] = '\0';
391     }
392     HUnlock(theString);
393     DisposeHandle(theString);
394     i++;
395 #endif
396 
397     sysEnv[i++] = NULL;
398     return sysEnv;
399 }
int TclMacCreateEnv ()

Definition at line 420 of file tclMacEnv.c.
References ckalloc, ckfree, environ, FileRCVariables(), kPrefsFile, NULL, PathVariables(), REZ_ENV, RezRCVariables(), and SystemVariables().
Referenced by TclpInitLibraryPath().421 {
422     char ** sysEnv = NULL;
423     char ** pathEnv = NULL;
424     char ** fileEnv = NULL;
425     char ** rezEnv = NULL;
426     int count = 0;
427     int i, j;
428 
429     sysEnv = SystemVariables();
430     if (sysEnv != NULL) {
431   for (i = 0; sysEnv[i] != NULL; count++, i++) {
432       /* Empty Loop */
433   }
434     }
435 
436     pathEnv = PathVariables();
437     if (pathEnv != NULL) {
438   for (i = 0; pathEnv[i] != NULL; count++, i++) {
439       /* Empty Loop */
440   }
441     }
442 
443 #ifdef kPrefsFile
444     fileEnv = FileRCVariables();
445     if (fileEnv != NULL) {
446   for (i = 0; fileEnv[i] != NULL; count++, i++) {
447       /* Empty Loop */
448   }
449     }
450 #endif
451 
452 #ifdef REZ_ENV
453     rezEnv = RezRCVariables();
454     if (rezEnv != NULL) {
455   for (i = 0; rezEnv[i] != NULL; count++, i++) {
456       /* Empty Loop */
457   }
458     }
459 #endif
460 
461     /*
462      * Create environ variable
463      */
464     environ = (char **) ckalloc((count + 1) * sizeof(char *));
465     j = 0;
466   
467     if (sysEnv != NULL) {
468   for (i = 0; sysEnv[i] != NULL;)
469       environ[j++] = sysEnv[i++];
470   ckfree((char *) sysEnv);
471     }
472 
473     if (pathEnv != NULL) {
474   for (i = 0; pathEnv[i] != NULL;)
475       environ[j++] = pathEnv[i++];
476   ckfree((char *) pathEnv);
477     }
478 
479 #ifdef kPrefsFile
480     if (fileEnv != NULL) {
481   for (i = 0; fileEnv[i] != NULL;)
482       environ[j++] = fileEnv[i++];
483   ckfree((char *) fileEnv);
484     }
485 #endif
486 
487 #ifdef REZ_ENV
488     if (rezEnv != NULL) {
489   for (i = 0; rezEnv[i] != NULL;)
490       environ[j++] = rezEnv[i++];
491   ckfree((char *) rezEnv);
492     }
493 #endif
494 
495     environ[j] = NULL;
496     return j;
497 }

Variable Documentation
char** environ = NULL

Definition at line 47 of file tclMacEnv.c.
Referenced by TclMacCreateEnv(), and TclpFindVariable().

mac/tclMacExit.c File Reference
#include "tclInt.h"
#include "tclMacInt.h"
#include <SegLoad.h>
#include <Traps.h>
#include <Processes.h>
Classes
struct ExitToShellUPPList
struct ExitToShellDataStruct
Defines
#define CallExitToShellProc(userRoutine)  (*(userRoutine))()
#define NewExitToShellProc(userRoutine)  (ExitToShellUPP)(userRoutine)
#define DisposeExitToShellProc(userRoutine)  DisposeRoutineDescriptor(userRoutine)
Typedefs
typedef ExitToShellProcPtr ExitToShellUPP
typedef ExitToShellDataStruct ExitToShellDataRec
typedef ExitToShellDataStruct * ExitToShellDataPtr
typedef ExitToShellDataStruct ** ExitToShellDataHdl
typedef ExitToShellUPPList ExitToShellUPPList
typedef ExitToShellUPPList * ExitToShellUPPListPtr
typedef ExitToShellUPPList ** ExitToShellUPPHdl
Enumerations
enum { uppExitToShellProcInfo =  kPascalStackBased }
Functions
void TclpExit (int status)
void TclMacExitHandler ()
OSErr TclMacInstallExitToShellPatch (ExitToShellProcPtr newProc)
static pascal void ExitToShellPatchRoutine ()
void TclMacInitExitToShell (int usePatch)
Variables
static ExitToShellDataPtr gExitToShellData = (ExitToShellDataPtr) NULL

Define Documentation
#define CallExitToShellProc(userRoutine)  (*(userRoutine))()

Definition at line 46 of file tclMacExit.c.
Referenced by ExitToShellPatchRoutine(), and TclMacExitHandler().#define DisposeExitToShellProc(userRoutine)  DisposeRoutineDescriptor(userRoutine)

Definition at line 52 of file tclMacExit.c.
Referenced by TclMacExitHandler().#define NewExitToShellProc(userRoutine)  (ExitToShellUPP)(userRoutine)

Definition at line 48 of file tclMacExit.c.
Referenced by TclMacInitExitToShell(), and TclMacInstallExitToShellPatch().
Typedef Documentation
typedef struct ExitToShellDataStruct ** ExitToShellDataHdl

Definition at line 66 of file tclMacExit.c.typedef struct ExitToShellDataStruct * ExitToShellDataPtr

Definition at line 66 of file tclMacExit.c.typedef struct ExitToShellDataStruct ExitToShellDataRec

Definition at line 66 of file tclMacExit.c.typedef ExitToShellProcPtr ExitToShellUPP

Definition at line 44 of file tclMacExit.c.typedef struct ExitToShellUPPList ** ExitToShellUPPHdl

Definition at line 68 of file tclMacExit.c.typedef struct ExitToShellUPPList ExitToShellUPPList

Definition at line 68 of file tclMacExit.c.typedef struct ExitToShellUPPList * ExitToShellUPPListPtr

Definition at line 68 of file tclMacExit.c.
Enumeration Type Documentation
anonymous enum

Enumerator: 
uppExitToShellProcInfo  

Definition at line 30 of file tclMacExit.c.30      {
31         uppExitToShellProcInfo = kPascalStackBased
32 };

Function Documentation
static pascal void ExitToShellPatchRoutine () [static]

Definition at line 243 of file tclMacExit.c.
References ExitToShellDataStruct::a5, CallExitToShellProc, gExitToShellData, ExitToShellDataStruct::oldProc, and TclMacExitHandler().
Referenced by TclMacInitExitToShell().244 {
245     ExitToShellUPP oldETS;
246     long oldA5;
247 
248     /*
249      * Set up our A5 world.  This allows us to have
250      * access to our global variables in the 68k world.
251      */
252     oldA5 = SetCurrentA5();
253     SetA5(gExitToShellData->a5);
254 
255     /*
256      * Call the function that invokes all
257      * of the handlers.
258      */
259     TclMacExitHandler();
260 
261     /*
262      * Call the origional ExitToShell routine.
263      */
264     oldETS = gExitToShellData->oldProc;
265     DisposePtr((Ptr) gExitToShellData);
266     SetA5(oldA5);
267     CallExitToShellProc(oldETS);
268     return;
269 }
void TclMacExitHandler ()

Definition at line 150 of file tclMacExit.c.
References CallExitToShellProc, DisposeExitToShellProc, gExitToShellData, ExitToShellUPPList::nextProc, NULL, ExitToShellUPPList::userProc, and ExitToShellDataStruct::userProcs.
Referenced by ExitToShellPatchRoutine(), and TclpExit().151 {
152     ExitToShellUPPListPtr curProc;
153 
154     /*
155      * Loop through all installed Exit handlers
156      * and call them.  Always make sure we are in
157      * a clean state in case we are recursivly called.
158      */
159     if ((gExitToShellData) != NULL && (gExitToShellData->userProcs != NULL)){
160     
161   /*
162    * Call the installed exit to shell routines.
163    */
164   curProc = gExitToShellData->userProcs;
165   do {
166       gExitToShellData->userProcs = curProc->nextProc;
167       CallExitToShellProc(curProc->userProc);
168       DisposeExitToShellProc(curProc->userProc);
169       DisposePtr((Ptr) curProc);
170       curProc = gExitToShellData->userProcs;
171   } while (curProc != (ExitToShellUPPListPtr) NULL);
172     }
173 
174     return;
175 }
void TclMacInitExitToShell (int usePatch)

Definition at line 297 of file tclMacExit.c.
References ExitToShellDataStruct::a5, ExitToShellPatchRoutine(), gExitToShellData, NewExitToShellProc, NULL, ExitToShellDataStruct::oldProc, and ExitToShellDataStruct::userProcs.
Referenced by TclMacInstallExitToShellPatch().299 {
300     if (gExitToShellData == (ExitToShellDataPtr) NULL){
301 #if GENERATINGCFM
302   gExitToShellData = (ExitToShellDataPtr)
303     NewPtr(sizeof(ExitToShellDataRec));
304   gExitToShellData->a5 = SetCurrentA5();
305   gExitToShellData->userProcs = (ExitToShellUPPList*) NULL;
306 #else
307   ExitToShellUPP oldExitToShell, newExitToShellPatch;
308   short exitToShellTrap;
309   
310   /*
311    * Initialize patch mechanism.
312    */
313    
314   gExitToShellData = (ExitToShellDataPtr) NewPtr(sizeof(ExitToShellDataRec));
315   gExitToShellData->a5 = SetCurrentA5();
316   gExitToShellData->userProcs = (ExitToShellUPPList*) NULL;
317 
318   /*
319    * Save state needed to call origional ExitToShell routine.  Install
320    * the new ExitToShell code in it's place.
321    */
322   if (usePatch) {
323       exitToShellTrap = _ExitToShell & 0x3ff;
324       newExitToShellPatch = NewExitToShellProc(ExitToShellPatchRoutine);
325       oldExitToShell = (ExitToShellUPP)
326         NGetTrapAddress(exitToShellTrap, ToolTrap);
327       NSetTrapAddress((UniversalProcPtr) newExitToShellPatch,
328         exitToShellTrap, ToolTrap);
329       gExitToShellData->oldProc = oldExitToShell;
330   }
331 #endif
332     }
333 }
OSErr TclMacInstallExitToShellPatch (ExitToShellProcPtr newProc)

Definition at line 201 of file tclMacExit.c.
References gExitToShellData, NewExitToShellProc, ExitToShellUPPList::nextProc, NULL, TclMacInitExitToShell(), ExitToShellUPPList::userProc, and ExitToShellDataStruct::userProcs.
Referenced by InitSockets(), and TclpSysAlloc().203 {
204     ExitToShellUPP exitHandler;
205     ExitToShellUPPListPtr listPtr;
206 
207     if (gExitToShellData == (ExitToShellDataPtr) NULL){
208   TclMacInitExitToShell(true);
209     }
210 
211     /*
212      * Add the passed in function pointer to the list of functions
213      * to be called when ExitToShell is called.
214      */
215     exitHandler = NewExitToShellProc(newProc);
216     listPtr = (ExitToShellUPPListPtr) NewPtrClear(sizeof(ExitToShellUPPList));
217     listPtr->userProc = exitHandler;
218     listPtr->nextProc = gExitToShellData->userProcs;
219     gExitToShellData->userProcs = listPtr;
220 
221     return noErr;
222 }
void TclpExit (int status)

Definition at line 107 of file tclMacExit.c.
References TclMacExitHandler().109 {
110     TclMacExitHandler();
111 
112 /* 
113  * If we are using the Metrowerks Standard Library, then we will call its exit so that it
114  * will get a chance to clean up temp files, and so forth.  It always calls the standard 
115  * ExitToShell, so the Tcl handlers will also get called.
116  *   
117  * If you have another exit, make sure that it does not patch ExitToShell, and does
118  * call it.  If so, it will probably work as well.
119  *
120  */
121  
122 #ifdef __MSL__    
123     exit(status);
124 #else
125     ExitToShell();
126 #endif
127 
128 }

Variable Documentation
ExitToShellDataPtr gExitToShellData = (ExitToShellDataPtr) NULL [static]

Definition at line 85 of file tclMacExit.c.
Referenced by ExitToShellPatchRoutine(), TclMacExitHandler(), TclMacInitExitToShell(), and TclMacInstallExitToShellPatch().

mac/tclMacFCmd.c File Reference
#include "tclInt.h"
#include "tclMac.h"
#include "tclMacInt.h"
#include "tclPort.h"
#include <FSpCompat.h>
#include <MoreFilesExtras.h>
#include <Strings.h>
#include <Errors.h>
#include <FileCopy.h>
#include <DirectoryCopy.h>
#include <Script.h>
#include <string.h>
#include <Finder.h>
#include <Aliases.h>
Defines
#define MAC_CREATOR_ATTRIBUTE  0
#define MAC_HIDDEN_ATTRIBUTE  1
#define MAC_READONLY_ATTRIBUTE  2
#define MAC_TYPE_ATTRIBUTE  3
#define MAXMACFILENAMELEN  31
Functions
static int GetFileFinderAttributes _ANSI_ARGS_ ((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr))
static int GetFileReadOnly _ANSI_ARGS_ ((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **readOnlyPtrPtr))
static int SetFileFinderAttributes _ANSI_ARGS_ ((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr))
static int SetFileReadOnly _ANSI_ARGS_ ((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *readOnlyPtr))
static pascal Boolean CopyErrHandler _ANSI_ARGS_ ((OSErr error, short failedOperation, short srcVRefNum, long srcDirID, ConstStr255Param srcName, short dstVRefNum, long dstDirID, ConstStr255Param dstName))
static int DoCopyDirectory _ANSI_ARGS_ ((CONST char *src, CONST char *dst, Tcl_DString *errorPtr))
static int DoCopyFile _ANSI_ARGS_ ((CONST char *src, CONST char *dst))
static int DoCreateDirectory _ANSI_ARGS_ ((CONST char *path))
static int DoRemoveDirectory _ANSI_ARGS_ ((CONST char *path, int recursive, Tcl_DString *errorPtr))
OSErr FSpGetFLockCompat _ANSI_ARGS_ ((const FSSpec *specPtr, Boolean *lockedPtr))
static OSErr GetFileSpecs _ANSI_ARGS_ ((CONST char *path, FSSpec *pathSpecPtr, FSSpec *dirSpecPtr, Boolean *pathExistsPtr, Boolean *pathIsDirectoryPtr))
static OSErr MoveRename _ANSI_ARGS_ ((const FSSpec *srcSpecPtr, const FSSpec *dstSpecPtr, StringPtr copyName))
static int Pstrequal _ANSI_ARGS_ ((ConstStr255Param stringA, ConstStr255Param stringB))
int TclpObjRenameFile (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
static int DoRenameFile (CONST char *src, CONST char *dst)
static OSErr MoveRename (const FSSpec *srcFileSpecPtr, const FSSpec *dstDirSpecPtr, StringPtr copyName)
int TclpObjCopyFile (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
static int DoCopyFile (CONST char *src, CONST char *dst)
int TclpObjDeleteFile (Tcl_Obj *pathPtr)
int TclpDeleteFile (CONST char *path)
int TclpObjCreateDirectory (Tcl_Obj *pathPtr)
static int DoCreateDirectory (CONST char *path)
int TclpObjCopyDirectory (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr)
static int DoCopyDirectory (CONST char *src, CONST char *dst, Tcl_DString *errorPtr)
static pascal Boolean CopyErrHandler (OSErr error, short failedOperation, short srcVRefNum, long srcDirID, ConstStr255Param srcName, short dstVRefNum, long dstDirID, ConstStr255Param dstName)
int TclpObjRemoveDirectory (Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr)
static int DoRemoveDirectory (CONST char *path, int recursive, Tcl_DString *errorPtr)
static OSErr GetFileSpecs (CONST char *path, FSSpec *pathSpecPtr, FSSpec *dirSpecPtr, Boolean *pathExistsPtr, Boolean *pathIsDirectoryPtr)
OSErr FSpGetFLockCompat (const FSSpec *specPtr, Boolean *lockedPtr)
static int Pstrequal (ConstStr255Param stringA, ConstStr255Param stringB)
static int GetFileFinderAttributes (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)
static int GetFileReadOnly (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **readOnlyPtrPtr)
static int SetFileFinderAttributes (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr)
static int SetFileReadOnly (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *readOnlyPtr)
Tcl_Obj * TclpObjListVolumes (void)
int TclpObjNormalizePath (Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint)
Variables
CONST char * tclpFileAttrStrings []
CONST TclFileAttrProcs tclpFileAttrProcs []
static long startSeed = 248923489

Define Documentation
#define MAC_CREATOR_ATTRIBUTE  0

Definition at line 51 of file tclMacFCmd.c.
Referenced by GetFileFinderAttributes(), and SetFileFinderAttributes().#define MAC_HIDDEN_ATTRIBUTE  1

Definition at line 52 of file tclMacFCmd.c.
Referenced by GetFileFinderAttributes(), and SetFileFinderAttributes().#define MAC_READONLY_ATTRIBUTE  2

Definition at line 53 of file tclMacFCmd.c.#define MAC_TYPE_ATTRIBUTE  3

Definition at line 54 of file tclMacFCmd.c.
Referenced by GetFileFinderAttributes(), and SetFileFinderAttributes().#define MAXMACFILENAMELEN  31

Referenced by TclpObjNormalizePath().
Function Documentation
static int Pstrequal _ANSI_ARGS_ ((ConstStr255Param stringA, ConstStr255Param stringB)) [static]
static OSErr MoveRename _ANSI_ARGS_ ((const FSSpec *srcSpecPtr, const FSSpec *dstSpecPtr, StringPtr copyName)) [static]
static OSErr GetFileSpecs _ANSI_ARGS_ ((CONST char *path, FSSpec *pathSpecPtr, FSSpec *dirSpecPtr, Boolean *pathExistsPtr, Boolean *pathIsDirectoryPtr)) [static]
OSErr FSpGetFLockCompat _ANSI_ARGS_ ((const FSSpec *specPtr, Boolean *lockedPtr))
static int DoRemoveDirectory _ANSI_ARGS_ ((CONST char *path, int recursive, Tcl_DString *errorPtr)) [static]
static int DoCreateDirectory _ANSI_ARGS_ ((CONST char *path)) [static]
static int DoCopyFile _ANSI_ARGS_ ((CONST char *src, CONST char *dst)) [static]
static int DoCopyDirectory _ANSI_ARGS_ ((CONST char *src, CONST char *dst, Tcl_DString *errorPtr)) [static]
static pascal Boolean CopyErrHandler _ANSI_ARGS_ ((OSErr error, short failedOperation, short srcVRefNum, long srcDirID, ConstStr255Param srcName, short dstVRefNum, long dstDirID, ConstStr255Param dstName)) [static]
static int SetFileReadOnly _ANSI_ARGS_ ((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *readOnlyPtr)) [static]
static int SetFileFinderAttributes _ANSI_ARGS_ ((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr)) [static]
static int GetFileReadOnly _ANSI_ARGS_ ((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **readOnlyPtrPtr)) [static]
static int GetFileFinderAttributes _ANSI_ARGS_ ((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)) [static]
static pascal Boolean CopyErrHandler (OSErr error, short failedOperation, short srcVRefNum, long srcDirID, ConstStr255Param srcName, short dstVRefNum, long dstDirID, ConstStr255Param dstName) [static]

Definition at line 789 of file tclMacFCmd.c.
Referenced by DoCopyDirectory().798 {
799     return true;
800 }
static int DoCopyDirectory (CONST char * src, CONST char * dst, Tcl_DString * errorPtr) [static]

Definition at line 647 of file tclMacFCmd.c.
References CopyErrHandler(), errno, FSpGetFLockCompat(), FSpLocationFromPath(), GetFileSpecs(), NULL, Pstrequal(), TCL_ERROR, Tcl_ExternalToUtfDString(), TCL_OK, and TclMacOSErrorToPosixError().
Referenced by TclpObjCopyDirectory().654 {
655     OSErr err, saveErr;
656     long srcID, tmpDirID;
657     FSSpec srcFileSpec, dstFileSpec, dstDirSpec, tmpDirSpec, tmpFileSpec;
658     Boolean srcIsDirectory, srcLocked;
659     Boolean dstIsDirectory, dstExists;
660     Str31 tmpName;
661 
662     err = FSpLocationFromPath(strlen(src), src, &srcFileSpec);
663     if (err == noErr) {
664       err = FSpGetDirectoryID(&srcFileSpec, &srcID, &srcIsDirectory);
665     }
666     if (err == noErr) {
667         if (srcIsDirectory == false) {
668             err = afpObjectTypeErr; /* ENOTDIR. */
669         }
670     }
671     if (err == noErr) {
672         err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists,
673           &dstIsDirectory);
674     }
675     if (dstExists) {
676         if (dstIsDirectory == false) {
677             err = afpObjectTypeErr; /* ENOTDIR. */
678         } else {
679             err = dupFNErr;   /* EEXIST. */
680         }
681     }
682     if (err != noErr) {
683         goto done;
684     }        
685     if ((srcFileSpec.vRefNum == dstFileSpec.vRefNum) &&
686           (srcFileSpec.parID == dstFileSpec.parID) &&
687             (Pstrequal(srcFileSpec.name, dstFileSpec.name) != 0)) {
688         /*
689          * Copying on top of self.  No-op.
690          */
691                     
692         goto done;
693     }
694 
695     /*
696      * This algorthm will work making a copy of the source directory in
697      * the current directory with a new name, in a new directory with the
698      * same name, and in a new directory with a new name:
699      *
700      * 1. Make dstDir/tmpDir.
701      * 2. Copy srcDir/src to dstDir/tmpDir/src
702      * 3. Rename dstDir/tmpDir/src to dstDir/tmpDir/dst (if necessary).
703      * 4. CatMove dstDir/tmpDir/dst to dstDir/dst.
704      * 5. Remove dstDir/tmpDir.
705      */
706                 
707     err = FSpGetFLockCompat(&srcFileSpec, &srcLocked);
708     if (srcLocked) {
709         FSpRstFLockCompat(&srcFileSpec);
710     }
711     if (err == noErr) {
712         err = GenerateUniqueName(dstFileSpec.vRefNum, &startSeed, dstFileSpec.parID, 
713               dstFileSpec.parID, tmpName);
714     }
715     if (err == noErr) {
716         FSMakeFSSpecCompat(dstFileSpec.vRefNum, dstFileSpec.parID,
717           tmpName, &tmpDirSpec);
718         err = FSpDirCreateCompat(&tmpDirSpec, smSystemScript, &tmpDirID);
719     }
720     if (err == noErr) {
721   err = FSpDirectoryCopy(&srcFileSpec, &tmpDirSpec, NULL, NULL, 0, true,
722         CopyErrHandler);
723     }
724     
725     /* 
726      * Even if the Copy failed, Rename/Move whatever did get copied to the
727      * appropriate final destination, if possible.  
728      */
729      
730     saveErr = err;
731     err = noErr;
732     if (Pstrequal(srcFileSpec.name, dstFileSpec.name) == 0) {
733         err = FSMakeFSSpecCompat(tmpDirSpec.vRefNum, tmpDirID, 
734           srcFileSpec.name, &tmpFileSpec);
735         if (err == noErr) {
736             err = FSpRenameCompat(&tmpFileSpec, dstFileSpec.name);
737         }
738     }
739     if (err == noErr) {
740         err = FSMakeFSSpecCompat(tmpDirSpec.vRefNum, tmpDirID,
741           dstFileSpec.name, &tmpFileSpec);
742     }
743     if (err == noErr) {
744         err = FSpCatMoveCompat(&tmpFileSpec, &dstDirSpec);
745     }
746     if (err == noErr) {
747         if (srcLocked) {
748             FSpSetFLockCompat(&dstFileSpec);
749         }
750     }
751     
752     FSpDeleteCompat(&tmpDirSpec);
753     
754     if (saveErr != noErr) {
755         err = saveErr;
756     }
757     
758     done:
759     if (err != noErr) {
760         errno = TclMacOSErrorToPosixError(err);
761         if (errorPtr != NULL) {
762             Tcl_ExternalToUtfDString(NULL, dst, -1, errorPtr);
763         }
764         return TCL_ERROR;
765     }
766     return TCL_OK;
767 }
static int DoCopyFile (CONST char * src, CONST char * dst) [static]

Definition at line 413 of file tclMacFCmd.c.
References EISDIR, errno, FSpGetFLockCompat(), FSpLLocationFromPath(), GetFileSpecs(), NULL, TCL_ERROR, TCL_OK, and TclMacOSErrorToPosixError().
Referenced by TclpObjCopyFile(), and TraversalCopy().416 {
417     OSErr err, dstErr;
418     Boolean dstExists, dstIsDirectory, dstLocked;
419     FSSpec srcFileSpec, dstFileSpec, dstDirSpec, tmpFileSpec;
420     Str31 tmpName;
421   
422     err = FSpLLocationFromPath(strlen(src), src, &srcFileSpec);
423     if (err == noErr) {
424         err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists,
425           &dstIsDirectory);
426     }
427     if (dstExists) {
428         if (dstIsDirectory) {
429             errno = EISDIR;
430             return TCL_ERROR;
431         }
432         err = FSpGetFLockCompat(&dstFileSpec, &dstLocked);
433         if (dstLocked) {
434             FSpRstFLockCompat(&dstFileSpec);
435         }
436         
437         /*
438          * Backup dest file.
439          */
440          
441         dstErr = GenerateUniqueName(dstFileSpec.vRefNum, &startSeed, dstFileSpec.parID, 
442               dstFileSpec.parID, tmpName);
443         if (dstErr == noErr) {
444             dstErr = FSpRenameCompat(&dstFileSpec, tmpName);
445         }   
446     }
447     if (err == noErr) {
448       err = FSpFileCopy(&srcFileSpec, &dstDirSpec, 
449         (StringPtr) dstFileSpec.name, NULL, 0, true);
450     }
451     if ((dstExists != false) && (dstErr == noErr)) {
452         FSMakeFSSpecCompat(dstFileSpec.vRefNum, dstFileSpec.parID,
453           tmpName, &tmpFileSpec);
454   if (err == noErr) {
455       /* 
456        * Delete backup file. 
457        */
458        
459       FSpDeleteCompat(&tmpFileSpec);
460   } else {
461   
462       /* 
463        * Restore backup file.
464        */
465        
466       FSpDeleteCompat(&dstFileSpec);
467       FSpRenameCompat(&tmpFileSpec, dstFileSpec.name);
468       if (dstLocked) {
469           FSpSetFLockCompat(&dstFileSpec);
470       }
471   }
472     }
473     
474     if (err != noErr) {
475   errno = TclMacOSErrorToPosixError(err);
476   return TCL_ERROR;
477     }
478     return TCL_OK;
479 }
static int DoCreateDirectory (CONST char * path) [static]

Definition at line 581 of file tclMacFCmd.c.
References errno, FSpLocationFromPath(), TCL_ERROR, TCL_OK, and TclMacOSErrorToPosixError().
Referenced by TclpObjCreateDirectory(), and TraversalCopy().583 {
584     OSErr err;
585     FSSpec dirSpec;
586     long outDirID;
587   
588     err = FSpLocationFromPath(strlen(path), path, &dirSpec);
589     if (err == noErr) {
590         err = dupFNErr;   /* EEXIST. */
591     } else if (err == fnfErr) {
592         err = FSpDirCreateCompat(&dirSpec, smSystemScript, &outDirID);
593     } 
594     
595     if (err != noErr) {
596   errno = TclMacOSErrorToPosixError(err);
597   return TCL_ERROR;
598     }
599     return TCL_OK;
600 }
static int DoRemoveDirectory (CONST char * path, int recursive, Tcl_DString * errorPtr) [static]

Definition at line 846 of file tclMacFCmd.c.
References ENOTDIR, errno, FSpLocationFromPath(), NULL, TCL_ERROR, TCL_OK, Tcl_UtfToExternalDString(), and TclMacOSErrorToPosixError().
Referenced by DoRenameFile(), TclpObjRemoveDirectory(), and TraversalDelete().855 {
856     OSErr err;
857     FSSpec fileSpec;
858     long dirID;
859     int locked;
860     Boolean isDirectory;
861     CInfoPBRec pb;
862     Str255 fileName;
863 
864 
865     locked = 0;
866     err = FSpLocationFromPath(strlen(path), path, &fileSpec);
867     if (err != noErr) {
868         goto done;
869     }   
870 
871     /*
872      * Since FSpDeleteCompat will delete a file, make sure this isn't
873      * a file first.
874      */
875          
876     isDirectory = 1;
877     FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
878     if (isDirectory == 0) {
879         errno = ENOTDIR;
880         return TCL_ERROR;
881     }
882     
883     err = FSpDeleteCompat(&fileSpec);
884     if (err == fLckdErr) {
885         locked = 1;
886       FSpRstFLockCompat(&fileSpec);
887       err = FSpDeleteCompat(&fileSpec);
888     }
889     if (err == noErr) {
890   return TCL_OK;
891     }
892     if (err != fBsyErr) {
893         goto done;
894     }
895      
896     if (recursive == 0) {
897   /*
898    * fBsyErr means one of three things: file busy, directory not empty, 
899    * or working directory control block open.  Determine if directory
900    * is empty. If directory is not empty, return EEXIST.
901    */
902 
903   pb.hFileInfo.ioVRefNum = fileSpec.vRefNum;
904   pb.hFileInfo.ioDirID = dirID;
905   pb.hFileInfo.ioNamePtr = (StringPtr) fileName;
906   pb.hFileInfo.ioFDirIndex = 1;
907   if (PBGetCatInfoSync(&pb) == noErr) {
908       err = dupFNErr; /* EEXIST */
909       goto done;
910   }
911     }
912   
913     /*
914      * DeleteDirectory removes a directory and all its contents, including
915      * any locked files.  There is no interface to get the name of the 
916      * file that caused the error, if an error occurs deleting this tree,
917      * unless we rewrite DeleteDirectory ourselves.
918      */
919    
920     err = DeleteDirectory(fileSpec.vRefNum, dirID, NULL);
921 
922     done:
923     if (err != noErr) {
924   if (errorPtr != NULL) {
925       Tcl_UtfToExternalDString(NULL, path, -1, errorPtr);
926   }
927         if (locked) {
928             FSpSetFLockCompat(&fileSpec);
929         }
930       errno = TclMacOSErrorToPosixError(err);
931       return TCL_ERROR;
932     }
933     return TCL_OK;
934 }
static int DoRenameFile (CONST char * src, CONST char * dst) [static]

Definition at line 148 of file tclMacFCmd.c.
References DoRemoveDirectory(), EISDIR, ENOTDIR, errno, FSpGetFLockCompat(), FSpLLocationFromPath(), GetFileSpecs(), MoveRename(), NULL, TCL_ERROR, TCL_OK, and TclMacOSErrorToPosixError().
Referenced by TclpObjRenameFile().153 {
154     FSSpec srcFileSpec, dstFileSpec, dstDirSpec;
155     OSErr err; 
156     long srcID, dummy;
157     Boolean srcIsDirectory, dstIsDirectory, dstExists, dstLocked;
158 
159     err = FSpLLocationFromPath(strlen(src), src, &srcFileSpec);
160     if (err == noErr) {
161   FSpGetDirectoryID(&srcFileSpec, &srcID, &srcIsDirectory);
162     }
163     if (err == noErr) {
164         err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists, 
165           &dstIsDirectory);
166     }
167     if (err == noErr) {
168   if (dstExists == 0) {
169             err = MoveRename(&srcFileSpec, &dstDirSpec, dstFileSpec.name);
170             goto end;
171         }
172         err = FSpGetFLockCompat(&dstFileSpec, &dstLocked);
173         if (dstLocked) {
174             FSpRstFLockCompat(&dstFileSpec);
175         }
176     }
177     if (err == noErr) {
178         if (srcIsDirectory) {
179       if (dstIsDirectory) {
180     /*
181      * The following call will remove an empty directory.  If it
182      * fails, it's because it wasn't empty.
183      */
184      
185                 if (DoRemoveDirectory(dst, 0, NULL) != TCL_OK) {
186                     return TCL_ERROR;
187                 }
188                 
189                 /*
190      * Now that that empty directory is gone, we can try
191      * renaming src.  If that fails, we'll put this empty
192      * directory back, for completeness.
193      */
194 
195     err = MoveRename(&srcFileSpec, &dstDirSpec, dstFileSpec.name);
196                 if (err != noErr) {
197         FSpDirCreateCompat(&dstFileSpec, smSystemScript, &dummy);
198         if (dstLocked) {
199             FSpSetFLockCompat(&dstFileSpec);
200         }
201     }
202       } else {
203           errno = ENOTDIR;
204           return TCL_ERROR;
205       }
206   } else {   
207       if (dstIsDirectory) {
208     errno = EISDIR;
209     return TCL_ERROR;
210       } else {                                
211     /*
212      * Overwrite existing file by:
213      * 
214      * 1. Rename existing file to temp name.
215      * 2. Rename old file to new name.
216      * 3. If success, delete temp file.  If failure,
217      *    put temp file back to old name.
218      */
219 
220           Str31 tmpName;
221           FSSpec tmpFileSpec;
222 
223           err = GenerateUniqueName(dstFileSpec.vRefNum, &startSeed,
224             dstFileSpec.parID, dstFileSpec.parID, tmpName);
225           if (err == noErr) {
226               err = FSpRenameCompat(&dstFileSpec, tmpName);
227           }
228           if (err == noErr) {
229               err = FSMakeFSSpecCompat(dstFileSpec.vRefNum,
230                     dstFileSpec.parID, tmpName, &tmpFileSpec);
231           }
232           if (err == noErr) {
233               err = MoveRename(&srcFileSpec, &dstDirSpec, 
234                     dstFileSpec.name);
235           }
236           if (err == noErr) {
237         FSpDeleteCompat(&tmpFileSpec);
238     } else {
239         FSpDeleteCompat(&dstFileSpec);
240         FSpRenameCompat(&tmpFileSpec, dstFileSpec.name);
241               if (dstLocked) {
242                 FSpSetFLockCompat(&dstFileSpec);
243               }
244           }
245       }
246     }
247     }    
248 
249     end:    
250     if (err != noErr) {
251   errno = TclMacOSErrorToPosixError(err);
252   return TCL_ERROR;
253     }
254     return TCL_OK;
255 }
OSErr FSpGetFLockCompat (const FSSpec * specPtr, Boolean * lockedPtr)

Definition at line 1019 of file tclMacFCmd.c.
Referenced by DoCopyDirectory(), DoCopyFile(), DoRenameFile(), and MoveRename().1024 {
1025     CInfoPBRec pb;
1026     OSErr err;
1027     
1028     pb.hFileInfo.ioVRefNum = specPtr->vRefNum;
1029     pb.hFileInfo.ioDirID = specPtr->parID;
1030     pb.hFileInfo.ioNamePtr = (StringPtr) specPtr->name;
1031     pb.hFileInfo.ioFDirIndex = 0;
1032     
1033     err = PBGetCatInfoSync(&pb);
1034     if ((err == noErr) && (pb.hFileInfo.ioFlAttrib & 0x01)) {
1035         *lockedPtr = true;
1036     } else {
1037         *lockedPtr = false;
1038     }
1039     return err;
1040 }
static int GetFileFinderAttributes (Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj ** attributePtrPtr) [static]

Definition at line 1096 of file tclMacFCmd.c.
References CONST, errno, FSpLLocationFromPath(), kIsInvisible, MAC_CREATOR_ATTRIBUTE, MAC_HIDDEN_ATTRIBUTE, MAC_TYPE_ATTRIBUTE, NULL, TCL_ERROR, Tcl_FSGetNativePath(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_NewBooleanObj(), Tcl_NewOSTypeObj(), TCL_OK, Tcl_PosixError(), and TclMacOSErrorToPosixError().1101 {
1102     OSErr err;
1103     FSSpec fileSpec;
1104     FInfo finfo;
1105     CONST char *native;
1106 
1107     native=Tcl_FSGetNativePath(fileName);
1108     err = FSpLLocationFromPath(strlen(native),
1109       native, &fileSpec);
1110 
1111     if (err == noErr) {
1112       err = FSpGetFInfo(&fileSpec, &finfo);
1113     }
1114     
1115     if (err == noErr) {
1116       switch (objIndex) {
1117           case MAC_CREATOR_ATTRIBUTE:
1118             *attributePtrPtr = Tcl_NewOSTypeObj(finfo.fdCreator);
1119             break;
1120           case MAC_HIDDEN_ATTRIBUTE:
1121             *attributePtrPtr = Tcl_NewBooleanObj(finfo.fdFlags
1122               & kIsInvisible);
1123             break;
1124           case MAC_TYPE_ATTRIBUTE:
1125             *attributePtrPtr = Tcl_NewOSTypeObj(finfo.fdType);
1126             break;
1127       }
1128     } else if (err == fnfErr) {
1129       long dirID;
1130       Boolean isDirectory = 0;
1131       
1132       err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
1133       if ((err == noErr) && isDirectory) {
1134           if (objIndex == MAC_HIDDEN_ATTRIBUTE) {
1135             *attributePtrPtr = Tcl_NewBooleanObj(0);
1136           } else {
1137             *attributePtrPtr = Tcl_NewOSTypeObj('Fldr');
1138           }
1139       }
1140     }
1141     
1142     if (err != noErr) {
1143       errno = TclMacOSErrorToPosixError(err);
1144       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
1145         "could not read \"", Tcl_GetString(fileName), "\": ",
1146         Tcl_PosixError(interp), (char *) NULL);
1147       return TCL_ERROR;
1148     }
1149     return TCL_OK;
1150 }
static int GetFileReadOnly (Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj ** readOnlyPtrPtr) [static]

Definition at line 1174 of file tclMacFCmd.c.
References CONST, errno, FSpLLocationFromPath(), NULL, TCL_ERROR, Tcl_FSGetNativePath(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_NewBooleanObj(), TCL_OK, Tcl_PosixError(), and TclMacOSErrorToPosixError().1179 {
1180     OSErr err;
1181     FSSpec fileSpec;
1182     CInfoPBRec paramBlock;
1183     CONST char *native;
1184 
1185     native=Tcl_FSGetNativePath(fileName);
1186     err = FSpLLocationFromPath(strlen(native),
1187       native, &fileSpec);
1188     
1189     if (err == noErr) {
1190       if (err == noErr) {
1191           paramBlock.hFileInfo.ioCompletion = NULL;
1192           paramBlock.hFileInfo.ioNamePtr = fileSpec.name;
1193           paramBlock.hFileInfo.ioVRefNum = fileSpec.vRefNum;
1194           paramBlock.hFileInfo.ioFDirIndex = 0;
1195           paramBlock.hFileInfo.ioDirID = fileSpec.parID;
1196           err = PBGetCatInfo(&paramBlock, 0);
1197           if (err == noErr) {
1198           
1199             /*
1200              * For some unknown reason, the Mac does not give
1201              * symbols for the bits in the ioFlAttrib field.
1202              * 1 -> locked.
1203              */
1204           
1205             *readOnlyPtrPtr = Tcl_NewBooleanObj(
1206               paramBlock.hFileInfo.ioFlAttrib & 1);
1207           }
1208       }
1209     }
1210     if (err != noErr) {
1211       errno = TclMacOSErrorToPosixError(err);
1212       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
1213         "could not read \"", Tcl_GetString(fileName), "\": ",
1214         Tcl_PosixError(interp), (char *) NULL);
1215       return TCL_ERROR;
1216     }
1217     return TCL_OK;
1218 }
static OSErr GetFileSpecs (CONST char * path, FSSpec * pathSpecPtr, FSSpec * dirSpecPtr, Boolean * pathExistsPtr, Boolean * pathIsDirectoryPtr) [static]

Definition at line 955 of file tclMacFCmd.c.
References ckfree, CONST, FSpLocationFromPath(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_JoinPath(), and Tcl_SplitPath().
Referenced by DoCopyDirectory(), DoCopyFile(), and DoRenameFile().965 {
966     CONST char *dirName;
967     OSErr err;
968     int argc;
969     CONST char **argv;
970     long d;
971     Tcl_DString buffer;
972         
973     *pathExistsPtr = false;
974     *pathIsDirectoryPtr = false;
975     
976     Tcl_DStringInit(&buffer);
977     Tcl_SplitPath(path, &argc, &argv);
978     if (argc == 1) {
979         dirName = ":";
980     } else {
981         dirName = Tcl_JoinPath(argc - 1, argv, &buffer);
982     }
983     err = FSpLocationFromPath(strlen(dirName), dirName, dirSpecPtr);
984     Tcl_DStringFree(&buffer);
985     ckfree((char *) argv);
986 
987     if (err == noErr) {
988         err = FSpLocationFromPath(strlen(path), path, pathSpecPtr);
989         if (err == noErr) {
990             *pathExistsPtr = true;
991             err = FSpGetDirectoryID(pathSpecPtr, &d, pathIsDirectoryPtr);
992         } else if (err == fnfErr) {
993             err = noErr;
994         }
995     }
996     return err;
997 }
static OSErr MoveRename (const FSSpec * srcFileSpecPtr, const FSSpec * dstDirSpecPtr, StringPtr copyName) [static]

Definition at line 280 of file tclMacFCmd.c.
References FSpGetFLockCompat(), NULL, and Pstrequal().
Referenced by DoRenameFile().285 {
286     OSErr err;
287     long srcID, dstID;
288     Boolean srcIsDir, dstIsDir;
289     Str31 tmpName;
290     FSSpec dstFileSpec, srcDirSpec, tmpSrcFileSpec, tmpDstFileSpec;
291     Boolean locked;
292     
293     if (srcFileSpecPtr->parID == 1) {
294         /*
295          * Trying to rename a volume.
296          */
297           
298         return badMovErr;
299     }
300     if (srcFileSpecPtr->vRefNum != dstDirSpecPtr->vRefNum) {
301   /*
302    * Renaming across volumes.
303    */
304    
305         return diffVolErr;
306     }
307     err = FSpGetFLockCompat(srcFileSpecPtr, &locked);
308     if (locked) {
309         FSpRstFLockCompat(srcFileSpecPtr);
310     }
311     if (err == noErr) {
312   err = FSpGetDirectoryID(dstDirSpecPtr, &dstID, &dstIsDir);
313     }
314     if (err == noErr) {
315         if (srcFileSpecPtr->parID == dstID) {
316             /*
317              * Renaming object within directory. 
318              */
319             
320             err = FSpRenameCompat(srcFileSpecPtr, copyName);
321             goto done; 
322         }
323         if (Pstrequal(srcFileSpecPtr->name, copyName)) {
324       /*
325        * Moving object to another directory (under same name). 
326        */
327    
328       err = FSpCatMoveCompat(srcFileSpecPtr, dstDirSpecPtr);
329       goto done; 
330         } 
331         err = FSpGetDirectoryID(srcFileSpecPtr, &srcID, &srcIsDir);
332     } 
333     if (err == noErr) {
334         /*
335          * Fullblown: rename source object to temp name, move temp to
336          * dest directory, and rename temp to target.
337          */
338           
339         err = GenerateUniqueName(srcFileSpecPtr->vRefNum, &startSeed,
340           srcFileSpecPtr->parID, dstID, tmpName);
341         FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
342           tmpName, &tmpSrcFileSpec);
343         FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum, dstID, tmpName,
344           &tmpDstFileSpec);
345     }
346     if (err == noErr) {
347         err = FSpRenameCompat(srcFileSpecPtr, tmpName);
348     }
349     if (err == noErr) {
350         err = FSpCatMoveCompat(&tmpSrcFileSpec, dstDirSpecPtr);
351         if (err == noErr) {
352             err = FSpRenameCompat(&tmpDstFileSpec, copyName);
353             if (err == noErr) {
354                 goto done;
355             }
356             FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
357                   NULL, &srcDirSpec);
358             FSpCatMoveCompat(&tmpDstFileSpec, &srcDirSpec);
359         }                 
360         FSpRenameCompat(&tmpSrcFileSpec, srcFileSpecPtr->name);
361     }
362     
363     done:
364     if (locked != false) {
365       if (err == noErr) {
366       FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum, 
367             dstID, copyName, &dstFileSpec);
368             FSpSetFLockCompat(&dstFileSpec);
369         } else {
370             FSpSetFLockCompat(srcFileSpecPtr);
371         }
372     }
373     return err;
374 }     
static int Pstrequal (ConstStr255Param stringA, ConstStr255Param stringB) [static]

Definition at line 1059 of file tclMacFCmd.c.
Referenced by DoCopyDirectory(), and MoveRename().1062 {
1063     int i, len;
1064     
1065     len = *stringA;
1066     for (i = 0; i <= len; i++) {
1067         if (*stringA++ != *stringB++) {
1068             return 0;
1069         }
1070     }
1071     return 1;
1072 }
static int SetFileFinderAttributes (Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj * attributePtr) [static]

Definition at line 1238 of file tclMacFCmd.c.
References CONST, errno, FSpLLocationFromPath(), kIsInvisible, MAC_CREATOR_ATTRIBUTE, MAC_HIDDEN_ATTRIBUTE, MAC_TYPE_ATTRIBUTE, NULL, TCL_ERROR, Tcl_FSGetNativePath(), Tcl_GetBooleanFromObj(), Tcl_GetObjResult(), Tcl_GetOSTypeFromObj(), Tcl_GetString(), TCL_OK, Tcl_PosixError(), and TclMacOSErrorToPosixError().1243 {
1244     OSErr err;
1245     FSSpec fileSpec;
1246     FInfo finfo;
1247     CONST char *native;
1248 
1249     native=Tcl_FSGetNativePath(fileName);
1250     err = FSpLLocationFromPath(strlen(native),
1251       native, &fileSpec);
1252     
1253     if (err == noErr) {
1254       err = FSpGetFInfo(&fileSpec, &finfo);
1255     }
1256     
1257     if (err == noErr) {
1258       switch (objIndex) {
1259           case MAC_CREATOR_ATTRIBUTE:
1260             if (Tcl_GetOSTypeFromObj(interp, attributePtr,
1261               &finfo.fdCreator) != TCL_OK) {
1262                 return TCL_ERROR;
1263             }
1264             break;
1265           case MAC_HIDDEN_ATTRIBUTE: {
1266             int hidden;
1267             
1268             if (Tcl_GetBooleanFromObj(interp, attributePtr, &hidden)
1269               != TCL_OK) {
1270                 return TCL_ERROR;
1271             }
1272             if (hidden) {
1273                 finfo.fdFlags |= kIsInvisible;
1274             } else {
1275                 finfo.fdFlags &= ~kIsInvisible;
1276             }
1277             break;
1278           }
1279           case MAC_TYPE_ATTRIBUTE:
1280             if (Tcl_GetOSTypeFromObj(interp, attributePtr,
1281               &finfo.fdType) != TCL_OK) {
1282                 return TCL_ERROR;
1283             }
1284             break;
1285       }
1286       err = FSpSetFInfo(&fileSpec, &finfo);
1287     } else if (err == fnfErr) {
1288       long dirID;
1289       Boolean isDirectory = 0;
1290       
1291       err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
1292       if ((err == noErr) && isDirectory) {
1293           Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
1294           Tcl_AppendStringsToObj(resultPtr, "cannot set ",
1295                 tclpFileAttrStrings[objIndex], ": \"",
1296                 Tcl_GetString(fileName), "\" is a directory", (char *) NULL);
1297           return TCL_ERROR;
1298       }
1299     }
1300     
1301     if (err != noErr) {
1302       errno = TclMacOSErrorToPosixError(err);
1303       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
1304         "could not read \"", Tcl_GetString(fileName), "\": ",
1305         Tcl_PosixError(interp), (char *) NULL);
1306       return TCL_ERROR;
1307     }
1308     return TCL_OK;
1309 }
static int SetFileReadOnly (Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj * readOnlyPtr) [static]

Definition at line 1329 of file tclMacFCmd.c.
References CONST, errno, FSpLLocationFromPath(), NULL, TCL_ERROR, Tcl_FSGetNativePath(), Tcl_GetBooleanFromObj(), Tcl_GetObjResult(), Tcl_GetString(), TCL_OK, Tcl_PosixError(), and TclMacOSErrorToPosixError().1334 {
1335     OSErr err;
1336     FSSpec fileSpec;
1337     HParamBlockRec paramBlock;
1338     int hidden;
1339     CONST char *native;
1340 
1341     native=Tcl_FSGetNativePath(fileName);
1342     err = FSpLLocationFromPath(strlen(native),
1343       native, &fileSpec);
1344     
1345     if (err == noErr) {
1346       if (Tcl_GetBooleanFromObj(interp, readOnlyPtr, &hidden) != TCL_OK) {
1347           return TCL_ERROR;
1348       }
1349     
1350       paramBlock.fileParam.ioCompletion = NULL;
1351       paramBlock.fileParam.ioNamePtr = fileSpec.name;
1352       paramBlock.fileParam.ioVRefNum = fileSpec.vRefNum;
1353       paramBlock.fileParam.ioDirID = fileSpec.parID;
1354       if (hidden) {
1355           err = PBHSetFLock(&paramBlock, 0);
1356       } else {
1357           err = PBHRstFLock(&paramBlock, 0);
1358       }
1359     }
1360     
1361     if (err == fnfErr) {
1362       long dirID;
1363       Boolean isDirectory = 0;
1364       err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
1365       if ((err == noErr) && isDirectory) {
1366           Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1367                 "cannot set a directory to read-only when File Sharing is turned off",
1368                 (char *) NULL);
1369           return TCL_ERROR;
1370       } else {
1371           err = fnfErr;
1372       }
1373     }
1374     
1375     if (err != noErr) {
1376       errno = TclMacOSErrorToPosixError(err);
1377       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
1378         "could not read \"", Tcl_GetString(fileName), "\": ",
1379         Tcl_PosixError(interp), (char *) NULL);
1380       return TCL_ERROR;
1381     }
1382     return TCL_OK;
1383 }
int TclpDeleteFile (CONST char * path)

Definition at line 511 of file tclMacFCmd.c.
References EISDIR, errno, FSpLLocationFromPath(), TCL_ERROR, TCL_OK, and TclMacOSErrorToPosixError().
Referenced by FSUnloadTempFile(), TclpObjDeleteFile(), and TraversalDelete().513 {
514     OSErr err;
515     FSSpec fileSpec;
516     Boolean isDirectory;
517     long dirID;
518     
519     err = FSpLLocationFromPath(strlen(path), path, &fileSpec);
520     if (err == noErr) {
521   /*
522        * Since FSpDeleteCompat will delete an empty directory, make sure
523        * that this isn't a directory first.
524          */
525         
526         FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
527   if (isDirectory == true) {
528             errno = EISDIR;
529             return TCL_ERROR;
530         }
531     }
532     err = FSpDeleteCompat(&fileSpec);
533     if (err == fLckdErr) {
534       FSpRstFLockCompat(&fileSpec);
535       err = FSpDeleteCompat(&fileSpec);
536       if (err != noErr) {
537           FSpSetFLockCompat(&fileSpec);
538       }
539     }
540     if (err != noErr) {
541   errno = TclMacOSErrorToPosixError(err);
542   return TCL_ERROR;
543     }
544     return TCL_OK;
545 }
int TclpObjCopyDirectory (Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr, Tcl_Obj ** errorPtr)

Definition at line 629 of file tclMacFCmd.c.
References DoCopyDirectory(), Tcl_DStringFree(), Tcl_DStringValue, Tcl_FSGetNativePath(), Tcl_IncrRefCount, Tcl_NewStringObj(), and TCL_OK.
Referenced by TestfileCmd().633 {
634     Tcl_DString ds;
635     int ret;
636     ret = DoCopyDirectory(Tcl_FSGetNativePath(srcPathPtr),
637         Tcl_FSGetNativePath(destPathPtr), &ds);
638     if (ret != TCL_OK) {
639   *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
640   Tcl_DStringFree(&ds);
641   Tcl_IncrRefCount(*errorPtr);
642     }
643     return ret;
644 }
int TclpObjCopyFile (Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)

Definition at line 404 of file tclMacFCmd.c.
References DoCopyFile(), and Tcl_FSGetNativePath().
Referenced by TestfileCmd().407 {
408     return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
409           Tcl_FSGetNativePath(destPathPtr));
410 }
int TclpObjCreateDirectory (Tcl_Obj * pathPtr)

Definition at line 574 of file tclMacFCmd.c.
References DoCreateDirectory(), and Tcl_FSGetNativePath().
Referenced by TestfileCmd().576 {
577     return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
578 }
int TclpObjDeleteFile (Tcl_Obj * pathPtr)

Definition at line 504 of file tclMacFCmd.c.
References Tcl_FSGetNativePath(), and TclpDeleteFile().
Referenced by TestfileCmd().506 {
507     return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr));
508 }
Tcl_Obj* TclpObjListVolumes (void)

Definition at line 1401 of file tclMacFCmd.c.
References CONST, NULL, Tcl_AppendToObj(), Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, Tcl_ExternalToUtfDString(), Tcl_IncrRefCount, Tcl_ListObjAppendElement(), Tcl_NewObj(), and Tcl_NewStringObj().1402 {
1403     HParamBlockRec pb;
1404     Str255 name;
1405     OSErr theError = noErr;
1406     Tcl_Obj *resultPtr, *elemPtr;
1407     short volIndex = 1;
1408     Tcl_DString dstr;
1409 
1410     resultPtr = Tcl_NewObj();
1411         
1412     /*
1413      * We use two facts:
1414      * 1) The Mac volumes are enumerated by the ioVolIndex parameter of
1415      * the HParamBlockRec.  They run through the integers contiguously, 
1416      * starting at 1.  
1417      * 2) PBHGetVInfoSync returns an error when you ask for a volume index
1418      * that does not exist.
1419      * 
1420      */
1421         
1422     while ( 1 ) {
1423         pb.volumeParam.ioNamePtr = (StringPtr) &name;
1424         pb.volumeParam.ioVolIndex = volIndex;
1425                 
1426         theError = PBHGetVInfoSync(&pb);
1427 
1428         if ( theError != noErr ) {
1429             break;
1430         }
1431         
1432         Tcl_ExternalToUtfDString(NULL, (CONST char *)&name[1], name[0], &dstr);
1433         elemPtr = Tcl_NewStringObj(Tcl_DStringValue(&dstr),
1434     Tcl_DStringLength(&dstr));
1435         Tcl_AppendToObj(elemPtr, ":", 1);
1436         Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
1437         
1438         Tcl_DStringFree(&dstr);
1439                 
1440         volIndex++;             
1441     }
1442 
1443     Tcl_IncrRefCount(resultPtr);
1444     return resultPtr;
1445 }
int TclpObjNormalizePath (Tcl_Interp * interp, Tcl_Obj * pathPtr, int nextCheckpoint)

Definition at line 1470 of file tclMacFCmd.c.
References FALSE, FSpLLocationFromPath(), FSpPathFromLocation(), MAXMACFILENAMELEN, NULL, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, Tcl_ExternalToUtfDString(), Tcl_GetStringFromObj(), Tcl_SetStringObj(), and Tcl_UtfToExternalDString().
Referenced by TCL_DECLARE_MUTEX().1474 {
1475     #define MAXMACFILENAMELEN 31  /* assumed to be < sizeof(StrFileName) */
1476  
1477     StrFileName fileName;
1478     StringPtr fileNamePtr;
1479     int fileNameLen,newPathLen;
1480     Handle newPathHandle;
1481     OSErr err;
1482     short vRefNum;
1483     long dirID;
1484     Boolean isDirectory;
1485     Boolean wasAlias=FALSE;
1486     FSSpec fileSpec, lastFileSpec;
1487     
1488     Tcl_DString nativeds;
1489 
1490     char cur;
1491     int firstCheckpoint=nextCheckpoint, lastCheckpoint;
1492     int origPathLen;
1493     char *path = Tcl_GetStringFromObj(pathPtr,&origPathLen);
1494     
1495     {
1496   int currDirValid=0;    
1497   /*
1498    * check if substring to first ':' after initial
1499    * nextCheckpoint is a valid relative or absolute
1500    * path to a directory, if not we return without
1501    * normalizing anything
1502    */
1503   
1504   while (1) {
1505       cur = path[nextCheckpoint];
1506       if (cur == ':' || cur == 0) {
1507     if (cur == ':') { 
1508         /* jump over separator */
1509         nextCheckpoint++; cur = path[nextCheckpoint]; 
1510     } 
1511     Tcl_UtfToExternalDString(NULL,path,nextCheckpoint,&nativeds);
1512     err = FSpLLocationFromPath(Tcl_DStringLength(&nativeds), 
1513             Tcl_DStringValue(&nativeds), 
1514             &fileSpec);
1515     Tcl_DStringFree(&nativeds);
1516     if (err == noErr) {
1517       lastFileSpec=fileSpec;
1518       err = ResolveAliasFile(&fileSpec, true, &isDirectory, 
1519                &wasAlias);
1520       if (err == noErr) {
1521         err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
1522         currDirValid = ((err == noErr) && isDirectory);
1523         vRefNum = fileSpec.vRefNum;
1524         }
1525     }
1526     break;
1527       }
1528       nextCheckpoint++;
1529   }
1530   
1531   if(!currDirValid) {
1532       /* can't determine root dir, bail out */
1533       return firstCheckpoint; 
1534   }
1535     }
1536   
1537     /*
1538      * Now vRefNum and dirID point to a valid
1539      * directory, so walk the rest of the path
1540      * ( code adapted from FSpLocationFromPath() )
1541      */
1542 
1543     lastCheckpoint=nextCheckpoint;
1544     while (1) {
1545   cur = path[nextCheckpoint];
1546   if (cur == ':' || cur == 0) {
1547       fileNameLen=nextCheckpoint-lastCheckpoint;
1548       fileNamePtr=fileName;
1549       if(fileNameLen==0) {
1550     if (cur == ':') {
1551         /*
1552          * special case for empty dirname i.e. encountered
1553          * a '::' path component: get parent dir of currDir
1554          */
1555         fileName[0]=2;
1556         strcpy((char *) fileName + 1, "::");
1557         lastCheckpoint--;
1558     } else {
1559         /*
1560          * empty filename, i.e. want FSSpec for currDir
1561          */
1562         fileNamePtr=NULL;
1563     }
1564       } else {
1565     Tcl_UtfToExternalDString(NULL,&path[lastCheckpoint],
1566            fileNameLen,&nativeds);
1567     fileNameLen=Tcl_DStringLength(&nativeds);
1568     if(fileNameLen > MAXMACFILENAMELEN) { 
1569         err = bdNamErr;
1570     } else {
1571     fileName[0]=fileNameLen;
1572     strncpy((char *) fileName + 1, Tcl_DStringValue(&nativeds), 
1573       fileNameLen);
1574     }
1575     Tcl_DStringFree(&nativeds);
1576       }
1577       if(err == noErr)
1578       err=FSMakeFSSpecCompat(vRefNum, dirID, fileNamePtr, &fileSpec);
1579       if(err != noErr) {
1580     if(err != fnfErr) {
1581         /*
1582          * this can occur if trying to get parent of a root
1583          * volume via '::' or when using an illegal
1584          * filename; revert to last checkpoint and stop
1585          * processing path further
1586          */
1587         err=FSMakeFSSpecCompat(vRefNum, dirID, NULL, &fileSpec);
1588         if(err != noErr) {
1589       /* should never happen, bail out */
1590       return firstCheckpoint; 
1591         }
1592         nextCheckpoint=lastCheckpoint;
1593         cur = path[lastCheckpoint];
1594     }
1595         break; /* arrived at nonexistent file or dir */
1596       } else {
1597     /* fileSpec could point to an alias, resolve it */
1598     lastFileSpec=fileSpec;
1599     err = ResolveAliasFile(&fileSpec, true, &isDirectory, 
1600                &wasAlias);
1601     if (err != noErr || !isDirectory) {
1602         break; /* fileSpec doesn't point to a dir */
1603     }
1604       }
1605       if (cur == 0) break; /* arrived at end of path */
1606       
1607       /* fileSpec points to possibly nonexisting subdirectory; validate */
1608       err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
1609       if (err != noErr || !isDirectory) {
1610           break; /* fileSpec doesn't point to existing dir */
1611       }
1612       vRefNum = fileSpec.vRefNum;
1613       
1614       /* found a new valid subdir in path, continue processing path */
1615       lastCheckpoint=nextCheckpoint+1;
1616   }
1617   wasAlias=FALSE;
1618   nextCheckpoint++;
1619     }
1620     
1621     if (wasAlias)
1622       fileSpec=lastFileSpec;
1623     
1624     /*
1625      * fileSpec now points to a possibly nonexisting file or dir
1626      *  inside a valid dir; get full path name to it
1627      */
1628     
1629     err=FSpPathFromLocation(&fileSpec, &newPathLen, &newPathHandle);
1630     if(err != noErr) {
1631   return firstCheckpoint; /* should not see any errors here, bail out */
1632     }
1633     
1634     HLock(newPathHandle);
1635     Tcl_ExternalToUtfDString(NULL,*newPathHandle,newPathLen,&nativeds);
1636     if (cur != 0) {
1637   /* not at end, append remaining path */
1638       if ( newPathLen==0 || (*(*newPathHandle+(newPathLen-1))!=':' && path[nextCheckpoint] !=':')) {
1639       Tcl_DStringAppend(&nativeds, ":" , 1);
1640   }
1641   Tcl_DStringAppend(&nativeds, &path[nextCheckpoint], 
1642         strlen(&path[nextCheckpoint]));
1643     }
1644     DisposeHandle(newPathHandle);
1645     
1646     fileNameLen=Tcl_DStringLength(&nativeds);
1647     Tcl_SetStringObj(pathPtr,Tcl_DStringValue(&nativeds),fileNameLen);
1648     Tcl_DStringFree(&nativeds);
1649     
1650     return nextCheckpoint+(fileNameLen-origPathLen);
1651 }
int TclpObjRemoveDirectory (Tcl_Obj * pathPtr, int recursive, Tcl_Obj ** errorPtr)

Definition at line 829 of file tclMacFCmd.c.
References DoRemoveDirectory(), Tcl_DStringFree(), Tcl_DStringValue, Tcl_FSGetNativePath(), Tcl_IncrRefCount, Tcl_NewStringObj(), and TCL_OK.
Referenced by TestfileCmd().833 {
834     Tcl_DString ds;
835     int ret;
836     ret = DoRemoveDirectory(Tcl_FSGetNativePath(pathPtr),recursive, &ds);
837     if (ret != TCL_OK) {
838   *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
839   Tcl_DStringFree(&ds);
840   Tcl_IncrRefCount(*errorPtr);
841     }
842     return ret;
843 }
int TclpObjRenameFile (Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)

Definition at line 139 of file tclMacFCmd.c.
References DoRenameFile(), and Tcl_FSGetNativePath().
Referenced by TestfileCmd().142 {
143     return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
144       Tcl_FSGetNativePath(destPathPtr));
145 }

Variable Documentation
long startSeed = 248923489 [static]

Definition at line 72 of file tclMacFCmd.c.CONST TclFileAttrProcs tclpFileAttrProcs[]
Initial value: {
  {GetFileFinderAttributes, SetFileFinderAttributes},
  {GetFileFinderAttributes, SetFileFinderAttributes},
  {GetFileReadOnly, SetFileReadOnly},
  {GetFileFinderAttributes, SetFileFinderAttributes}}
Definition at line 62 of file tclMacFCmd.c.CONST char* tclpFileAttrStrings[]
Initial value: {"-creator", "-hidden", "-readonly",
  "-type", (char *) NULL}
Definition at line 60 of file tclMacFCmd.c.

mac/tclMacFile.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include "tclMacInt.h"
#include <Aliases.h>
#include <Resources.h>
#include <Files.h>
#include <Errors.h>
#include <Processes.h>
#include <Strings.h>
#include <Types.h>
#include <MoreFiles.h>
#include <MoreFilesExtras.h>
#include <FSpCompat.h>
Functions
static int NativeMatchType (Tcl_Obj *tempName, Tcl_GlobTypeData *types, HFileInfo fileInfo, OSType okType, OSType okCreator)
static OSErr FspLocationFromFsPath _ANSI_ARGS_ ((Tcl_Obj *pathPtr, FSSpec *specPtr))
static OSErr CreateAliasFile _ANSI_ARGS_ ((FSSpec *theAliasFile, FSSpec *targetFile))
static OSErr FspLocationFromFsPath (Tcl_Obj *pathPtr, FSSpec *specPtr)
static OSErr FspLLocationFromFsPath (Tcl_Obj *pathPtr, FSSpec *specPtr)
char * TclpFindExecutable (CONST char *argv0)
int TclpMatchInDirectory (Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types)
int TclpObjAccess (Tcl_Obj *pathPtr, int mode)
int TclpObjChdir (Tcl_Obj *pathPtr)
Tcl_Obj * TclpObjGetCwd (Tcl_Interp *interp)
CONST char * TclpGetCwd (Tcl_Interp *interp, Tcl_DString *bufferPtr)
char * TclpReadlink (CONST char *path, Tcl_DString *linkPtr)
static int TclpObjStatAlias _ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_StatBuf *bufPtr, Boolean resolveLink))
int TclpObjLstat (Tcl_Obj *pathPtr, Tcl_StatBuf *buf)
int TclpObjStat (Tcl_Obj *pathPtr, Tcl_StatBuf *bufPtr)
static int TclpObjStatAlias (Tcl_Obj *pathPtr, Tcl_StatBuf *bufPtr, Boolean resolveLink)
Tcl_Pid Tcl_WaitPid (Tcl_Pid pid, int *statPtr, int options)
FILE * TclMacFOpenHack (CONST char *path, CONST char *mode)
char * TclpGetUserHome (CONST char *name, Tcl_DString *bufferPtr)
int TclMacOSErrorToPosixError (int error)
int TclMacChmod (CONST char *path, int mode)
Tcl_Obj * TclpTempFileName ()
Tcl_Obj * TclpFilesystemPathType (Tcl_Obj *pathObjPtr)
int TclpUtime (Tcl_Obj *pathPtr, struct utimbuf *tval)
static OSErr CreateAliasFile (FSSpec *theAliasFile, FSSpec *targetFile)

Function Documentation
static int TclpObjStatAlias _ANSI_ARGS_ ((Tcl_Obj *pathPtr, Tcl_StatBuf *bufPtr, Boolean resolveLink)) [static]
static OSErr CreateAliasFile _ANSI_ARGS_ ((FSSpec *theAliasFile, FSSpec *targetFile)) [static]
static OSErr FspLocationFromFsPath _ANSI_ARGS_ ((Tcl_Obj *pathPtr, FSSpec *specPtr)) [static]
static OSErr CreateAliasFile (FSSpec * theAliasFile, FSSpec * targetFile) [static]

Definition at line 1296 of file tclMacFile.c.
References kIsAlias.1297 {
1298     CInfoPBRec cat;
1299     FInfo fndrInfo;
1300     AliasHandle theAlias;
1301     short saveRef, rsrc = -1;
1302     OSErr err;
1303     
1304     saveRef = CurResFile();
1305     /* set up the Finder information record for the alias file */
1306     cat.dirInfo.ioNamePtr = targetFile->name;
1307     cat.dirInfo.ioVRefNum = targetFile->vRefNum;
1308     cat.dirInfo.ioFDirIndex = 0;
1309     cat.dirInfo.ioDrDirID = targetFile->parID;
1310     err = PBGetCatInfoSync(&cat);
1311     if (err != noErr) goto bail;
1312     if ((cat.dirInfo.ioFlAttrib & 16) == 0) {
1313         /* file alias */
1314         switch (cat.hFileInfo.ioFlFndrInfo.fdType) {
1315             case 'APPL': fndrInfo.fdType = kApplicationAliasType; break;
1316             case 'APPC': fndrInfo.fdType = kApplicationCPAliasType; break;
1317             case 'APPD': fndrInfo.fdType = kApplicationDAAliasType; break;
1318             default: fndrInfo.fdType = cat.hFileInfo.ioFlFndrInfo.fdType; break;
1319         }
1320         fndrInfo.fdCreator = cat.hFileInfo.ioFlFndrInfo.fdCreator;
1321     } else {
1322         /* folder alias */
1323         fndrInfo.fdType = kContainerFolderAliasType;
1324         fndrInfo.fdCreator = 'MACS';
1325     }
1326     fndrInfo.fdFlags = kIsAlias;
1327     fndrInfo.fdLocation.v = 0;
1328     fndrInfo.fdLocation.h = 0;
1329     fndrInfo.fdFldr = 0;
1330     /* create new file and set the file information */
1331     FSpCreateResFile( theAliasFile, fndrInfo.fdCreator, fndrInfo.fdType, smSystemScript);
1332     if ((err = ResError()) != noErr) goto bail;
1333     err = FSpSetFInfo( theAliasFile, &fndrInfo);
1334     if (err != noErr) goto bail;
1335     /* save the alias resource */
1336     rsrc = FSpOpenResFile(theAliasFile, fsRdWrPerm);
1337     if (rsrc == -1) { err = ResError(); goto bail; }
1338     UseResFile(rsrc);
1339     err = NewAlias(theAliasFile, targetFile, &theAlias);
1340     if (err != noErr) goto bail;
1341     AddResource((Handle) theAlias, rAliasType, 0, theAliasFile->name);
1342     if ((err = ResError()) != noErr) goto bail;
1343     CloseResFile(rsrc);
1344     rsrc = -1;
1345     /* done */
1346  bail:
1347     if (rsrc != -1) CloseResFile(rsrc);
1348     UseResFile(saveRef);
1349     return err;
1350 }
static OSErr FspLLocationFromFsPath (Tcl_Obj * pathPtr, FSSpec* specPtr) [static]

Definition at line 55 of file tclMacFile.c.
References CONST, FSpLLocationFromPath(), and Tcl_FSGetNativePath().
Referenced by TclpMatchInDirectory(), TclpObjAccess(), and TclpObjStatAlias().58 {
59     CONST char *native = Tcl_FSGetNativePath(pathPtr);
60     return FSpLLocationFromPath(strlen(native), native, specPtr);
61 }
static OSErr FspLocationFromFsPath (Tcl_Obj * pathPtr, FSSpec* specPtr) [static]

Definition at line 46 of file tclMacFile.c.
References CONST, FSpLocationFromPath(), and Tcl_FSGetNativePath().
Referenced by TclpObjChdir(), and TclpObjStatAlias().49 {
50     CONST char *native = Tcl_FSGetNativePath(pathPtr);
51     return FSpLocationFromPath(strlen(native), native, specPtr);
52 }
static int NativeMatchType (Tcl_Obj * tempName, Tcl_GlobTypeData * types, HFileInfo fileInfo, OSType okType, OSType okCreator) [static]

Definition at line 338 of file tclMacFile.c.
References kIsInvisible, NULL, R_OK, S_ISBLK, S_ISCHR, S_ISDIR, S_ISFIFO, S_ISLNK, S_ISREG, S_ISSOCK, TCL_GLOB_PERM_HIDDEN, TCL_GLOB_PERM_R, TCL_GLOB_PERM_RONLY, TCL_GLOB_PERM_W, TCL_GLOB_PERM_X, TCL_GLOB_TYPE_BLOCK, TCL_GLOB_TYPE_CHAR, TCL_GLOB_TYPE_DIR, TCL_GLOB_TYPE_FILE, TCL_GLOB_TYPE_LINK, TCL_GLOB_TYPE_PIPE, TCL_GLOB_TYPE_SOCK, TclpObjAccess(), TclpObjLstat(), TclpObjStat(), W_OK, and X_OK.
Referenced by TclpMatchInDirectory().344 {
345     if (types == NULL) {
346   /* If invisible, don't return the file */
347   if (fileInfo.ioFlFndrInfo.fdFlags & kIsInvisible) {
348       return 0;
349   }
350     } else {
351   Tcl_StatBuf buf;
352   
353   if (fileInfo.ioFlFndrInfo.fdFlags & kIsInvisible) {
354       /* If invisible */
355       if ((types->perm == 0) || 
356         !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
357     return 0;
358       }
359   } else {
360       /* Visible */
361       if (types->perm & TCL_GLOB_PERM_HIDDEN) {
362     return 0;
363       }
364   }
365   if (types->perm != 0) {
366       if (
367     ((types->perm & TCL_GLOB_PERM_RONLY) &&
368       !(fileInfo.ioFlAttrib & 1)) ||
369     ((types->perm & TCL_GLOB_PERM_R) &&
370       (TclpObjAccess(tempName, R_OK) != 0)) ||
371     ((types->perm & TCL_GLOB_PERM_W) &&
372       (TclpObjAccess(tempName, W_OK) != 0)) ||
373     ((types->perm & TCL_GLOB_PERM_X) &&
374       (TclpObjAccess(tempName, X_OK) != 0))
375     ) {
376     return 0;
377       }
378   }
379   if (types->type != 0) {
380       if (TclpObjStat(tempName, &buf) != 0) {
381     /* Posix error occurred */
382     return 0;
383       }
384       /*
385        * In order bcdpfls as in 'find -t'
386        */
387       if (
388     ((types->type & TCL_GLOB_TYPE_BLOCK) &&
389       S_ISBLK(buf.st_mode)) ||
390     ((types->type & TCL_GLOB_TYPE_CHAR) &&
391       S_ISCHR(buf.st_mode)) ||
392     ((types->type & TCL_GLOB_TYPE_DIR) &&
393       S_ISDIR(buf.st_mode)) ||
394     ((types->type & TCL_GLOB_TYPE_PIPE) &&
395       S_ISFIFO(buf.st_mode)) ||
396     ((types->type & TCL_GLOB_TYPE_FILE) &&
397       S_ISREG(buf.st_mode))
398 #ifdef S_ISSOCK
399     || ((types->type & TCL_GLOB_TYPE_SOCK) &&
400       S_ISSOCK(buf.st_mode))
401 #endif
402     ) {
403     /* Do nothing -- this file is ok */
404       } else {
405     int typeOk = 0;
406 #ifdef S_ISLNK
407     if (types->type & TCL_GLOB_TYPE_LINK) {
408         if (TclpObjLstat(tempName, &buf) == 0) {
409       if (S_ISLNK(buf.st_mode)) {
410           typeOk = 1;
411       }
412         }
413     }
414 #endif
415     if (typeOk == 0) {
416         return 0;
417     }
418       }
419   }
420   if (((okType != 0) && (okType !=
421              fileInfo.ioFlFndrInfo.fdType)) ||
422       ((okCreator != 0) && (okCreator !=
423           fileInfo.ioFlFndrInfo.fdCreator))) {
424       return 0;
425   }
426     }
427     return 1;
428 }
Tcl_Pid Tcl_WaitPid (Tcl_Pid pid, int * statPtr, int options)

Definition at line 961 of file tclMacFile.c.
Referenced by Tcl_ReapDetachedProcs(), TclCleanupChildren(), and TclpCreateProcess().965 {
966     return (Tcl_Pid) -1;
967 }
int TclMacChmod (CONST char * path, int mode)

Definition at line 1100 of file tclMacFile.c.
References errno, and TclMacOSErrorToPosixError().1103 {
1104     HParamBlockRec hpb;
1105     OSErr err;
1106     Str255 pathName;
1107     strcpy((char *) pathName + 1, path);
1108     pathName[0] = strlen(path);
1109     hpb.fileParam.ioNamePtr = pathName;
1110     hpb.fileParam.ioVRefNum = 0;
1111     hpb.fileParam.ioDirID = 0;
1112     
1113     if (mode & 0200) {
1114         err = PBHRstFLockSync(&hpb);
1115     } else {
1116         err = PBHSetFLockSync(&hpb);
1117     }
1118     
1119     if (err != noErr) {
1120         errno = TclMacOSErrorToPosixError(err);
1121         return -1;
1122     }
1123     
1124     return 0;
1125 }
FILE* TclMacFOpenHack (CONST char * path, CONST char * mode)

Definition at line 988 of file tclMacFile.c.
References fopen, FSpLocationFromPath(), FSpPathFromLocation(), and NULL.991 {
992     OSErr err;
993     FSSpec fileSpec;
994     Handle pathString = NULL;
995     int size;
996     FILE * f;
997     
998     err = FSpLocationFromPath(strlen(path), path, &fileSpec);
999     if ((err != noErr) && (err != fnfErr)) {
1000   return NULL;
1001     }
1002     err = FSpPathFromLocation(&fileSpec, &size, &pathString);
1003     if ((err != noErr) && (err != fnfErr)) {
1004   return NULL;
1005     }
1006     
1007     HLock(pathString);
1008     f = fopen(*pathString, mode);
1009     HUnlock(pathString);
1010     DisposeHandle(pathString);
1011     return f;
1012 }
int TclMacOSErrorToPosixError (int error)

Definition at line 1061 of file tclMacFile.c.
References EACCES, EBUSY, EEXIST, EINVAL, ENAMETOOLONG, ENFILE, ENOENT, ENOSPC, ENOTDIR, EROFS, and EXDEV.
Referenced by DoCopyDirectory(), DoCopyFile(), DoCreateDirectory(), DoRemoveDirectory(), DoRenameFile(), FileClose(), FileOutput(), FileSeek(), GetFileFinderAttributes(), GetFileReadOnly(), OpenFileChannel(), SetFileFinderAttributes(), SetFileReadOnly(), TclMacChmod(), TclpDeleteFile(), TclpObjAccess(), TclpObjStatAlias(), and TclpReadlink().1063 {
1064     switch (error) {
1065   case noErr:
1066       return 0;
1067   case bdNamErr:
1068       return ENAMETOOLONG;
1069   case afpObjectTypeErr:
1070       return ENOTDIR;
1071   case fnfErr:
1072   case dirNFErr:
1073       return ENOENT;
1074   case dupFNErr:
1075       return EEXIST;
1076   case dirFulErr:
1077   case dskFulErr:
1078       return ENOSPC;
1079   case fBsyErr:
1080       return EBUSY;
1081   case tmfoErr:
1082       return ENFILE;
1083   case fLckdErr:
1084   case permErr:
1085   case afpAccessDenied:
1086       return EACCES;
1087   case wPrErr:
1088   case vLckdErr:
1089       return EROFS;
1090   case badMovErr:
1091       return EINVAL;
1092   case diffVolErr:
1093       return EXDEV;
1094   default:
1095       return EINVAL;
1096     }
1097 }
Tcl_Obj* TclpFilesystemPathType (Tcl_Obj* pathObjPtr)

Definition at line 1245 of file tclMacFile.c.
References NULL.1247 {
1248     /* All native paths are of the same type */
1249     return NULL;
1250 }
char* TclpFindExecutable (CONST char * argv0)

Definition at line 86 of file tclMacFile.c.
References ckalloc, ckfree, FSpPathFromLocation(), NULL, Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, Tcl_ExternalToUtfDString(), tclExecutableName, and TclInitSubsystems().
Referenced by Tcl_FindExecutable(), TclFindEncodings(), and TclpCreateProcess().88 {
89     ProcessSerialNumber psn;
90     ProcessInfoRec info;
91     Str63 appName;
92     FSSpec fileSpec;
93     int pathLength;
94     Handle pathName = NULL;
95     OSErr err;
96     Tcl_DString ds;
97     
98     TclInitSubsystems(argv0);
99     
100     GetCurrentProcess(&psn);
101     info.processInfoLength = sizeof(ProcessInfoRec);
102     info.processName = appName;
103     info.processAppSpec = &fileSpec;
104     GetProcessInformation(&psn, &info);
105 
106     if (tclExecutableName != NULL) {
107   ckfree(tclExecutableName);
108   tclExecutableName = NULL;
109     }
110     
111     err = FSpPathFromLocation(&fileSpec, &pathLength, &pathName);
112     HLock(pathName);
113     Tcl_ExternalToUtfDString(NULL, *pathName, pathLength, &ds);
114     HUnlock(pathName);
115     DisposeHandle(pathName);  
116 
117     tclExecutableName = (char *) ckalloc((unsigned) 
118           (Tcl_DStringLength(&ds) + 1));
119     strcpy(tclExecutableName, Tcl_DStringValue(&ds));
120     Tcl_DStringFree(&ds);
121     return tclExecutableName;
122 }
CONST char* TclpGetCwd (Tcl_Interp * interp, Tcl_DString * bufferPtr)

Definition at line 622 of file tclMacFile.c.
References FSpGetDefaultDir(), FSpPathFromLocation(), NULL, Tcl_DStringValue, Tcl_ExternalToUtfDString(), Tcl_SetResult(), and TCL_STATIC.
Referenced by TclpFindExecutable(), and TclpObjGetCwd().626 {
627     FSSpec theSpec;
628     int length;
629     Handle pathHandle = NULL;
630     
631     if (FSpGetDefaultDir(&theSpec) != noErr) {
632   if (interp != NULL) {
633       Tcl_SetResult(interp, "error getting working directory name",
634         TCL_STATIC);
635   }
636   return NULL;
637     }
638     if (FSpPathFromLocation(&theSpec, &length, &pathHandle) != noErr) {
639   if (interp != NULL) {
640        Tcl_SetResult(interp, "error getting working directory name",
641         TCL_STATIC);
642   }
643   return NULL;
644     }
645     HLock(pathHandle);
646     Tcl_ExternalToUtfDString(NULL, *pathHandle, length, bufferPtr);
647     HUnlock(pathHandle);
648     DisposeHandle(pathHandle);  
649 
650     return Tcl_DStringValue(bufferPtr);
651 }
char* TclpGetUserHome (CONST char * name, Tcl_DString * bufferPtr)

Definition at line 1036 of file tclMacFile.c.
References NULL.
Referenced by DoTildeSubst(), and SetFsPathFromAny().1040 {
1041     return NULL;
1042 }
int TclpMatchInDirectory (Tcl_Interp * interp, Tcl_Obj * resultPtr, Tcl_Obj * pathPtr, CONST char * pattern, Tcl_GlobTypeData * types)

Definition at line 144 of file tclMacFile.c.
References FspLLocationFromFsPath(), FSpLocationFromPath(), NativeMatchType(), NULL, Tcl_DecrRefCount, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringSetLength(), Tcl_DStringValue, TCL_ERROR, Tcl_ExternalToUtfDString(), Tcl_FSGetTranslatedPath(), Tcl_GetOSTypeFromObj(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_ListObjAppendElement(), Tcl_NewStringObj(), TCL_OK, Tcl_StringMatch(), Tcl_UtfToExternalDString(), and TclpObjLstat().154 {
155     OSType okType = 0;
156     OSType okCreator = 0;
157     Tcl_Obj *fileNamePtr;
158 
159     fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
160     if (fileNamePtr == NULL) {
161   return TCL_ERROR;
162     }
163     
164     if (types != NULL) {
165   if (types->macType != NULL) {
166       Tcl_GetOSTypeFromObj(NULL, types->macType, &okType);
167   }
168   if (types->macCreator != NULL) {
169       Tcl_GetOSTypeFromObj(NULL, types->macCreator, &okCreator);
170   }
171     }
172 
173     if (pattern == NULL || (*pattern == '\0')) {
174   /* Match a single file directly */
175   Tcl_StatBuf buf;
176   CInfoPBRec paramBlock;
177   FSSpec fileSpec;
178   
179   if (TclpObjLstat(fileNamePtr, &buf) != 0) {
180       /* File doesn't exist */
181       Tcl_DecrRefCount(fileNamePtr);
182       return TCL_OK;
183   }
184 
185   if (FspLLocationFromFsPath(fileNamePtr, &fileSpec) == noErr) {
186       paramBlock.hFileInfo.ioCompletion = NULL;
187       paramBlock.hFileInfo.ioNamePtr = fileSpec.name;
188       paramBlock.hFileInfo.ioVRefNum = fileSpec.vRefNum;
189       paramBlock.hFileInfo.ioFDirIndex = 0;
190       paramBlock.hFileInfo.ioDirID = fileSpec.parID;
191       
192       PBGetCatInfo(&paramBlock, 0);
193   }
194 
195   if (NativeMatchType(fileNamePtr, types, paramBlock.hFileInfo,
196           okType, okCreator)) {
197       int fnameLen;
198       char *fname = Tcl_GetStringFromObj(pathPtr,&fnameLen);
199       if ((fnameLen > 1) && (strchr(fname+1, ':') == NULL)) {
200     Tcl_ListObjAppendElement(interp, resultPtr, 
201       Tcl_NewStringObj(fname+1, fnameLen-1));
202       } else {
203     Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
204       }
205   }
206   Tcl_DecrRefCount(fileNamePtr);
207   return TCL_OK;
208     } else {
209   char *fname;
210   int fnameLen, result = TCL_OK;
211   int baseLength;
212   CInfoPBRec pb;
213   OSErr err;
214   FSSpec dirSpec;
215   Boolean isDirectory;
216   long dirID;
217   short itemIndex;
218   Str255 fileName;
219   Tcl_DString fileString;    
220   Tcl_DString dsOrig;
221 
222   Tcl_DStringInit(&dsOrig);
223   Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
224   baseLength = Tcl_DStringLength(&dsOrig);
225 
226   /*
227    * Make sure that the directory part of the name really is a
228    * directory.
229    */
230 
231   Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&dsOrig),
232     Tcl_DStringLength(&dsOrig), &fileString);
233 
234   err = FSpLocationFromPath(Tcl_DStringLength(&fileString), 
235           Tcl_DStringValue(&fileString), &dirSpec);
236   Tcl_DStringFree(&fileString);
237   if (err == noErr) {
238       err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
239   }
240   
241   if ((err != noErr) || !isDirectory) {
242       /*
243        * Check if we had a relative path (unix style relative path 
244        * compatibility for glob)
245        */
246       Tcl_DStringFree(&dsOrig);
247       Tcl_DStringAppend(&dsOrig, ":", 1);
248       Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
249       baseLength = Tcl_DStringLength(&dsOrig);
250 
251       Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&dsOrig),
252         Tcl_DStringLength(&dsOrig), &fileString);
253       
254       err = FSpLocationFromPath(Tcl_DStringLength(&fileString), 
255               Tcl_DStringValue(&fileString), &dirSpec);
256       Tcl_DStringFree(&fileString);
257       if (err == noErr) {
258     err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
259       }
260       
261       if ((err != noErr) || !isDirectory) {
262     Tcl_DStringFree(&dsOrig);
263     Tcl_DecrRefCount(fileNamePtr);
264     return TCL_OK;
265       }
266   }
267 
268   /* Make sure we have a trailing directory delimiter */
269   if (Tcl_DStringValue(&dsOrig)[baseLength-1] != ':') {
270       Tcl_DStringAppend(&dsOrig, ":", 1);
271       baseLength++;
272   }
273   
274   /*
275    * Now open the directory for reading and iterate over the contents.
276    */
277 
278   pb.hFileInfo.ioVRefNum = dirSpec.vRefNum;
279   pb.hFileInfo.ioDirID = dirID;
280   pb.hFileInfo.ioNamePtr = (StringPtr) fileName;
281   pb.hFileInfo.ioFDirIndex = itemIndex = 1;
282 
283   while (1) {
284       pb.hFileInfo.ioFDirIndex = itemIndex;
285       pb.hFileInfo.ioDirID = dirID;
286       err = PBGetCatInfoSync(&pb);
287       if (err != noErr) {
288     break;
289       }
290 
291       /*
292        * Now check to see if the file matches.  
293        */
294        
295       Tcl_ExternalToUtfDString(NULL, (char *) fileName + 1, fileName[0],
296         &fileString);
297       if (Tcl_StringMatch(Tcl_DStringValue(&fileString), pattern)) {
298     Tcl_Obj *tempName;
299     Tcl_DStringSetLength(&dsOrig, baseLength);
300     Tcl_DStringAppend(&dsOrig, Tcl_DStringValue(&fileString), -1);
301     fname = Tcl_DStringValue(&dsOrig);
302     fnameLen = Tcl_DStringLength(&dsOrig);
303     
304     /* 
305      * We use this tempName in calls to check the file's
306      * type below.  We may also use it for the result.
307      */
308     tempName = Tcl_NewStringObj(fname, fnameLen);
309     Tcl_IncrRefCount(tempName);
310 
311     /* Is the type acceptable? */
312     if (NativeMatchType(tempName, types, pb.hFileInfo,
313             okType, okCreator)) {
314         if ((fnameLen > 1) && (strchr(fname+1, ':') == NULL)) {
315       Tcl_ListObjAppendElement(interp, resultPtr, 
316         Tcl_NewStringObj(fname+1, fnameLen-1));
317         } else {
318       Tcl_ListObjAppendElement(interp, resultPtr, tempName);
319         }
320     }
321     /* 
322      * This will free the object, unless it was inserted in
323      * the result list above.
324      */
325     Tcl_DecrRefCount(tempName);
326       }
327       Tcl_DStringFree(&fileString);
328       itemIndex++;
329   }
330 
331   Tcl_DStringFree(&dsOrig);
332   Tcl_DecrRefCount(fileNamePtr);
333   return result;
334     }
335 }
int TclpObjAccess (Tcl_Obj * pathPtr, int mode)

Definition at line 448 of file tclMacFile.c.
References EACCES, EROFS, errno, FspLLocationFromFsPath(), TclMacOSErrorToPosixError(), W_OK, and X_OK.
Referenced by NativeMatchType(), and PretendTclpAccess().451 {
452     HFileInfo fpb;
453     HVolumeParam vpb;
454     OSErr err;
455     FSSpec fileSpec;
456     Boolean isDirectory;
457     long dirID;
458     int full_mode = 0;
459 
460     err = FspLLocationFromFsPath(pathPtr, &fileSpec);
461 
462     if (err != noErr) {
463   errno = TclMacOSErrorToPosixError(err);
464   return -1;
465     }
466     
467     /*
468      * Fill the fpb & vpb struct up with info about file or directory.
469      */
470     FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
471     vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum;
472     vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name;
473     if (isDirectory) {
474   fpb.ioDirID = fileSpec.parID;
475     } else {
476   fpb.ioDirID = dirID;
477     }
478 
479     fpb.ioFDirIndex = 0;
480     err = PBGetCatInfoSync((CInfoPBPtr)&fpb);
481     if (err == noErr) {
482   vpb.ioVolIndex = 0;
483   err = PBHGetVInfoSync((HParmBlkPtr)&vpb);
484   if (err == noErr) {
485       /* 
486        * Use the Volume Info & File Info to determine
487        * access information.  If we have got this far
488        * we know the directory is searchable or the file
489        * exists.  (We have F_OK)
490        */
491 
492       /*
493        * Check to see if the volume is hardware or
494        * software locked.  If so we arn't W_OK.
495        */
496       if (mode & W_OK) {
497     if ((vpb.ioVAtrb & 0x0080) || (vpb.ioVAtrb & 0x8000)) {
498         errno = EROFS;
499         return -1;
500     }
501     if (fpb.ioFlAttrib & 0x01) {
502         errno = EACCES;
503         return -1;
504     }
505       }
506       
507       /*
508        * Directories are always searchable and executable.  But only 
509        * files of type 'APPL' are executable.
510        */
511       if (!(fpb.ioFlAttrib & 0x10) && (mode & X_OK)
512     && (fpb.ioFlFndrInfo.fdType != 'APPL')) {
513     return -1;
514       }
515   }
516     }
517 
518     if (err != noErr) {
519   errno = TclMacOSErrorToPosixError(err);
520   return -1;
521     }
522     
523     return 0;
524 }
int TclpObjChdir (Tcl_Obj * pathPtr)

Definition at line 544 of file tclMacFile.c.
References EACCES, ENOENT, ENOTDIR, errno, FspLocationFromFsPath(), and FSpSetDefaultDir().546 {
547     FSSpec spec;
548     OSErr err;
549     Boolean isFolder;
550     long dirID;
551 
552     err = FspLocationFromFsPath(pathPtr, &spec);
553 
554     if (err != noErr) {
555   errno = ENOENT;
556   return -1;
557     }
558     
559     err = FSpGetDirectoryID(&spec, &dirID, &isFolder);
560     if (err != noErr) {
561   errno = ENOENT;
562   return -1;
563     }
564 
565     if (isFolder != true) {
566   errno = ENOTDIR;
567   return -1;
568     }
569 
570     err = FSpSetDefaultDir(&spec);
571     if (err != noErr) {
572   switch (err) {
573       case afpAccessDenied:
574     errno = EACCES;
575     break;
576       default:
577     errno = ENOENT;
578   }
579   return -1;
580     }
581 
582     return 0;
583 }
Tcl_Obj* TclpObjGetCwd (Tcl_Interp * interp)

Definition at line 607 of file tclMacFile.c.
References NULL, Tcl_DStringFree(), Tcl_DStringValue, Tcl_IncrRefCount, Tcl_NewStringObj(), and TclpGetCwd().609 {
610     Tcl_DString ds;
611     if (TclpGetCwd(interp, &ds) != NULL) {
612   Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
613   Tcl_IncrRefCount(cwdPtr);
614   Tcl_DStringFree(&ds);
615   return cwdPtr;
616     } else {
617   return NULL;
618     }
619 }
int TclpObjLstat (Tcl_Obj * pathPtr, Tcl_StatBuf * buf)

Definition at line 808 of file tclMacFile.c.
References FALSE, and TclpObjStatAlias().
Referenced by NativeMatchType(), and TclpMatchInDirectory().811 {
812     return TclpObjStatAlias(pathPtr, buf, FALSE);
813 }
int TclpObjStat (Tcl_Obj * pathPtr, Tcl_StatBuf * bufPtr)

Definition at line 832 of file tclMacFile.c.
References TclpObjStatAlias(), and TRUE.
Referenced by GetGroupAttribute(), GetOwnerAttribute(), GetPermissionsAttribute(), NativeMatchType(), PretendTclpStat(), and SetPermissionsAttribute().835 {
836     return TclpObjStatAlias(pathPtr, bufPtr, TRUE);
837 }
static int TclpObjStatAlias (Tcl_Obj * pathPtr, Tcl_StatBuf * bufPtr, Boolean resolveLink) [static]

Definition at line 841 of file tclMacFile.c.
References errno, FspLLocationFromFsPath(), FspLocationFromFsPath(), NULL, S_IFLNK, tcl_mac_epoch_offset, TclMacOSErrorToPosixError(), and TclpGetGMTOffset().
Referenced by TclpObjLstat(), and TclpObjStat().842 {
843     HFileInfo fpb;
844     HVolumeParam vpb;
845     OSErr err;
846     FSSpec fileSpec;
847     Boolean isDirectory;
848     long dirID;
849     
850     if (resolveLink)
851       err = FspLocationFromFsPath(pathPtr, &fileSpec);
852     else
853       err = FspLLocationFromFsPath(pathPtr, &fileSpec);
854     
855     if (err != noErr) {
856   errno = TclMacOSErrorToPosixError(err);
857   return -1;
858     }
859     
860     /*
861      * Fill the fpb & vpb struct up with info about file or directory.
862      */
863      
864     FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
865     vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum;
866     vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name;
867     if (isDirectory) {
868   fpb.ioDirID = fileSpec.parID;
869     } else {
870   fpb.ioDirID = dirID;
871     }
872 
873     fpb.ioFDirIndex = 0;
874     err = PBGetCatInfoSync((CInfoPBPtr)&fpb);
875     if (err == noErr) {
876   vpb.ioVolIndex = 0;
877   err = PBHGetVInfoSync((HParmBlkPtr)&vpb);
878   if (err == noErr && bufPtr != NULL) {
879       /* 
880        * Files are always readable by everyone.
881        */
882        
883       bufPtr->st_mode = S_IRUSR | S_IRGRP | S_IROTH;
884 
885       /* 
886        * Use the Volume Info & File Info to fill out stat buf.
887        */
888       if (fpb.ioFlAttrib & 0x10) {
889     bufPtr->st_mode |= S_IFDIR;
890     bufPtr->st_nlink = 2;
891       } else {
892     bufPtr->st_nlink = 1;
893     if (fpb.ioFlFndrInfo.fdFlags & 0x8000) {
894         bufPtr->st_mode |= S_IFLNK;
895     } else {
896         bufPtr->st_mode |= S_IFREG;
897     }
898       }
899       if ((fpb.ioFlAttrib & 0x10) || (fpb.ioFlFndrInfo.fdType == 'APPL')) {
900     /*
901      * Directories and applications are executable by everyone.
902      */
903      
904     bufPtr->st_mode |= S_IXUSR | S_IXGRP | S_IXOTH;
905       }
906       if ((fpb.ioFlAttrib & 0x01) == 0){
907     /* 
908      * If not locked, then everyone has write acces.
909      */
910      
911     bufPtr->st_mode |= S_IWUSR | S_IWGRP | S_IWOTH;
912       }
913       bufPtr->st_ino = fpb.ioDirID;
914       bufPtr->st_dev = fpb.ioVRefNum;
915       bufPtr->st_uid = -1;
916       bufPtr->st_gid = -1;
917       bufPtr->st_rdev = 0;
918       bufPtr->st_size = fpb.ioFlLgLen;
919       bufPtr->st_blksize = vpb.ioVAlBlkSiz;
920       bufPtr->st_blocks = (bufPtr->st_size + bufPtr->st_blksize - 1)
921     / bufPtr->st_blksize;
922 
923       /*
924        * The times returned by the Mac file system are in the
925        * local time zone.  We convert them to GMT so that the
926        * epoch starts from GMT.  This is also consistent with
927        * what is returned from "clock seconds".
928        */
929 
930       bufPtr->st_atime = bufPtr->st_mtime = fpb.ioFlMdDat 
931         - TclpGetGMTOffset() + tcl_mac_epoch_offset;
932       bufPtr->st_ctime = fpb.ioFlCrDat - TclpGetGMTOffset() 
933         + tcl_mac_epoch_offset;
934   }
935     }
936 
937     if (err != noErr) {
938   errno = TclMacOSErrorToPosixError(err);
939     }
940     
941     return (err == noErr ? 0 : -1);
942 }
char* TclpReadlink (CONST char * path, Tcl_DString * linkPtr)

Definition at line 674 of file tclMacFile.c.
References EINVAL, ENAMETOOLONG, errno, FSpLocationFromPath(), FSpPathFromLocation(), NULL, Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringSetLength(), Tcl_DStringValue, Tcl_ExternalToUtfDString(), Tcl_UtfToExternalDString(), and TclMacOSErrorToPosixError().678 {
679     HFileInfo fpb;
680     OSErr err;
681     FSSpec fileSpec;
682     Boolean isDirectory;
683     Boolean wasAlias;
684     long dirID;
685     char fileName[257];
686     char *end;
687     Handle theString = NULL;
688     int pathSize;
689     Tcl_DString ds;
690     
691     Tcl_UtfToExternalDString(NULL, path, -1, &ds);
692 
693     /*
694      * Remove ending colons if they exist.
695      */
696      
697     while ((Tcl_DStringLength(&ds) != 0) 
698      && (Tcl_DStringValue(&ds)[Tcl_DStringLength(&ds) - 1] == ':')) {
699   Tcl_DStringSetLength(&ds, Tcl_DStringLength(&ds) - 1);
700     }
701 
702     end = strrchr(Tcl_DStringValue(&ds), ':');
703     if (end == NULL ) {
704   strcpy(fileName + 1, Tcl_DStringValue(&ds));
705     } else {
706   strcpy(fileName + 1, end + 1);
707   Tcl_DStringSetLength(&ds, end + 1 - Tcl_DStringValue(&ds));
708     }
709     fileName[0] = (char) strlen(fileName + 1);
710     
711     /*
712      * Create the file spec for the directory of the file
713      * we want to look at.
714      */
715 
716     if (end != NULL) {
717   err = FSpLocationFromPath(Tcl_DStringLength(&ds), 
718           Tcl_DStringValue(&ds), &fileSpec);
719   if (err != noErr) {
720       Tcl_DStringFree(&ds);
721       errno = EINVAL;
722       return NULL;
723   }
724     } else {
725   FSMakeFSSpecCompat(0, 0, NULL, &fileSpec);
726     }
727     Tcl_DStringFree(&ds);
728     
729     /*
730      * Fill the fpb struct up with info about file or directory.
731      */
732 
733     FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
734     fpb.ioVRefNum = fileSpec.vRefNum;
735     fpb.ioDirID = dirID;
736     fpb.ioNamePtr = (StringPtr) fileName;
737 
738     fpb.ioFDirIndex = 0;
739     err = PBGetCatInfoSync((CInfoPBPtr)&fpb);
740     if (err != noErr) {
741   errno = TclMacOSErrorToPosixError(err);
742   return NULL;
743     } else {
744   if (fpb.ioFlAttrib & 0x10) {
745       errno = EINVAL;
746       return NULL;
747   } else {
748       if (fpb.ioFlFndrInfo.fdFlags & 0x8000) {
749     /*
750      * The file is a link!
751      */
752       } else {
753     errno = EINVAL;
754     return NULL;
755       }
756   }
757     }
758     
759     /*
760      * If we are here it's really a link - now find out
761      * where it points to.
762      */
763     err = FSMakeFSSpecCompat(fileSpec.vRefNum, dirID, (StringPtr) fileName, 
764           &fileSpec);
765     if (err == noErr) {
766   err = ResolveAliasFile(&fileSpec, true, &isDirectory, &wasAlias);
767     }
768     if ((err == fnfErr) || wasAlias) {
769   err = FSpPathFromLocation(&fileSpec, &pathSize, &theString);
770   if (err != noErr) {
771       DisposeHandle(theString);
772       errno = ENAMETOOLONG;
773       return NULL;
774   }
775     } else {
776       errno = EINVAL;
777   return NULL;
778     }
779     
780     Tcl_ExternalToUtfDString(NULL, *theString, pathSize, linkPtr);
781     DisposeHandle(theString);
782     
783     return Tcl_DStringValue(linkPtr);
784 }
Tcl_Obj* TclpTempFileName ()

Definition at line 1145 of file tclMacFile.c.
References L_tmpnam, NULL, TclpNativeToNormalized(), and tmpnam().
Referenced by SimpleCopy(), and Tcl_FSLoadFile().1146 {
1147     char fileName[L_tmpnam];
1148     
1149     if (tmpnam(fileName) == NULL) {        /* INTL: Native. */
1150   return NULL;
1151     }
1152 
1153     return TclpNativeToNormalized((ClientData) fileName);
1154 }
int TclpUtime (Tcl_Obj * pathPtr, struct utimbuf * tval)

Definition at line 1268 of file tclMacFile.c.
References gmt_offset, NULL, Tcl_FSGetNativePath(), Tcl_FSGetNormalizedPath(), and TclpGetGMTOffset().
Referenced by TCL_DECLARE_MUTEX().1271 {
1272     long gmt_offset=TclpGetGMTOffset();
1273     struct utimbuf local_tval;
1274     local_tval.actime=tval->actime+gmt_offset;
1275     local_tval.modtime=tval->modtime+gmt_offset;
1276     return utime(Tcl_FSGetNativePath(Tcl_FSGetNormalizedPath(NULL,pathPtr)),
1277      &local_tval);
1278 }

mac/tclMacInit.c File Reference
#include <AppleEvents.h>
#include <AEDataModel.h>
#include <AEObjects.h>
#include <AEPackObject.h>
#include <AERegistry.h>
#include <Files.h>
#include <Folders.h>
#include <Gestalt.h>
#include <TextUtils.h>
#include <Resources.h>
#include <Strings.h>
#include "tclInt.h"
#include "tclMacInt.h"
#include "tclPort.h"
#include "tclInitScript.h"
Classes
struct Map
Functions
static int GetFinderFont (int *finderID)
char * TclMacGetFontEncoding (int fontId)
void TclpInitPlatform ()
int TclpInitLibraryPath (CONST char *argv0)
void TclpSetInitialEncodings ()
void TclpSetVariables (Tcl_Interp *interp)
int TclpCheckStackSpace ()
int TclpFindVariable (CONST char *name, int *lengthPtr)
int Tcl_Init (Tcl_Interp *interp)
void Tcl_SourceRCFile (Tcl_Interp *interp)
Variables
static char initCmd []
static Map scriptMap []
static Map romanMap []
static Map cyrillicMap []
static Tcl_Encoding binaryEncoding = NULL
static int libraryPathEncodingFixed = 0

Function Documentation
static int GetFinderFont (int * finderID) [static]

Definition at line 163 of file tclMacInit.c.
References NULL, TCL_ERROR, and TCL_OK.
Referenced by TclpSetInitialEncodings().164 {
165     OSErr err = noErr;
166     OSType finderPrefs, viewFont = 'vfnt';
167     DescType returnType;
168     Size returnSize;
169     long result, sys8Mask = 0x0800;
170     static AppleEvent outgoingAevt = {typeNull, NULL};
171     AppleEvent returnAevt;
172     AEAddressDesc fndrAddress;
173     AEDesc nullContainer = {typeNull, NULL}, 
174            tempDesc = {typeNull, NULL}, 
175            tempDesc2 = {typeNull, NULL}, 
176            finalDesc = {typeNull, NULL};
177     const OSType finderSignature = 'MACS';
178     
179     
180     if (outgoingAevt.descriptorType == typeNull) {
181         if ((Gestalt(gestaltSystemVersion, &result) != noErr)
182           || (result >= sys8Mask)) {
183             finderPrefs = 'pfrp';
184         } else {
185       finderPrefs = 'pvwp';
186         }
187         
188         AECreateDesc(typeApplSignature, &finderSignature,
189     sizeof(finderSignature), &fndrAddress);
190             
191         err = AECreateAppleEvent(kAECoreSuite, kAEGetData, &fndrAddress, 
192                 kAutoGenerateReturnID, kAnyTransactionID, &outgoingAevt);
193                 
194         AEDisposeDesc(&fndrAddress);
195     
196         /*
197          * The structure is:
198          * the property view font ('vfnt')
199          *    of the property view preferences ('pvwp')
200          *        of the Null Container (i.e. the Finder itself). 
201          */
202          
203         AECreateDesc(typeType, &finderPrefs, sizeof(finderPrefs), &tempDesc);
204         err = CreateObjSpecifier(typeType, &nullContainer, formPropertyID,
205     &tempDesc, true, &tempDesc2);
206         AECreateDesc(typeType, &viewFont, sizeof(viewFont), &tempDesc);
207         err = CreateObjSpecifier(typeType, &tempDesc2, formPropertyID,
208     &tempDesc, true, &finalDesc);
209     
210         AEPutKeyDesc(&outgoingAevt, keyDirectObject, &finalDesc);
211         AEDisposeDesc(&finalDesc);
212     }
213              
214     err = AESend(&outgoingAevt, &returnAevt, kAEWaitReply, kAEHighPriority,
215       kAEDefaultTimeout, NULL, NULL);
216     if (err == noErr) {
217         err = AEGetKeyPtr(&returnAevt, keyDirectObject, typeInteger, 
218                 &returnType, (void *) finderID, sizeof(int), &returnSize);
219         if (err == noErr) {
220             return TCL_OK;
221         }
222     }
223     return TCL_ERROR;
224 }
int Tcl_Init (Tcl_Interp * interp)

Definition at line 694 of file tclMacInit.c.
References initCmd, NULL, Tcl_DecrRefCount, TCL_ERROR, Tcl_Eval(), TCL_GLOBAL_ONLY, Tcl_IncrRefCount, Tcl_NewObj(), Tcl_SetVar2Ex(), TclGetLibraryPath(), and tclPreInitScript.
Referenced by SlaveCreate(), Tcl_AppInit(), and TestfeventCmd().696 {
697     Tcl_Obj *pathPtr;
698 
699     if (tclPreInitScript != NULL) {
700     if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
701         return (TCL_ERROR);
702     };
703     }
704 
705     /*
706      * For Macintosh applications the Init function may be contained in
707      * the application resources.  If it exists we use it - otherwise we
708      * look in the tcl_library directory.  Ditto for the history command.
709      */
710 
711     pathPtr = TclGetLibraryPath();
712     if (pathPtr == NULL) {
713   pathPtr = Tcl_NewObj();
714     }
715     Tcl_IncrRefCount(pathPtr);
716     Tcl_SetVar2Ex(interp, "auto_path", NULL, pathPtr, TCL_GLOBAL_ONLY);
717     Tcl_DecrRefCount(pathPtr);
718     return Tcl_Eval(interp, initCmd);
719 }
void Tcl_SourceRCFile (Tcl_Interp * interp)

Definition at line 742 of file tclMacInit.c.
References CONST, NULL, Tcl_Close(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringValue, Tcl_EvalFile(), Tcl_GetObjResult(), Tcl_GetStdChannel(), Tcl_GetVar(), TCL_GLOBAL_ONLY, Tcl_MacEvalResource(), TCL_OK, Tcl_OpenFileChannel(), Tcl_ResetResult(), TCL_STDERR, Tcl_TranslateFileName(), Tcl_UtfToExternalDString(), Tcl_WriteChars(), and Tcl_WriteObj().
Referenced by Tcl_Main().744 {
745     Tcl_DString temp;
746     CONST char *fileName;
747     Tcl_Channel errChannel;
748     Handle h;
749 
750     fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
751 
752     if (fileName != NULL) {
753         Tcl_Channel c;
754   CONST char *fullName;
755 
756         Tcl_DStringInit(&temp);
757   fullName = Tcl_TranslateFileName(interp, fileName, &temp);
758   if (fullName == NULL) {
759       /*
760        * Couldn't translate the file name (e.g. it referred to a
761        * bogus user or there was no HOME environment variable).
762        * Just do nothing.
763        */
764   } else {
765 
766       /*
767        * Test for the existence of the rc file before trying to read it.
768        */
769 
770             c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
771             if (c != (Tcl_Channel) NULL) {
772                 Tcl_Close(NULL, c);
773     if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
774         errChannel = Tcl_GetStdChannel(TCL_STDERR);
775         if (errChannel) {
776       Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
777       Tcl_WriteChars(errChannel, "\n", 1);
778         }
779     }
780       }
781   }
782         Tcl_DStringFree(&temp);
783     }
784 
785     fileName = Tcl_GetVar(interp, "tcl_rcRsrcName", TCL_GLOBAL_ONLY);
786 
787     if (fileName != NULL) {
788   Str255 rezName;
789   Tcl_DString ds;
790   Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
791   strcpy((char *) rezName + 1, Tcl_DStringValue(&ds));
792   rezName[0] = (unsigned) Tcl_DStringLength(&ds);
793   h = GetNamedResource('TEXT', rezName);
794   Tcl_DStringFree(&ds);
795   if (h != NULL) {
796       if (Tcl_MacEvalResource(interp, fileName, 0, NULL) != TCL_OK) {
797     errChannel = Tcl_GetStdChannel(TCL_STDERR);
798     if (errChannel) {
799         Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
800         Tcl_WriteChars(errChannel, "\n", 1);
801     }
802       }
803       Tcl_ResetResult(interp);
804       ReleaseResource(h);
805   }
806     }
807 }
char* TclMacGetFontEncoding (int fontId)

Definition at line 248 of file tclMacInit.c.
References NULL, Map::numKey, romanMap, and Map::strKey.
Referenced by TclpSetInitialEncodings().250 {
251     int script, lang;
252     char *name;
253     Map *mapPtr;
254     
255     script = FontToScript(fontId);    
256     lang = GetScriptVariable(script, smScriptLang);
257     name = NULL;
258     if (script == smRoman) {
259         for (mapPtr = romanMap; mapPtr->strKey != NULL; mapPtr++) {
260             if (mapPtr->numKey == lang) {
261                 name = mapPtr->strKey;
262                 break;
263             }
264         }
265     } else if (script == smCyrillic) {
266         for (mapPtr = cyrillicMap; mapPtr->strKey != NULL; mapPtr++) {
267             if (mapPtr->numKey == lang) {
268                 name = mapPtr->strKey;
269                 break;
270             }
271         }
272     }
273     if (name == NULL) {
274         for (mapPtr = scriptMap; mapPtr->strKey != NULL; mapPtr++) {
275             if (mapPtr->numKey == script) {
276                 name = mapPtr->strKey;
277                 break;
278             }
279         }
280     }
281     return name;
282 }
int TclpCheckStackSpace ()

Definition at line 611 of file tclMacInit.c.
References TCL_MAC_STACK_THRESHOLD.
Referenced by TclInterpReady().612 {
613     return StackSpace() > TCL_MAC_STACK_THRESHOLD;
614 }
int TclpFindVariable (CONST char * name, int * lengthPtr)

Definition at line 638 of file tclMacInit.c.
Referenced by TclGetEnv(), TclSetEnv(), and TclUnsetEnv().645 {
646     int i, result = -1;
647     register CONST char *env, *p1, *p2;
648     Tcl_DString envString;
649 
650     Tcl_DStringInit(&envString);
651     for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
652   p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
653   p2 = name;
654 
655   for (; *p2 == *p1; p1++, p2++) {
656       /* NULL loop body. */
657   }
658   if ((*p1 == '=') && (*p2 == '\0')) {
659       *lengthPtr = p2 - name;
660       result = i;
661       goto done;
662   }
663   
664   Tcl_DStringFree(&envString);
665     }
666     
667     *lengthPtr = i;
668 
669     done:
670     Tcl_DStringFree(&envString);
671     return result;
672 }
int TclpInitLibraryPath (CONST char * argv0)

Definition at line 352 of file tclMacInit.c.
References CONST, NULL, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_GetDefaultEncodingDir(), Tcl_JoinPath(), Tcl_ListObjAppendElement(), Tcl_ListObjAppendList(), Tcl_NewObj(), Tcl_NewStringObj(), TCL_VERSION, TclGetEnv(), TclGetLibraryPath(), TclMacCreateEnv(), and TclSetLibraryPath().
Referenced by TclFindEncodings().356 {
357     Tcl_Obj *objPtr, *pathPtr;
358     CONST char *str;
359     Tcl_DString ds;
360     
361     TclMacCreateEnv();
362 
363     pathPtr = Tcl_NewObj();
364     
365     /*
366      * Look for the library relative to default encoding dir.
367      */
368 
369     str = Tcl_GetDefaultEncodingDir();
370     if ((str != NULL) && (str[0] != '\0')) {
371   objPtr = Tcl_NewStringObj(str, -1);
372   Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
373     }
374 
375     str = TclGetEnv("TCL_LIBRARY", &ds);
376     if ((str != NULL) && (str[0] != '\0')) {
377   /*
378    * If TCL_LIBRARY is set, search there.
379    */
380    
381   objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
382   Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
383   Tcl_DStringFree(&ds);
384     }
385     
386     objPtr = TclGetLibraryPath();
387     if (objPtr != NULL) {
388         Tcl_ListObjAppendList(NULL, pathPtr, objPtr);
389     }
390     
391     /*
392      * lappend path [file join $env(EXT_FOLDER) \
393      *      "Tool Command Language" "tcl[info version]"
394      */
395 
396     str = TclGetEnv("EXT_FOLDER", &ds);
397     if ((str != NULL) && (str[0] != '\0')) {
398       Tcl_DString libPath, path;
399       CONST char *argv[3];
400       
401       argv[0] = str;
402       argv[1] = "Tool Command Language";      
403       Tcl_DStringInit(&libPath);
404       Tcl_DStringAppend(&libPath, "tcl", -1);
405       argv[2] = Tcl_DStringAppend(&libPath, TCL_VERSION, -1);
406       Tcl_DStringInit(&path);
407       str = Tcl_JoinPath(3, argv, &path);
408         objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&path));
409       Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
410       Tcl_DStringFree(&ds);
411       Tcl_DStringFree(&libPath);
412       Tcl_DStringFree(&path);
413     }    
414     TclSetLibraryPath(pathPtr);
415 
416     return 1; /* 1 indicates that pathPtr may be dirty utf (needs cleaning) */
417 }
void TclpInitPlatform ()

Definition at line 304 of file tclMacInit.c.
References TCL_PLATFORM_MAC, and tclPlatform.
Referenced by TclInitSubsystems().305 {
306     tclPlatform = TCL_PLATFORM_MAC;
307 }
void TclpSetInitialEncodings ()

Definition at line 444 of file tclMacInit.c.
References binaryEncoding, CONST, GetFinderFont(), libraryPathEncodingFixed, NULL, Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, Tcl_ExternalToUtfDString(), Tcl_GetEncoding(), Tcl_GetStringFromObj(), Tcl_InvalidateStringRep(), Tcl_ListObjGetElements(), TCL_OK, Tcl_SetStringObj(), Tcl_SetSystemEncoding(), TclGetLibraryPath(), and TclMacGetFontEncoding().
Referenced by TclFindEncodings().445 {
446     CONST char *encoding;
447     Tcl_Obj *pathPtr;
448     int fontId, err;
449     
450     fontId = 0;
451     GetFinderFont(&fontId);
452     encoding = TclMacGetFontEncoding(fontId);
453     if (encoding == NULL) {
454         encoding = "macRoman";
455     }
456     
457     err = Tcl_SetSystemEncoding(NULL, encoding);
458 
459     if (err == TCL_OK && libraryPathEncodingFixed == 0) {
460   
461     /*
462      * Until the system encoding was actually set, the library path was
463      * actually in the native multi-byte encoding, and not really UTF-8
464      * as advertised.  We cheated as follows:
465      *
466      * 1. It was safe to allow the Tcl_SetSystemEncoding() call to 
467      * append the ASCII chars that make up the encoding's filename to 
468      * the names (in the native encoding) of directories in the library 
469      * path, since all Unix multi-byte encodings have ASCII in the
470      * beginning.
471      *
472      * 2. To open the encoding file, the native bytes in the file name
473      * were passed to the OS, without translating from UTF-8 to native,
474      * because the name was already in the native encoding.
475      *
476      * Now that the system encoding was actually successfully set,
477      * translate all the names in the library path to UTF-8.  That way,
478      * next time we search the library path, we'll translate the names 
479      * from UTF-8 to the system encoding which will be the native 
480      * encoding.
481      */
482 
483     pathPtr = TclGetLibraryPath();
484     if (pathPtr != NULL) {
485       int i, objc;
486   Tcl_Obj **objv;
487   
488   objc = 0;
489   Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
490   for (i = 0; i < objc; i++) {
491       int length;
492       char *string;
493       Tcl_DString ds;
494 
495       string = Tcl_GetStringFromObj(objv[i], &length);
496       Tcl_ExternalToUtfDString(NULL, string, length, &ds);
497       Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds), 
498         Tcl_DStringLength(&ds));
499       Tcl_DStringFree(&ds);
500   }
501   Tcl_InvalidateStringRep(pathPtr);
502     }
503   libraryPathEncodingFixed = 1;
504     }
505     
506     /* This is only ever called from the startup thread */
507     if (binaryEncoding == NULL) {
508   /*
509    * Keep the iso8859-1 encoding preloaded.  The IO package uses
510    * it for gets on a binary channel.
511    */
512   binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
513     }
514 }   
void TclpSetVariables (Tcl_Interp * interp)

Definition at line 535 of file tclMacInit.c.
References CONST, NULL, Tcl_DStringFree(), Tcl_DStringInit(), Tcl_GetStringFromObj(), TCL_GLOBAL_ONLY, TCL_INTEGER_SPACE, Tcl_ListObjGetElements(), Tcl_SetVar(), Tcl_SetVar2(), Tcl_SetVar2Ex(), TclGetEnv(), and TclGetLibraryPath().537 {
538     long int gestaltResult;
539     int minor, major, objc;
540     Tcl_Obj **objv;
541     char versStr[2 * TCL_INTEGER_SPACE];
542     CONST char *str;
543     Tcl_Obj *pathPtr;
544     Tcl_DString ds;
545 
546     str = "no library";
547     pathPtr = TclGetLibraryPath();
548     if (pathPtr != NULL) {
549         objc = 0;
550         Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
551         if (objc > 0) {
552             str = Tcl_GetStringFromObj(objv[0], NULL);
553         }
554     }
555     Tcl_SetVar(interp, "tcl_library", str, TCL_GLOBAL_ONLY);
556     
557     if (pathPtr != NULL) {
558         Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
559     }
560     
561     Tcl_SetVar2(interp, "tcl_platform", "platform", "macintosh",
562       TCL_GLOBAL_ONLY);
563     Tcl_SetVar2(interp, "tcl_platform", "os", "MacOS", TCL_GLOBAL_ONLY);
564     Gestalt(gestaltSystemVersion, &gestaltResult);
565     major = (gestaltResult & 0x0000FF00) >> 8;
566     minor = (gestaltResult & 0x000000F0) >> 4;
567     sprintf(versStr, "%d.%d", major, minor);
568     Tcl_SetVar2(interp, "tcl_platform", "osVersion", versStr, TCL_GLOBAL_ONLY);
569 #if GENERATINGPOWERPC
570     Tcl_SetVar2(interp, "tcl_platform", "machine", "ppc", TCL_GLOBAL_ONLY);
571 #else
572     Tcl_SetVar2(interp, "tcl_platform", "machine", "68k", TCL_GLOBAL_ONLY);
573 #endif
574 
575     /*
576      * Copy USER or LOGIN environment variable into tcl_platform(user)
577      * These are set by SystemVariables in tclMacEnv.c
578      */
579 
580     Tcl_DStringInit(&ds);
581     str = TclGetEnv("USER", &ds);
582     if (str == NULL) {
583   str = TclGetEnv("LOGIN", &ds);
584   if (str == NULL) {
585       str = "";
586   }
587     }
588     Tcl_SetVar2(interp, "tcl_platform", "user", str, TCL_GLOBAL_ONLY);
589     Tcl_DStringFree(&ds);
590 }

Variable Documentation
Tcl_Encoding binaryEncoding = NULL [static]

Definition at line 141 of file tclMacInit.c.
Referenced by TclpSetInitialEncodings(), and TclWinEncodingsCleanup().Map cyrillicMap[] [static]
Initial value: {
    {langUkrainian, "macUkraine"},
    {langBulgarian, "macBulgaria"},
    {NULL,    NULL}
}
Definition at line 132 of file tclMacInit.c.char initCmd[] [static]

Definition at line 37 of file tclMacInit.c.
Referenced by Tcl_Init().int libraryPathEncodingFixed = 0 [static]

Definition at line 143 of file tclMacInit.c.
Referenced by TclpSetInitialEncodings(), and TclWinEncodingsCleanup().Map romanMap[] [static]
Initial value: {
    {langCroatian,  "macCroatian"},
    {langSlovenian, "macCroatian"},
    {langIcelandic, "macIceland"},
    {langRomanian,  "macRomania"},
    {langTurkish, "macTurkish"},
    {langGreek,   "macGreek"},
    {NULL,    NULL}
}
Definition at line 122 of file tclMacInit.c.
Referenced by TclMacGetFontEncoding().Map scriptMap[] [static]

Definition at line 86 of file tclMacInit.c.

mac/tclMacInt.h File Reference
#include "tclInt.h"
#include "tclPort.h"
#include <Events.h>
#include <Files.h>
#include "tclIntPlatDecls.h"
Defines
#define TCL_MAC_68K_STACK_GROWTH  (512*1024)
#define TCL_MAC_STACK_THRESHOLD  16384
#define TCL_RESOURCE_DONT_CLOSE  2
#define TCL_STORAGE_CLASS  DLLIMPORT
Functions
EXTERN char *TclMacGetFontEncoding _ANSI_ARGS_ ((int fontId))
EXTERN int TclMacHaveThreads _ANSI_ARGS_ ((void))

Define Documentation
#define TCL_MAC_68K_STACK_GROWTH  (512*1024)

Definition at line 42 of file tclMacInt.h.
Referenced by MacintoshInit().#define TCL_MAC_STACK_THRESHOLD  16384

Definition at line 45 of file tclMacInt.h.
Referenced by TclpCheckStackSpace().#define TCL_RESOURCE_DONT_CLOSE  2

Definition at line 58 of file tclMacInt.h.
Referenced by BuildResourceForkList(), OpenLibraryResource(), and TclMacUnRegisterResourceFork().#define TCL_STORAGE_CLASS  DLLIMPORT

Definition at line 73 of file tclMacInt.h.
Function Documentation
EXTERN int TclMacHaveThreads _ANSI_ARGS_ ((void))
EXTERN char* TclMacGetFontEncoding _ANSI_ARGS_ ((int fontId))

mac/tclMacInterupt.c File Reference
#include "tclInt.h"
#include "tclMacInt.h"
#include <LowMem.h>
#include <Processes.h>
#include <Timer.h>
Classes
struct TMInfo
Defines
#define MAX_TIMER_ARRAY_SIZE  16
Functions
static TMInfo * GetTMInfo (void)
void * TclMacStartTimer (long ms)
void TclMacRemoveTimer (void *timerToken)
int TclMacTimerExpired (void *timerToken)
static void SleepTimerProc ()
static pascal void CleanUpExitProc ()
Variables
static TimerUPP sleepTimerProc = NULL
static int interuptsInited = false
static ProcessSerialNumber applicationPSN
static TMInfo timerInfoArray [MAX_TIMER_ARRAY_SIZE]
static int topTimerElement = 0

Define Documentation
#define MAX_TIMER_ARRAY_SIZE  16

Definition at line 42 of file tclMacInterupt.c.
Referenced by CleanUpExitProc(), and TclMacStartTimer().
Function Documentation
static pascal void CleanUpExitProc () [static]

Definition at line 279 of file tclMacInterupt.c.
References TMInfo::installed, MAX_TIMER_ARRAY_SIZE, and timerInfoArray.280 {
281     int i;
282     
283     for (i = 0; i < MAX_TIMER_ARRAY_SIZE; i++) {
284   if (timerInfoArray[i].installed) {
285       RmvTime((QElemPtr) &timerInfoArray[i]);
286       timerInfoArray[i].installed = false;
287   }
288     }
289 }
static TMInfo* GetTMInfo (void) [static]

Definition at line 51 of file tclMacInterupt.c.
Referenced by SleepTimerProc().66           :
67  *  None.
68  *
69  * Side effects:
70  *  Various initialization.
71  *
72  *----------------------------------------------------------------------
73  */
74 
75 void
76 InitInteruptSystem()
77 {
78     int i;
79     
80     sleepTimerProc = NewTimerProc(SleepTimerProc);
81     GetCurrentProcess(&applicationPSN);
82     for (i = 0; i < MAX_TIMER_ARRAY_SIZE; i++) {
83   timerInfoArray[i].installed = false;
84     }
85     
86     /*
87      * Install the ExitToShell patch.  We use this patch instead
88      * of the Tcl exit mechanism because we need to ensure that
89      * these routines are cleaned up even if we crash or are forced
90      * to quit.  There are some circumstances when the Tcl exit
91      * handlers may not fire.
92      */
93      
94     TclMacInstallExitToShellPatch(CleanUpExitProc);
95     interuptsInited = true;
96 }

static void SleepTimerProc () [static]

Definition at line 235 of file tclMacInterupt.c.
References applicationPSN, GetTMInfo(), and TMInfo::psn.236 {
237     /*
238      * In CFM code we can access our code directly.  In 68k code that
239      * isn't based on CFM we must do a glorious hack.  The function 
240      * GetTMInfo is an inline assembler call that moves the pointer 
241      * at A1 to the top of the stack.  The Time Manager keeps the TMTask
242      * info record there before calling this call back.  In order for
243      * this to work the infoPtr argument must be the *last* item on the
244      * stack.  If we "piggyback" our data to the TMTask info record we 
245      * can get access to the information we need.  While this is really 
246      * ugly - it's the way Apple recomends it be done - go figure...
247      */
248     
249 #if GENERATINGCFM
250     WakeUpProcess(&applicationPSN);
251 #else
252     TMInfo * infoPtr;
253     
254     infoPtr = GetTMInfo();
255     WakeUpProcess(&infoPtr->psn);
256 #endif
257 }
void TclMacRemoveTimer (void * timerToken)

Definition at line 170 of file tclMacInterupt.c.
References NULL, and topTimerElement.
Referenced by Tcl_Sleep(), and Tcl_WaitForEvent().172 {
173     TMInfo *timerInfoPtr = (TMInfo *) timerToken;
174     
175     if (timerInfoPtr == NULL) {
176   return;
177     }
178     
179     RmvTime((QElemPtr) timerInfoPtr);
180     timerInfoPtr->installed = false;
181     topTimerElement--;
182 }
void* TclMacStartTimer (long ms)

Definition at line 117 of file tclMacInterupt.c.
References applicationPSN, TMInfo::installed, interuptsInited, MAX_TIMER_ARRAY_SIZE, NULL, TMInfo::psn, sleepTimerProc, timerInfoArray, TMInfo::tmTask, and topTimerElement.
Referenced by Tcl_Sleep(), and Tcl_WaitForEvent().119 {
120     TMInfo *timerInfoPtr;
121     
122     if (!interuptsInited) {
123   InitInteruptSystem();
124     }
125     
126     /*
127      * Obtain a pointer for the timer.  We only allocate up
128      * to MAX_TIMER_ARRAY_SIZE timers.  If we are past that
129      * max we return NULL.
130      */
131     if (topTimerElement < MAX_TIMER_ARRAY_SIZE) {
132   timerInfoPtr = &timerInfoArray[topTimerElement];
133   topTimerElement++;
134     } else {
135   return NULL;
136     }
137     
138     /*
139      * Install timer to wake process in ms milliseconds.
140      */
141     timerInfoPtr->tmTask.tmAddr = sleepTimerProc;
142     timerInfoPtr->tmTask.tmWakeUp = 0;
143     timerInfoPtr->tmTask.tmReserved = 0;
144     timerInfoPtr->psn = applicationPSN;
145     timerInfoPtr->installed = true;
146 
147     InsTime((QElemPtr) timerInfoPtr);
148     PrimeTime((QElemPtr) timerInfoPtr, (long) ms);
149 
150     return (void *) timerInfoPtr;
151 }
int TclMacTimerExpired (void * timerToken)

Definition at line 201 of file tclMacInterupt.c.
References NULL, and TMInfo::tmTask.
Referenced by Tcl_Sleep(), and Tcl_WaitForEvent().203 {
204     TMInfo *timerInfoPtr = (TMInfo *) timerToken;
205     
206     if ((timerInfoPtr == NULL) || 
207   !(timerInfoPtr->tmTask.qType & kTMTaskActive)) {
208   return true;
209     } else {
210   return false;
211     }
212 }

Variable Documentation
ProcessSerialNumber applicationPSN [static]

Definition at line 41 of file tclMacInterupt.c.
Referenced by SleepTimerProc(), and TclMacStartTimer().int interuptsInited = false [static]

Definition at line 40 of file tclMacInterupt.c.
Referenced by TclMacStartTimer().TimerUPP sleepTimerProc = NULL [static]

Definition at line 39 of file tclMacInterupt.c.
Referenced by TclMacStartTimer().TMInfo timerInfoArray[MAX_TIMER_ARRAY_SIZE] [static]

Definition at line 43 of file tclMacInterupt.c.
Referenced by CleanUpExitProc(), and TclMacStartTimer().int topTimerElement = 0 [static]

Definition at line 44 of file tclMacInterupt.c.
Referenced by TclMacRemoveTimer(), and TclMacStartTimer().

mac/tclMacLibrary.c File Reference
#include <CodeFragments.h>
#include <Errors.h>
#include <Resources.h>
#include <Strings.h>
#include "tclMacInt.h"
Functions
OSErr TclMacInitializeFragment _ANSI_ARGS_ ((struct CFragInitBlock *initBlkPtr))
void TclMacTerminateFragment _ANSI_ARGS_ ((void))
OSErr TclMacInitializeFragment (struct CFragInitBlock *initBlkPtr)
void TclMacTerminateFragment ()
static OSErr OpenLibraryResource (struct CFragInitBlock *initBlkPtr)
static void CloseLibraryResource ()
Variables
static short ourResFile = kResFileNotOpened

Function Documentation
void TclMacTerminateFragment _ANSI_ARGS_ ((void))
OSErr TclMacInitializeFragment _ANSI_ARGS_ ((struct CFragInitBlock *initBlkPtr))
static void CloseLibraryResource () [static]

Definition at line 235 of file tclMacLibrary.c.
References NULL, Tcl_DecrRefCount, Tcl_GetStringFromObj(), and TclMacUnRegisterResourceFork().
Referenced by TclMacTerminateFragment().236 {
237     if (ourResFile != kResFileNotOpened) {
238 #ifdef TCL_REGISTER_LIBRARY
239         int length;
240         TclMacUnRegisterResourceFork(
241           Tcl_GetStringFromObj(ourResToken, &length),
242                 NULL);
243         Tcl_DecrRefCount(ourResToken);
244 #endif
245   CloseResFile(ourResFile);
246   ourResFile = kResFileNotOpened;
247     }
248 }
static OSErr OpenLibraryResource (struct CFragInitBlock * initBlkPtr) [static]

Definition at line 163 of file tclMacLibrary.c.
References NULL, Tcl_IncrRefCount, Tcl_NewObj(), TCL_RESOURCE_DONT_CLOSE, Tcl_SetStringObj(), and TclMacRegisterResourceFork().
Referenced by TclMacInitializeFragment().165 {
166     /*
167      * The 3.0 version of the Universal headers changed CFragInitBlock
168      * to an opaque pointer type.  CFragSystem7InitBlock is now the
169      * real pointer.
170      */
171      
172 #if !defined(UNIVERSAL_INTERFACES_VERSION) || (UNIVERSAL_INTERFACES_VERSION < 0x0300)
173     struct CFragInitBlock *realInitBlkPtr = initBlkPtr;
174 #else 
175     CFragSystem7InitBlock *realInitBlkPtr = (CFragSystem7InitBlock *) initBlkPtr;
176 #endif
177     FSSpec* fileSpec = NULL;
178     OSErr err = noErr;
179     
180 
181     if (realInitBlkPtr->fragLocator.where == kDataForkCFragLocator) {
182       fileSpec = realInitBlkPtr->fragLocator.u.onDisk.fileSpec;
183     } else if (realInitBlkPtr->fragLocator.where == kResourceCFragLocator) {
184       fileSpec = realInitBlkPtr->fragLocator.u.inSegs.fileSpec;
185     } else {
186       err = resFNotFound;
187     }
188 
189     /*
190      * Open the resource fork for this library in read-only mode.  
191      * This will make it the current res file, ahead of the 
192      * application's own resources.
193      */
194     
195     if (fileSpec != NULL) {
196   ourResFile = FSpOpenResFile(fileSpec, fsRdPerm);
197   if (ourResFile == kResFileNotOpened) {
198       err = ResError();
199   } else {
200 #ifdef TCL_REGISTER_LIBRARY
201       ourResToken = Tcl_NewObj();
202       Tcl_IncrRefCount(ourResToken);
203       p2cstr(realInitBlkPtr->libName);
204       Tcl_SetStringObj(ourResToken, (char *) realInitBlkPtr->libName, -1);
205       c2pstr((char *) realInitBlkPtr->libName);
206       TclMacRegisterResourceFork(ourResFile, ourResToken,
207               TCL_RESOURCE_DONT_CLOSE);
208 #endif
209             SetResFileAttrs(ourResFile, mapReadOnly);
210   }
211     }
212     
213     return err;
214 }
OSErr TclMacInitializeFragment (struct CFragInitBlock * initBlkPtr)

Definition at line 91 of file tclMacLibrary.c.
References OpenLibraryResource().93 {
94     OSErr err = noErr;
95 
96 #ifdef __MWERKS__
97     {
98       extern OSErr __initialize( CFragInitBlock* initBlkPtr);
99       err = __initialize((CFragInitBlock *) initBlkPtr);
100     }
101 #endif
102     if (err == noErr)
103       err = OpenLibraryResource( initBlkPtr);
104     return err;
105 }
void TclMacTerminateFragment ()

Definition at line 124 of file tclMacLibrary.c.
References CloseLibraryResource().125 {
126     CloseLibraryResource();
127 
128 #ifdef __MWERKS__
129     {
130       extern void __terminate(void);
131       __terminate();
132     }
133 #endif
134 }

Variable Documentation
short ourResFile = kResFileNotOpened [static]

Definition at line 60 of file tclMacLibrary.c.

mac/tclMacLoad.c File Reference
#include <CodeFragments.h>
#include <Errors.h>
#include <Resources.h>
#include <Strings.h>
#include <FSpCompat.h>
#include "tclPort.h"
#include "tclInt.h"
#include "tclMacInt.h"
Classes
struct CfrgHeader
struct CfrgItem
struct TclMacLoadInfo
Defines
#define fragNoErr  noErr
#define OUR_ARCH_TYPE  kMotorola68KCFragArch
Typedefs
typedef CfrgHeader CfrgHeader
typedef CfrgHeader * CfrgHeaderPtr
typedef CfrgHeader ** CfrgHeaderPtrHand
typedef CfrgItem CfrgItem
Functions
static int TryToLoad (Tcl_Interp *interp, TclMacLoadInfo *loadInfo, Tcl_Obj *pathPtr, CONST char *sym)
int TclpDlopen (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr)
Tcl_PackageInitProc * TclpFindSymbol (Tcl_Interp *interp, Tcl_LoadHandle loadHandle, CONST char *symbol)
void TclpUnloadFile (Tcl_LoadHandle loadHandle)
int TclGuessPackageName (CONST char *fileName, Tcl_DString *bufPtr)

Define Documentation
#define fragNoErr  noErr

Definition at line 28 of file tclMacLoad.c.
Referenced by TclpFindSymbol(), and TryToLoad().#define OUR_ARCH_TYPE  kMotorola68KCFragArch

Definition at line 38 of file tclMacLoad.c.
Referenced by TryToLoad().
Typedef Documentation
typedef struct CfrgHeader CfrgHeader

Definition at line 57 of file tclMacLoad.c.typedef struct CfrgHeader * CfrgHeaderPtr

Definition at line 57 of file tclMacLoad.c.typedef struct CfrgHeader ** CfrgHeaderPtrHand

Definition at line 57 of file tclMacLoad.c.typedef struct CfrgItem CfrgItem

Definition at line 78 of file tclMacLoad.c.
Function Documentation
int TclGuessPackageName (CONST char * fileName, Tcl_DString * bufPtr)

Definition at line 373 of file tclMacLoad.c.378 {
379     return 0;
380 }
int TclpDlopen (Tcl_Interp * interp, Tcl_Obj * pathPtr, Tcl_LoadHandle * loadHandle, Tcl_FSUnloadFileProc ** unloadProcPtr)

Definition at line 119 of file tclMacLoad.c.
References ckalloc, ckfree, TclMacLoadInfo::connID, CONST, TclMacLoadInfo::fileSpec, FSpLocationFromPath(), TclMacLoadInfo::loaded, NULL, TCL_ERROR, Tcl_FSGetNativePath(), TCL_OK, Tcl_SetResult(), TCL_STATIC, TclpUnloadFile(), and TryToLoad().130 {
131     OSErr err;
132     FSSpec fileSpec;
133     CONST char *native;
134     TclMacLoadInfo *loadInfo;
135     
136     native = Tcl_FSGetNativePath(pathPtr);
137     err = FSpLocationFromPath(strlen(native), native, &fileSpec);
138     
139     if (err != noErr) {
140   Tcl_SetResult(interp, "could not locate shared library", TCL_STATIC);
141   return TCL_ERROR;
142     }
143     
144     loadInfo = (TclMacLoadInfo *) ckalloc(sizeof(TclMacLoadInfo));
145     loadInfo->loaded = 0;
146     loadInfo->fileSpec = fileSpec;
147     loadInfo->connID = NULL;
148     
149     if (TryToLoad(interp, loadInfo, pathPtr, NULL) != TCL_OK) {
150   ckfree((char*) loadInfo);
151   return TCL_ERROR;
152     }
153 
154     *loadHandle = (Tcl_LoadHandle)loadInfo;
155     *unloadProcPtr = &TclpUnloadFile;
156     return TCL_OK;
157 }
Tcl_PackageInitProc* TclpFindSymbol (Tcl_Interp * interp, Tcl_LoadHandle loadHandle, CONST char * symbol)

Definition at line 279 of file tclMacLoad.c.
References TclMacLoadInfo::connID, fragNoErr, TclMacLoadInfo::loaded, NULL, Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringSetLength(), Tcl_DStringValue, TCL_OK, Tcl_SetResult(), TCL_STATIC, Tcl_UtfToExternalDString(), and TryToLoad().283 {
284     Tcl_DString ds;
285     Tcl_PackageInitProc *proc=NULL;
286     TclMacLoadInfo *loadInfo = (TclMacLoadInfo *)loadHandle;
287     Str255 symbolName;
288     CFragSymbolClass symClass;
289     OSErr err;
290    
291     if (loadInfo->loaded == 0) {
292   int res;
293   /*
294    * First thing we must do is infer the package name from the
295    * sym variable.  We do this by removing the '_Init'.
296    */
297   Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
298   Tcl_DStringSetLength(&ds, Tcl_DStringLength(&ds) - 5);
299   res = TryToLoad(interp, loadInfo, NULL, Tcl_DStringValue(&ds));
300   Tcl_DStringFree(&ds);
301   if (res != TCL_OK) {
302       return NULL;
303   }
304     }
305     
306     Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
307     strcpy((char *) symbolName + 1, Tcl_DStringValue(&ds));
308     symbolName[0] = (unsigned) Tcl_DStringLength(&ds);
309     err = FindSymbol(loadInfo->connID, symbolName, (Ptr *) &proc, &symClass);
310     Tcl_DStringFree(&ds);
311     if (err != fragNoErr || symClass == kDataCFragSymbol) {
312   Tcl_SetResult(interp,
313     "could not find Initialization routine in library",
314     TCL_STATIC);
315   return NULL;
316     }
317     return proc;
318 }
void TclpUnloadFile (Tcl_LoadHandle loadHandle)

Definition at line 339 of file tclMacLoad.c.
References ckfree, TclMacLoadInfo::connID, and TclMacLoadInfo::loaded.344 {
345     TclMacLoadInfo *loadInfo = (TclMacLoadInfo *)loadHandle;
346     if (loadInfo->loaded) {
347   CloseConnection((CFragConnectionID*) &(loadInfo->connID));
348     }
349     ckfree((char*)loadInfo);
350 }
static int TryToLoad (Tcl_Interp * interp, TclMacLoadInfo * loadInfo, Tcl_Obj * pathPtr, CONST char * sym) [static]

Definition at line 165 of file tclMacLoad.c.
References CfrgItem::archType, CfrgItem::codeLength, CfrgItem::codeOffset, TclMacLoadInfo::connID, TclMacLoadInfo::fileSpec, fragNoErr, CfrgItem::itemSize, TclMacLoadInfo::loaded, CfrgItem::name, NULL, OUR_ARCH_TYPE, strncasecmp(), TCL_ERROR, Tcl_GetString(), and TCL_OK.
Referenced by TclpDlopen(), and TclpFindSymbol().167 {
168     OSErr err;
169     CFragConnectionID connID;
170     Ptr dummy;
171     short fragFileRef, saveFileRef;
172     Handle fragResource;
173     UInt32 offset = 0;
174     UInt32 length = kCFragGoesToEOF;
175     Str255 errName;
176     StringPtr fragName=NULL;
177 
178     if (loadInfo->loaded == 1) {
179         return TCL_OK;
180     }
181 
182     /*
183      * See if this fragment has a 'cfrg' resource.  It will tell us where
184      * to look for the fragment in the file.  If it doesn't exist we will
185      * assume we have a ppc frag using the whole data fork.  If it does
186      * exist we find the frag that matches the one we are looking for and
187      * get the offset and size from the resource.
188      */
189      
190     saveFileRef = CurResFile();
191     SetResLoad(false);
192     fragFileRef = FSpOpenResFile(&loadInfo->fileSpec, fsRdPerm);
193     SetResLoad(true);
194     if (fragFileRef != -1) {
195   if (sym != NULL) {
196       UseResFile(fragFileRef);
197       fragResource = Get1Resource(kCFragResourceType, kCFragResourceID);
198       HLock(fragResource);
199       if (ResError() == noErr) {
200     CfrgItem* srcItem;
201     long itemCount, index;
202     Ptr itemStart;
203 
204     itemCount = (*(CfrgHeaderPtrHand)fragResource)->itemCount;
205     itemStart = &(*(CfrgHeaderPtrHand)fragResource)->arrayStart;
206     for (index = 0; index < itemCount;
207          index++, itemStart += srcItem->itemSize) {
208         srcItem = (CfrgItem*)itemStart;
209         if (srcItem->archType != OUR_ARCH_TYPE) continue;
210         if (!strncasecmp(sym, (char *) srcItem->name + 1,
211           strlen(sym))) {
212       offset = srcItem->codeOffset;
213       length = srcItem->codeLength;
214       fragName=srcItem->name;
215         }
216     }
217       }
218   }
219   /*
220    * Close the resource file.  If the extension wants to reopen the
221    * resource fork it should use the tclMacLibrary.c file during it's
222    * construction.
223    */
224   HUnlock(fragResource);
225   ReleaseResource(fragResource);
226   CloseResFile(fragFileRef);
227   UseResFile(saveFileRef);
228   if (sym == NULL) {
229       /* We just return */
230       return TCL_OK;
231   }
232     }
233 
234     /*
235      * Now we can attempt to load the fragment using the offset & length
236      * obtained from the resource.  We don't worry about the main entry point
237      * as we are going to search for specific entry points passed to us.
238      */
239     
240     err = GetDiskFragment(&loadInfo->fileSpec, offset, length, fragName,
241       kLoadCFrag, &connID, &dummy, errName);
242     
243     if (err != fragNoErr) {
244   p2cstr(errName);
245   if(pathPtr) {
246   Tcl_AppendResult(interp, "couldn't load file \"", 
247        Tcl_GetString(pathPtr),
248        "\": ", errName, (char *) NULL);
249   } else if(sym) {
250   Tcl_AppendResult(interp, "couldn't load library \"", 
251        sym,
252        "\": ", errName, (char *) NULL);
253   }
254   return TCL_ERROR;
255     }
256 
257     loadInfo->connID = connID;
258     loadInfo->loaded = 1;
259 
260     return TCL_OK;
261 }

mac/tclMacMath.h File Reference
#include <math.h>

mac/tclMacNotify.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include "tclMac.h"
#include "tclMacInt.h"
#include <signal.h>
#include <Events.h>
#include <LowMem.h>
#include <Processes.h>
#include <Timer.h>
#include <Threads.h>
Defines
#define NOTIFY_IDLE  (1<<1)
#define NOTIFY_TIMER  (1<<2)
Functions
static int HandleMacEvents _ANSI_ARGS_ ((void))
static void NotifierExitHandler _ANSI_ARGS_ ((ClientData clientData))
ClientData Tcl_InitNotifier ()
void Tcl_FinalizeNotifier (ClientData clientData)
void Tcl_AlertNotifier (ClientData clientData)
static void InitNotifier (void)
static void NotifierExitHandler (ClientData clientData)
static int HandleMacEvents (void)
void Tcl_SetTimer (Tcl_Time *timePtr)
void Tcl_ServiceModeHook (int mode)
int Tcl_WaitForEvent (Tcl_Time *timePtr)
void Tcl_Sleep (int ms)
void Tcl_MacSetEventProc (Tcl_MacConvertEventPtr procPtr)
Variables
TclStubs tclStubs
Tcl_NotifierProcs tclOriginalNotifier
static int initialized = 0
struct {
  int timerActive
  Tcl_Time timer
  int flags
  Point lastMousePosition
  RgnHandle utilityRgn
  Tcl_MacConvertEventPtr eventProcPtr
} notifier

Define Documentation
#define NOTIFY_IDLE  (1<<1)

Definition at line 82 of file tclMacNotify.c.#define NOTIFY_TIMER  (1<<2)

Definition at line 83 of file tclMacNotify.c.
Function Documentation
static void NotifierExitHandler _ANSI_ARGS_ ((ClientData clientData)) [static]
static int HandleMacEvents _ANSI_ARGS_ ((void)) [static]
static int HandleMacEvents (void) [static]

Definition at line 257 of file tclMacNotify.c.
References GetGlobalMouseTcl(), notifier, and NULL.
Referenced by Tcl_WaitForEvent().258 {
259     EventRecord theEvent;
260     int eventFound = 0, needsUpdate = 0;
261     Point currentMouse;
262     WindowRef windowRef;
263     Rect mouseRect;
264 
265     /*
266      * Check for mouse moved events.  These events aren't placed on the
267      * system event queue unless we call WaitNextEvent.
268      */
269 
270     GetGlobalMouseTcl(&currentMouse);
271     if ((notifier.eventProcPtr != NULL) &&
272       !EqualPt(currentMouse, notifier.lastMousePosition)) {
273   notifier.lastMousePosition = currentMouse;
274   theEvent.what = nullEvent;
275   if ((*notifier.eventProcPtr)(&theEvent) == true) {
276       eventFound = 1;
277   }
278     }
279 
280     /*
281      * Check for update events.  Since update events aren't generated
282      * until we call GetNextEvent, we may need to force a call to
283      * GetNextEvent, even if the queue is empty.
284      */
285 
286     for (windowRef = FrontWindow(); windowRef != NULL;
287       windowRef = GetNextWindow(windowRef)) {
288   GetWindowUpdateRgn(windowRef, notifier.utilityRgn);
289   if (!EmptyRgn(notifier.utilityRgn)) {
290       needsUpdate = 1;
291       break;
292   }
293     }
294     
295     /*
296      * Process events from the OS event queue.
297      */
298 
299     while (needsUpdate || (GetEvQHdr()->qHead != NULL)) {
300   GetGlobalMouseTcl(&currentMouse);
301   SetRect(&mouseRect, currentMouse.h, currentMouse.v,
302     currentMouse.h + 1, currentMouse.v + 1);
303   RectRgn(notifier.utilityRgn, &mouseRect);
304   
305   WaitNextEvent(everyEvent, &theEvent, 5, notifier.utilityRgn);
306   needsUpdate = 0;
307   if ((notifier.eventProcPtr != NULL)
308     && ((*notifier.eventProcPtr)(&theEvent) == true)) {
309       eventFound = 1;
310   }
311     }
312     
313     return eventFound;
314 }
static void InitNotifier (void) [static]

Definition at line 207 of file tclMacNotify.c.
References notifier, NotifierExitHandler(), NULL, and Tcl_CreateExitHandler().
Referenced by CreateFileHandler(), DeleteFileHandler(), SetTimer(), TclSetAppContext(), Tclxttest_Init(), and WaitForEvent().208 {
209     initialized = 1;
210     memset(&notifier, 0, sizeof(notifier));
211     Tcl_CreateExitHandler(NotifierExitHandler, NULL);
212 }
static void NotifierExitHandler (ClientData clientData) [static]

Definition at line 233 of file tclMacNotify.c.
Referenced by InitNotifier().235 {
236     initialized = 0;
237 }
void Tcl_AlertNotifier (ClientData clientData)

Definition at line 177 of file tclMacNotify.c.
References TclMacHaveThreads().
Referenced by Tcl_ServiceModeHook().179 {
180 
181 #ifdef TCL_THREADS
182     if (TclMacHaveThreads()) {
183         YieldToThread((ThreadID) clientData);
184     }
185 #endif
186 
187 }
void Tcl_FinalizeNotifier (ClientData clientData)

Definition at line 150 of file tclMacNotify.c.152 {
153     /* Nothing to do on the Mac */
154 }
ClientData Tcl_InitNotifier ()

Definition at line 114 of file tclMacNotify.c.
References NULL, and TclMacHaveThreads().115 {
116     
117 #ifdef TCL_THREADS
118     ThreadID curThread;
119     if (TclMacHaveThreads()) {
120         GetCurrentThread(&curThread);
121         return (ClientData) curThread;
122     } else {
123         return NULL;
124     }
125 #else
126     return NULL;
127 #endif
128 
129 }
void Tcl_MacSetEventProc (Tcl_MacConvertEventPtr procPtr)

Definition at line 577 of file tclMacNotify.c.
References notifier.
Referenced by MacintoshInit().579 {
580     notifier.eventProcPtr = procPtr;
581 }
void Tcl_ServiceModeHook (int mode)

Definition at line 383 of file tclMacNotify.c.386 {
387 }
void Tcl_SetTimer (Tcl_Time * timePtr)

Definition at line 335 of file tclMacNotify.c.
References notifier, Tcl_Time::sec, Tcl_NotifierProcs::setTimerProc, Tcl_GetTime(), tclOriginalNotifier, and Tcl_Time::usec.
Referenced by Tcl_ServiceAll(), Tcl_SetMaxBlockTime(), and WaitForEvent().337 {
338     /*
339      * Allow the notifier to be hooked.  This may not make sense
340      * on the Mac, but mirrors the UNIX hook.
341      */
342 
343     if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) {
344   tclStubs.tcl_SetTimer(timePtr);
345   return;
346     }
347 
348     if (!timePtr) {
349   notifier.timerActive = 0;
350     } else {
351   /*
352    * Compute when the timer should fire.
353    */
354   
355   Tcl_GetTime(&notifier.timer);
356   notifier.timer.sec += timePtr->sec;
357   notifier.timer.usec += timePtr->usec;
358   if (notifier.timer.usec >= 1000000) {
359       notifier.timer.usec -= 1000000;
360       notifier.timer.sec += 1;
361   }
362   notifier.timerActive = 1;
363     }
364 }
void Tcl_Sleep (int ms)

Definition at line 534 of file tclMacNotify.c.
References NULL, TclMacHaveThreads(), TclMacRemoveTimer(), TclMacStartTimer(), and TclMacTimerExpired().
Referenced by Tcl_AfterObjCmd().536 {
537     EventRecord dummy;
538     void *timerToken;
539     
540     if (ms <= 0) {
541   return;
542     }
543     
544     timerToken = TclMacStartTimer((long) ms);
545     while (1) {
546   WaitNextEvent(0, &dummy, (ms / 16.66) + 1, NULL);
547         if (TclMacHaveThreads()) {
548       YieldToAnyThread();
549   }
550   if (TclMacTimerExpired(timerToken)) {
551       break;
552   }
553     }
554     TclMacRemoveTimer(timerToken);
555 }
int Tcl_WaitForEvent (Tcl_Time * timePtr)

Definition at line 408 of file tclMacNotify.c.
References GetGlobalMouseTcl(), HandleMacEvents(), INT_MAX, notifier, NULL, Tcl_Time::sec, TclMacHaveThreads(), TclMacRemoveTimer(), TclMacStartTimer(), TclMacTimerExpired(), tclOriginalNotifier, Tcl_Time::usec, and Tcl_NotifierProcs::waitForEventProc.
Referenced by Tcl_DoOneEvent().410 {
411     int found;
412     EventRecord macEvent;
413     long sleepTime = 5;
414     long ms;
415     Point currentMouse;
416     void * timerToken;
417     Rect mouseRect;
418 
419     /*
420      * Allow the notifier to be hooked.  This may not make
421      * sense on the Mac, but mirrors the UNIX hook.
422      */
423 
424     if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) {
425   return tclStubs.tcl_WaitForEvent(timePtr);
426     }
427 
428     /*
429      * Compute the next timeout value.
430      */
431 
432     if (!timePtr) {
433   ms = INT_MAX;
434     } else {
435   ms = (timePtr->sec * 1000) + (timePtr->usec / 1000);
436     }
437     timerToken = TclMacStartTimer((long) ms);
438    
439     /*
440      * Poll the Mac event sources.  This loop repeats until something
441      * happens: a timeout, a socket event, mouse motion, or some other
442      * window event.  Note that we don't call WaitNextEvent if another
443      * event is found to avoid context switches.  This effectively gives
444      * events coming in via WaitNextEvent a slightly lower priority.
445      */
446 
447     found = 0;
448     if (notifier.utilityRgn == NULL) {
449   notifier.utilityRgn = NewRgn();
450     }
451 
452     while (!found) {
453   /*
454    * Check for generated and queued events.
455    */
456 
457   if (HandleMacEvents()) {
458       found = 1;
459   }
460 
461   /*
462    * Check for time out.
463    */
464 
465   if (!found && TclMacTimerExpired(timerToken)) {
466       found = 1;
467   }
468 
469   /*
470    * Check for window events.  We may receive a NULL event for
471    * various reasons. 1) the timer has expired, 2) a mouse moved
472    * event is occuring or 3) the os is giving us time for idle
473    * events.  Note that we aren't sharing the processor very
474    * well here.  We really ought to do a better job of calling
475    * WaitNextEvent for time slicing purposes.
476    */
477 
478   if (!found) {
479       /*
480        * Set up mouse region so we will wake if the mouse is moved.
481        * We do this by defining the smallest possible region around
482        * the current mouse position.
483        */
484 
485       GetGlobalMouseTcl(&currentMouse);
486       SetRect(&mouseRect, currentMouse.h, currentMouse.v,
487         currentMouse.h + 1, currentMouse.v + 1);
488       RectRgn(notifier.utilityRgn, &mouseRect);
489   
490       WaitNextEvent(everyEvent, &macEvent, sleepTime,
491         notifier.utilityRgn);
492 
493       if (notifier.eventProcPtr != NULL) {
494     if ((*notifier.eventProcPtr)(&macEvent) == true) {
495         found = 1;
496     }
497       }
498   }
499     }
500     TclMacRemoveTimer(timerToken);
501     
502     /*
503      * Yield time to nay other thread at this point.  If we find that the
504      * apps thrash too switching between threads, we can put a timer here,
505      * and only yield when the timer fires.
506      */
507      
508     if (TclMacHaveThreads()) {
509         YieldToAnyThread();
510     }
511     
512     return 0;
513 }

Variable Documentation
Tcl_MacConvertEventPtr eventProcPtr

Definition at line 72 of file tclMacNotify.c.int flags

Definition at line 67 of file tclMacNotify.c.int initialized = 0 [static]

Definition at line 57 of file tclMacNotify.c.
Referenced by ConsoleInit(), CreateFileHandler(), DeleteFileHandler(), InitNotifier(), InitSockets(), PipeInit(), ProcExitHandler(), ResourceInit(), SerialInit(), SerialOutputProc(), SetTimer(), SocketExitHandler(), TCL_DECLARE_MUTEX(), Tcl_MacOSXOpenVersionedBundleResources(), Tcl_ResourceObjCmd(), TclMacHaveThreads(), TclMacRegisterResourceFork(), TclpSysAlloc(), TclSetAppContext(), TestfilehandlerCmd(), TestplatformChmod(), and WaitForEvent().Point lastMousePosition

Definition at line 68 of file tclMacNotify.c.struct { ... }   notifier [static]

Referenced by CreateFileHandler(), DeleteFileHandler(), FileHandlerEventProc(), HandleMacEvents(), InitNotifier(), NotifierExitHandler(), SetTimer(), Tcl_MacSetEventProc(), Tcl_SetTimer(), Tcl_WaitForEvent(), TclSetAppContext(), TimerProc(), and WaitForEvent().Tcl_NotifierProcs tclOriginalNotifier

Definition at line 46 of file tclStubInit.c.TclStubs tclStubs

Definition at line 411 of file tclStubInit.c.Tcl_Time timer

Definition at line 66 of file tclMacNotify.c.int timerActive

Definition at line 65 of file tclMacNotify.c.RgnHandle utilityRgn

Definition at line 69 of file tclMacNotify.c.

mac/tclMacOSA.c File Reference
#include <Aliases.h>
#include <string.h>
#include <AppleEvents.h>
#include <AppleScript.h>
#include <OSA.h>
#include <OSAGeneric.h>
#include <Script.h>
#include <FullPath.h>
#include <components.h>
#include <resources.h>
#include <FSpCompat.h>
#include <MoreFiles.h>
#include "tcl.h"
#include "tclInt.h"
#include "tclMacInt.h"
Classes
struct tclOSAScript
struct tclOSAContext
struct tclOSAComponent
Defines
#define MAC_TCL
#define REALLOC_INCR  30
Functions
static pascal OSErr TclOSAActiveProc _ANSI_ARGS_ ((long refCon))
static int TclOSACompileCmd _ANSI_ARGS_ ((Tcl_Interp *interp, tclOSAComponent *OSAComponent, int argc, CONST char **argv))
static int tclOSADecompileCmd _ANSI_ARGS_ ((Tcl_Interp *Interp, tclOSAComponent *OSAComponent, int argc, CONST char **argv))
static void GetRawDataFromDescriptor _ANSI_ARGS_ ((AEDesc *theDesc, Ptr destPtr, Size destMaxSize, Size *actSize))
static OSErr GetCStringFromDescriptor _ANSI_ARGS_ ((AEDesc *sourceDesc, char *resultStr, Size resultMaxSize, Size *resultSize))
static int Tcl_OSAComponentCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv))
static void getSortedHashKeys _ANSI_ARGS_ ((Tcl_HashTable *theTable, CONST char *pattern, Tcl_DString *theResult))
static int ASCIICompareProc _ANSI_ARGS_ ((const void *first, const void *second))
static void tclOSAClose _ANSI_ARGS_ ((ClientData clientData))
static tclOSAComponent *tclOSAMakeNewComponent _ANSI_ARGS_ ((Tcl_Interp *interp, char *cmdName, char *languageName, OSType scriptSubtype, long componentFlags))
static int prepareScriptData _ANSI_ARGS_ ((int argc, CONST char **argv, Tcl_DString *scrptData, AEDesc *scrptDesc))
static void tclOSAResultFromID _ANSI_ARGS_ ((Tcl_Interp *interp, ComponentInstance theComponent, OSAID resultID))
static void tclOSAASError _ANSI_ARGS_ ((Tcl_Interp *interp, ComponentInstance theComponent, char *scriptSource))
static int tclOSAGetContextID _ANSI_ARGS_ ((tclOSAComponent *theComponent, CONST char *contextName, OSAID *theContext))
static void tclOSAAddContext _ANSI_ARGS_ ((tclOSAComponent *theComponent, char *contextName, const OSAID theContext))
static int tclOSADeleteContext _ANSI_ARGS_ ((tclOSAComponent *theComponent, CONST char *contextName))
static int tclOSALoad _ANSI_ARGS_ ((Tcl_Interp *interp, tclOSAComponent *theComponent, CONST char *resourceName, int resourceNumber, CONST char *fileName, OSAID *resultID))
static int tclOSAStore _ANSI_ARGS_ ((Tcl_Interp *interp, tclOSAComponent *theComponent, CONST char *resourceName, int resourceNumber, CONST char *scriptName, CONST char *fileName))
static int tclOSAAddScript _ANSI_ARGS_ ((tclOSAComponent *theComponent, char *scriptName, long modeFlags, OSAID scriptID))
static int tclOSAGetScriptID _ANSI_ARGS_ ((tclOSAComponent *theComponent, CONST char *scriptName, OSAID *scriptID))
static tclOSAScript *tclOSAGetScript _ANSI_ARGS_ ((tclOSAComponent *theComponent, CONST char *scriptName))
static int tclOSADeleteScript _ANSI_ARGS_ ((tclOSAComponent *theComponent, CONST char *scriptName, char *errMsg))
int Tclapplescript_Init (Tcl_Interp *interp)
int Tcl_OSACmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
int Tcl_OSAComponentCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int TclOSACompileCmd (Tcl_Interp *interp, tclOSAComponent *OSAComponent, int argc, CONST char **argv)
static int tclOSADecompileCmd (Tcl_Interp *interp, tclOSAComponent *OSAComponent, int argc, CONST char **argv)
static int tclOSADeleteCmd (Tcl_Interp *interp, tclOSAComponent *OSAComponent, int argc, CONST char **argv)
static int tclOSAExecuteCmd (Tcl_Interp *interp, tclOSAComponent *OSAComponent, int argc, CONST char **argv)
static int tclOSAInfoCmd (Tcl_Interp *interp, tclOSAComponent *OSAComponent, int argc, CONST char **argv)
static int tclOSALoadCmd (Tcl_Interp *interp, tclOSAComponent *OSAComponent, int argc, CONST char **argv)
static int tclOSARunCmd (Tcl_Interp *interp, tclOSAComponent *OSAComponent, int argc, CONST char **argv)
static int tclOSAStoreCmd (Tcl_Interp *interp, tclOSAComponent *OSAComponent, int argc, CONST char **argv)
tclOSAComponent * tclOSAMakeNewComponent (Tcl_Interp *interp, char *cmdName, char *languageName, OSType scriptSubtype, long componentFlags)
void tclOSAClose (ClientData clientData)
static int tclOSAGetContextID (tclOSAComponent *theComponent, CONST char *contextName, OSAID *theContext)
static void tclOSAAddContext (tclOSAComponent *theComponent, char *contextName, const OSAID theContext)
static int tclOSADeleteContext (tclOSAComponent *theComponent, CONST char *contextName)
static int tclOSAMakeContext (tclOSAComponent *theComponent, CONST char *contextName, OSAID *theContext)
int tclOSAStore (Tcl_Interp *interp, tclOSAComponent *theComponent, CONST char *resourceName, int resourceNumber, CONST char *scriptName, CONST char *fileName)
int tclOSALoad (Tcl_Interp *interp, tclOSAComponent *theComponent, CONST char *resourceName, int resourceNumber, CONST char *fileName, OSAID *resultID)
static int tclOSAGetScriptID (tclOSAComponent *theComponent, CONST char *scriptName, OSAID *scriptID)
static int tclOSAAddScript (tclOSAComponent *theComponent, char *scriptName, long modeFlags, OSAID scriptID)
static tclOSAScript * tclOSAGetScript (tclOSAComponent *theComponent, CONST char *scriptName)
static int tclOSADeleteScript (tclOSAComponent *theComponent, CONST char *scriptName, char *errMsg)
static pascal OSErr TclOSAActiveProc (long refCon)
static int ASCIICompareProc (const void *first, const void *second)
static void getSortedHashKeys (Tcl_HashTable *theTable, CONST char *pattern, Tcl_DString *theResult)
static int prepareScriptData (int argc, CONST char **argv, Tcl_DString *scrptData, AEDesc *scrptDesc)
void tclOSAResultFromID (Tcl_Interp *interp, ComponentInstance theComponent, OSAID resultID)
void tclOSAASError (Tcl_Interp *interp, ComponentInstance theComponent, char *scriptData)
static void GetRawDataFromDescriptor (AEDesc *theDesc, Ptr destPtr, Size destMaxSize, Size *actSize)
static OSErr GetCStringFromDescriptor (AEDesc *sourceDesc, char *resultStr, Size resultMaxSize, Size *resultSize)

Define Documentation
#define MAC_TCL

Definition at line 18 of file tclMacOSA.c.#define REALLOC_INCR  30

Definition at line 2608 of file tclMacOSA.c.
Referenced by getSortedHashKeys().
Function Documentation
static int tclOSADeleteScript _ANSI_ARGS_ ((tclOSAComponent *theComponent, CONST char *scriptName, char *errMsg)) [static]
static tclOSAScript* tclOSAGetScript _ANSI_ARGS_ ((tclOSAComponent *theComponent, CONST char *scriptName)) [static]
static int tclOSAGetScriptID _ANSI_ARGS_ ((tclOSAComponent *theComponent, CONST char *scriptName, OSAID *scriptID)) [static]
static int tclOSAAddScript _ANSI_ARGS_ ((tclOSAComponent *theComponent, char *scriptName, long modeFlags, OSAID scriptID)) [static]
static int tclOSAStore _ANSI_ARGS_ ((Tcl_Interp *interp, tclOSAComponent *theComponent, CONST char *resourceName, int resourceNumber, CONST char *scriptName, CONST char *fileName)) [static]
static int tclOSALoad _ANSI_ARGS_ ((Tcl_Interp *interp, tclOSAComponent *theComponent, CONST char *resourceName, int resourceNumber, CONST char *fileName, OSAID *resultID)) [static]
static int tclOSADeleteContext _ANSI_ARGS_ ((tclOSAComponent *theComponent, CONST char *contextName)) [static]
static void tclOSAAddContext _ANSI_ARGS_ ((tclOSAComponent *theComponent, char *contextName, const OSAID theContext)) [static]
static int tclOSAGetContextID _ANSI_ARGS_ ((tclOSAComponent *theComponent, CONST char *contextName, OSAID *theContext)) [static]
static void tclOSAASError _ANSI_ARGS_ ((Tcl_Interp *interp, ComponentInstance theComponent, char *scriptSource)) [static]
static void tclOSAResultFromID _ANSI_ARGS_ ((Tcl_Interp *interp, ComponentInstance theComponent, OSAID resultID)) [static]
static int prepareScriptData _ANSI_ARGS_ ((int argc, CONST char **argv, Tcl_DString *scrptData, AEDesc *scrptDesc)) [static]
static tclOSAComponent* tclOSAMakeNewComponent _ANSI_ARGS_ ((Tcl_Interp *interp, char *cmdName, char *languageName, OSType scriptSubtype, long componentFlags)) [static]
static void tclOSAClose _ANSI_ARGS_ ((ClientData clientData)) [static]
static int ASCIICompareProc _ANSI_ARGS_ ((const void *first, const void *second)) [static]
static void getSortedHashKeys _ANSI_ARGS_ ((Tcl_HashTable *theTable, CONST char *pattern, Tcl_DString *theResult)) [static]
static int Tcl_OSAComponentCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)) [static]
static OSErr GetCStringFromDescriptor _ANSI_ARGS_ ((AEDesc *sourceDesc, char *resultStr, Size resultMaxSize, Size *resultSize)) [static]
static void GetRawDataFromDescriptor _ANSI_ARGS_ ((AEDesc *theDesc, Ptr destPtr, Size destMaxSize, Size *actSize)) [static]
static int tclOSADecompileCmd _ANSI_ARGS_ ((Tcl_Interp *Interp, tclOSAComponent *OSAComponent, int argc, CONST char **argv)) [static]
static int TclOSACompileCmd _ANSI_ARGS_ ((Tcl_Interp *interp, tclOSAComponent *OSAComponent, int argc, CONST char **argv)) [static]
static pascal OSErr TclOSAActiveProc _ANSI_ARGS_ ((long refCon)) [static]
static int ASCIICompareProc (const void * first, const void * second) [static]

Definition at line 2596 of file tclMacOSA.c.
Referenced by getSortedHashKeys().2597 {
2598     int order;
2599     
2600     char *firstString = *((char **) first);
2601     char *secondString = *((char **) second);
2602 
2603     order = strcmp(firstString, secondString);
2604   
2605     return order;
2606 }
static OSErr GetCStringFromDescriptor (AEDesc * sourceDesc, char * resultStr, Size resultMaxSize, Size * resultSize) [static]

Definition at line 2932 of file tclMacOSA.c.
References GetRawDataFromDescriptor().
Referenced by Tclapplescript_Init().2937 {
2938     OSErr err;
2939     AEDesc resultDesc;
2940 
2941     resultDesc.dataHandle = nil;
2942         
2943     err = AECoerceDesc(sourceDesc, typeChar, &resultDesc);
2944     
2945     if (!err) {
2946   GetRawDataFromDescriptor(&resultDesc, (Ptr) resultStr,
2947     resultMaxSize - 1, resultSize);
2948   resultStr[*resultSize] = 0;
2949     } else {
2950   err = errAECoercionFail;
2951     }
2952       
2953     if (resultDesc.dataHandle) {
2954   AEDisposeDesc(&resultDesc);
2955     }
2956     
2957     return err;
2958 }
static void GetRawDataFromDescriptor (AEDesc * theDesc, Ptr destPtr, Size destMaxSize, Size * actSize) [static]

Definition at line 2895 of file tclMacOSA.c.
Referenced by GetCStringFromDescriptor().2900   {
2901       Size copySize;
2902 
2903       if (theDesc->dataHandle) {
2904     HLock((Handle)theDesc->dataHandle);
2905     *actSize = GetHandleSize((Handle)theDesc->dataHandle);
2906     copySize = *actSize < destMaxSize ? *actSize : destMaxSize;
2907     BlockMove(*theDesc->dataHandle, destPtr, copySize);
2908     HUnlock((Handle)theDesc->dataHandle);
2909       } else {
2910     *actSize = 0;
2911       }
2912       
2913   }
static void getSortedHashKeys (Tcl_HashTable * theTable, CONST char * pattern, Tcl_DString * theResult) [static]

Definition at line 2629 of file tclMacOSA.c.
References ASCIICompareProc(), ckrealloc, NULL, REALLOC_INCR, size_t(), Tcl_DStringAppendElement(), Tcl_DStringInit(), Tcl_FirstHashEntry(), Tcl_GetHashKey, Tcl_NextHashEntry(), Tcl_StringMatch(), and VOID.
Referenced by Tcl_OSACmd(), and tclOSAInfoCmd().2633 {
2634     Tcl_HashSearch search;
2635     Tcl_HashEntry *hPtr;
2636     Boolean compare = true;
2637     char *keyPtr;
2638     static char **resultArgv = NULL;
2639     static int totSize = 0;
2640     int totElem = 0, i;
2641   
2642     if (pattern == NULL || *pattern == '\0' || 
2643       (*pattern == '*' && *(pattern + 1) == '\0')) {
2644   compare = false;
2645     }
2646   
2647     for (hPtr = Tcl_FirstHashEntry(theTable,&search), totElem = 0;
2648    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
2649       
2650   keyPtr = (char *) Tcl_GetHashKey(theTable, hPtr);
2651   if (!compare || Tcl_StringMatch(keyPtr, pattern)) {
2652       totElem++;    
2653       if (totElem >= totSize) {
2654     totSize += REALLOC_INCR;
2655     resultArgv = (char **) ckrealloc((char *) resultArgv,
2656       totSize * sizeof(char *));
2657       }
2658       resultArgv[totElem - 1] = keyPtr;
2659   } 
2660     }
2661     
2662     Tcl_DStringInit(theResult);
2663     if (totElem == 1) {
2664   Tcl_DStringAppendElement(theResult, resultArgv[0]);
2665     } else if (totElem > 1) {
2666   qsort((VOID *) resultArgv, (size_t) totElem, sizeof (char *),
2667     ASCIICompareProc);
2668 
2669   for (i = 0; i < totElem; i++) {
2670       Tcl_DStringAppendElement(theResult, resultArgv[i]);
2671   }
2672     } 
2673 }
static int prepareScriptData (int argc, CONST char ** argv, Tcl_DString * scrptData, AEDesc * scrptDesc) [static]

Definition at line 2697 of file tclMacOSA.c.
References NULL, Tcl_DString::string, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringValue, TCL_ERROR, TCL_OK, and Tcl_UtfToExternalDString().
Referenced by TclOSACompileCmd(), and tclOSAExecuteCmd().2702 {
2703     char * ptr;
2704     int i;
2705     char buffer[7];
2706     OSErr sysErr = noErr;
2707     Tcl_DString encodedText;
2708 
2709     Tcl_DStringInit(scrptData);
2710 
2711     for (i = 0; i < argc; i++) {
2712   Tcl_DStringAppend(scrptData, argv[i], -1);
2713   Tcl_DStringAppend(scrptData, " ", 1);
2714     }
2715 
2716     /*
2717      * First replace the \n's with \r's in the script argument
2718      * Also replace "\\n" with "  ".
2719      */
2720 
2721     for (ptr = scrptData->string; *ptr != '\0'; ptr++) {
2722   if (*ptr == '\n') {
2723       *ptr = '\r';
2724   } else if (*ptr == '\\') {
2725       if (*(ptr + 1) == '\n') {
2726     *ptr = ' ';
2727     *(ptr + 1) = ' ';
2728       }
2729   }
2730     }
2731 
2732     Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(scrptData),
2733       Tcl_DStringLength(scrptData), &encodedText);
2734     sysErr = AECreateDesc(typeChar, Tcl_DStringValue(&encodedText),
2735       Tcl_DStringLength(&encodedText), scrptDesc);
2736     Tcl_DStringFree(&encodedText);
2737 
2738     if (sysErr != noErr) {
2739   sprintf(buffer, "%6d", sysErr);
2740   Tcl_DStringFree(scrptData);
2741   Tcl_DStringAppend(scrptData, "Error #", 7);
2742   Tcl_DStringAppend(scrptData, buffer, -1);
2743   Tcl_DStringAppend(scrptData, " creating Script Data Descriptor.", 33);
2744   return TCL_ERROR;         
2745     }
2746 
2747     return TCL_OK;
2748 }
int Tcl_OSACmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv)

Definition at line 356 of file tclMacOSA.c.
References getSortedHashKeys(), NULL, strstr(), Tcl_DeleteCommand(), Tcl_DStringInit(), Tcl_DStringResult(), TCL_ERROR, Tcl_FindHashEntry, Tcl_FirstHashEntry(), Tcl_GetAssocData(), Tcl_GetHashKey, Tcl_GetHashValue, Tcl_NextHashEntry(), TCL_OK, Tcl_SetResult(), TCL_VOLATILE, and tclOSAMakeNewComponent().361 {
362     static unsigned short componentCmdIndex = 0;
363     char autoName[32];
364     char c;
365     int length;
366     Tcl_HashTable *ComponentTable = NULL;
367   
368 
369     if (argc == 1) {
370   Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
371     argv[0], " option\"", (char *) NULL);
372   return TCL_ERROR;
373     }
374   
375     c = *argv[1];
376     length = strlen(argv[1]);
377   
378     /*
379      * Query out the Component Table, since most of these commands use it...
380      */
381   
382     ComponentTable = (Tcl_HashTable *) Tcl_GetAssocData(interp,
383       "OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL);
384   
385     if (ComponentTable == NULL) {
386   Tcl_AppendResult(interp, "Error, could not get the Component Table",
387     " from the Associated data.", (char *) NULL);
388   return TCL_ERROR;
389     }
390   
391     if (c == 'c' && strncmp(argv[1],"close",length) == 0) {
392   Tcl_HashEntry *hashEntry;
393   if (argc != 3) {
394       Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
395         argv[0], " ",argv[1], " componentName\"",
396         (char *) NULL);
397       return TCL_ERROR;
398   }
399     
400   if ((hashEntry = Tcl_FindHashEntry(ComponentTable,argv[2])) == NULL) {
401       Tcl_AppendResult(interp, "Component \"", argv[2], "\" not found",
402         (char *) NULL);
403       return TCL_ERROR;
404   } else {
405       Tcl_DeleteCommand(interp,argv[2]);
406       return TCL_OK;
407   }
408     } else if (c == 'o' && strncmp(argv[1],"open",length) == 0) {
409   /*
410    * Default language is AppleScript.
411    */
412   OSType scriptSubtype = kAppleScriptSubtype;
413   char *languageName = "AppleScript English";
414   char *errMsg = NULL;
415   ComponentDescription *theCD;
416 
417   argv += 2;
418   argc -= 2;
419      
420   while (argc > 0 ) {
421       if (*argv[0] == '-') {
422     c = *(argv[0] + 1);
423     if (c == 'l' && strcmp(argv[0] + 1, "language") == 0) {
424         if (argc == 1) {
425       Tcl_AppendResult(interp,
426         "Error - no language provided for the -language switch",
427         (char *) NULL);
428       return TCL_ERROR;
429         } else {
430       Tcl_HashEntry *hashEntry;
431       Tcl_HashSearch search;
432       Boolean gotIt = false;
433       Tcl_HashTable *LanguagesTable;
434             
435       /*
436        * Look up the language in the languages table
437        * Do a simple strstr match, so AppleScript
438        * will match "AppleScript English"...
439        */
440             
441       LanguagesTable = Tcl_GetAssocData(interp,
442         "OSAScript_LangTable",
443         (Tcl_InterpDeleteProc **) NULL);
444               
445       for (hashEntry =
446          Tcl_FirstHashEntry(LanguagesTable, &search);
447            hashEntry != NULL;
448            hashEntry = Tcl_NextHashEntry(&search)) {
449           languageName = Tcl_GetHashKey(LanguagesTable,
450             hashEntry);
451           if (strstr(languageName,argv[1]) != NULL) {
452         theCD = (ComponentDescription *)
453             Tcl_GetHashValue(hashEntry);
454         gotIt = true;
455         break;
456           }
457       }
458       if (!gotIt) {
459           Tcl_AppendResult(interp,
460             "Error, could not find the language \"",
461             argv[1],
462             "\" in the list of known languages.",
463             (char *) NULL);
464           return TCL_ERROR;
465       }
466         }
467     }
468     argc -= 2;
469     argv += 2;        
470       } else {
471     Tcl_AppendResult(interp, "Expected a flag, but got ",
472       argv[0], (char *) NULL);
473     return TCL_ERROR;
474       }
475   }
476       
477   sprintf(autoName, "OSAComponent%-d", componentCmdIndex++);
478   if (tclOSAMakeNewComponent(interp, autoName, languageName,
479     theCD->componentSubType, theCD->componentFlags) == NULL ) {
480       return TCL_ERROR;
481   } else {
482       Tcl_SetResult(interp,autoName,TCL_VOLATILE);
483       return TCL_OK;  
484   }
485     
486     } else if (c == 'i' && strncmp(argv[1],"info",length) == 0) {
487   if (argc == 2) {
488       Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
489         argv[0], " ", argv[1], " what\"",
490         (char *) NULL);
491       return TCL_ERROR;
492   }
493       
494   c = *argv[2];
495   length = strlen(argv[2]);
496     
497   if (c == 'c' && strncmp(argv[2], "components", length) == 0) {
498       Tcl_DString theResult;
499       
500       Tcl_DStringInit(&theResult);
501       
502       if (argc == 3) {
503     getSortedHashKeys(ComponentTable,(char *) NULL, &theResult);
504       } else if (argc == 4) {
505     getSortedHashKeys(ComponentTable, argv[3], &theResult);
506       } else {
507     Tcl_AppendResult(interp, "Error: wrong # of arguments",
508       ", should be \"", argv[0], " ", argv[1], " ",
509       argv[2], " ?pattern?\".", (char *) NULL);
510     return TCL_ERROR;
511       }
512       Tcl_DStringResult(interp, &theResult);
513       return TCL_OK;      
514   } else if (c == 'l' && strncmp(argv[2],"languages",length) == 0) {
515       Tcl_DString theResult;
516       Tcl_HashTable *LanguagesTable;
517       
518       Tcl_DStringInit(&theResult);
519       LanguagesTable = Tcl_GetAssocData(interp,
520         "OSAScript_LangTable", (Tcl_InterpDeleteProc **) NULL);
521               
522       if (argc == 3) {
523     getSortedHashKeys(LanguagesTable, (char *) NULL, &theResult);
524       } else if (argc == 4) {
525     getSortedHashKeys(LanguagesTable, argv[3], &theResult);
526       } else {
527     Tcl_AppendResult(interp, "Error: wrong # of arguments",
528       ", should be \"", argv[0], " ", argv[1], " ",
529       argv[2], " ?pattern?\".", (char *) NULL);
530     return TCL_ERROR;
531       }
532       Tcl_DStringResult(interp,&theResult);
533       return TCL_OK;      
534   } else {
535       Tcl_AppendResult(interp, "Unknown option: ", argv[2],
536         " for OSA info, should be one of",
537         " \"components\" or \"languages\"",
538         (char *) NULL);
539       return TCL_ERROR;
540   }
541     } else {
542   Tcl_AppendResult(interp, "Unknown option: ", argv[1],
543     ", should be one of \"open\", \"close\" or \"info\".",
544     (char *) NULL);
545   return TCL_ERROR;
546     }
547     return TCL_OK;
548 }
int Tcl_OSAComponentCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv)

Definition at line 580 of file tclMacOSA.c.
References NULL, TCL_ERROR, TCL_OK, TclOSACompileCmd(), tclOSADecompileCmd(), tclOSADeleteCmd(), tclOSAExecuteCmd(), tclOSAInfoCmd(), tclOSALoadCmd(), tclOSARunCmd(), and tclOSAStoreCmd().
Referenced by tclOSAMakeNewComponent().585 {
586     int length;
587     char c;
588   
589     tclOSAComponent *OSAComponent = (tclOSAComponent *) clientData;
590   
591     if (argc == 1) {
592   Tcl_AppendResult(interp, "wrong # args: should be \"",
593     argv[0], " option ?arg ...?\"",
594     (char *) NULL);
595   return TCL_ERROR;
596     }
597   
598     c = *argv[1];
599     length = strlen(argv[1]);
600     if (c == 'c' && strncmp(argv[1], "compile", length) == 0) {
601   return TclOSACompileCmd(interp, OSAComponent, argc, argv);
602     } else if (c == 'l' && strncmp(argv[1], "load", length) == 0) {
603   return tclOSALoadCmd(interp, OSAComponent, argc, argv);
604     } else if (c == 'e' && strncmp(argv[1], "execute", length) == 0) {
605   return tclOSAExecuteCmd(interp, OSAComponent, argc, argv);
606     } else if (c == 'i' && strncmp(argv[1], "info", length) == 0) {
607   return tclOSAInfoCmd(interp, OSAComponent, argc, argv);
608     } else if (c == 'd' && strncmp(argv[1], "decompile", length) == 0) {
609   return tclOSADecompileCmd(interp, OSAComponent, argc, argv);
610     } else if (c == 'd' && strncmp(argv[1], "delete", length) == 0) {
611   return tclOSADeleteCmd(interp, OSAComponent, argc, argv);
612     } else if (c == 'r' && strncmp(argv[1], "run", length) == 0) {
613   return tclOSARunCmd(interp, OSAComponent, argc, argv);
614     } else if (c == 's' && strncmp(argv[1], "store", length) == 0) {
615   return tclOSAStoreCmd(interp, OSAComponent, argc, argv);
616     } else {
617   Tcl_AppendResult(interp,"bad option \"", argv[1],
618     "\": should be compile, decompile, delete, ",
619      "execute, info, load, run or store",
620      (char *) NULL);
621   return TCL_ERROR;
622     }
623 
624     return TCL_OK;
625 }
int Tclapplescript_Init (Tcl_Interp * interp)

Definition at line 183 of file tclMacOSA.c.
References ckalloc, ckfree, GetCStringFromDescriptor(), NULL, panic, Tcl_CreateHashEntry, TCL_ERROR, Tcl_InitHashTable(), Tcl_InitStubs, Tcl_PkgProvide(), Tcl_SetAssocData(), Tcl_SetHashValue, TCL_STRING_KEYS, and tclOSAMakeNewComponent().185 {
186     char *errMsg = NULL;
187     OSErr myErr = noErr;
188     Boolean gotAppleScript = false;
189     Boolean GotOneOSALanguage = false;
190     ComponentDescription compDescr = {
191   kOSAComponentType,
192   (OSType) 0,
193   (OSType) 0,
194   (long) 0,
195   (long) 0
196     }, *foundComp;
197     Component curComponent = (Component) 0;
198     ComponentInstance curOpenComponent;
199     Tcl_HashTable *ComponentTable;
200     Tcl_HashTable *LanguagesTable;
201     Tcl_HashEntry *hashEntry;
202     int newPtr;
203     AEDesc componentName = { typeNull, NULL };
204     char nameStr[32];     
205     Size nameLen;
206     long appleScriptFlags;
207   
208     /* 
209      * Perform the required stubs magic...
210      */
211       
212     if (!Tcl_InitStubs(interp, "8.2", 0)) {
213   return TCL_ERROR;
214     }
215 
216     /* 
217      * Here We Will Get The Available Osa Languages, Since They Can Only Be 
218      * Registered At Startup...  If You Dynamically Load Components, This
219      * Will Fail, But This Is Not A Common Thing To Do.
220      */
221    
222     LanguagesTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
223   
224     if (LanguagesTable == NULL) {
225   panic("Memory Error Allocating Languages Hash Table");
226     }
227   
228     Tcl_SetAssocData(interp, "OSAScript_LangTable", NULL, LanguagesTable);
229     Tcl_InitHashTable(LanguagesTable, TCL_STRING_KEYS);
230   
231       
232     while ((curComponent = FindNextComponent(curComponent, &compDescr)) != 0) {
233   int nbytes = sizeof(ComponentDescription);
234   foundComp = (ComponentDescription *)
235       ckalloc(sizeof(ComponentDescription));
236   myErr = GetComponentInfo(curComponent, foundComp, NULL, NULL, NULL);
237   if (foundComp->componentSubType ==
238     kOSAGenericScriptingComponentSubtype) {
239       /* Skip the generic component */
240       ckfree((char *) foundComp);
241   } else {
242       GotOneOSALanguage = true;
243 
244       /*
245        * This is gross: looks like I have to open the component just  
246        * to get its name!!! GetComponentInfo is supposed to return
247        * the name, but AppleScript always returns an empty string.
248        */
249       
250       curOpenComponent = OpenComponent(curComponent);
251       if (curOpenComponent == NULL) {
252     Tcl_AppendResult(interp,"Error opening component",
253       (char *) NULL);
254     return TCL_ERROR;
255       }
256        
257       myErr = OSAScriptingComponentName(curOpenComponent,&componentName);
258       if (myErr == noErr) {
259     myErr = GetCStringFromDescriptor(&componentName,
260       nameStr, 31, &nameLen);
261     AEDisposeDesc(&componentName);
262       }
263       CloseComponent(curOpenComponent);
264 
265       if (myErr == noErr) {
266     hashEntry = Tcl_CreateHashEntry(LanguagesTable,
267       nameStr, &newPtr);
268     Tcl_SetHashValue(hashEntry, (ClientData) foundComp);
269       } else {
270     Tcl_AppendResult(interp,"Error getting componentName.",
271       (char *) NULL);
272     return TCL_ERROR;
273       }
274       
275       /*
276        * Make sure AppleScript is loaded, otherwise we will
277        * not bother to make the AppleScript command.
278        */
279       if (foundComp->componentSubType == kAppleScriptSubtype) {
280     appleScriptFlags = foundComp->componentFlags;
281     gotAppleScript = true;
282       }     
283   }
284     }       
285 
286     /*
287      * Create the OSA command.
288      */
289   
290     if (!GotOneOSALanguage) {
291   Tcl_AppendResult(interp,"Could not find any OSA languages",
292     (char *) NULL);
293   return TCL_ERROR;
294     }
295   
296     /*
297      * Create the Component Assoc Data & put it in the interpreter.
298      */
299   
300     ComponentTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
301   
302     if (ComponentTable == NULL) {
303   panic("Memory Error Allocating Hash Table");
304     }
305   
306     Tcl_SetAssocData(interp, "OSAScript_CompTable", NULL, ComponentTable);
307       
308     Tcl_InitHashTable(ComponentTable, TCL_STRING_KEYS);
309 
310     /*
311      * The OSA command is not currently supported.   
312     Tcl_CreateCommand(interp, "OSA", Tcl_OSACmd, (ClientData) NULL,
313       (Tcl_CmdDeleteProc *) NULL);
314      */
315      
316     /* 
317      * Open up one AppleScript component, with a default context
318      * and tie it to the AppleScript command.
319      * If the user just wants single-threaded AppleScript execution
320      * this should be enough.
321      *
322      */
323    
324     if (gotAppleScript) {
325   if (tclOSAMakeNewComponent(interp, "AppleScript",
326     "AppleScript English", kAppleScriptSubtype,
327     appleScriptFlags) == NULL ) {
328       return TCL_ERROR;
329   }
330     }
331 
332     return Tcl_PkgProvide(interp, "OSAConnect", "1.0");
333 }
static pascal OSErr TclOSAActiveProc (long refCon) [static]

Definition at line 2569 of file tclMacOSA.c.
References tclOSAComponent::defActiveProc, tclOSAComponent::defRefCon, TCL_DONT_WAIT, and Tcl_DoOneEvent().
Referenced by tclOSAMakeNewComponent().2571 {
2572     tclOSAComponent *theComponent = (tclOSAComponent *) refCon;
2573   
2574     Tcl_DoOneEvent(TCL_DONT_WAIT);
2575     InvokeOSAActiveUPP(theComponent->defRefCon, theComponent->defActiveProc);
2576   
2577     return noErr;
2578 }
static void tclOSAAddContext (tclOSAComponent * theComponent, char * contextName, const OSAID theContext) [static]

Definition at line 1930 of file tclMacOSA.c.
References ckalloc, tclOSAContext::contextID, tclOSAComponent::contextTable, NULL, Tcl_CreateHashEntry, TCL_INTEGER_SPACE, and Tcl_SetHashValue.
Referenced by TclOSACompileCmd(), tclOSALoadCmd(), and tclOSAMakeContext().1934 {
1935     static unsigned short contextIndex = 0;
1936     tclOSAContext *contextStruct;
1937     Tcl_HashEntry *hashEntry;
1938     int newPtr;
1939 
1940     if (contextName == NULL) {
1941   contextName = ckalloc(16 + TCL_INTEGER_SPACE);
1942   sprintf(contextName, "OSAContext%d", contextIndex++);
1943     } else if (*contextName == '\0') {
1944   sprintf(contextName, "OSAContext%d", contextIndex++);
1945     }
1946   
1947     hashEntry = Tcl_CreateHashEntry(&theComponent->contextTable,
1948       contextName, &newPtr);  
1949 
1950     contextStruct = (tclOSAContext *) ckalloc(sizeof(tclOSAContext));
1951     contextStruct->contextID = theContext;
1952     Tcl_SetHashValue(hashEntry,(ClientData) contextStruct);
1953 }
static int tclOSAAddScript (tclOSAComponent * theComponent, char * scriptName, long modeFlags, OSAID scriptID) [static]

Definition at line 2439 of file tclMacOSA.c.
References ckalloc, tclOSAComponent::languageID, tclOSAScript::languageID, tclOSAScript::modeFlags, NULL, tclOSAScript::scriptID, tclOSAComponent::scriptTable, Tcl_CreateHashEntry, TCL_ERROR, Tcl_GetHashValue, TCL_OK, Tcl_SetHashValue, and tclOSAComponent::theComponent.
Referenced by TclOSACompileCmd(), and tclOSALoadCmd().2444 {
2445     Tcl_HashEntry *hashEntry;
2446     int newPtr;
2447     static int scriptIndex = 0;
2448     tclOSAScript *theScript;
2449   
2450     if (*scriptName == '\0') {
2451   sprintf(scriptName, "OSAScript%d", scriptIndex++);
2452     }
2453   
2454     hashEntry = Tcl_CreateHashEntry(&theComponent->scriptTable,
2455       scriptName, &newPtr);
2456     if (newPtr == 0) {
2457   theScript = (tclOSAScript *) Tcl_GetHashValue(hashEntry);
2458   OSADispose(theComponent->theComponent, theScript->scriptID);
2459     } else {    
2460   theScript = (tclOSAScript *) ckalloc(sizeof(tclOSAScript));
2461   if (theScript == NULL) {
2462       return TCL_ERROR;
2463   }
2464     }
2465     
2466     theScript->scriptID = scriptID;
2467     theScript->languageID = theComponent->languageID;
2468     theScript->modeFlags = modeFlags;
2469   
2470     Tcl_SetHashValue(hashEntry,(ClientData) theScript);
2471 
2472     return TCL_OK;
2473 }
void tclOSAASError (Tcl_Interp * interp, ComponentInstance theComponent, char * scriptData)

Definition at line 2808 of file tclMacOSA.c.
References NULL, Tcl_DStringAppend(), Tcl_DStringInit(), and Tcl_DStringResult().
Referenced by TclOSACompileCmd(), tclOSAExecuteCmd(), and tclOSARunCmd().2812 {
2813     OSErr myErr = noErr;
2814     AEDesc errResult,errLimits;
2815     Tcl_DString errStr;
2816     DescType returnType;
2817     Size returnSize;
2818     short srcStart,srcEnd;
2819     char buffer[16];
2820   
2821     Tcl_DStringInit(&errStr);
2822     Tcl_DStringAppend(&errStr, "An AppleScript error was encountered.\n", -1); 
2823   
2824     OSAScriptError(theComponent, kOSAErrorNumber,
2825       typeShortInteger, &errResult);
2826   
2827     sprintf(buffer, "Error #%-6.6d\n", (short int) **errResult.dataHandle);
2828 
2829     AEDisposeDesc(&errResult);
2830   
2831     Tcl_DStringAppend(&errStr,buffer, 15);
2832   
2833     OSAScriptError(theComponent, kOSAErrorMessage, typeChar, &errResult);
2834     Tcl_DStringAppend(&errStr, (char *) *errResult.dataHandle,
2835       GetHandleSize(errResult.dataHandle));
2836     AEDisposeDesc(&errResult);
2837   
2838     if (scriptData != NULL) {
2839   int lowerB, upperB;
2840     
2841   myErr = OSAScriptError(theComponent, kOSAErrorRange,
2842     typeOSAErrorRange, &errResult);
2843     
2844   myErr = AECoerceDesc(&errResult, typeAERecord, &errLimits);
2845   myErr = AEGetKeyPtr(&errLimits, keyOSASourceStart,
2846     typeShortInteger, &returnType, &srcStart,
2847     sizeof(short int), &returnSize);
2848   myErr = AEGetKeyPtr(&errLimits, keyOSASourceEnd, typeShortInteger,
2849     &returnType, &srcEnd, sizeof(short int), &returnSize);
2850   AEDisposeDesc(&errResult);
2851   AEDisposeDesc(&errLimits);
2852 
2853   Tcl_DStringAppend(&errStr, "\nThe offending bit of code was:\n\t", -1);
2854   /*
2855    * Get the full line on which the error occured:
2856    */
2857   for (lowerB = srcStart; lowerB > 0; lowerB--) {
2858       if (*(scriptData + lowerB ) == '\r') {
2859     lowerB++;
2860     break;
2861       }
2862   }
2863     
2864   for (upperB = srcEnd; *(scriptData + upperB) != '\0'; upperB++) {
2865       if (*(scriptData + upperB) == '\r') {
2866     break;
2867       }
2868   }
2869 
2870   Tcl_DStringAppend(&errStr, scriptData+lowerB, srcStart - lowerB);
2871   Tcl_DStringAppend(&errStr, "_", 1);
2872   Tcl_DStringAppend(&errStr, scriptData+srcStart, upperB - srcStart);
2873     }
2874   
2875     Tcl_DStringResult(interp,&errStr);
2876 }
void tclOSAClose (ClientData clientData)

Definition at line 1817 of file tclMacOSA.c.
References ckfree, tclOSAComponent::contextTable, tclOSAComponent::languageName, NULL, panic, tclOSAScript::scriptID, tclOSAComponent::scriptTable, Tcl_DeleteHashEntry(), Tcl_FindHashEntry, Tcl_FirstHashEntry(), Tcl_GetAssocData(), Tcl_GetHashValue, Tcl_NextHashEntry(), tclOSAComponent::theComponent, tclOSAComponent::theInterp, and tclOSAComponent::theName.
Referenced by tclOSAMakeNewComponent().1819 {
1820     tclOSAComponent *theComponent = (tclOSAComponent *) clientData;
1821     Tcl_HashEntry *hashEntry;
1822     Tcl_HashSearch search;
1823     tclOSAScript *theScript;
1824     Tcl_HashTable *ComponentTable;
1825   
1826     /* 
1827      * Delete the context and script tables 
1828      * the memory for the language name, and
1829      * the hash entry.
1830      */
1831   
1832     for (hashEntry = Tcl_FirstHashEntry(&theComponent->scriptTable, &search);
1833    hashEntry != NULL;
1834    hashEntry = Tcl_NextHashEntry(&search)) {
1835 
1836   theScript = (tclOSAScript *) Tcl_GetHashValue(hashEntry);
1837   OSADispose(theComponent->theComponent, theScript->scriptID);  
1838   ckfree((char *) theScript);
1839   Tcl_DeleteHashEntry(hashEntry);
1840     }
1841   
1842     for (hashEntry = Tcl_FirstHashEntry(&theComponent->contextTable, &search);
1843    hashEntry != NULL;
1844    hashEntry = Tcl_NextHashEntry(&search)) {
1845 
1846   Tcl_DeleteHashEntry(hashEntry);
1847     }
1848   
1849     ckfree(theComponent->languageName);
1850     ckfree(theComponent->theName);
1851   
1852     /*
1853      * Finally close the component
1854      */
1855   
1856     CloseComponent(theComponent->theComponent);
1857   
1858     ComponentTable = (Tcl_HashTable *)
1859   Tcl_GetAssocData(theComponent->theInterp,
1860     "OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL);
1861   
1862     if (ComponentTable == NULL) {
1863   panic("Error, could not get the Component Table from the Associated data.");
1864     }
1865   
1866     hashEntry = Tcl_FindHashEntry(ComponentTable, theComponent->theName);
1867     if (hashEntry != NULL) {
1868   Tcl_DeleteHashEntry(hashEntry);
1869     }
1870     
1871     ckfree((char *) theComponent);
1872 }
static int TclOSACompileCmd (Tcl_Interp * interp, tclOSAComponent * OSAComponent, int argc, CONST char ** argv) [static]

Definition at line 647 of file tclMacOSA.c.
References tclOSAComponent::componentFlags, NULL, prepareScriptData(), Tcl_DStringFree(), Tcl_DStringResult(), Tcl_DStringValue, TCL_ERROR, Tcl_GetBoolean(), TCL_OK, Tcl_SetResult(), TCL_VOLATILE, tclOSAAddContext(), tclOSAAddScript(), tclOSAASError(), tclOSAGetContextID(), and tclOSAComponent::theComponent.
Referenced by Tcl_OSAComponentCmd().652 {
653     int  tclError = TCL_OK;
654     int augment = 1;
655     int makeContext = 0;
656     char c;
657     char autoName[16];
658     char buffer[32];
659     char *resultName;
660     Boolean makeNewContext = false;
661     Tcl_DString scrptData;
662     AEDesc scrptDesc = { typeNull, NULL };
663     long modeFlags = kOSAModeCanInteract;
664     OSAID resultID = kOSANullScript;
665     OSAID contextID = kOSANullScript;
666     OSAID parentID = kOSANullScript;
667     OSAError osaErr = noErr;
668   
669     if (!(OSAComponent->componentFlags && kOSASupportsCompiling)) {
670   Tcl_AppendResult(interp,
671     "OSA component does not support compiling",
672     (char *) NULL);
673   return TCL_ERROR;
674     }
675 
676     /* 
677      * This signals that we should make up a name, which is the
678      * default behavior:
679      */
680    
681     autoName[0] = '\0';
682     resultName = NULL;
683   
684     if (argc == 2) {
685   numArgs:
686   Tcl_AppendResult(interp,
687     "wrong # args: should be \"", argv[0], " ", argv[1],
688     " ?options? code\"",(char *) NULL);
689   return TCL_ERROR;
690     } 
691 
692     argv += 2;
693     argc -= 2;
694 
695     /*
696      * Do the argument parsing.
697      */
698   
699     while (argc > 0) {
700     
701   if (*argv[0] == '-') {
702       c = *(argv[0] + 1);
703       
704       /*
705        * "--" is the only switch that has no value, stops processing
706        */
707       
708       if (c == '-' && *(argv[0] + 2) == '\0') {
709     argv += 1;
710     argc--;
711     break;
712       }
713       
714       /*
715        * So we can check here a switch with no value.
716        */
717       
718       if (argc == 1)  {
719     Tcl_AppendResult(interp,
720       "no value given for switch: ",
721       argv[0], (char *) NULL);
722     return TCL_ERROR;
723       }
724       
725       if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) {
726     if (Tcl_GetBoolean(interp, argv[1], &makeContext) != TCL_OK) {
727         return TCL_ERROR;
728     }
729       } else if (c == 'a' && strcmp(argv[0] + 1, "augment") == 0) {
730     /*
731      * Augment the current context which implies making a context.
732      */
733 
734     if (Tcl_GetBoolean(interp, argv[1], &augment) != TCL_OK) {
735         return TCL_ERROR;
736     }
737     makeContext = 1;
738       } else if (c == 'n' && strcmp(argv[0] + 1, "name") == 0) {
739     strncpy(autoName, argv[1], 15);
740     autoName[15] = '\0';
741     resultName = autoName;
742       } else if (c == 'p' && strcmp(argv[0] + 1,"parent") == 0) {
743     /*
744      * Since this implies we are compiling into a context, 
745      * set makeContext here
746      */
747     if (tclOSAGetContextID(OSAComponent,
748       argv[1], &parentID) != TCL_OK) {
749         Tcl_AppendResult(interp, "context not found \"",
750           argv[1], "\"", (char *) NULL);
751         return TCL_ERROR;
752     }
753     makeContext = 1;
754       } else {
755     Tcl_AppendResult(interp, "bad option \"", argv[0],
756       "\": should be -augment, -context, -name or -parent",
757        (char *) NULL);
758     return TCL_ERROR;
759       }
760       argv += 2;
761       argc -= 2;
762       
763   } else {
764       break;
765   }
766     }
767 
768     /*
769      * Make sure we have some data left...
770      */
771     if (argc == 0) {
772   goto numArgs;
773     }
774   
775     /* 
776      * Now if we are making a context, see if it is a new one... 
777      * There are three options here:
778      * 1) There was no name provided, so we autoName it
779      * 2) There was a name, then check and see if it already exists
780      *  a) If yes, then makeNewContext is false
781      *  b) Otherwise we are making a new context
782      */
783 
784     if (makeContext) {
785   modeFlags |= kOSAModeCompileIntoContext;
786   if (resultName == NULL) {
787       /*
788        * Auto name the new context.
789        */
790       resultName = autoName;
791       resultID = kOSANullScript;
792       makeNewContext = true;
793   } else if (tclOSAGetContextID(OSAComponent,
794     resultName, &resultID) == TCL_OK) {
795   } else { 
796       makeNewContext = true;
797   }
798     
799   /*
800    * Deal with the augment now...
801    */
802   if (augment && !makeNewContext) {
803       modeFlags |= kOSAModeAugmentContext;
804   }
805     } else if (resultName == NULL) {
806   resultName = autoName; /* Auto name the script */
807     }
808   
809     /*
810      * Ok, now we have the options, so we can compile the script data.
811      */
812       
813     if (prepareScriptData(argc, argv, &scrptData, &scrptDesc) == TCL_ERROR) {
814   Tcl_DStringResult(interp, &scrptData);
815   AEDisposeDesc(&scrptDesc);
816   return TCL_ERROR;
817     }
818 
819     /* 
820      * If we want to use a parent context, we have to make the context 
821      * by hand. Note, parentID is only specified when you make a new context. 
822      */
823   
824     if (parentID != kOSANullScript && makeNewContext) {
825   AEDesc contextDesc = { typeNull, NULL };
826 
827   osaErr = OSAMakeContext(OSAComponent->theComponent,
828     &contextDesc, parentID, &resultID);
829   modeFlags |= kOSAModeAugmentContext;
830     }
831   
832     osaErr = OSACompile(OSAComponent->theComponent, &scrptDesc,
833       modeFlags, &resultID);                
834     if (osaErr == noErr) {
835    
836   if (makeContext) {
837       /* 
838        * For the compiled context to be active, you need to run 
839        * the code that is in the context.
840        */
841       OSAID activateID;
842 
843       osaErr = OSAExecute(OSAComponent->theComponent, resultID,
844         resultID, kOSAModeCanInteract, &activateID);
845       OSADispose(OSAComponent->theComponent, activateID);
846 
847       if (osaErr == noErr) {
848     if (makeNewContext) {
849         /*
850          * If we have compiled into a context, 
851          * this is added to the context table 
852          */
853            
854         tclOSAAddContext(OSAComponent, resultName, resultID);
855     }
856         
857     Tcl_SetResult(interp, resultName, TCL_VOLATILE);
858     tclError = TCL_OK;
859       }
860   } else {
861       /*
862        * For a script, we return the script name.
863        */
864       tclOSAAddScript(OSAComponent, resultName, modeFlags, resultID);
865       Tcl_SetResult(interp, resultName, TCL_VOLATILE);
866       tclError = TCL_OK;  
867   }
868     }
869   
870     /* 
871      * This catches the error either from the original compile, 
872      * or from the execute in case makeContext == true
873      */
874               
875     if (osaErr == errOSAScriptError) {
876   OSADispose(OSAComponent->theComponent, resultID);
877   tclOSAASError(interp, OSAComponent->theComponent,
878     Tcl_DStringValue(&scrptData));
879   tclError = TCL_ERROR;
880     } else if (osaErr != noErr)  {
881   sprintf(buffer, "Error #%-6ld compiling script", osaErr);
882   Tcl_AppendResult(interp, buffer, (char *) NULL);
883   tclError = TCL_ERROR;   
884     } 
885 
886     Tcl_DStringFree(&scrptData);
887     AEDisposeDesc(&scrptDesc);
888   
889     return tclError;
890 }
static int tclOSADecompileCmd (Tcl_Interp * interp, tclOSAComponent * OSAComponent, int argc, CONST char ** argv) [static]

Definition at line 910 of file tclMacOSA.c.
References tclOSAComponent::componentFlags, NULL, Tcl_DStringAppend(), Tcl_DStringInit(), Tcl_DStringResult(), TCL_ERROR, TCL_OK, tclOSAGetContextID(), tclOSAGetScriptID(), and tclOSAComponent::theComponent.
Referenced by Tcl_OSAComponentCmd().915 {
916     AEDesc resultingSourceData = { typeChar, NULL };
917     OSAID scriptID;
918     Boolean isContext;
919     long result;
920     OSErr sysErr = noErr;
921     
922     if (argc == 2) {
923   Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
924     argv[0], " ",argv[1], " scriptName \"", (char *) NULL );
925   return TCL_ERROR;
926     }
927   
928     if (!(OSAComponent->componentFlags && kOSASupportsGetSource)) {
929   Tcl_AppendResult(interp,
930     "Error, this component does not support get source",
931     (char *) NULL);
932   return TCL_ERROR;
933     }
934   
935     if (tclOSAGetScriptID(OSAComponent, argv[2], &scriptID) == TCL_OK) {
936   isContext = false;
937     } else if (tclOSAGetContextID(OSAComponent, argv[2], &scriptID)
938       == TCL_OK ) {
939   isContext = true;
940     } else { 
941   Tcl_AppendResult(interp, "Could not find script \"",
942     argv[2], "\"", (char *) NULL);
943   return TCL_ERROR;
944     }
945   
946     OSAGetScriptInfo(OSAComponent->theComponent, scriptID,
947       kOSACanGetSource, &result);
948             
949     sysErr = OSAGetSource(OSAComponent->theComponent, 
950       scriptID, typeChar, &resultingSourceData);
951   
952     if (sysErr == noErr) {
953   Tcl_DString theResult;
954   Tcl_DStringInit(&theResult);
955 
956   Tcl_DStringAppend(&theResult, *resultingSourceData.dataHandle,
957     GetHandleSize(resultingSourceData.dataHandle));
958   Tcl_DStringResult(interp, &theResult);
959   AEDisposeDesc(&resultingSourceData);
960   return TCL_OK;
961     } else {
962   Tcl_AppendResult(interp, "Error getting source data", (char *) NULL);
963   AEDisposeDesc(&resultingSourceData);
964   return TCL_ERROR;
965     }
966 }     
static int tclOSADeleteCmd (Tcl_Interp * interp, tclOSAComponent * OSAComponent, int argc, CONST char ** argv) [static]

Definition at line 987 of file tclMacOSA.c.
References ckfree, NULL, TCL_ERROR, TCL_OK, tclOSADeleteContext(), and tclOSADeleteScript().
Referenced by Tcl_OSAComponentCmd().992 {
993     char c,*errMsg = NULL;
994     int length;
995   
996     if (argc < 4) {
997   Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
998     argv[0], " ", argv[1], " what scriptName", (char *) NULL);
999   return TCL_ERROR;
1000     }
1001   
1002     c = *argv[2];
1003     length = strlen(argv[2]);
1004     if (c == 'c' && strncmp(argv[2], "context", length) == 0) {
1005   if (strcmp(argv[3], "global") == 0) {
1006       Tcl_AppendResult(interp, "You cannot delete the global context",
1007         (char *) NULL);
1008       return TCL_ERROR;
1009   } else if (tclOSADeleteContext(OSAComponent, argv[3]) != TCL_OK) {
1010       Tcl_AppendResult(interp, "Error deleting script \"", argv[2],
1011         "\": ", errMsg, (char *) NULL);
1012       ckfree(errMsg);
1013       return TCL_ERROR;
1014   }
1015     } else if (c == 's' && strncmp(argv[2], "script", length) == 0) {
1016   if (tclOSADeleteScript(OSAComponent, argv[3], errMsg) != TCL_OK) {
1017       Tcl_AppendResult(interp, "Error deleting script \"", argv[3],
1018         "\": ", errMsg, (char *) NULL);
1019       ckfree(errMsg);
1020       return TCL_ERROR;
1021   }
1022     } else {
1023   Tcl_AppendResult(interp,"Unknown value ", argv[2],
1024     " should be one of ",
1025     "\"context\" or \"script\".",
1026     (char *) NULL );
1027   return TCL_ERROR;
1028     }
1029     return TCL_OK;
1030 }
static int tclOSADeleteContext (tclOSAComponent * theComponent, CONST char * contextName) [static]

Definition at line 1973 of file tclMacOSA.c.
References ckfree, tclOSAContext::contextID, tclOSAComponent::contextTable, NULL, Tcl_DeleteHashEntry(), TCL_ERROR, Tcl_FindHashEntry, Tcl_GetHashValue, TCL_OK, and tclOSAComponent::theComponent.
Referenced by tclOSADeleteCmd().1976 {
1977     Tcl_HashEntry *hashEntry;
1978     tclOSAContext *contextStruct;
1979   
1980     hashEntry = Tcl_FindHashEntry(&theComponent->contextTable, contextName);
1981     if (hashEntry == NULL) {
1982   return TCL_ERROR;
1983     } 
1984     /*
1985      * Dispose of the script context data
1986      */
1987     contextStruct = (tclOSAContext *) Tcl_GetHashValue(hashEntry);
1988     OSADispose(theComponent->theComponent,contextStruct->contextID);
1989     /*
1990      * Then the hash entry
1991      */
1992     ckfree((char *) contextStruct);
1993     Tcl_DeleteHashEntry(hashEntry);
1994     return TCL_OK;
1995 }
static int tclOSADeleteScript (tclOSAComponent * theComponent, CONST char * scriptName, char * errMsg) [static]

Definition at line 2526 of file tclMacOSA.c.
References ckalloc, ckfree, NULL, tclOSAScript::scriptID, tclOSAComponent::scriptTable, Tcl_DeleteHashEntry(), TCL_ERROR, Tcl_FindHashEntry, Tcl_GetHashValue, TCL_OK, and tclOSAComponent::theComponent.
Referenced by tclOSADeleteCmd().2530 {
2531     Tcl_HashEntry *hashEntry;
2532     tclOSAScript *scriptPtr;
2533 
2534     hashEntry = Tcl_FindHashEntry(&theComponent->scriptTable, scriptName);
2535     if (hashEntry == NULL) {
2536   errMsg = ckalloc(17);
2537   strcpy(errMsg,"Script not found");
2538   return TCL_ERROR;
2539     }
2540   
2541     scriptPtr = (tclOSAScript *) Tcl_GetHashValue(hashEntry);
2542     OSADispose(theComponent->theComponent, scriptPtr->scriptID);
2543     ckfree((char *) scriptPtr);
2544     Tcl_DeleteHashEntry(hashEntry);
2545     return TCL_OK;
2546 }
static int tclOSAExecuteCmd (Tcl_Interp * interp, tclOSAComponent * OSAComponent, int argc, CONST char ** argv) [static]

Definition at line 1050 of file tclMacOSA.c.
References tclOSAComponent::componentFlags, tclOSAComponent::languageID, NULL, prepareScriptData(), Tcl_DStringFree(), Tcl_DStringResult(), Tcl_DStringValue, TCL_ERROR, TCL_OK, tclOSAASError(), tclOSAGetContextID(), tclOSAResultFromID(), and tclOSAComponent::theComponent.
Referenced by Tcl_OSAComponentCmd().1055 {
1056     int tclError = TCL_OK, resID = 128;
1057     char c,buffer[32],
1058   *contextName = NULL,*scriptName = NULL, *resName = NULL;
1059     Boolean makeNewContext = false,makeContext = false;
1060     AEDesc scrptDesc = { typeNull, NULL };
1061     long modeFlags = kOSAModeCanInteract;
1062     OSAID resultID = kOSANullScript,
1063   contextID = kOSANullScript,
1064   parentID = kOSANullScript;
1065     Tcl_DString scrptData;
1066     OSAError osaErr = noErr;
1067     OSErr  sysErr = noErr;
1068 
1069     if (argc == 2) {
1070   Tcl_AppendResult(interp,
1071     "Error, no script data for \"", argv[0],
1072     " run\"", (char *) NULL);
1073   return TCL_ERROR;
1074     } 
1075 
1076     argv += 2;
1077     argc -= 2;
1078 
1079     /*
1080      * Set the context to the global context by default.
1081      * Then parse the argument list for switches
1082      */
1083     tclOSAGetContextID(OSAComponent, "global", &contextID);
1084   
1085     while (argc > 0) {
1086     
1087   if (*argv[0] == '-') {
1088       c = *(argv[0] + 1);
1089 
1090       /*
1091        * "--" is the only switch that has no value.
1092        */
1093       
1094       if (c == '-' && *(argv[0] + 2) == '\0') {
1095     argv += 1;
1096     argc--;
1097     break;
1098       }
1099       
1100       /*
1101        * So we can check here for a switch with no value.
1102        */
1103       
1104       if (argc == 1)  {
1105     Tcl_AppendResult(interp,
1106       "Error, no value given for switch ",
1107       argv[0], (char *) NULL);
1108     return TCL_ERROR;
1109       }
1110       
1111       if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) {
1112     if (tclOSAGetContextID(OSAComponent,
1113       argv[1], &contextID) == TCL_OK) {
1114     } else {
1115         Tcl_AppendResult(interp, "Script context \"",
1116           argv[1], "\" not found", (char *) NULL);
1117         return TCL_ERROR;
1118     }
1119       } else { 
1120     Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
1121       " should be \"-context\"", (char *) NULL);
1122     return TCL_ERROR;
1123       }
1124       
1125       argv += 2;
1126       argc -= 2;
1127   } else {
1128       break;
1129   }
1130     }
1131   
1132     if (argc == 0) {
1133   Tcl_AppendResult(interp, "Error, no script data", (char *) NULL);
1134   return TCL_ERROR;
1135     }
1136     
1137     if (prepareScriptData(argc, argv, &scrptData, &scrptDesc) == TCL_ERROR) {
1138   Tcl_DStringResult(interp, &scrptData);
1139   AEDisposeDesc(&scrptDesc);
1140   return TCL_ERROR;
1141     }
1142     /*
1143      * Now try to compile and run, but check to make sure the
1144      * component supports the one shot deal
1145      */
1146     if (OSAComponent->componentFlags && kOSASupportsConvenience) {
1147   osaErr = OSACompileExecute(OSAComponent->theComponent,
1148     &scrptDesc, contextID, modeFlags, &resultID);
1149     } else {
1150   /*
1151    * If not, we have to do this ourselves
1152    */
1153   if (OSAComponent->componentFlags && kOSASupportsCompiling) {
1154       OSAID compiledID = kOSANullScript;
1155       osaErr = OSACompile(OSAComponent->theComponent, &scrptDesc,
1156         modeFlags, &compiledID);
1157       if (osaErr == noErr) {
1158     osaErr = OSAExecute(OSAComponent->theComponent, compiledID,
1159       contextID, modeFlags, &resultID);
1160       }
1161       OSADispose(OSAComponent->theComponent, compiledID);
1162   } else {
1163       /*
1164        * The scripting component had better be able to load text data...
1165        */
1166       OSAID loadedID = kOSANullScript;
1167       
1168       scrptDesc.descriptorType = OSAComponent->languageID;
1169       osaErr = OSALoad(OSAComponent->theComponent, &scrptDesc,
1170         modeFlags, &loadedID);
1171       if (osaErr == noErr) {
1172     OSAExecute(OSAComponent->theComponent, loadedID,
1173       contextID, modeFlags, &resultID);
1174       }
1175       OSADispose(OSAComponent->theComponent, loadedID);
1176   }
1177     }
1178     if (osaErr == errOSAScriptError) {
1179   tclOSAASError(interp, OSAComponent->theComponent,
1180     Tcl_DStringValue(&scrptData));
1181   tclError = TCL_ERROR;
1182     } else if (osaErr != noErr) {
1183   sprintf(buffer, "Error #%-6ld compiling script", osaErr);
1184   Tcl_AppendResult(interp, buffer, (char *) NULL);
1185   tclError = TCL_ERROR;   
1186     } else  {
1187   tclOSAResultFromID(interp, OSAComponent->theComponent, resultID);
1188   osaErr = OSADispose(OSAComponent->theComponent, resultID);
1189   tclError = TCL_OK;
1190     } 
1191 
1192     Tcl_DStringFree(&scrptData);
1193     AEDisposeDesc(&scrptDesc);  
1194 
1195     return tclError;  
1196 } 
static int tclOSAGetContextID (tclOSAComponent * theComponent, CONST char * contextName, OSAID * theContext) [static]

Definition at line 1891 of file tclMacOSA.c.
References tclOSAContext::contextID, tclOSAComponent::contextTable, NULL, TCL_ERROR, Tcl_FindHashEntry, Tcl_GetHashValue, and TCL_OK.
Referenced by TclOSACompileCmd(), tclOSADecompileCmd(), tclOSAExecuteCmd(), tclOSARunCmd(), and tclOSAStore().1895 {
1896     Tcl_HashEntry *hashEntry;
1897     tclOSAContext *contextStruct;
1898   
1899     if ((hashEntry = Tcl_FindHashEntry(&theComponent->contextTable,
1900       contextName)) == NULL ) {     
1901   return TCL_ERROR;
1902     } else {
1903   contextStruct = (tclOSAContext *) Tcl_GetHashValue(hashEntry);
1904   *theContext = contextStruct->contextID;
1905     }
1906     return TCL_OK;
1907 }
static tclOSAScript* tclOSAGetScript (tclOSAComponent * theComponent, CONST char * scriptName) [static]

Definition at line 2492 of file tclMacOSA.c.
References NULL, tclOSAComponent::scriptTable, Tcl_FindHashEntry, and Tcl_GetHashValue.
Referenced by tclOSAGetScriptID().2495 {
2496     Tcl_HashEntry *hashEntry;
2497   
2498     hashEntry = Tcl_FindHashEntry(&theComponent->scriptTable, scriptName);
2499     if (hashEntry == NULL) {
2500   return NULL;
2501     }
2502   
2503     return (tclOSAScript *) Tcl_GetHashValue(hashEntry);
2504 }
static int tclOSAGetScriptID (tclOSAComponent * theComponent, CONST char * scriptName, OSAID * scriptID) [static]

Definition at line 2405 of file tclMacOSA.c.
References NULL, tclOSAScript::scriptID, TCL_ERROR, TCL_OK, and tclOSAGetScript().
Referenced by tclOSADecompileCmd(), tclOSARunCmd(), and tclOSAStore().2409 {
2410     tclOSAScript *theScript;
2411   
2412     theScript = tclOSAGetScript(theComponent, scriptName);
2413     if (theScript == NULL) {
2414   return TCL_ERROR;
2415     }
2416   
2417     *scriptID = theScript->scriptID;
2418     return TCL_OK;
2419 }
static int tclOSAInfoCmd (Tcl_Interp * interp, tclOSAComponent * OSAComponent, int argc, CONST char ** argv) [static]

Definition at line 1214 of file tclMacOSA.c.
References tclOSAComponent::contextTable, getSortedHashKeys(), tclOSAComponent::languageName, NULL, tclOSAComponent::scriptTable, Tcl_DStringInit(), Tcl_DStringResult(), TCL_ERROR, TCL_OK, Tcl_SetResult(), and TCL_STATIC.
Referenced by Tcl_OSAComponentCmd().1219 {
1220     char c;
1221     int length;
1222     Tcl_DString theResult;
1223   
1224     if (argc == 2) {
1225   Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
1226     argv[0], " ", argv[1], " what \"", (char *) NULL );
1227   return TCL_ERROR;
1228     }
1229   
1230     c = *argv[2];
1231     length = strlen(argv[2]);
1232     if (c == 's' && strncmp(argv[2], "scripts", length) == 0) {
1233   Tcl_DStringInit(&theResult);
1234   if (argc == 3) {
1235       getSortedHashKeys(&OSAComponent->scriptTable, (char *) NULL,
1236         &theResult);
1237   } else if (argc == 4) {
1238       getSortedHashKeys(&OSAComponent->scriptTable, argv[3], &theResult);
1239   } else {
1240       Tcl_AppendResult(interp, "Error: wrong # of arguments,",
1241         " should be \"", argv[0], " ", argv[1], " ",
1242         argv[2], " ?pattern?", (char *) NULL);
1243       return TCL_ERROR;
1244   }
1245   Tcl_DStringResult(interp, &theResult);
1246   return TCL_OK;      
1247     } else if (c == 'c' && strncmp(argv[2], "contexts", length) == 0) {
1248   Tcl_DStringInit(&theResult);    
1249   if (argc == 3) {
1250       getSortedHashKeys(&OSAComponent->contextTable, (char *) NULL,
1251        &theResult);
1252   } else if (argc == 4) {
1253       getSortedHashKeys(&OSAComponent->contextTable,
1254         argv[3], &theResult);
1255   } else {
1256       Tcl_AppendResult(interp, "Error: wrong # of arguments for ,",
1257         " should be \"", argv[0], " ", argv[1], " ",
1258         argv[2], " ?pattern?", (char *) NULL);
1259       return TCL_ERROR;
1260   }
1261   Tcl_DStringResult(interp, &theResult);
1262   return TCL_OK;      
1263     } else if (c == 'l' && strncmp(argv[2], "language", length) == 0) {
1264   Tcl_SetResult(interp, OSAComponent->languageName, TCL_STATIC);
1265   return TCL_OK;
1266     } else {
1267   Tcl_AppendResult(interp, "Unknown argument \"", argv[2],
1268     "\" for \"", argv[0], " info \", should be one of ",
1269     "\"scripts\" \"language\", or \"contexts\"",
1270     (char *) NULL);
1271   return TCL_ERROR;
1272     } 
1273 }
int tclOSALoad (Tcl_Interp * interp, tclOSAComponent * theComponent, CONST char * resourceName, int resourceNumber, CONST char * fileName, OSAID * resultID)

Definition at line 2283 of file tclMacOSA.c.
References CONST, FSpLocationFromPath(), FSpOpenResFileCompatTcl(), NULL, Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, TCL_ERROR, TCL_INTEGER_SPACE, TCL_OK, Tcl_TranslateFileName(), Tcl_UtfToExternalDString(), and tclOSAComponent::theComponent.
Referenced by tclOSALoadCmd().2290 {
2291     Handle sourceData;
2292     Str255 rezName;
2293     int result = TCL_OK;
2294     short saveRef, fileRef = -1;
2295     char idStr[16 + TCL_INTEGER_SPACE];
2296     FSSpec fileSpec;
2297     Tcl_DString ds, buffer;
2298     CONST char *nativeName;
2299 
2300     saveRef = CurResFile();
2301   
2302     if (fileName != NULL) {
2303   OSErr err;
2304     
2305   if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) {
2306       return TCL_ERROR;
2307   }
2308   nativeName = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer), 
2309           Tcl_DStringLength(&buffer), &ds);
2310   err = FSpLocationFromPath(strlen(nativeName), nativeName, &fileSpec);
2311   Tcl_DStringFree(&ds);
2312   Tcl_DStringFree(&buffer);
2313   if (err != noErr) {
2314       Tcl_AppendResult(interp, "Error finding the file: \"", 
2315         fileName, "\".", NULL);
2316       return TCL_ERROR;
2317   }
2318       
2319   fileRef = FSpOpenResFileCompatTcl(&fileSpec, fsRdPerm);
2320   if (fileRef == -1) {
2321       Tcl_AppendResult(interp, "Error reading the file: \"", 
2322         fileName, "\".", NULL);
2323       return TCL_ERROR;
2324   }
2325   UseResFile(fileRef);
2326     } else {
2327   /*
2328    * The default behavior will search through all open resource files.
2329    * This may not be the behavior you desire.  If you want the behavior
2330    * of this call to *only* search the application resource fork, you
2331    * must call UseResFile at this point to set it to the application
2332    * file.  This means you must have already obtained the application's 
2333    * fileRef when the application started up.
2334    */
2335     }
2336   
2337     /*
2338      * Load the resource by name or ID
2339      */
2340     if (resourceName != NULL) {
2341   strcpy((char *) rezName + 1, resourceName);
2342   rezName[0] = strlen(resourceName);
2343   sourceData = GetNamedResource('scpt', rezName);
2344     } else {
2345   sourceData = GetResource('scpt', (short) resourceNumber);
2346     }
2347   
2348     if (sourceData == NULL) {
2349   result = TCL_ERROR;
2350     } else {
2351   AEDesc scriptDesc;
2352   OSAError osaErr;
2353     
2354   scriptDesc.descriptorType = typeOSAGenericStorage;
2355   scriptDesc.dataHandle = sourceData;
2356     
2357   osaErr = OSALoad(theComponent->theComponent, &scriptDesc,
2358     kOSAModeNull, resultID);
2359     
2360   ReleaseResource(sourceData);
2361     
2362   if (osaErr != noErr) {
2363       result = TCL_ERROR;
2364       goto rezEvalError;
2365   }
2366       
2367   goto rezEvalCleanUp;
2368     }
2369   
2370     rezEvalError:
2371     sprintf(idStr, "ID=%d", resourceNumber);
2372     Tcl_AppendResult(interp, "The resource \"",
2373       (resourceName != NULL ? resourceName : idStr),
2374       "\" could not be loaded from ",
2375       (fileName != NULL ? fileName : "application"),
2376       ".", NULL);
2377 
2378     rezEvalCleanUp:
2379     if (fileRef != -1) {
2380   CloseResFile(fileRef);
2381     }
2382 
2383     UseResFile(saveRef);
2384   
2385     return result;
2386 }
static int tclOSALoadCmd (Tcl_Interp * interp, tclOSAComponent * OSAComponent, int argc, CONST char ** argv) [static]

Definition at line 1294 of file tclMacOSA.c.
References CONST, NULL, TCL_ERROR, Tcl_GetInt(), TCL_OK, Tcl_SetResult(), TCL_VOLATILE, tclOSAAddContext(), tclOSAAddScript(), tclOSALoad(), and tclOSAComponent::theComponent.
Referenced by Tcl_OSAComponentCmd().1299 {
1300     int tclError = TCL_OK, resID = 128;
1301     char c, autoName[24],
1302   *contextName = NULL, *scriptName = NULL;
1303     CONST char *resName = NULL;
1304     Boolean makeNewContext = false, makeContext = false;
1305     AEDesc scrptDesc = { typeNull, NULL };
1306     long modeFlags = kOSAModeCanInteract;
1307     OSAID resultID = kOSANullScript,
1308   contextID = kOSANullScript,
1309   parentID = kOSANullScript;
1310     OSAError osaErr = noErr;
1311     OSErr  sysErr = noErr;
1312     long scptInfo;
1313   
1314     autoName[0] = '\0';
1315     scriptName = autoName;
1316     contextName = autoName;
1317   
1318     if (argc == 2) {
1319   Tcl_AppendResult(interp,
1320     "Error, no data for \"", argv[0], " ", argv[1],
1321     "\"", (char *) NULL);
1322   return TCL_ERROR;
1323     } 
1324 
1325     argv += 2;
1326     argc -= 2;
1327 
1328     /*
1329      * Do the argument parsing.
1330      */
1331   
1332     while (argc > 0) {
1333     
1334   if (*argv[0] == '-') {
1335       c = *(argv[0] + 1);
1336       
1337       /*
1338        * "--" is the only switch that has no value.
1339        */
1340       
1341       if (c == '-' && *(argv[0] + 2) == '\0') {
1342     argv += 1;
1343     argc--;
1344     break;
1345       }
1346       
1347       /*
1348        * So we can check here a switch with no value.
1349        */
1350       
1351       if (argc == 1)  {
1352     Tcl_AppendResult(interp, "Error, no value given for switch ",
1353       argv[0], (char *) NULL);
1354     return TCL_ERROR;
1355       }
1356       
1357       if (c == 'r' && strcmp(argv[0] + 1, "rsrcname") == 0) {
1358     resName = argv[1];
1359       } else if (c == 'r' && strcmp(argv[0] + 1, "rsrcid") == 0) {
1360     if (Tcl_GetInt(interp, argv[1], &resID) != TCL_OK) {
1361         Tcl_AppendResult(interp,
1362           "Error getting resource ID", (char *) NULL);
1363         return TCL_ERROR;
1364     }
1365       } else {
1366     Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
1367       " should be \"--\", \"-rsrcname\" or \"-rsrcid\"",
1368       (char *) NULL);
1369     return TCL_ERROR;
1370       }
1371       
1372       argv += 2;
1373       argc -= 2;
1374   } else {
1375       break;
1376   }
1377     }
1378     /*
1379      * Ok, now we have the options, so we can load the resource,
1380      */
1381     if (argc == 0) {
1382   Tcl_AppendResult(interp, "Error, no filename given", (char *) NULL);
1383   return TCL_ERROR;
1384     }
1385   
1386     if (tclOSALoad(interp, OSAComponent, resName, resID,
1387       argv[0], &resultID) != TCL_OK) {
1388   Tcl_AppendResult(interp, "Error in load command", (char *) NULL);
1389   return TCL_ERROR;
1390     }
1391    
1392     /*
1393      *  Now find out whether we have a script, or a script context.
1394      */
1395    
1396     OSAGetScriptInfo(OSAComponent->theComponent, resultID,
1397       kOSAScriptIsTypeScriptContext, &scptInfo);
1398     
1399     if (scptInfo) {
1400   autoName[0] = '\0';
1401   tclOSAAddContext(OSAComponent, autoName, resultID);
1402     
1403   Tcl_SetResult(interp, autoName, TCL_VOLATILE);
1404     } else {
1405   /*
1406    * For a script, we return the script name
1407    */
1408   autoName[0] = '\0';
1409   tclOSAAddScript(OSAComponent, autoName, kOSAModeCanInteract, resultID);
1410   Tcl_SetResult(interp, autoName, TCL_VOLATILE);
1411     }     
1412     return TCL_OK;
1413 }
static int tclOSAMakeContext (tclOSAComponent * theComponent, CONST char * contextName, OSAID * theContext) [static]

Definition at line 2015 of file tclMacOSA.c.
References NULL, TCL_ERROR, TCL_OK, tclOSAAddContext(), and tclOSAComponent::theComponent.
Referenced by tclOSAMakeNewComponent().2019 {
2020     AEDesc contextNameDesc = {typeNull, NULL};
2021     OSAError osaErr = noErr;
2022 
2023     AECreateDesc(typeChar, contextName, strlen(contextName), &contextNameDesc);
2024     osaErr = OSAMakeContext(theComponent->theComponent, &contextNameDesc,
2025       kOSANullScript, theContext);
2026                 
2027     AEDisposeDesc(&contextNameDesc);
2028   
2029     if (osaErr == noErr) {
2030   char name[24];
2031   strncpy(name, contextName, 23);
2032   name[23] = '\0';
2033   tclOSAAddContext(theComponent, name, *theContext);
2034     } else {
2035   *theContext = (OSAID) osaErr;
2036   return TCL_ERROR;
2037     }
2038   
2039     return TCL_OK;
2040 }
tclOSAComponent* tclOSAMakeNewComponent (Tcl_Interp * interp, char * cmdName, char * languageName, OSType scriptSubtype, long componentFlags)

Definition at line 1686 of file tclMacOSA.c.
References ckalloc, ckfree, tclOSAComponent::componentFlags, tclOSAComponent::contextTable, tclOSAComponent::languageID, tclOSAComponent::languageName, NULL, tclOSAComponent::scriptTable, Tcl_CreateCommand(), Tcl_CreateHashEntry, Tcl_GetAssocData(), Tcl_InitHashTable(), TCL_OK, Tcl_OSAComponentCmd(), Tcl_SetHashValue, TCL_STRING_KEYS, TclOSAActiveProc(), tclOSAClose(), tclOSAMakeContext(), tclOSAComponent::theComponent, tclOSAComponent::theInterp, and tclOSAComponent::theName.
Referenced by Tcl_OSACmd(), and Tclapplescript_Init().1692 {
1693     char buffer[32];
1694     AEDesc resultingName = {typeNull, NULL};
1695     AEDesc nullDesc = {typeNull, NULL };
1696     OSAID globalContext;
1697     char global[] = "global";
1698     int nbytes;
1699     ComponentDescription requestedComponent = {
1700   kOSAComponentType,
1701   (OSType) 0,
1702   (OSType) 0,
1703   (long int) 0,
1704   (long int) 0
1705     };
1706     Tcl_HashTable *ComponentTable;
1707     Component foundComponent = NULL;
1708     OSAActiveUPP myActiveProcUPP;
1709       
1710     tclOSAComponent *newComponent;
1711     Tcl_HashEntry *hashEntry;
1712     int newPtr;
1713   
1714     requestedComponent.componentSubType = scriptSubtype;
1715     nbytes = sizeof(tclOSAComponent);
1716     newComponent = (tclOSAComponent *) ckalloc(sizeof(tclOSAComponent));
1717     if (newComponent == NULL) {
1718   goto CleanUp;
1719     }
1720   
1721     foundComponent = FindNextComponent(0, &requestedComponent);
1722     if (foundComponent == 0) {
1723   Tcl_AppendResult(interp,
1724     "Could not find component of requested type", (char *) NULL);
1725   goto CleanUp;
1726     } 
1727   
1728     newComponent->theComponent = OpenComponent(foundComponent); 
1729   
1730     if (newComponent->theComponent == NULL) {
1731   Tcl_AppendResult(interp,
1732     "Could not open component of the requested type",
1733     (char *) NULL);
1734   goto CleanUp;
1735     }
1736               
1737     newComponent->languageName = (char *) ckalloc(strlen(languageName) + 1);
1738     strcpy(newComponent->languageName,languageName);
1739   
1740     newComponent->componentFlags = componentFlags;
1741   
1742     newComponent->theInterp = interp;
1743   
1744     Tcl_InitHashTable(&newComponent->contextTable, TCL_STRING_KEYS);
1745     Tcl_InitHashTable(&newComponent->scriptTable, TCL_STRING_KEYS);
1746     
1747     if (tclOSAMakeContext(newComponent, global, &globalContext) != TCL_OK) {
1748   sprintf(buffer, "%-6.6ld", globalContext);
1749   Tcl_AppendResult(interp, "Error ", buffer, " making ", global,
1750     " context.", (char *) NULL);
1751   goto CleanUp;
1752     }
1753     
1754     newComponent->languageID = scriptSubtype;
1755   
1756     newComponent->theName = (char *) ckalloc(strlen(cmdName) + 1 );
1757     strcpy(newComponent->theName, cmdName);
1758 
1759     Tcl_CreateCommand(interp, newComponent->theName, Tcl_OSAComponentCmd,
1760       (ClientData) newComponent, tclOSAClose);
1761           
1762     /*
1763      * Register the new component with the component table
1764      */ 
1765 
1766     ComponentTable = (Tcl_HashTable *) Tcl_GetAssocData(interp,
1767       "OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL);
1768   
1769     if (ComponentTable == NULL) {
1770   Tcl_AppendResult(interp, "Error, could not get the Component Table",
1771     " from the Associated data.", (char *) NULL);
1772   return (tclOSAComponent *) NULL;
1773     }
1774   
1775     hashEntry = Tcl_CreateHashEntry(ComponentTable,
1776       newComponent->theName, &newPtr);  
1777     Tcl_SetHashValue(hashEntry, (ClientData) newComponent);
1778 
1779     /*
1780      * Set the active proc to call Tcl_DoOneEvent() while idle
1781      */
1782     if (OSAGetActiveProc(newComponent->theComponent,
1783       &newComponent->defActiveProc, &newComponent->defRefCon) != noErr ) {
1784       /* TODO -- clean up here... */
1785     }
1786 
1787     myActiveProcUPP = NewOSAActiveUPP(TclOSAActiveProc);
1788     OSASetActiveProc(newComponent->theComponent,
1789       myActiveProcUPP, (long) newComponent);
1790     return newComponent;
1791   
1792     CleanUp:
1793   
1794     ckfree((char *) newComponent);
1795     return (tclOSAComponent *) NULL;
1796 }
void tclOSAResultFromID (Tcl_Interp * interp, ComponentInstance theComponent, OSAID resultID)

Definition at line 2769 of file tclMacOSA.c.
References Tcl_DStringAppend(), Tcl_DStringInit(), and Tcl_DStringResult().
Referenced by tclOSAExecuteCmd(), and tclOSARunCmd().2773 {
2774     OSErr myErr = noErr;
2775     AEDesc resultDesc;
2776     Tcl_DString resultStr;
2777   
2778     Tcl_DStringInit(&resultStr);
2779   
2780     myErr = OSADisplay(theComponent, resultID, typeChar,
2781       kOSAModeNull, &resultDesc);
2782     Tcl_DStringAppend(&resultStr, (char *) *resultDesc.dataHandle,
2783       GetHandleSize(resultDesc.dataHandle));
2784     Tcl_DStringResult(interp,&resultStr);
2785 }
static int tclOSARunCmd (Tcl_Interp * interp, tclOSAComponent * OSAComponent, int argc, CONST char ** argv) [static]

Definition at line 1433 of file tclMacOSA.c.
References CONST, NULL, TCL_ERROR, TCL_OK, Tcl_SetResult(), TCL_VOLATILE, tclOSAASError(), tclOSAGetContextID(), tclOSAGetScriptID(), tclOSAResultFromID(), tclOSAComponent::theComponent, and tclOSAComponent::theName.
Referenced by Tcl_OSAComponentCmd().1438 {
1439     int tclError = TCL_OK,
1440   resID = 128;
1441     char c, *contextName = NULL,
1442   *scriptName = NULL, 
1443   *resName = NULL;
1444     AEDesc scrptDesc = { typeNull, NULL };
1445     long modeFlags = kOSAModeCanInteract;
1446     OSAID resultID = kOSANullScript,
1447   contextID = kOSANullScript,
1448   parentID = kOSANullScript;
1449     OSAError osaErr = noErr;
1450     OSErr sysErr = noErr;
1451     CONST char *componentName = argv[0];
1452     OSAID scriptID;
1453   
1454     if (argc == 2) {
1455   Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
1456     argv[0], " ", argv[1], " scriptName", (char *) NULL);
1457   return TCL_ERROR;
1458     }
1459   
1460     /*
1461      * Set the context to the global context for this component,
1462      * as a default
1463      */
1464     if (tclOSAGetContextID(OSAComponent, "global", &contextID) != TCL_OK) {
1465   Tcl_AppendResult(interp,
1466     "Could not find the global context for component ",
1467     OSAComponent->theName, (char *) NULL );
1468   return TCL_ERROR;
1469     }
1470 
1471     /*
1472      * Now parse the argument list for switches
1473      */
1474     argv += 2;
1475     argc -= 2;
1476   
1477     while (argc > 0) {
1478   if (*argv[0] == '-') {
1479       c = *(argv[0] + 1);
1480       /*
1481        * "--" is the only switch that has no value
1482        */
1483       if (c == '-' && *(argv[0] + 2) == '\0') {
1484     argv += 1;
1485     argc--;
1486     break;
1487       }
1488       
1489       /*
1490        * So we can check here for a switch with no value.
1491        */
1492       if (argc == 1)  {
1493     Tcl_AppendResult(interp, "Error, no value given for switch ",
1494       argv[0], (char *) NULL);
1495     return TCL_ERROR;
1496       }
1497       
1498       if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) {
1499     if (argc == 1) {
1500         Tcl_AppendResult(interp,
1501           "Error - no context provided for the -context switch",
1502           (char *) NULL);
1503         return TCL_ERROR;
1504     } else if (tclOSAGetContextID(OSAComponent,
1505       argv[1], &contextID) == TCL_OK) {
1506     } else {
1507         Tcl_AppendResult(interp, "Script context \"", argv[1],
1508           "\" not found", (char *) NULL);
1509         return TCL_ERROR;
1510     } 
1511       } else {
1512     Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
1513       " for ", componentName,
1514       " should be \"-context\"", (char *) NULL);
1515     return TCL_ERROR;
1516       }
1517       argv += 2;
1518       argc -= 2;
1519   } else {
1520       break;
1521   }
1522     }
1523   
1524     if (tclOSAGetScriptID(OSAComponent, argv[0], &scriptID) != TCL_OK) {
1525   if (tclOSAGetContextID(OSAComponent, argv[0], &scriptID) != TCL_OK) {
1526       Tcl_AppendResult(interp, "Could not find script \"",
1527         argv[2], "\"", (char *) NULL);
1528       return TCL_ERROR;
1529   }
1530     }
1531   
1532     sysErr = OSAExecute(OSAComponent->theComponent,
1533       scriptID, contextID, modeFlags, &resultID);
1534               
1535     if (sysErr == errOSAScriptError) {
1536   tclOSAASError(interp, OSAComponent->theComponent, (char *) NULL);
1537   tclError = TCL_ERROR;
1538     } else if (sysErr != noErr) {
1539   char buffer[32];
1540   sprintf(buffer, "Error #%6.6d encountered in run", sysErr);
1541   Tcl_SetResult(interp, buffer, TCL_VOLATILE);
1542   tclError = TCL_ERROR;
1543     } else {
1544   tclOSAResultFromID(interp, OSAComponent->theComponent, resultID );
1545     }
1546     OSADispose(OSAComponent->theComponent, resultID);
1547 
1548     return tclError;    
1549 }
int tclOSAStore (Tcl_Interp * interp, tclOSAComponent * theComponent, CONST char * resourceName, int resourceNumber, CONST char * scriptName, CONST char * fileName)

Definition at line 2063 of file tclMacOSA.c.
References CONST, FSpCreateResFileCompatTcl(), FSpLocationFromPath(), FSpOpenResFileCompatTcl(), NULL, Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, TCL_ERROR, TCL_INTEGER_SPACE, TCL_OK, Tcl_TranslateFileName(), Tcl_UtfToExternalDString(), tclOSAGetContextID(), tclOSAGetScriptID(), and tclOSAComponent::theComponent.
Referenced by tclOSAStoreCmd().2070 {
2071     Handle resHandle;
2072     Str255 rezName;
2073     int result = TCL_OK;
2074     short saveRef, fileRef = -1;
2075     char idStr[16 + TCL_INTEGER_SPACE];
2076     FSSpec fileSpec;
2077     Tcl_DString ds, buffer;
2078     CONST char *nativeName;
2079     OSErr myErr = noErr;
2080     OSAID scriptID;
2081     Size scriptSize;
2082     AEDesc scriptData;
2083 
2084     /*
2085      * First extract the script data
2086      */
2087   
2088     if (tclOSAGetScriptID(theComponent, scriptName, &scriptID) != TCL_OK ) {
2089   if (tclOSAGetContextID(theComponent, scriptName, &scriptID)
2090     != TCL_OK) {
2091       Tcl_AppendResult(interp, "Error getting script ",
2092         scriptName, (char *) NULL);
2093       return TCL_ERROR;
2094   }
2095     }
2096   
2097     myErr = OSAStore(theComponent->theComponent, scriptID,
2098       typeOSAGenericStorage, kOSAModeNull, &scriptData);
2099     if (myErr != noErr) {
2100   sprintf(idStr, "%d", myErr);
2101   Tcl_AppendResult(interp, "Error #", idStr,
2102     " storing script ", scriptName, (char *) NULL);
2103   return TCL_ERROR;
2104     }
2105 
2106     /*
2107      * Now try to open the output file
2108      */
2109   
2110     saveRef = CurResFile();
2111   
2112     if (fileName != NULL) {
2113   OSErr err;
2114     
2115   if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) {
2116       return TCL_ERROR;
2117   }
2118   nativeName = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer), 
2119           Tcl_DStringLength(&buffer), &ds);
2120   err = FSpLocationFromPath(strlen(nativeName), nativeName, &fileSpec);
2121     
2122   Tcl_DStringFree(&ds);
2123   Tcl_DStringFree(&buffer);
2124   if ((err != noErr) && (err != fnfErr)) {
2125       Tcl_AppendResult(interp,
2126         "Error getting a location for the file: \"", 
2127         fileName, "\".", NULL);
2128       return TCL_ERROR;
2129   }
2130     
2131   FSpCreateResFileCompatTcl(&fileSpec,
2132     'WiSH', 'osas', smSystemScript);  
2133   myErr = ResError();
2134   
2135   if ((myErr != noErr) && (myErr != dupFNErr)) {
2136       sprintf(idStr, "%d", myErr);
2137       Tcl_AppendResult(interp, "Error #", idStr,
2138         " creating new resource file ", fileName, (char *) NULL);
2139       result = TCL_ERROR;
2140       goto rezEvalCleanUp;
2141   }
2142     
2143   fileRef = FSpOpenResFileCompatTcl(&fileSpec, fsRdWrPerm);
2144   if (fileRef == -1) {
2145       Tcl_AppendResult(interp, "Error reading the file: \"", 
2146         fileName, "\".", NULL);
2147       result = TCL_ERROR;
2148       goto rezEvalCleanUp;
2149   }
2150   UseResFile(fileRef);
2151     } else {
2152   /*
2153    * The default behavior will search through all open resource files.
2154    * This may not be the behavior you desire.  If you want the behavior
2155    * of this call to *only* search the application resource fork, you
2156    * must call UseResFile at this point to set it to the application
2157    * file.  This means you must have already obtained the application's 
2158    * fileRef when the application started up.
2159    */
2160     }
2161   
2162     /*
2163      * Load the resource by name 
2164      */
2165     if (resourceName != NULL) {
2166   strcpy((char *) rezName + 1, resourceName);
2167   rezName[0] = strlen(resourceName);
2168   resHandle = Get1NamedResource('scpt', rezName);
2169   myErr = ResError();
2170   if (resHandle == NULL) {
2171       /*
2172        * These signify either the resource or the resource
2173        * type were not found
2174        */
2175       if (myErr == resNotFound || myErr == noErr) {
2176     short uniqueID;
2177     while ((uniqueID = Unique1ID('scpt') ) < 128) {}
2178     AddResource(scriptData.dataHandle, 'scpt', uniqueID, rezName);
2179     WriteResource(resHandle);
2180     result = TCL_OK;
2181     goto rezEvalCleanUp;
2182       } else {
2183     /*
2184      * This means there was some other error, for now
2185      * I just bag out.
2186      */
2187     sprintf(idStr, "%d", myErr);
2188     Tcl_AppendResult(interp, "Error #", idStr,
2189       " opening scpt resource named ", resourceName,
2190       " in file ", fileName, (char *) NULL);
2191     result = TCL_ERROR;
2192     goto rezEvalCleanUp;
2193       }
2194   }
2195   /*
2196    * Or ID
2197    */ 
2198     } else {
2199   resHandle = Get1Resource('scpt', resourceNumber);
2200   rezName[0] = 0;
2201   rezName[1] = '\0';
2202   myErr = ResError();
2203   if (resHandle == NULL) {
2204       /*
2205        * These signify either the resource or the resource
2206        * type were not found
2207        */
2208       if (myErr == resNotFound || myErr == noErr) {
2209     AddResource(scriptData.dataHandle, 'scpt',
2210       resourceNumber, rezName);
2211     WriteResource(resHandle);
2212     result = TCL_OK;
2213     goto rezEvalCleanUp;
2214       } else {
2215     /*
2216      * This means there was some other error, for now
2217      * I just bag out */
2218     sprintf(idStr, "%d", myErr);
2219     Tcl_AppendResult(interp, "Error #", idStr,
2220       " opening scpt resource named ", resourceName,
2221       " in file ", fileName,(char *) NULL);
2222     result = TCL_ERROR;
2223     goto rezEvalCleanUp;
2224       }
2225   } 
2226     }
2227   
2228     /* 
2229      * We get to here if the resource exists 
2230      * we just copy into it... 
2231      */
2232    
2233     scriptSize = GetHandleSize(scriptData.dataHandle);
2234     SetHandleSize(resHandle, scriptSize);
2235     HLock(scriptData.dataHandle);
2236     HLock(resHandle);
2237     BlockMove(*scriptData.dataHandle, *resHandle,scriptSize);
2238     HUnlock(scriptData.dataHandle);
2239     HUnlock(resHandle);
2240     ChangedResource(resHandle);
2241     WriteResource(resHandle);
2242     result = TCL_OK;
2243     goto rezEvalCleanUp;
2244       
2245     rezEvalError:
2246     sprintf(idStr, "ID=%d", resourceNumber);
2247     Tcl_AppendResult(interp, "The resource \"",
2248       (resourceName != NULL ? resourceName : idStr),
2249       "\" could not be loaded from ",
2250       (fileName != NULL ? fileName : "application"),
2251       ".", NULL);
2252 
2253     rezEvalCleanUp:
2254     if (fileRef != -1) {
2255   CloseResFile(fileRef);
2256     }
2257 
2258     UseResFile(saveRef);
2259   
2260     return result;
2261 }
static int tclOSAStoreCmd (Tcl_Interp * interp, tclOSAComponent * OSAComponent, int argc, CONST char ** argv) [static]

Definition at line 1569 of file tclMacOSA.c.
References CONST, NULL, TCL_ERROR, Tcl_GetInt(), TCL_OK, Tcl_ResetResult(), and tclOSAStore().
Referenced by Tcl_OSAComponentCmd().1574 {
1575     int tclError = TCL_OK, resID = 128;
1576     char c, *contextName = NULL, *scriptName = NULL;
1577     CONST char *resName = NULL;
1578     Boolean makeNewContext = false, makeContext = false;
1579     AEDesc scrptDesc = { typeNull, NULL };
1580     long modeFlags = kOSAModeCanInteract;
1581     OSAID resultID = kOSANullScript,
1582   contextID = kOSANullScript,
1583   parentID = kOSANullScript;
1584     OSAError osaErr = noErr;
1585     OSErr  sysErr = noErr;
1586     
1587     if (argc == 2) {
1588   Tcl_AppendResult(interp, "Error, no data for \"", argv[0],
1589     " ",argv[1], "\"", (char *) NULL);
1590   return TCL_ERROR;
1591     } 
1592 
1593     argv += 2;
1594     argc -= 2;
1595 
1596     /*
1597      * Do the argument parsing
1598      */
1599   
1600     while (argc > 0) {
1601   if (*argv[0] == '-') {
1602       c = *(argv[0] + 1);
1603       
1604       /*
1605        * "--" is the only switch that has no value
1606        */
1607       if (c == '-' && *(argv[0] + 2) == '\0') {
1608     argv += 1;
1609     argc--;
1610     break;
1611       }
1612       
1613       /*
1614        * So we can check here a switch with no value.
1615        */
1616       if (argc == 1)  {
1617     Tcl_AppendResult(interp,
1618       "Error, no value given for switch ",
1619       argv[0], (char *) NULL);
1620     return TCL_ERROR;
1621       }
1622       
1623       if (c == 'r' && strcmp(argv[0] + 1, "rsrcname") == 0) {
1624     resName = argv[1];
1625       } else if (c == 'r' && strcmp(argv[0] + 1, "rsrcid") == 0) {
1626     if (Tcl_GetInt(interp, argv[1], &resID) != TCL_OK) {
1627         Tcl_AppendResult(interp,
1628           "Error getting resource ID", (char *) NULL);
1629         return TCL_ERROR;
1630     }
1631       } else {
1632     Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
1633       " should be \"--\", \"-rsrcname\" or \"-rsrcid\"",
1634       (char *) NULL);
1635     return TCL_ERROR;
1636       }
1637       
1638       argv += 2;
1639       argc -= 2;
1640   } else {
1641       break;
1642   }
1643     }
1644     /*
1645      * Ok, now we have the options, so we can load the resource,
1646      */
1647     if (argc != 2) {
1648   Tcl_AppendResult(interp, "Error, wrong # of arguments, should be ",
1649     argv[0], " ", argv[1], "?option flag? scriptName fileName",
1650     (char *) NULL);
1651   return TCL_ERROR;
1652     }
1653   
1654     if (tclOSAStore(interp, OSAComponent, resName, resID,
1655       argv[0], argv[1]) != TCL_OK) {
1656   Tcl_AppendResult(interp, "Error in load command", (char *) NULL);
1657   return TCL_ERROR;
1658     } else {
1659   Tcl_ResetResult(interp);
1660   tclError = TCL_OK;
1661     }
1662     
1663     return tclError;
1664 }

mac/tclMacPanic.c File Reference
#include <Events.h>
#include <Controls.h>
#include <ControlDefinitions.h>
#include <Windows.h>
#include <TextEdit.h>
#include <Fonts.h>
#include <Dialogs.h>
#include <Icons.h>
#include <Sound.h>
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include "tclInt.h"
#include "tclMacInt.h"
Defines
#define PANICHEIGHT  150
#define PANICWIDTH  350
#define PANIC_BUTTON_RECT  {125, 260, 145, 335}
#define PANIC_ICON_RECT  {10, 20, 42, 52}
#define PANIC_TEXT_RECT  {10, 65, 140, 330}
#define ENTERCODE  (0x03)
#define RETURNCODE  (0x0D)
Functions
void TclpPanic TCL_VARARGS_DEF (CONST char *, format)

Define Documentation
#define ENTERCODE  (0x03)

Definition at line 42 of file tclMacPanic.c.
Referenced by TCL_VARARGS_DEF().#define PANIC_BUTTON_RECT  {125, 260, 145, 335}

Definition at line 39 of file tclMacPanic.c.
Referenced by TCL_VARARGS_DEF().#define PANIC_ICON_RECT  {10, 20, 42, 52}

Definition at line 40 of file tclMacPanic.c.
Referenced by TCL_VARARGS_DEF().#define PANIC_TEXT_RECT  {10, 65, 140, 330}

Definition at line 41 of file tclMacPanic.c.
Referenced by TCL_VARARGS_DEF().#define PANICHEIGHT  150

Definition at line 37 of file tclMacPanic.c.
Referenced by TCL_VARARGS_DEF().#define PANICWIDTH  350

Definition at line 38 of file tclMacPanic.c.
Referenced by TCL_VARARGS_DEF().#define RETURNCODE  (0x0D)

Definition at line 43 of file tclMacPanic.c.
Referenced by TCL_VARARGS_DEF().
Function Documentation
void TclpPanic TCL_VARARGS_DEF (CONST char *, format)

Definition at line 64 of file tclMacPanic.c.
References Debugger, ENTERCODE, format, NULL, PANIC_BUTTON_RECT, PANIC_ICON_RECT, PANIC_TEXT_RECT, PANICHEIGHT, PANICWIDTH, and RETURNCODE.65 {
66     va_list varg;
67     char msg[256];
68     WindowRef macWinPtr, foundWinPtr;
69     Rect macRect;
70     Rect buttonRect = PANIC_BUTTON_RECT;
71     Rect iconRect = PANIC_ICON_RECT;
72     Rect textRect = PANIC_TEXT_RECT;
73     ControlHandle okButtonHandle;
74     EventRecord event;
75     Handle stopIconHandle;
76     int part;
77     Boolean done = false;
78 
79     va_start(varg, format);
80     vsprintf(msg, format, varg);
81     va_end(varg);
82 
83     /*
84      * Put up an alert without using the Resource Manager (there may 
85      * be no resources to load). Use the Window and Control Managers instead.
86      * We want the window centered on the main monitor. The following 
87      * should be tested with multiple monitors. Look and see if there is a way
88      * not using qd.screenBits.
89      */
90  
91     macRect.top = (qd.screenBits.bounds.top + qd.screenBits.bounds.bottom)
92   / 2 - (PANICHEIGHT / 2);
93     macRect.bottom = (qd.screenBits.bounds.top + qd.screenBits.bounds.bottom)
94   / 2 + (PANICHEIGHT / 2);
95     macRect.left = (qd.screenBits.bounds.left + qd.screenBits.bounds.right)
96   / 2 - (PANICWIDTH / 2);
97     macRect.right = (qd.screenBits.bounds.left + qd.screenBits.bounds.right)
98   / 2 + (PANICWIDTH / 2);
99     
100     macWinPtr = NewWindow(NULL, &macRect, "\p", true, dBoxProc, (WindowRef) -1,
101             false, 0);
102     if (macWinPtr == NULL) {
103   goto exitNow;
104     }
105     
106     okButtonHandle = NewControl(macWinPtr, &buttonRect, "\pOK", true,
107       0, 0, 1, pushButProc, 0);
108     if (okButtonHandle == NULL) {
109   CloseWindow(macWinPtr);
110   goto exitNow;
111     }
112     
113     SelectWindow(macWinPtr);
114     SetCursor(&qd.arrow);
115     stopIconHandle = GetIcon(kStopIcon);
116             
117     while (!done) {
118   if (WaitNextEvent(mDownMask | keyDownMask | updateMask,
119     &event, 0, NULL)) {
120       switch(event.what) {
121     case mouseDown:
122         part = FindWindow(event.where, &foundWinPtr);
123     
124         if ((foundWinPtr != macWinPtr) || (part != inContent)) {
125           SysBeep(1);
126         } else {
127           SetPortWindowPort(macWinPtr);
128           GlobalToLocal(&event.where);
129           part = FindControl(event.where, macWinPtr,
130         &okButtonHandle);
131       
132       if ((kControlButtonPart == part) && 
133         (TrackControl(okButtonHandle,
134           event.where, NULL))) {
135           done = true;
136       }
137         }
138         break;
139     case keyDown:
140         switch (event.message & charCodeMask) {
141       case ENTERCODE:
142       case RETURNCODE:
143           HiliteControl(okButtonHandle, 1);
144           HiliteControl(okButtonHandle, 0);
145           done = true;
146         }
147         break;
148     case updateEvt:   
149         SetPortWindowPort(macWinPtr);
150         TextFont(systemFont);
151         
152         BeginUpdate(macWinPtr);
153         if (stopIconHandle != NULL) {
154       PlotIcon(&iconRect, stopIconHandle);
155         }
156         TETextBox(msg, strlen(msg), &textRect, teFlushDefault);
157         DrawControls(macWinPtr);
158         EndUpdate(macWinPtr);
159       }
160   }
161     }
162 
163     CloseWindow(macWinPtr);
164 
165   exitNow:
166 #ifdef TCL_DEBUG
167     Debugger();
168 #else
169     abort();
170 #endif
171 }

mac/tclMacPort.h File Reference
#include "tclInt.h"
#include "tclErrno.h"
#include <float.h>
#include "tclMac.h"
#include "tclIntPlatDecls.h"
Defines
#define EOVERFLOW  EINVAL
#define SIGQUIT  300
#define SIGPIPE  13
#define SIGHUP  100
#define WAIT_STATUS_TYPE  int
#define WNOHANG  1
#define WIFSTOPPED(stat)  (1)
#define WIFSIGNALED(stat)  (1)
#define WIFEXITED(stat)  (1)
#define WIFSTOPSIG(stat)  (1)
#define WIFTERMSIG(stat)  (1)
#define WIFEXITSTATUS(stat)  (1)
#define WEXITSTATUS(stat)  (1)
#define WTERMSIG(status)  (1)
#define WSTOPSIG(status)  (1)
#define MAXPATHLEN  2048
#define NBBY  8
#define geteuid()  1
#define getpid()  -1
#define TCL_PLATFORM_TRANSLATION  TCL_TRANSLATE_CR
#define TCL_SHLIB_EXT  ".shlb"
#define HAVE_TM_ZONE
#define tcl_mac_epoch_offset  0L
#define TclpGetPid(pid)  ((unsigned long) (pid))
#define TclSetSystemEnv(a, b)
#define tzset()
#define fopen(path, mode)  TclMacFOpenHack(path, mode)
#define readlink(fileName, buffer, size)  TclMacReadlink(fileName, buffer, size)
#define unsetenv  TclUnsetEnv
#define putenv  Tcl_PutEnv
#define setenv  TclSetEnv
#define TclpMutexInit(a)
#define TclpMutexLock(a)
#define TclpMutexUnlock(a)
#define TCL_STORAGE_CLASS  DLLIMPORT
Typedefs
typedef int TclpMutex
typedef pascal void(*) ExitToShellProcPtr (void)
Functions
char * TclpFindExecutable (const char *argv0)
int TclpFindVariable (CONST char *name, int *lengthPtr)
void TclSetEnv (CONST char *name, CONST char *value)
void TclUnsetEnv (CONST char *name)
Variables
char ** environ

Define Documentation
#define EOVERFLOW  EINVAL

Definition at line 37 of file tclMacPort.h.#define fopen(path, mode)  TclMacFOpenHack(path, mode)

Definition at line 227 of file tclMacPort.h.
Referenced by FindLibraries(), GrepForDefine(), main(), and TclMacFOpenHack().#define geteuid()  1

Definition at line 149 of file tclMacPort.h.
Referenced by Tcl_FileObjCmd().#define getpid()  -1

Definition at line 152 of file tclMacPort.h.
Referenced by Tcl_PidObjCmd().#define HAVE_TM_ZONE

Definition at line 193 of file tclMacPort.h.#define MAXPATHLEN  2048

Definition at line 133 of file tclMacPort.h.
Referenced by DoCopyFile(), DoRenameFile(), TclpGetCwd(), TclpInitLibraryPath(), TclpObjNormalizePath(), TclpReadlink(), and TclpSetVariables().#define NBBY  8

Definition at line 142 of file tclMacPort.h.
Referenced by TclUnixWaitForFile().#define putenv  Tcl_PutEnv

Definition at line 246 of file tclMacPort.h.
Referenced by TclSetEnv(), and TclUnsetEnv().#define readlink(fileName, buffer, size)  TclMacReadlink(fileName, buffer, size)

Definition at line 228 of file tclMacPort.h.
Referenced by DoCopyFile(), and TclpReadlink().#define setenv  TclSetEnv

Definition at line 247 of file tclMacPort.h.#define SIGHUP  100

Definition at line 99 of file tclMacPort.h.
Referenced by RestoreSignals(), Tcl_SignalId(), and Tcl_SignalMsg().#define SIGPIPE  13

Definition at line 95 of file tclMacPort.h.
Referenced by RestoreSignals(), Tcl_SignalId(), Tcl_SignalMsg(), and TclpInitPlatform().#define SIGQUIT  300

Definition at line 91 of file tclMacPort.h.
Referenced by RestoreSignals(), Tcl_SignalId(), and Tcl_SignalMsg().#define tcl_mac_epoch_offset  0L

Definition at line 212 of file tclMacPort.h.
Referenced by Tcl_GetTime(), TclpGetDate(), TclpGetSeconds(), and TclpObjStatAlias().#define TCL_PLATFORM_TRANSLATION  TCL_TRANSLATE_CR

Definition at line 173 of file tclMacPort.h.
Referenced by Tcl_CreateChannel(), and Tcl_SetChannelOption().#define TCL_SHLIB_EXT  ".shlb"

Definition at line 179 of file tclMacPort.h.
Referenced by InfoSharedlibCmd().#define TCL_STORAGE_CLASS  DLLIMPORT

Definition at line 277 of file tclMacPort.h.#define TclpGetPid(pid)  ((unsigned long) (pid))

Definition at line 220 of file tclMacPort.h.
Referenced by Tcl_PidObjCmd(), TclCleanupChildren(), and TclGetAndDetachPids().#define TclpMutexInit(a)

Definition at line 266 of file tclMacPort.h.#define TclpMutexLock(a)

Definition at line 267 of file tclMacPort.h.#define TclpMutexUnlock(a)

Definition at line 268 of file tclMacPort.h.#define TclSetSystemEnv(a, b)

Definition at line 221 of file tclMacPort.h.#define tzset()

Definition at line 222 of file tclMacPort.h.
Referenced by FormatClock(), SetTZIfNecessary(), TclpGetDate(), TclpGetTimeZone(), and TclpStrftime().#define unsetenv  TclUnsetEnv

Definition at line 245 of file tclMacPort.h.#define WAIT_STATUS_TYPE  int

Definition at line 108 of file tclMacPort.h.
Referenced by TclCleanupChildren(), and waitpid().#define WEXITSTATUS(stat)  (1)

Definition at line 116 of file tclMacPort.h.
Referenced by TclCleanupChildren().#define WIFEXITED(stat)  (1)

Definition at line 112 of file tclMacPort.h.
Referenced by TclCleanupChildren().#define WIFEXITSTATUS(stat)  (1)

Definition at line 115 of file tclMacPort.h.#define WIFSIGNALED(stat)  (1)

Definition at line 111 of file tclMacPort.h.
Referenced by TclCleanupChildren().#define WIFSTOPPED(stat)  (1)

Definition at line 110 of file tclMacPort.h.
Referenced by TclCleanupChildren(), and waitpid().#define WIFSTOPSIG(stat)  (1)

Definition at line 113 of file tclMacPort.h.#define WIFTERMSIG(stat)  (1)

Definition at line 114 of file tclMacPort.h.#define WNOHANG  1

Definition at line 109 of file tclMacPort.h.
Referenced by Tcl_ReapDetachedProcs().#define WSTOPSIG(status)  (1)

Definition at line 118 of file tclMacPort.h.
Referenced by TclCleanupChildren().#define WTERMSIG(status)  (1)

Definition at line 117 of file tclMacPort.h.
Referenced by TclCleanupChildren().
Typedef Documentation
typedef pascal void(*) ExitToShellProcPtr(void)

Definition at line 271 of file tclMacPort.h.typedef int TclpMutex

Definition at line 265 of file tclMacPort.h.
Function Documentation
char* TclpFindExecutable (const char * argv0)
int TclpFindVariable (CONST char * name, int * lengthPtr)

Definition at line 638 of file tclMacInit.c.
References ckalloc, ckfree, CONST, environ, NULL, size_t(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringSetLength(), Tcl_ExternalToUtfDString(), Tcl_UtfToUpper(), and VOID.645 {
646     int i, result = -1;
647     register CONST char *env, *p1, *p2;
648     Tcl_DString envString;
649 
650     Tcl_DStringInit(&envString);
651     for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
652   p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
653   p2 = name;
654 
655   for (; *p2 == *p1; p1++, p2++) {
656       /* NULL loop body. */
657   }
658   if ((*p1 == '=') && (*p2 == '\0')) {
659       *lengthPtr = p2 - name;
660       result = i;
661       goto done;
662   }
663   
664   Tcl_DStringFree(&envString);
665     }
666     
667     *lengthPtr = i;
668 
669     done:
670     Tcl_DStringFree(&envString);
671     return result;
672 }
void TclSetEnv (CONST char * name, CONST char * value)

Definition at line 178 of file tclEnv.c.
References ckalloc, ckfree, ckrealloc, CONST, putenv, ReplaceString(), Tcl_DStringFree(), Tcl_ExternalToUtfDString(), Tcl_FSMountsChanged(), Tcl_MutexLock, Tcl_MutexUnlock, Tcl_UtfToExternalDString(), TclpFindVariable(), and VOID.
Referenced by EnvTraceProc(), and Tcl_PutEnv().182 {
183     Tcl_DString envString;
184     int index, length, nameLength;
185     char *p, *oldValue;
186     CONST char *p2;
187 
188     /*
189      * Figure out where the entry is going to go.  If the name doesn't
190      * already exist, enlarge the array if necessary to make room.  If the
191      * name exists, free its old entry.
192      */
193 
194     Tcl_MutexLock(&envMutex);
195     index = TclpFindVariable(name, &length);
196 
197     if (index == -1) {
198 #ifndef USE_PUTENV
199   /*
200    * We need to handle the case where the environment may be changed
201    * outside our control.  environSize is only valid if the current
202    * environment is the one we allocated. [Bug 979640]
203    */
204   if ((ourEnviron != environ) || ((length + 2) > environSize)) {
205       char **newEnviron;
206 
207       newEnviron = (char **) ckalloc((unsigned)
208         ((length + 5) * sizeof(char *)));
209       memcpy((VOID *) newEnviron, (VOID *) environ,
210         length*sizeof(char *));
211       if ((environSize != 0) && (ourEnviron != NULL)) {
212     ckfree((char *) ourEnviron);
213       }
214       environ = ourEnviron = newEnviron;
215       environSize = length + 5;
216 #if defined(__APPLE__) && defined(__DYNAMIC__)
217       {
218       char ***e = _NSGetEnviron();
219       *e = environ;
220       }
221 #endif
222   }
223   index = length;
224   environ[index + 1] = NULL;
225 #endif
226   oldValue = NULL;
227   nameLength = strlen(name);
228     } else {
229   CONST char *env;
230 
231   /*
232    * Compare the new value to the existing value.  If they're
233    * the same then quit immediately (e.g. don't rewrite the
234    * value or propagate it to other interpreters).  Otherwise,
235    * when there are N interpreters there will be N! propagations
236    * of the same value among the interpreters.
237    */
238 
239   env = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envString);
240   if (strcmp(value, (env + length + 1)) == 0) {
241       Tcl_DStringFree(&envString);
242       Tcl_MutexUnlock(&envMutex);
243       return;
244   }
245   Tcl_DStringFree(&envString);
246 
247   oldValue = environ[index];
248   nameLength = length;
249     }
250 
251     /*
252      * Create a new entry.  Build a complete UTF string that contains
253      * a "name=value" pattern.  Then convert the string to the native
254      * encoding, and set the environ array value.
255      */
256 
257     p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2));
258     strcpy(p, name);
259     p[nameLength] = '=';
260     strcpy(p+nameLength+1, value);
261     p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);
262 
263     /*
264      * Copy the native string to heap memory.
265      */
266     
267     p = (char *) ckrealloc(p, (unsigned) (strlen(p2) + 1));
268     strcpy(p, p2);
269     Tcl_DStringFree(&envString);
270 
271 #ifdef USE_PUTENV
272     /*
273      * Update the system environment.
274      */
275 
276     putenv(p);
277     index = TclpFindVariable(name, &length);
278 #else
279     environ[index] = p;
280 #endif
281 
282     /*
283      * Watch out for versions of putenv that copy the string (e.g. VC++).
284      * In this case we need to free the string immediately.  Otherwise
285      * update the string in the cache.
286      */
287 
288     if ((index != -1) && (environ[index] == p)) {
289   ReplaceString(oldValue, p);
290 #ifdef HAVE_PUTENV_THAT_COPIES
291     } else {
292   /* This putenv() copies instead of taking ownership */
293   ckfree(p);
294 #endif
295     }
296 
297     Tcl_MutexUnlock(&envMutex);
298     
299     if (!strcmp(name, "HOME")) {
300   /* 
301    * If the user's home directory has changed, we must invalidate
302    * the filesystem cache, because '~' expansions will now be
303    * incorrect.
304    */
305         Tcl_FSMountsChanged(NULL);
306     }
307 }
void TclUnsetEnv (CONST char * name)

Definition at line 384 of file tclEnv.c.
References ckalloc, ckfree, ckrealloc, putenv, ReplaceString(), size_t(), Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_UtfToExternalDString(), TclpFindVariable(), and VOID.
Referenced by EnvTraceProc().386 {
387     char *oldValue;
388     int length;
389     int index;
390 #ifdef USE_PUTENV_FOR_UNSET
391     Tcl_DString envString;
392     char *string;
393 #else
394     char **envPtr;
395 #endif
396 
397     Tcl_MutexLock(&envMutex);
398     index = TclpFindVariable(name, &length);
399 
400     /*
401      * First make sure that the environment variable exists to avoid
402      * doing needless work and to avoid recursion on the unset.
403      */
404 
405     if (index == -1) {
406   Tcl_MutexUnlock(&envMutex);
407   return;
408     }
409     /*
410      * Remember the old value so we can free it if Tcl created the string.
411      */
412 
413     oldValue = environ[index];
414 
415     /*
416      * Update the system environment.  This must be done before we 
417      * update the interpreters or we will recurse.
418      */
419 
420 #ifdef USE_PUTENV_FOR_UNSET
421     /*
422      * For those platforms that support putenv to unset, Linux indicates
423      * that no = should be included, and Windows requires it.
424      */
425 #ifdef WIN32
426     string = ckalloc((unsigned int) length+2);
427     memcpy((VOID *) string, (VOID *) name, (size_t) length);
428     string[length] = '=';
429     string[length+1] = '\0';
430 #else
431     string = ckalloc((unsigned int) length+1);
432     memcpy((VOID *) string, (VOID *) name, (size_t) length);
433     string[length] = '\0';
434 #endif
435 
436     Tcl_UtfToExternalDString(NULL, string, -1, &envString);
437     string = ckrealloc(string, (unsigned) (Tcl_DStringLength(&envString)+1));
438     strcpy(string, Tcl_DStringValue(&envString));
439     Tcl_DStringFree(&envString);
440 
441     putenv(string);
442 
443     /*
444      * Watch out for versions of putenv that copy the string (e.g. VC++).
445      * In this case we need to free the string immediately.  Otherwise
446      * update the string in the cache.
447      */
448 
449     if (environ[index] == string) {
450   ReplaceString(oldValue, string);
451 #ifdef HAVE_PUTENV_THAT_COPIES
452     } else {
453   /* This putenv() copies instead of taking ownership */
454   ckfree(string);
455 #endif
456     }
457 #else
458     for (envPtr = environ+index+1; ; envPtr++) {
459   envPtr[-1] = *envPtr;
460   if (*envPtr == NULL) {
461       break;
462   }
463     }
464     ReplaceString(oldValue, NULL);
465 #endif
466 
467     Tcl_MutexUnlock(&envMutex);
468 }

Variable Documentation
char** environ

Definition at line 47 of file tclMacEnv.c.

mac/tclMacResource.c File Reference
#include <Errors.h>
#include <FSpCompat.h>
#include <Processes.h>
#include <Resources.h>
#include <Sound.h>
#include <Strings.h>
#include <Traps.h>
#include <LowMem.h>
#include "FullPath.h"
#include "tcl.h"
#include "tclInt.h"
#include "tclMac.h"
#include "tclMacInt.h"
#include "tclMacPort.h"
Classes
struct OpenResourceFork
Defines
#define TCL_RESOURCE_INSERT_TAIL  1
#define TCL_RESOURCE_CHECK_IF_OPEN  4
Enumerations
enum WhichVolume { SYS_BEEP_VOLUME, DEFAULT_SND_VOLUME, RESET_VOLUME }
Functions
static void DupOSTypeInternalRep _ANSI_ARGS_ ((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr))
static void ResourceInit _ANSI_ARGS_ ((void))
static int SetOSTypeFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr))
static void UpdateStringOfOSType _ANSI_ARGS_ ((Tcl_Obj *objPtr))
static OpenResourceFork *GetRsrcRefFromObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, int okayOnReadOnly, const char *operation, Tcl_Obj *resultPtr))
static void SetSoundVolume (int volume, enum WhichVolume mode)
int Tcl_ResourceObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
int Tcl_MacSourceObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
int Tcl_BeepObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
int Tcl_MacEvalResource (Tcl_Interp *interp, CONST char *resourceName, int resourceNumber, CONST char *fileName)
char * Tcl_MacConvertTextResource (Handle resource)
Handle Tcl_MacFindResource (Tcl_Interp *interp, long resourceType, CONST char *resourceName, int resourceNumber, CONST char *resFileRef, int *releaseIt)
static void ResourceInit ()
Tcl_Obj * Tcl_NewOSTypeObj (OSType newOSType)
void Tcl_SetOSTypeObj (Tcl_Obj *objPtr, OSType newOSType)
int Tcl_GetOSTypeFromObj (Tcl_Interp *interp, Tcl_Obj *objPtr, OSType *osTypePtr)
static void DupOSTypeInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
static int SetOSTypeFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr)
static void UpdateStringOfOSType (register Tcl_Obj *objPtr)
static OpenResourceFork * GetRsrcRefFromObj (register Tcl_Obj *objPtr, int okayOnReadOnly, const char *operation, Tcl_Obj *resultPtr)
int TclMacRegisterResourceFork (short fileRef, Tcl_Obj *tokenPtr, int flags)
short TclMacUnRegisterResourceFork (char *tokenPtr, Tcl_Obj *resultPtr)
void BuildResourceForkList ()
Variables
static Tcl_HashTable nameTable
static Tcl_HashTable resourceTable
static Tcl_Obj * resourceForkList
static int appResourceIndex
static int newId = 0
static int initialized = 0
static int osTypeInit = 0
static Tcl_ObjType osType

Define Documentation
#define TCL_RESOURCE_CHECK_IF_OPEN  4

Definition at line 45 of file tclMacResource.c.
Referenced by Tcl_ResourceObjCmd(), and TclMacRegisterResourceFork().#define TCL_RESOURCE_INSERT_TAIL  1

Definition at line 39 of file tclMacResource.c.
Referenced by BuildResourceForkList(), and TclMacRegisterResourceFork().
Enumeration Type Documentation
enum WhichVolume

Enumerator: 
SYS_BEEP_VOLUME  
DEFAULT_SND_VOLUME  
RESET_VOLUME  

Definition at line 52 of file tclMacResource.c.52                  {
53     SYS_BEEP_VOLUME,    /* This sets the volume for SysBeep calls */ 
54     DEFAULT_SND_VOLUME, /* This one for SndPlay calls */
55     RESET_VOLUME        /* And this undoes the last call to SetSoundVolume */
56 };

Function Documentation
static OpenResourceFork* GetRsrcRefFromObj _ANSI_ARGS_ ((Tcl_Obj *objPtr, int okayOnReadOnly, const char *operation, Tcl_Obj *resultPtr)) [static]
static void UpdateStringOfOSType _ANSI_ARGS_ ((Tcl_Obj *objPtr)) [static]
static int SetOSTypeFromAny _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *objPtr)) [static]
static void ResourceInit _ANSI_ARGS_ ((void)) [static]
static void DupOSTypeInternalRep _ANSI_ARGS_ ((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)) [static]
void BuildResourceForkList ()

Definition at line 2151 of file tclMacResource.c.
References NULL, Tcl_NewObj(), TCL_RESOURCE_DONT_CLOSE, TCL_RESOURCE_INSERT_TAIL, Tcl_SetStringObj(), and TclMacRegisterResourceFork().
Referenced by ResourceInit().2152 {
2153     Handle currentMapHandle, mSysMapHandle;  
2154     Ptr tempPtr;
2155     FCBPBRec fileRec;
2156     char fileName[256];
2157     char appName[62];
2158     Tcl_Obj *nameObj;
2159     OSErr err;
2160     ProcessSerialNumber psn;
2161     ProcessInfoRec info;
2162     FSSpec fileSpec;
2163         
2164     /* 
2165      * Get the application name, so we can substitute
2166      * the token "application" for the application's resource.
2167      */ 
2168      
2169     GetCurrentProcess(&psn);
2170     info.processInfoLength = sizeof(ProcessInfoRec);
2171     info.processName = (StringPtr) &appName;
2172     info.processAppSpec = &fileSpec;
2173     GetProcessInformation(&psn, &info);
2174     p2cstr((StringPtr) appName);
2175 
2176     
2177     fileRec.ioCompletion = NULL;
2178     fileRec.ioVRefNum = 0;
2179     fileRec.ioFCBIndx = 0;
2180     fileRec.ioNamePtr = (StringPtr) &fileName;
2181     
2182     
2183     currentMapHandle = LMGetTopMapHndl();
2184     mSysMapHandle = LMGetSysMapHndl();
2185     
2186     while (1) {
2187         /* 
2188          * Now do the ones opened after the application.
2189          */
2190        
2191         nameObj = Tcl_NewObj();
2192         
2193         tempPtr = *currentMapHandle;
2194 
2195         fileRec.ioRefNum = *((short *) (tempPtr + 20));
2196         err = PBGetFCBInfo(&fileRec, false);
2197         
2198         if (err != noErr) {
2199             /*
2200              * The ROM resource map does not correspond to an opened file...
2201              */
2202              Tcl_SetStringObj(nameObj, "ROM Map", -1);
2203         } else {
2204             p2cstr((StringPtr) fileName);
2205             if (strcmp(fileName,appName) == 0) {
2206                 Tcl_SetStringObj(nameObj, "application", -1);
2207             } else {
2208                 Tcl_SetStringObj(nameObj, fileName, -1);
2209             }
2210             c2pstr(fileName);
2211         }
2212         
2213         TclMacRegisterResourceFork(fileRec.ioRefNum, nameObj, 
2214             TCL_RESOURCE_DONT_CLOSE | TCL_RESOURCE_INSERT_TAIL);
2215        
2216         if (currentMapHandle == mSysMapHandle) {
2217             break;
2218         }
2219         
2220         currentMapHandle = *((Handle *) (tempPtr + 16));
2221     }
2222 }
static void DupOSTypeInternalRep (Tcl_Obj * srcPtr, Tcl_Obj * copyPtr) [static]

Definition at line 1678 of file tclMacResource.c.
References Tcl_Obj::internalRep, Tcl_Obj::longValue, osType, and Tcl_Obj::typePtr.1681 {
1682     copyPtr->internalRep.longValue = srcPtr->internalRep.longValue;
1683     copyPtr->typePtr = &osType;
1684 }
static OpenResourceFork* GetRsrcRefFromObj (register Tcl_Obj * objPtr, int okayOnReadOnly, const char * operation, Tcl_Obj * resultPtr) [static]

Definition at line 1796 of file tclMacResource.c.
References OpenResourceFork::fileRef, nameTable, NULL, Tcl_FindHashEntry, Tcl_GetHashValue, and Tcl_GetStringFromObj().
Referenced by Tcl_ResourceObjCmd().1803 {
1804     char *stringPtr;
1805     Tcl_HashEntry *nameHashPtr;
1806     OpenResourceFork *resourceRef;
1807     int length;
1808     OSErr err;
1809     
1810     stringPtr = Tcl_GetStringFromObj(objPtr, &length);
1811     nameHashPtr = Tcl_FindHashEntry(&nameTable, stringPtr);
1812     if (nameHashPtr == NULL) {
1813         Tcl_AppendStringsToObj(resultPtr,
1814           "invalid resource file reference \"",
1815           stringPtr, "\"", (char *) NULL);
1816         return NULL;
1817     }
1818 
1819     resourceRef = (OpenResourceFork *) Tcl_GetHashValue(nameHashPtr);
1820     
1821     if (!okayOnReadOnly) {
1822         err = GetResFileAttrs((short) resourceRef->fileRef);
1823         if (err & mapReadOnly) {
1824             Tcl_AppendStringsToObj(resultPtr, "cannot ", operation, 
1825                     " resource file \"",
1826                     stringPtr, "\", it was opened read only",
1827                     (char *) NULL);
1828             return NULL;
1829         }
1830     }
1831     return resourceRef;
1832 }
static void ResourceInit () [static]

Definition at line 1523 of file tclMacResource.c.
References BuildResourceForkList(), initialized, nameTable, resourceForkList, resourceTable, Tcl_IncrRefCount, Tcl_InitHashTable(), Tcl_NewObj(), TCL_ONE_WORD_KEYS, and TCL_STRING_KEYS.
Referenced by Tcl_ResourceObjCmd(), and TclMacRegisterResourceFork().1524 {
1525 
1526     initialized = 1;
1527     Tcl_InitHashTable(&nameTable, TCL_STRING_KEYS);
1528     Tcl_InitHashTable(&resourceTable, TCL_ONE_WORD_KEYS);
1529     resourceForkList = Tcl_NewObj();
1530     Tcl_IncrRefCount(resourceForkList);
1531 
1532     BuildResourceForkList();
1533     
1534 }
static int SetOSTypeFromAny (Tcl_Interp * interp, Tcl_Obj * objPtr) [static]

Definition at line 1707 of file tclMacResource.c.
References Tcl_ObjType::freeIntRepProc, Tcl_Obj::internalRep, Tcl_Obj::longValue, NULL, osType, TCL_ERROR, Tcl_GetObjResult(), Tcl_GetStringFromObj(), TCL_OK, Tcl_ResetResult(), and Tcl_Obj::typePtr.
Referenced by Tcl_GetOSTypeFromObj().1710 {
1711     Tcl_ObjType *oldTypePtr = objPtr->typePtr;
1712     char *string;
1713     int length;
1714     long newOSType;
1715 
1716     /*
1717      * Get the string representation. Make it up-to-date if necessary.
1718      */
1719 
1720     string = Tcl_GetStringFromObj(objPtr, &length);
1721 
1722     if (length != 4) {
1723   if (interp != NULL) {
1724       Tcl_ResetResult(interp);
1725       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1726         "expected Macintosh OS type but got \"", string, "\"",
1727         (char *) NULL);
1728   }
1729   return TCL_ERROR;
1730     }
1731     newOSType =  *((long *) string);
1732     
1733     /*
1734      * The conversion to resource type succeeded. Free the old internalRep 
1735      * before setting the new one.
1736      */
1737 
1738     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
1739   oldTypePtr->freeIntRepProc(objPtr);
1740     }
1741     
1742     objPtr->internalRep.longValue = newOSType;
1743     objPtr->typePtr = &osType;
1744     return TCL_OK;
1745 }
void SetSoundVolume (int volume, enum WhichVolume mode) [static]

Definition at line 1145 of file tclMacResource.c.
References DEFAULT_SND_VOLUME, RESET_VOLUME, and SYS_BEEP_VOLUME.
Referenced by Tcl_BeepObjCmd().1148                  : SysBeep, SndPlay, or instructs us
1149             * to reset the volume */
1150 {
1151     static int hasSM3 = -1;
1152     static enum WhichVolume oldMode;
1153     static long oldVolume = -1;
1154 
1155     /*
1156      * The volume setting calls only work if we have SoundManager
1157      * 3.0 or higher.  So we check that here.
1158      */
1159     
1160     if (hasSM3 == -1) {
1161       if (GetToolboxTrapAddress(_SoundDispatch) 
1162     != GetToolboxTrapAddress(_Unimplemented)) {
1163       NumVersion SMVers = SndSoundManagerVersion();
1164       if (SMVers.majorRev > 2) {
1165         hasSM3 = 1;
1166       } else {
1167     hasSM3 = 0;
1168       }
1169   } else {
1170       /*
1171        * If the SoundDispatch trap is not present, then
1172        * we don't have the SoundManager at all.
1173        */
1174       
1175       hasSM3 = 0;
1176   }
1177     }
1178     
1179     /*
1180      * If we don't have Sound Manager 3.0, we can't set the sound volume.
1181      * We will just ignore the request rather than raising an error.
1182      */
1183     
1184     if (!hasSM3) {
1185       return;
1186     }
1187     
1188     switch (mode) {
1189       case SYS_BEEP_VOLUME:
1190       GetSysBeepVolume(&oldVolume);
1191       SetSysBeepVolume(volume);
1192       oldMode = SYS_BEEP_VOLUME;
1193       break;
1194   case DEFAULT_SND_VOLUME:
1195       GetDefaultOutputVolume(&oldVolume);
1196       SetDefaultOutputVolume(volume);
1197       oldMode = DEFAULT_SND_VOLUME;
1198       break;
1199   case RESET_VOLUME:
1200       /*
1201        * If oldVolume is -1 someone has made a programming error
1202        * and called reset before setting the volume.  This is benign
1203        * however, so we will just exit.
1204        */
1205     
1206       if (oldVolume != -1) {  
1207           if (oldMode == SYS_BEEP_VOLUME) {
1208             SetSysBeepVolume(oldVolume);
1209           } else if (oldMode == DEFAULT_SND_VOLUME) {
1210         SetDefaultOutputVolume(oldVolume);
1211           }
1212       }
1213       oldVolume = -1;
1214     }
1215 }
int Tcl_BeepObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])

Definition at line 1007 of file tclMacResource.c.
References DEFAULT_SND_VOLUME, NULL, RESET_VOLUME, SetSoundVolume(), SYS_BEEP_VOLUME, TCL_ERROR, Tcl_GetIntFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_ListObjAppendElement(), Tcl_NewStringObj(), TCL_OK, and Tcl_WrongNumArgs().1012 {
1013     Tcl_Obj *resultPtr, *objPtr;
1014     Handle sound;
1015     Str255 sndName;
1016     int volume = -1, length;
1017     char * sndArg = NULL;
1018 
1019     resultPtr = Tcl_GetObjResult(interp);
1020     if (objc == 1) {
1021   SysBeep(1);
1022   return TCL_OK;
1023     } else if (objc == 2) {
1024   if (!strcmp(Tcl_GetStringFromObj(objv[1], &length), "-list")) {
1025       int count, i;
1026       short id;
1027       Str255 theName;
1028       ResType rezType;
1029       
1030       count = CountResources('snd ');
1031       for (i = 1; i <= count; i++) {
1032     sound = GetIndResource('snd ', i);
1033     if (sound != NULL) {
1034         GetResInfo(sound, &id, &rezType, theName);
1035         if (theName[0] == 0) {
1036       continue;
1037         }
1038         objPtr = Tcl_NewStringObj((char *) theName + 1,
1039           theName[0]);
1040         Tcl_ListObjAppendElement(interp, resultPtr, objPtr);
1041     }
1042       }
1043       return TCL_OK;
1044   } else {
1045       sndArg = Tcl_GetStringFromObj(objv[1], &length);
1046   }
1047     } else if (objc == 3) {
1048   if (!strcmp(Tcl_GetStringFromObj(objv[1], &length), "-volume")) {
1049       Tcl_GetIntFromObj(interp, objv[2], &volume);
1050   } else {
1051       goto beepUsage;
1052   }
1053     } else if (objc == 4) {
1054   if (!strcmp(Tcl_GetStringFromObj(objv[1], &length), "-volume")) {
1055       Tcl_GetIntFromObj(interp, objv[2], &volume);
1056       sndArg = Tcl_GetStringFromObj(objv[3], &length);
1057   } else {
1058       goto beepUsage;
1059   }
1060     } else {
1061   goto beepUsage;
1062     }
1063   
1064     /*
1065      * Play the sound
1066      */
1067     if (sndArg == NULL) {
1068   /*
1069          * Set Volume for SysBeep
1070          */
1071 
1072   if (volume >= 0) {
1073       SetSoundVolume(volume, SYS_BEEP_VOLUME);
1074   }
1075   SysBeep(1);
1076 
1077   /*
1078          * Reset Volume
1079          */
1080 
1081   if (volume >= 0) {
1082       SetSoundVolume(0, RESET_VOLUME);
1083   }
1084     } else {
1085   strcpy((char *) sndName + 1, sndArg);
1086   sndName[0] = length;
1087   sound = GetNamedResource('snd ', sndName);
1088   if (sound != NULL) {
1089       /*
1090              * Set Volume for Default Output device
1091              */
1092 
1093       if (volume >= 0) {
1094     SetSoundVolume(volume, DEFAULT_SND_VOLUME);
1095       }
1096 
1097       SndPlay(NULL, (SndListHandle) sound, false);
1098 
1099       /*
1100              * Reset Volume
1101              */
1102 
1103       if (volume >= 0) {
1104     SetSoundVolume(0, RESET_VOLUME);
1105       }
1106   } else {
1107       Tcl_AppendStringsToObj(resultPtr, " \"", sndArg, 
1108         "\" is not a valid sound.  (Try ",
1109         Tcl_GetString(objv[0]), " -list)", NULL);
1110       return TCL_ERROR;
1111   }
1112     }
1113 
1114     return TCL_OK;
1115 
1116     beepUsage:
1117     Tcl_WrongNumArgs(interp, 1, objv, "[-volume num] [-list | sndName]?");
1118     return TCL_ERROR;
1119 }
int Tcl_GetOSTypeFromObj (Tcl_Interp * interp, Tcl_Obj * objPtr, OSType * osTypePtr)

Definition at line 1635 of file tclMacResource.c.
References Tcl_Obj::internalRep, Tcl_Obj::longValue, osType, osTypeInit, SetOSTypeFromAny(), TCL_OK, Tcl_RegisterObjType(), and Tcl_Obj::typePtr.
Referenced by SetFileFinderAttributes(), Tcl_ResourceObjCmd(), and TclpMatchInDirectory().1639 {
1640     register int result;
1641     
1642     if (!osTypeInit) {
1643   osTypeInit = 1;
1644   Tcl_RegisterObjType(&osType);
1645     }
1646 
1647     if (objPtr->typePtr == &osType) {
1648   *osTypePtr = objPtr->internalRep.longValue;
1649   return TCL_OK;
1650     }
1651 
1652     result = SetOSTypeFromAny(interp, objPtr);
1653     if (result == TCL_OK) {
1654   *osTypePtr = objPtr->internalRep.longValue;
1655     }
1656     return result;
1657 }
char* Tcl_MacConvertTextResource (Handle resource)

Definition at line 1385 of file tclMacResource.c.
References ckalloc, NULL, size_t(), Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, Tcl_ExternalToUtfDString(), and VOID.
Referenced by Tcl_MacEvalResource().1387 {
1388     int i, size;
1389     char *resultStr;
1390     Tcl_DString dstr;
1391 
1392     size = GetResourceSizeOnDisk(resource);
1393     
1394     Tcl_ExternalToUtfDString(NULL, *resource, size, &dstr);
1395 
1396     size = Tcl_DStringLength(&dstr) + 1;
1397     resultStr = (char *) ckalloc((unsigned) size);
1398     
1399     memcpy((VOID *) resultStr, (VOID *) Tcl_DStringValue(&dstr), (size_t) size);
1400     
1401     Tcl_DStringFree(&dstr);
1402     
1403     for (i=0; i<size; i++) {
1404   if (resultStr[i] == '\r') {
1405       resultStr[i] = '\n';
1406   }
1407     }
1408 
1409     return resultStr;
1410 }
int Tcl_MacEvalResource (Tcl_Interp * interp, CONST char * resourceName, int resourceNumber, CONST char * fileName)

Definition at line 1236 of file tclMacResource.c.
References ckfree, CONST, Tcl_Interp::errorLine, FSpLocationFromPath(), NULL, Tcl_AddErrorInfo(), Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, TCL_ERROR, Tcl_Eval(), Tcl_MacConvertTextResource(), TCL_OK, TCL_RETURN, Tcl_TranslateFileName(), and Tcl_UtfToExternalDString().
Referenced by Tcl_MacSourceObjCmd(), Tcl_Main(), and Tcl_SourceRCFile().1243 {
1244     Handle sourceText;
1245     Str255 rezName;
1246     char msg[200];
1247     int result, iOpenedResFile = false;
1248     short saveRef, fileRef = -1;
1249     char idStr[64];
1250     FSSpec fileSpec;
1251     Tcl_DString ds, buffer;
1252     CONST char *nativeName;
1253 
1254     saveRef = CurResFile();
1255   
1256     if (fileName != NULL) {
1257   OSErr err;
1258   
1259   if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) {
1260       return TCL_ERROR;
1261   }
1262   nativeName = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer), 
1263           Tcl_DStringLength(&buffer), &ds);
1264   err = FSpLocationFromPath(strlen(nativeName), nativeName,
1265                 &fileSpec);
1266   Tcl_DStringFree(&ds);
1267   Tcl_DStringFree(&buffer);
1268   if (err != noErr) {
1269       Tcl_AppendResult(interp, "Error finding the file: \"", 
1270     fileName, "\".", NULL);
1271       return TCL_ERROR;
1272   }
1273     
1274   fileRef = FSpOpenResFileCompat(&fileSpec, fsRdPerm);
1275   if (fileRef == -1) {
1276       Tcl_AppendResult(interp, "Error reading the file: \"", 
1277     fileName, "\".", NULL);
1278       return TCL_ERROR;
1279   }
1280     
1281   UseResFile(fileRef);
1282   iOpenedResFile = true;
1283     } else {
1284   /*
1285    * The default behavior will search through all open resource files.
1286    * This may not be the behavior you desire.  If you want the behavior
1287    * of this call to *only* search the application resource fork, you
1288    * must call UseResFile at this point to set it to the application
1289    * file.  This means you must have already obtained the application's 
1290    * fileRef when the application started up.
1291    */
1292     }
1293   
1294     /*
1295      * Load the resource by name or ID
1296      */
1297     if (resourceName != NULL) {
1298   Tcl_DString ds;
1299   Tcl_UtfToExternalDString(NULL, resourceName, -1, &ds);
1300   strcpy((char *) rezName + 1, Tcl_DStringValue(&ds));
1301   rezName[0] = (unsigned) Tcl_DStringLength(&ds);
1302   sourceText = GetNamedResource('TEXT', rezName);
1303   Tcl_DStringFree(&ds);
1304     } else {
1305   sourceText = GetResource('TEXT', (short) resourceNumber);
1306     }
1307   
1308     if (sourceText == NULL) {
1309   result = TCL_ERROR;
1310     } else {
1311   char *sourceStr = NULL;
1312 
1313   HLock(sourceText);
1314   sourceStr = Tcl_MacConvertTextResource(sourceText);
1315   HUnlock(sourceText);
1316   ReleaseResource(sourceText);
1317     
1318   /*
1319    * We now evaluate the Tcl source
1320    */
1321   result = Tcl_Eval(interp, sourceStr);
1322   ckfree(sourceStr);
1323   if (result == TCL_RETURN) {
1324       result = TCL_OK;
1325   } else if (result == TCL_ERROR) {
1326       sprintf(msg, "\n    (rsrc \"%.150s\" line %d)",
1327                     resourceName,
1328         interp->errorLine);
1329       Tcl_AddErrorInfo(interp, msg);
1330   }
1331         
1332   goto rezEvalCleanUp;
1333     }
1334   
1335     rezEvalError:
1336     sprintf(idStr, "ID=%d", resourceNumber);
1337     Tcl_AppendResult(interp, "The resource \"",
1338       (resourceName != NULL ? resourceName : idStr),
1339       "\" could not be loaded from ",
1340       (fileName != NULL ? fileName : "application"),
1341       ".", NULL);
1342 
1343     rezEvalCleanUp:
1344 
1345     /* 
1346      * TRICKY POINT: The code that you are sourcing here could load a
1347      * shared library.  This will go AHEAD of the resource we stored away
1348      * in saveRef on the resource path.  
1349      * If you restore the saveRef in this case, you will never be able
1350      * to get to the resources in the shared library, since you are now
1351      * pointing too far down on the resource list.  
1352      * So, we only reset the current resource file if WE opened a resource
1353      * explicitly, and then only if the CurResFile is still the 
1354      * one we opened... 
1355      */
1356      
1357     if (iOpenedResFile && (CurResFile() == fileRef)) {
1358         UseResFile(saveRef);
1359     }
1360   
1361     if (fileRef != -1) {
1362   CloseResFile(fileRef);
1363     }
1364 
1365     return result;
1366 }
Handle Tcl_MacFindResource (Tcl_Interp * interp, long resourceType, CONST char * resourceName, int resourceNumber, CONST char * resFileRef, int * releaseIt)

Definition at line 1429 of file tclMacResource.c.
References OpenResourceFork::fileRef, nameTable, NULL, Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, Tcl_FindHashEntry, Tcl_GetHashValue, and Tcl_UtfToExternalDString().
Referenced by Tcl_ResourceObjCmd().1438 {
1439     Tcl_HashEntry *nameHashPtr;
1440     OpenResourceFork *resourceRef;
1441     int limitSearch = false;
1442     short saveRef;
1443     Handle resource;
1444 
1445     if (resFileRef != NULL) {
1446   nameHashPtr = Tcl_FindHashEntry(&nameTable, resFileRef);
1447   if (nameHashPtr == NULL) {
1448       Tcl_AppendResult(interp, "invalid resource file reference \"",
1449            resFileRef, "\"", (char *) NULL);
1450       return NULL;
1451   }
1452   resourceRef = (OpenResourceFork *) Tcl_GetHashValue(nameHashPtr);
1453   saveRef = CurResFile();
1454   UseResFile((short) resourceRef->fileRef);
1455   limitSearch = true;
1456     }
1457 
1458     /* 
1459      * Some system resources (for example system resources) should not 
1460      * be released.  So we set autoload to false, and try to get the resource.
1461      * If the Master Pointer of the returned handle is null, then resource was 
1462      * not in memory, and it is safe to release it.  Otherwise, it is not.
1463      */
1464     
1465     SetResLoad(false);
1466    
1467     if (resourceName == NULL) {
1468   if (limitSearch) {
1469       resource = Get1Resource(resourceType, resourceNumber);
1470   } else {
1471       resource = GetResource(resourceType, resourceNumber);
1472   }
1473     } else {
1474       Str255 rezName;
1475   Tcl_DString ds;
1476   Tcl_UtfToExternalDString(NULL, resourceName, -1, &ds);
1477   strcpy((char *) rezName + 1, Tcl_DStringValue(&ds));
1478   rezName[0] = (unsigned) Tcl_DStringLength(&ds);
1479   if (limitSearch) {
1480       resource = Get1NamedResource(resourceType,
1481         rezName);
1482   } else {
1483       resource = GetNamedResource(resourceType,
1484         rezName);
1485   }
1486   Tcl_DStringFree(&ds);
1487     }
1488     
1489     if (resource != NULL && *resource == NULL) {
1490       *releaseIt = 1;
1491       LoadResource(resource);
1492     } else {
1493       *releaseIt = 0;
1494     }
1495     
1496     SetResLoad(true);
1497       
1498 
1499     if (limitSearch) {
1500   UseResFile(saveRef);
1501     }
1502 
1503     return resource;
1504 }
int Tcl_MacSourceObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])

Definition at line 937 of file tclMacResource.c.
References NULL, TCL_ERROR, Tcl_FSEvalFile(), Tcl_GetLongFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_MacEvalResource(), and TCL_OK.942 {
943     char *errNum = "wrong # args: ";
944     char *errBad = "bad argument: ";
945     char *errStr;
946     char *fileName = NULL, *rsrcName = NULL;
947     long rsrcID = -1;
948     char *string;
949     int length;
950 
951     if (objc < 2 || objc > 4)  {
952       errStr = errNum;
953       goto sourceFmtErr;
954     }
955     
956     if (objc == 2)  {
957   return Tcl_FSEvalFile(interp, objv[1]);
958     }
959     
960     /*
961      * The following code supports a few older forms of this command
962      * for backward compatability.
963      */
964     string = Tcl_GetStringFromObj(objv[1], &length);
965     if (!strcmp(string, "-rsrc") || !strcmp(string, "-rsrcname")) {
966   rsrcName = Tcl_GetStringFromObj(objv[2], &length);
967     } else if (!strcmp(string, "-rsrcid")) {
968   if (Tcl_GetLongFromObj(interp, objv[2], &rsrcID) != TCL_OK) {
969       return TCL_ERROR;
970   }
971     } else {
972       errStr = errBad;
973       goto sourceFmtErr;
974     }
975     
976     if (objc == 4) {
977   fileName = Tcl_GetStringFromObj(objv[3], &length);
978     }
979     return Tcl_MacEvalResource(interp, rsrcName, rsrcID, fileName);
980   
981     sourceFmtErr:
982     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), errStr, "should be \"",
983     Tcl_GetString(objv[0]), " fileName\" or \"",
984     Tcl_GetString(objv[0]), " -rsrc name ?fileName?\" or \"", 
985     Tcl_GetString(objv[0]), " -rsrcid id ?fileName?\"",
986     (char *) NULL);
987     return TCL_ERROR;
988 }
Tcl_Obj* Tcl_NewOSTypeObj (OSType newOSType)

Definition at line 1557 of file tclMacResource.c.
References Tcl_Obj::bytes, Tcl_Obj::internalRep, Tcl_Obj::longValue, NULL, osType, osTypeInit, Tcl_NewObj(), Tcl_RegisterObjType(), and Tcl_Obj::typePtr.
Referenced by GetFileFinderAttributes(), and Tcl_ResourceObjCmd().1559 {
1560     register Tcl_Obj *objPtr;
1561 
1562     if (!osTypeInit) {
1563   osTypeInit = 1;
1564   Tcl_RegisterObjType(&osType);
1565     }
1566 
1567     objPtr = Tcl_NewObj();
1568     objPtr->bytes = NULL;
1569     objPtr->internalRep.longValue = newOSType;
1570     objPtr->typePtr = &osType;
1571     return objPtr;
1572 }
int Tcl_ResourceObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])

Definition at line 127 of file tclMacResource.c.
References CONST, errbuf, OpenResourceFork::fileRef, FSpLocationFromPath(), GetRsrcRefFromObj(), initialized, NULL, panic, resourceForkList, ResourceInit(), Tcl_DecrRefCount, Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, TCL_ERROR, Tcl_ExternalToUtfDString(), Tcl_GetByteArrayFromObj(), Tcl_GetIndexFromObj(), Tcl_GetLongFromObj(), Tcl_GetObjResult(), Tcl_GetOSTypeFromObj(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_ListObjAppendElement(), Tcl_MacFindResource(), Tcl_NewIntObj(), Tcl_NewOSTypeObj(), Tcl_NewStringObj(), TCL_OK, Tcl_ResetResult(), TCL_RESOURCE_CHECK_IF_OPEN, Tcl_SetByteArrayObj(), Tcl_SetStringObj(), Tcl_TranslateFileName(), Tcl_UtfToExternalDString(), Tcl_WrongNumArgs(), TclGetOpenMode(), TclMacRegisterResourceFork(), and TclMacUnRegisterResourceFork().132 {
133     Tcl_Obj *resultPtr, *objPtr;
134     int index, result;
135     long fileRef, rsrcId;
136     FSSpec fileSpec;
137     char *stringPtr;
138     char errbuf[16];
139     OpenResourceFork *resourceRef;
140     Handle resource = NULL;
141     OSErr err;
142     int count, i, limitSearch = false, length;
143     short id, saveRef, resInfo;
144     Str255 theName;
145     OSType rezType;
146     int gotInt, releaseIt = 0, force;
147     char *resourceId = NULL;  
148     long size;
149     char macPermision;
150     int mode;
151 
152     static CONST char *switches[] = {"close", "delete" ,"files", "list", 
153             "open", "read", "types", "write", (char *) NULL
154     };
155           
156     enum {
157             RESOURCE_CLOSE, RESOURCE_DELETE, RESOURCE_FILES, RESOURCE_LIST, 
158             RESOURCE_OPEN, RESOURCE_READ, RESOURCE_TYPES, RESOURCE_WRITE
159     };
160               
161     static CONST char *writeSwitches[] = {
162             "-id", "-name", "-file", "-force", (char *) NULL
163     };
164             
165     enum {
166             RESOURCE_WRITE_ID, RESOURCE_WRITE_NAME, 
167             RESOURCE_WRITE_FILE, RESOURCE_FORCE
168     };
169             
170     static CONST char *deleteSwitches[] = {"-id", "-name", "-file", (char *) NULL};
171              
172     enum {RESOURCE_DELETE_ID, RESOURCE_DELETE_NAME, RESOURCE_DELETE_FILE};
173 
174     resultPtr = Tcl_GetObjResult(interp);
175     
176     if (objc < 2) {
177   Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
178   return TCL_ERROR;
179     }
180 
181     if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index)
182       != TCL_OK) {
183   return TCL_ERROR;
184     }
185     if (!initialized) {
186   ResourceInit();
187     }
188     result = TCL_OK;
189 
190     switch (index) {
191   case RESOURCE_CLOSE:      
192       if (objc != 3) {
193     Tcl_WrongNumArgs(interp, 2, objv, "resourceRef");
194     return TCL_ERROR;
195       }
196       stringPtr = Tcl_GetStringFromObj(objv[2], &length);
197       fileRef = TclMacUnRegisterResourceFork(stringPtr, resultPtr);
198       
199       if (fileRef >= 0) {
200           CloseResFile((short) fileRef);
201           return TCL_OK;
202       } else {
203           return TCL_ERROR;
204       }
205   case RESOURCE_DELETE:
206       if (!((objc >= 3) && (objc <= 9) && ((objc % 2) == 1))) {
207     Tcl_WrongNumArgs(interp, 2, objv, 
208         "?-id resourceId? ?-name resourceName? ?-file \
209 resourceRef? resourceType");
210     return TCL_ERROR;
211       }
212       
213       i = 2;
214       fileRef = -1;
215       gotInt = false;
216       resourceId = NULL;
217       limitSearch = false;
218 
219       while (i < (objc - 2)) {
220     if (Tcl_GetIndexFromObj(interp, objv[i], deleteSwitches,
221       "option", 0, &index) != TCL_OK) {
222         return TCL_ERROR;
223     }
224 
225     switch (index) {
226         case RESOURCE_DELETE_ID:    
227       if (Tcl_GetLongFromObj(interp, objv[i+1], &rsrcId)
228         != TCL_OK) {
229           return TCL_ERROR;
230       }
231       gotInt = true;
232       break;
233         case RESOURCE_DELETE_NAME:    
234       resourceId = Tcl_GetStringFromObj(objv[i+1], &length);
235       if (length > 255) {
236           Tcl_AppendStringsToObj(resultPtr,"-name argument ",
237                   "too long, must be < 255 characters",
238                   (char *) NULL);
239           return TCL_ERROR;
240       }
241       strcpy((char *) theName, resourceId);
242       resourceId = (char *) theName;
243       c2pstr(resourceId);
244       break;
245         case RESOURCE_DELETE_FILE:
246             resourceRef = GetRsrcRefFromObj(objv[i+1], 0, 
247                     "delete from", resultPtr);
248             if (resourceRef == NULL) {
249                 return TCL_ERROR;
250             } 
251       limitSearch = true;
252       break;
253     }
254     i += 2;
255       }
256       
257       if ((resourceId == NULL) && !gotInt) {
258     Tcl_AppendStringsToObj(resultPtr,"you must specify either ",
259             "\"-id\" or \"-name\" or both ",
260             "to \"resource delete\"",
261             (char *) NULL);
262           return TCL_ERROR;
263             }
264 
265       if (Tcl_GetOSTypeFromObj(interp, objv[i], &rezType) != TCL_OK) {
266     return TCL_ERROR;
267       }
268 
269       if (limitSearch) {
270     saveRef = CurResFile();
271     UseResFile((short) resourceRef->fileRef);
272       }
273       
274       SetResLoad(false);
275       
276       if (gotInt == true) {
277           if (limitSearch) {
278         resource = Get1Resource(rezType, rsrcId);
279     } else {
280         resource = GetResource(rezType, rsrcId);
281     }
282                 err = ResError();
283             
284                 if (err == resNotFound || resource == NULL) {
285               Tcl_AppendStringsToObj(resultPtr, "resource not found",
286                   (char *) NULL);
287               result = TCL_ERROR;
288               goto deleteDone;               
289                 } else if (err != noErr) {
290                     char buffer[16];
291                 
292                     sprintf(buffer, "%12d", err);
293               Tcl_AppendStringsToObj(resultPtr, "resource error #",
294                       buffer, "occured while trying to find resource",
295                       (char *) NULL);
296               result = TCL_ERROR;
297               goto deleteDone;               
298           }
299       } 
300       
301       if (resourceId != NULL) {
302           Handle tmpResource;
303           if (limitSearch) {
304               tmpResource = Get1NamedResource(rezType,
305           (StringPtr) resourceId);
306           } else {
307               tmpResource = GetNamedResource(rezType,
308           (StringPtr) resourceId);
309           }
310                 err = ResError();
311             
312                 if (err == resNotFound || tmpResource == NULL) {
313               Tcl_AppendStringsToObj(resultPtr, "resource not found",
314                   (char *) NULL);
315               result = TCL_ERROR;
316               goto deleteDone;               
317                 } else if (err != noErr) {
318                     char buffer[16];
319                 
320                     sprintf(buffer, "%12d", err);
321               Tcl_AppendStringsToObj(resultPtr, "resource error #",
322                       buffer, "occured while trying to find resource",
323                       (char *) NULL);
324               result = TCL_ERROR;
325               goto deleteDone;               
326           }
327           
328           if (gotInt) { 
329               if (resource != tmpResource) {
330                   Tcl_AppendStringsToObj(resultPtr,
331         "\"-id\" and \"-name\" ",
332                           "values do not point to the same resource",
333                           (char *) NULL);
334                   result = TCL_ERROR;
335                   goto deleteDone;
336               }
337           } else {
338               resource = tmpResource;
339           }
340       }
341           
342             resInfo = GetResAttrs(resource);
343       
344       if ((resInfo & resProtected) == resProtected) {
345           Tcl_AppendStringsToObj(resultPtr, "resource ",
346                   "cannot be deleted: it is protected.",
347                   (char *) NULL);
348           result = TCL_ERROR;
349           goto deleteDone;               
350       } else if ((resInfo & resSysHeap) == resSysHeap) {   
351           Tcl_AppendStringsToObj(resultPtr, "resource",
352                   "cannot be deleted: it is in the system heap.",
353                   (char *) NULL);
354           result = TCL_ERROR;
355           goto deleteDone;               
356       }
357       
358       /*
359        * Find the resource file, if it was not specified,
360        * so we can flush the changes now.  Perhaps this is
361        * a little paranoid, but better safe than sorry.
362        */
363        
364       RemoveResource(resource);
365       
366       if (!limitSearch) {
367           UpdateResFile(HomeResFile(resource));
368       } else {
369           UpdateResFile(resourceRef->fileRef);
370       }
371       
372       
373       deleteDone:
374       
375             SetResLoad(true);
376       if (limitSearch) {
377                  UseResFile(saveRef);                        
378       }
379       return result;
380       
381   case RESOURCE_FILES:
382       if ((objc < 2) || (objc > 3)) {
383     Tcl_SetStringObj(resultPtr,
384             "wrong # args: should be \"resource files \
385 ?resourceId?\"", -1);
386     return TCL_ERROR;
387       }
388       
389       if (objc == 2) {
390           stringPtr = Tcl_GetStringFromObj(resourceForkList, &length);
391           Tcl_SetStringObj(resultPtr, stringPtr, length);
392       } else {
393                 FCBPBRec fileRec;
394                 Handle pathHandle;
395                 short pathLength;
396                 Str255 fileName;
397                 Tcl_DString dstr;
398           
399           if (strcmp(Tcl_GetString(objv[2]), "ROM Map") == 0) {
400               Tcl_SetStringObj(resultPtr,"no file path for ROM Map", -1);
401               return TCL_ERROR;
402           }
403           
404           resourceRef = GetRsrcRefFromObj(objv[2], 1, "files", resultPtr);
405           if (resourceRef == NULL) {
406               return TCL_ERROR;
407           }
408 
409                 fileRec.ioCompletion = NULL;
410                 fileRec.ioFCBIndx = 0;
411                 fileRec.ioNamePtr = fileName;
412                 fileRec.ioVRefNum = 0;
413                 fileRec.ioRefNum = resourceRef->fileRef;
414                 err = PBGetFCBInfo(&fileRec, false);
415                 if (err != noErr) {
416                     Tcl_SetStringObj(resultPtr,
417                             "could not get FCB for resource file", -1);
418                     return TCL_ERROR;
419                 }
420                 
421                 err = GetFullPath(fileRec.ioFCBVRefNum, fileRec.ioFCBParID,
422                         fileRec.ioNamePtr, &pathLength, &pathHandle);
423                 if ( err != noErr) {
424                     Tcl_SetStringObj(resultPtr,
425                             "could not get file path from token", -1);
426                     return TCL_ERROR;
427                 }
428                 
429                 HLock(pathHandle);
430                 Tcl_ExternalToUtfDString(NULL, *pathHandle, pathLength, &dstr);
431                 
432                 Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
433                 HUnlock(pathHandle);
434                 DisposeHandle(pathHandle);
435                 Tcl_DStringFree(&dstr);
436             }                         
437       return TCL_OK;
438   case RESOURCE_LIST:     
439       if (!((objc == 3) || (objc == 4))) {
440     Tcl_WrongNumArgs(interp, 2, objv, "resourceType ?resourceRef?");
441     return TCL_ERROR;
442       }
443       if (Tcl_GetOSTypeFromObj(interp, objv[2], &rezType) != TCL_OK) {
444     return TCL_ERROR;
445       }
446 
447       if (objc == 4) {
448           resourceRef = GetRsrcRefFromObj(objv[3], 1, 
449                     "list", resultPtr);
450     if (resourceRef == NULL) {
451         return TCL_ERROR;
452     } 
453 
454     saveRef = CurResFile();
455     UseResFile((short) resourceRef->fileRef);
456     limitSearch = true;
457       }
458 
459       Tcl_ResetResult(interp);
460       if (limitSearch) {
461     count = Count1Resources(rezType);
462       } else {
463     count = CountResources(rezType);
464       }
465       SetResLoad(false);
466       for (i = 1; i <= count; i++) {
467     if (limitSearch) {
468         resource = Get1IndResource(rezType, i);
469     } else {
470         resource = GetIndResource(rezType, i);
471     }
472     if (resource != NULL) {
473         GetResInfo(resource, &id, (ResType *) &rezType, theName);
474         if (theName[0] != 0) {
475             
476       objPtr = Tcl_NewStringObj((char *) theName + 1,
477         theName[0]);
478         } else {
479       objPtr = Tcl_NewIntObj(id);
480         }
481         ReleaseResource(resource);
482         result = Tcl_ListObjAppendElement(interp, resultPtr,
483           objPtr);
484         if (result != TCL_OK) {
485       Tcl_DecrRefCount(objPtr);
486       break;
487         }
488     }
489       }
490       SetResLoad(true);
491   
492       if (limitSearch) {
493     UseResFile(saveRef);
494       }
495   
496       return TCL_OK;
497   case RESOURCE_OPEN: {
498       Tcl_DString ds, buffer;
499       CONST char *str, *native;
500       int length;
501             
502       if (!((objc == 3) || (objc == 4))) {
503     Tcl_WrongNumArgs(interp, 2, objv, "fileName ?permissions?");
504     return TCL_ERROR;
505       }
506       str = Tcl_GetStringFromObj(objv[2], &length);
507       if (Tcl_TranslateFileName(interp, str, &buffer) == NULL) {
508           return TCL_ERROR;
509       }
510       native = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer),
511             Tcl_DStringLength(&buffer), &ds);
512       err = FSpLocationFromPath(Tcl_DStringLength(&ds), native, &fileSpec);
513       Tcl_DStringFree(&ds);
514       Tcl_DStringFree(&buffer);
515 
516       if (!((err == noErr) || (err == fnfErr))) {
517     Tcl_AppendStringsToObj(resultPtr, "invalid path", (char *) NULL);
518     return TCL_ERROR;
519       }
520 
521       /*
522        * Get permissions for the file.  We really only understand
523        * read-only and shared-read-write.  If no permissions are 
524        * given we default to read only.
525        */
526       
527       if (objc == 4) {
528     stringPtr = Tcl_GetStringFromObj(objv[3], &length);
529     mode = TclGetOpenMode(interp, stringPtr, &index);
530     if (mode == -1) {
531         /* TODO: TclGetOpenMode doesn't work with Obj commands. */
532         return TCL_ERROR;
533     }
534     switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
535         case O_RDONLY:
536       macPermision = fsRdPerm;
537         break;
538         case O_WRONLY:
539         case O_RDWR:
540       macPermision = fsRdWrShPerm;
541       break;
542         default:
543       panic("Tcl_ResourceObjCmd: invalid mode value");
544         break;
545     }
546       } else {
547     macPermision = fsRdPerm;
548       }
549       
550       /*
551        * Don't load in any of the resources in the file, this could 
552        * cause problems if you open a file that has CODE resources...
553        */
554        
555       SetResLoad(false); 
556       fileRef = (long) FSpOpenResFileCompat(&fileSpec, macPermision);
557       SetResLoad(true);
558       
559       if (fileRef == -1) {
560         err = ResError();
561     if (((err == fnfErr) || (err == eofErr)) &&
562       (macPermision == fsRdWrShPerm)) {
563         /*
564          * No resource fork existed for this file.  Since we are
565          * opening it for writing we will create the resource fork
566          * now.
567          */
568          
569         HCreateResFile(fileSpec.vRefNum, fileSpec.parID,
570           fileSpec.name);
571         fileRef = (long) FSpOpenResFileCompat(&fileSpec,
572           macPermision);
573         if (fileRef == -1) {
574       goto openError;
575         }
576     } else if (err == fnfErr) {
577         Tcl_AppendStringsToObj(resultPtr,
578       "file does not exist", (char *) NULL);
579         return TCL_ERROR;
580     } else if (err == eofErr) {
581         Tcl_AppendStringsToObj(resultPtr,
582       "file does not contain resource fork", (char *) NULL);
583         return TCL_ERROR;
584     } else {
585         openError:
586         Tcl_AppendStringsToObj(resultPtr,
587       "error opening resource file", (char *) NULL);
588         return TCL_ERROR;
589     }
590       }
591             
592             /*
593              * The FspOpenResFile function does not set the ResFileAttrs.
594              * Even if you open the file read only, the mapReadOnly
595              * attribute is not set.  This means we can't detect writes to a 
596              * read only resource fork until the write fails, which is bogus.  
597              * So set it here...
598              */
599             
600             if (macPermision == fsRdPerm) {
601                 SetResFileAttrs(fileRef, mapReadOnly);
602             }
603             
604             Tcl_SetStringObj(resultPtr, "", 0);
605             if (TclMacRegisterResourceFork(fileRef, resultPtr, 
606                     TCL_RESOURCE_CHECK_IF_OPEN) != TCL_OK) {
607                 CloseResFile(fileRef);
608     return TCL_ERROR;
609             }
610       return TCL_OK;
611   }
612   case RESOURCE_READ:     
613       if (!((objc == 4) || (objc == 5))) {
614     Tcl_WrongNumArgs(interp, 2, objv,
615       "resourceType resourceId ?resourceRef?");
616     return TCL_ERROR;
617       }
618 
619       if (Tcl_GetOSTypeFromObj(interp, objv[2], &rezType) != TCL_OK) {
620     return TCL_ERROR;
621       }
622       
623       if (Tcl_GetLongFromObj((Tcl_Interp *) NULL, objv[3], &rsrcId)
624         != TCL_OK) {
625     resourceId = Tcl_GetStringFromObj(objv[3], &length);
626             }
627 
628       if (objc == 5) {
629     stringPtr = Tcl_GetStringFromObj(objv[4], &length);
630       } else {
631     stringPtr = NULL;
632       }
633   
634       resource = Tcl_MacFindResource(interp, rezType, resourceId,
635     rsrcId, stringPtr, &releaseIt);
636           
637       if (resource != NULL) {
638     size = GetResourceSizeOnDisk(resource);
639     Tcl_SetByteArrayObj(resultPtr, (unsigned char *) *resource, size);
640 
641     /*
642      * Don't release the resource unless WE loaded it...
643      */
644      
645     if (releaseIt) {
646         ReleaseResource(resource);
647     }
648     return TCL_OK;
649       } else {
650     Tcl_AppendStringsToObj(resultPtr, "could not load resource",
651         (char *) NULL);
652     return TCL_ERROR;
653       }
654   case RESOURCE_TYPES:      
655       if (!((objc == 2) || (objc == 3))) {
656     Tcl_WrongNumArgs(interp, 2, objv, "?resourceRef?");
657     return TCL_ERROR;
658       }
659 
660       if (objc == 3) {
661           resourceRef = GetRsrcRefFromObj(objv[2], 1, 
662                     "get types of", resultPtr);
663     if (resourceRef == NULL) {
664         return TCL_ERROR;
665     }
666       
667     saveRef = CurResFile();
668     UseResFile((short) resourceRef->fileRef);
669     limitSearch = true;
670       }
671 
672       if (limitSearch) {
673     count = Count1Types();
674       } else {
675     count = CountTypes();
676       }
677       for (i = 1; i <= count; i++) {
678     if (limitSearch) {
679         Get1IndType((ResType *) &rezType, i);
680     } else {
681         GetIndType((ResType *) &rezType, i);
682     }
683     objPtr = Tcl_NewOSTypeObj(rezType);
684     result = Tcl_ListObjAppendElement(interp, resultPtr, objPtr);
685     if (result != TCL_OK) {
686         Tcl_DecrRefCount(objPtr);
687         break;
688     }
689       }
690     
691       if (limitSearch) {
692     UseResFile(saveRef);
693       }
694     
695       return result;
696   case RESOURCE_WRITE:      
697       if ((objc < 4) || (objc > 11)) {
698     Tcl_WrongNumArgs(interp, 2, objv, 
699     "?-id resourceId? ?-name resourceName? ?-file resourceRef?\
700  ?-force? resourceType data");
701     return TCL_ERROR;
702       }
703       
704       i = 2;
705       gotInt = false;
706       resourceId = NULL;
707       limitSearch = false;
708       force = 0;
709 
710       while (i < (objc - 2)) {
711     if (Tcl_GetIndexFromObj(interp, objv[i], writeSwitches,
712       "switch", 0, &index) != TCL_OK) {
713         return TCL_ERROR;
714     }
715 
716     switch (index) {
717         case RESOURCE_WRITE_ID:   
718       if (Tcl_GetLongFromObj(interp, objv[i+1], &rsrcId)
719         != TCL_OK) {
720           return TCL_ERROR;
721       }
722       gotInt = true;
723             i += 2;
724       break;
725         case RESOURCE_WRITE_NAME:   
726       resourceId = Tcl_GetStringFromObj(objv[i+1], &length);
727       strcpy((char *) theName, resourceId);
728       resourceId = (char *) theName;
729       c2pstr(resourceId);
730             i += 2;
731       break;
732         case RESOURCE_WRITE_FILE:   
733                   resourceRef = GetRsrcRefFromObj(objv[i+1], 0, 
734                             "write to", resultPtr);
735                         if (resourceRef == NULL) {
736                             return TCL_ERROR;
737             } 
738       limitSearch = true;
739             i += 2;
740       break;
741         case RESOURCE_FORCE:
742             force = 1;
743             i += 1;
744             break;
745     }
746       }
747       if (Tcl_GetOSTypeFromObj(interp, objv[i], &rezType) != TCL_OK) {
748     return TCL_ERROR;
749       }
750       stringPtr = (char *) Tcl_GetByteArrayFromObj(objv[i+1], &length);
751 
752       if (gotInt == false) {
753     rsrcId = UniqueID(rezType);
754       }
755       if (resourceId == NULL) {
756     resourceId = (char *) "\p";
757       }
758       if (limitSearch) {
759     saveRef = CurResFile();
760     UseResFile((short) resourceRef->fileRef);
761       }
762       
763       /*
764        * If we are adding the resource by number, then we must make sure
765        * there is not already a resource of that number.  We are not going
766        * load it here, since we want to detect whether we loaded it or
767        * not.  Remember that releasing some resources in particular menu
768        * related ones, can be fatal.
769        */
770        
771       if (gotInt == true) {
772           SetResLoad(false);
773           resource = Get1Resource(rezType,rsrcId);
774           SetResLoad(true);
775       }     
776             
777       if (resource == NULL) {
778           /*
779            * We get into this branch either if there was not already a
780            * resource of this type & id, or the id was not specified.
781            */
782            
783           resource = NewHandle(length);
784           if (resource == NULL) {
785               resource = NewHandleSys(length);
786               if (resource == NULL) {
787                   panic("could not allocate memory to write resource");
788               }
789           }
790           HLock(resource);
791           memcpy(*resource, stringPtr, length);
792           HUnlock(resource);
793           AddResource(resource, rezType, (short) rsrcId,
794         (StringPtr) resourceId);
795     releaseIt = 1;
796             } else {
797                 /* 
798                  * We got here because there was a resource of this type 
799                  * & ID in the file. 
800                  */ 
801                 
802                 if (*resource == NULL) {
803                     releaseIt = 1;
804                 } else {
805                     releaseIt = 0;
806                 }
807                
808                 if (!force) {
809                     /*
810                      *We only overwrite extant resources
811                      * when the -force flag has been set.
812                      */
813                      
814                     sprintf(errbuf,"%d", rsrcId);
815                   
816                     Tcl_AppendStringsToObj(resultPtr, "the resource ",
817                           errbuf, " already exists, use \"-force\"",
818                           " to overwrite it.", (char *) NULL);
819                     
820                     result = TCL_ERROR;
821                     goto writeDone;
822                 } else if (GetResAttrs(resource) & resProtected) {
823                     /*  
824                      *  
825                      * Next, check to see if it is protected...
826                      */
827                  
828                     sprintf(errbuf,"%d", rsrcId);
829                     Tcl_AppendStringsToObj(resultPtr,
830           "could not write resource id ",
831                             errbuf, " of type ",
832                             Tcl_GetStringFromObj(objv[i],&length),
833                             ", it was protected.",(char *) NULL);
834                     result = TCL_ERROR;
835                     goto writeDone;
836                 } else {
837                     /*
838                      * Be careful, the resource might already be in memory
839                      * if something else loaded it.
840                      */
841                      
842                     if (*resource == 0) {
843                       LoadResource(resource);
844                       err = ResError();
845                       if (err != noErr) {
846                             sprintf(errbuf,"%d", rsrcId);
847                             Tcl_AppendStringsToObj(resultPtr,
848             "error loading resource ",
849                                     errbuf, " of type ",
850                                     Tcl_GetStringFromObj(objv[i],&length),
851                                     " to overwrite it", (char *) NULL);
852                             goto writeDone;
853                       }
854                     }
855                      
856                     SetHandleSize(resource, length);
857                     if ( MemError() != noErr ) {
858                         panic("could not allocate memory to write resource");
859                     }
860 
861                     HLock(resource);
862               memcpy(*resource, stringPtr, length);
863               HUnlock(resource);
864              
865                     ChangedResource(resource);
866                 
867                     /*
868                      * We also may have changed the name...
869                      */ 
870                  
871                     SetResInfo(resource, rsrcId, (StringPtr) resourceId);
872                 }
873             }
874             
875       err = ResError();
876       if (err != noErr) {
877     Tcl_AppendStringsToObj(resultPtr,
878       "error adding resource to resource map",
879             (char *) NULL);
880     result = TCL_ERROR;
881     goto writeDone;
882       }
883       
884       WriteResource(resource);
885       err = ResError();
886       if (err != noErr) {
887     Tcl_AppendStringsToObj(resultPtr,
888       "error writing resource to disk",
889             (char *) NULL);
890     result = TCL_ERROR;
891       }
892       
893       writeDone:
894       
895       if (releaseIt) {
896           ReleaseResource(resource);
897           err = ResError();
898           if (err != noErr) {
899         Tcl_AppendStringsToObj(resultPtr,
900           "error releasing resource",
901                 (char *) NULL);
902         result = TCL_ERROR;
903           }
904       }
905       
906       if (limitSearch) {
907     UseResFile(saveRef);
908       }
909 
910       return result;
911   default:
912       panic("Tcl_GetIndexFromObj returned unrecognized option");
913       return TCL_ERROR; /* Should never be reached. */
914     }
915 }
void Tcl_SetOSTypeObj (Tcl_Obj * objPtr, OSType newOSType)

Definition at line 1593 of file tclMacResource.c.
References Tcl_ObjType::freeIntRepProc, Tcl_Obj::internalRep, Tcl_Obj::longValue, NULL, osType, osTypeInit, Tcl_InvalidateStringRep(), Tcl_RegisterObjType(), and Tcl_Obj::typePtr.1596 {
1597     register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
1598 
1599     if (!osTypeInit) {
1600   osTypeInit = 1;
1601   Tcl_RegisterObjType(&osType);
1602     }
1603 
1604     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
1605   oldTypePtr->freeIntRepProc(objPtr);
1606     }
1607     
1608     objPtr->internalRep.longValue = newOSType;
1609     objPtr->typePtr = &osType;
1610 
1611     Tcl_InvalidateStringRep(objPtr);
1612 }
int TclMacRegisterResourceFork (short fileRef, Tcl_Obj * tokenPtr, int flags)

Definition at line 1871 of file tclMacResource.c.
References ckalloc, OpenResourceFork::fileRef, OpenResourceFork::flags, initialized, nameTable, newId, NULL, panic, resourceForkList, ResourceInit(), resourceTable, Tcl_CreateHashEntry, TCL_ERROR, Tcl_FindHashEntry, Tcl_FirstHashEntry(), Tcl_GetHashKey, Tcl_GetHashValue, Tcl_GetStringFromObj(), Tcl_ListObjAppendElement(), Tcl_ListObjReplace(), Tcl_NextHashEntry(), TCL_OK, TCL_RESOURCE_CHECK_IF_OPEN, TCL_RESOURCE_INSERT_TAIL, Tcl_SetHashValue, and Tcl_SetStringObj().
Referenced by BuildResourceForkList(), OpenLibraryResource(), and Tcl_ResourceObjCmd().1878 {
1879     Tcl_HashEntry *resourceHashPtr;
1880     Tcl_HashEntry *nameHashPtr;
1881     OpenResourceFork *resourceRef;
1882     int new;
1883     char *resourceId = NULL;
1884    
1885     if (!initialized) {
1886         ResourceInit();
1887     }
1888     
1889     /*
1890      * If we were asked to, check that this file has not been opened
1891      * already with a different permission.  It it has, then return an error.
1892      */
1893      
1894     new = 1;
1895     
1896     if (flags & TCL_RESOURCE_CHECK_IF_OPEN) {
1897         Tcl_HashSearch search;
1898         short oldFileRef, filePermissionFlag;
1899         FCBPBRec newFileRec, oldFileRec;
1900         OSErr err;
1901         
1902         oldFileRec.ioCompletion = NULL;
1903         oldFileRec.ioFCBIndx = 0;
1904         oldFileRec.ioNamePtr = NULL;
1905         
1906         newFileRec.ioCompletion = NULL;
1907         newFileRec.ioFCBIndx = 0;
1908         newFileRec.ioNamePtr = NULL;
1909         newFileRec.ioVRefNum = 0;
1910         newFileRec.ioRefNum = fileRef;
1911         err = PBGetFCBInfo(&newFileRec, false);
1912         filePermissionFlag = ( newFileRec.ioFCBFlags >> 12 ) & 0x1;
1913             
1914         
1915         resourceHashPtr = Tcl_FirstHashEntry(&resourceTable, &search);
1916         while (resourceHashPtr != NULL) {
1917             oldFileRef = (short) Tcl_GetHashKey(&resourceTable,
1918                     resourceHashPtr);
1919             if (oldFileRef == fileRef) {
1920                 new = 0;
1921                 break;
1922             }
1923             oldFileRec.ioVRefNum = 0;
1924             oldFileRec.ioRefNum = oldFileRef;
1925             err = PBGetFCBInfo(&oldFileRec, false);
1926             
1927             /*
1928              * err might not be noErr either because the file has closed 
1929              * out from under us somehow, which is bad but we're not going
1930              * to fix it here, OR because it is the ROM MAP, which has a 
1931              * fileRef, but can't be gotten to by PBGetFCBInfo.
1932              */
1933             if ((err == noErr) 
1934                     && (newFileRec.ioFCBVRefNum == oldFileRec.ioFCBVRefNum)
1935                     && (newFileRec.ioFCBFlNm == oldFileRec.ioFCBFlNm)) {
1936                 /*
1937      * In MacOS 8.1 it seems like we get different file refs even
1938                  * though we pass the same file & permissions.  This is not
1939                  * what Inside Mac says should happen, but it does, so if it
1940                  * does, then close the new res file and return the original
1941                  * one...
1942      */
1943                  
1944                 if (filePermissionFlag == ((oldFileRec.ioFCBFlags >> 12) & 0x1)) {
1945                     CloseResFile(fileRef);
1946                     new = 0;
1947                     break;
1948                 } else {
1949                     if (tokenPtr != NULL) {
1950                         Tcl_SetStringObj(tokenPtr, "Resource already open with different permissions.", -1);
1951                     }     
1952                     return TCL_ERROR;
1953                 }
1954             }
1955             resourceHashPtr = Tcl_NextHashEntry(&search);
1956         }
1957     }
1958        
1959     
1960     /*
1961      * If the file has already been opened with these same permissions, then it
1962      * will be in our list and we will have set new to 0 above.
1963      * So we will just return the token (if tokenPtr is non-null)
1964      */
1965      
1966     if (new) {
1967         resourceHashPtr = Tcl_CreateHashEntry(&resourceTable,
1968     (char *) fileRef, &new);
1969     }
1970     
1971     if (!new) {
1972         if (tokenPtr != NULL) {   
1973             resourceId = (char *) Tcl_GetHashValue(resourceHashPtr);
1974       Tcl_SetStringObj(tokenPtr, resourceId, -1);
1975         }
1976         return TCL_OK;
1977     }        
1978 
1979     /*
1980      * If we were passed in a result pointer which is not an empty
1981      * string, attempt to use that as the key.  If the key already
1982      * exists, silently fall back on resource%d...
1983      */
1984      
1985     if (tokenPtr != NULL) {
1986         char *tokenVal;
1987         int length;
1988         tokenVal = Tcl_GetStringFromObj(tokenPtr, &length);
1989         if (length > 0) {
1990             nameHashPtr = Tcl_FindHashEntry(&nameTable, tokenVal);
1991             if (nameHashPtr == NULL) {
1992                 resourceId = ckalloc(length + 1);
1993                 memcpy(resourceId, tokenVal, length);
1994                 resourceId[length] = '\0';
1995             }
1996         }
1997     }
1998     
1999     if (resourceId == NULL) { 
2000         resourceId = (char *) ckalloc(15);
2001         sprintf(resourceId, "resource%d", newId);
2002     }
2003     
2004     Tcl_SetHashValue(resourceHashPtr, resourceId);
2005     newId++;
2006 
2007     nameHashPtr = Tcl_CreateHashEntry(&nameTable, resourceId, &new);
2008     if (!new) {
2009   panic("resource id has repeated itself");
2010     }
2011     
2012     resourceRef = (OpenResourceFork *) ckalloc(sizeof(OpenResourceFork));
2013     resourceRef->fileRef = fileRef;
2014     resourceRef->flags = flags;
2015     
2016     Tcl_SetHashValue(nameHashPtr, (ClientData) resourceRef);
2017     if (tokenPtr != NULL) {
2018         Tcl_SetStringObj(tokenPtr, resourceId, -1);
2019     }
2020     
2021     if (flags & TCL_RESOURCE_INSERT_TAIL) {
2022         Tcl_ListObjAppendElement(NULL, resourceForkList, tokenPtr);
2023     } else {
2024         Tcl_ListObjReplace(NULL, resourceForkList, 0, 0, 1, &tokenPtr); 
2025     }
2026     return TCL_OK;
2027 }
short TclMacUnRegisterResourceFork (char * tokenPtr, Tcl_Obj * resultPtr)

Definition at line 2048 of file tclMacResource.c.
References ckfree, OpenResourceFork::fileRef, OpenResourceFork::flags, memcmp(), nameTable, NULL, panic, resourceForkList, resourceTable, size_t(), Tcl_DeleteHashEntry(), Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_GetStringFromObj(), Tcl_ListObjGetElements(), Tcl_ListObjReplace(), and TCL_RESOURCE_DONT_CLOSE.
Referenced by CloseLibraryResource(), and Tcl_ResourceObjCmd().2052 {
2053     Tcl_HashEntry *resourceHashPtr;
2054     Tcl_HashEntry *nameHashPtr;
2055     OpenResourceFork *resourceRef;
2056     char *resourceId = NULL;
2057     short fileRef;
2058     char *bytes;
2059     int i, match, index, listLen, length, elemLen;
2060     Tcl_Obj **elemPtrs;
2061     
2062      
2063     nameHashPtr = Tcl_FindHashEntry(&nameTable, tokenPtr);
2064     if (nameHashPtr == NULL) {
2065         if (resultPtr != NULL) {
2066       Tcl_AppendStringsToObj(resultPtr,
2067         "invalid resource file reference \"",
2068         tokenPtr, "\"", (char *) NULL);
2069         }
2070   return -1;
2071     }
2072     
2073     resourceRef = (OpenResourceFork *) Tcl_GetHashValue(nameHashPtr);
2074     fileRef = resourceRef->fileRef;
2075         
2076     if ( resourceRef->flags & TCL_RESOURCE_DONT_CLOSE ) {
2077         if (resultPtr != NULL) {
2078       Tcl_AppendStringsToObj(resultPtr,
2079         "can't close \"", tokenPtr, "\" resource file", 
2080         (char *) NULL);
2081   }
2082   return -1;
2083     }            
2084 
2085     Tcl_DeleteHashEntry(nameHashPtr);
2086     ckfree((char *) resourceRef);
2087     
2088     
2089     /* 
2090      * Now remove the resource from the resourceForkList object 
2091      */
2092      
2093     Tcl_ListObjGetElements(NULL, resourceForkList, &listLen, &elemPtrs);
2094     
2095  
2096     index = -1;
2097     length = strlen(tokenPtr);
2098     
2099     for (i = 0; i < listLen; i++) {
2100   match = 0;
2101   bytes = Tcl_GetStringFromObj(elemPtrs[i], &elemLen);
2102   if (length == elemLen) {
2103     match = (memcmp(bytes, tokenPtr,
2104       (size_t) length) == 0);
2105   }
2106   if (match) {
2107       index = i;
2108       break;
2109   }
2110     }
2111     if (!match) {
2112         panic("the resource Fork List is out of synch!");
2113     }
2114     
2115     Tcl_ListObjReplace(NULL, resourceForkList, index, 1, 0, NULL);
2116     
2117     resourceHashPtr = Tcl_FindHashEntry(&resourceTable, (char *) fileRef);
2118     
2119     if (resourceHashPtr == NULL) {
2120   panic("Resource & Name tables are out of synch in resource command.");
2121     }
2122     ckfree(Tcl_GetHashValue(resourceHashPtr));
2123     Tcl_DeleteHashEntry(resourceHashPtr);
2124     
2125     return fileRef;
2126 
2127 }
static void UpdateStringOfOSType (register Tcl_Obj * objPtr) [static]

Definition at line 1767 of file tclMacResource.c.
References ckalloc.1769 {
1770     objPtr->bytes = ckalloc(5);
1771     sprintf(objPtr->bytes, "%-4.4s", &(objPtr->internalRep.longValue));
1772     objPtr->length = 4;
1773 }

Variable Documentation
int appResourceIndex [static]

Definition at line 72 of file tclMacResource.c.int initialized = 0 [static]

Definition at line 75 of file tclMacResource.c.Tcl_HashTable nameTable [static]

Definition at line 69 of file tclMacResource.c.
Referenced by GetRsrcRefFromObj(), ResourceInit(), Tcl_MacFindResource(), TclMacRegisterResourceFork(), and TclMacUnRegisterResourceFork().int newId = 0 [static]

Definition at line 74 of file tclMacResource.c.
Referenced by TclMacRegisterResourceFork().Tcl_ObjType osType [static]
Initial value: {
    "ostype",       
    (Tcl_FreeInternalRepProc *) NULL,   
    DupOSTypeInternalRep,         
    UpdateStringOfOSType,   
    SetOSTypeFromAny      
}
Definition at line 101 of file tclMacResource.c.
Referenced by DupOSTypeInternalRep(), SetOSTypeFromAny(), Tcl_GetOSTypeFromObj(), Tcl_NewOSTypeObj(), and Tcl_SetOSTypeObj().int osTypeInit = 0 [static]

Definition at line 77 of file tclMacResource.c.
Referenced by Tcl_GetOSTypeFromObj(), Tcl_NewOSTypeObj(), and Tcl_SetOSTypeObj().Tcl_Obj* resourceForkList [static]

Definition at line 71 of file tclMacResource.c.
Referenced by ResourceInit(), Tcl_ResourceObjCmd(), TclMacRegisterResourceFork(), and TclMacUnRegisterResourceFork().Tcl_HashTable resourceTable [static]

Definition at line 70 of file tclMacResource.c.
Referenced by ResourceInit(), TclMacRegisterResourceFork(), and TclMacUnRegisterResourceFork().

mac/tclMacSock.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include "tclMacInt.h"
#include <AddressXlation.h>
#include <Aliases.h>
#include <Devices.h>
#include <Errors.h>
#include <Events.h>
#include <Files.h>
#include <Gestalt.h>
#include <MacTCP.h>
#include <Processes.h>
#include <Strings.h>
Classes
struct PortInfo
struct TcpState
struct DNRState
struct SocketEvent
struct ThreadSpecificData
Defines
#define Debugger()
#define CHANNEL_BUF_SIZE  8192
#define TCP_ASYNC_SOCKET  (1<<0)
#define TCP_ASYNC_CONNECT  (1<<1)
#define TCP_CONNECTED  (1<<2)
#define TCP_PENDING  (1<<3)
#define TCP_LISTENING  (1<<4)
#define TCP_LISTEN_CONNECT  (1<<5)
#define TCP_REMOTE_CLOSED  (1<<6)
#define TCP_RELEASE  (1<<7)
#define TCP_WRITING  (1<<8)
#define TCP_SERVER_ZOMBIE  (1<<9)
#define gestaltMacTCPVersion  'mtcp'
Functions
static pascal void CleanUpExitProc _ANSI_ARGS_ ((void))
static void CloseCompletionRoutine _ANSI_ARGS_ ((TCPiopb *pb))
static TcpState *CreateSocket _ANSI_ARGS_ ((Tcl_Interp *interp, int port, CONST char *host, CONST char *myAddr, int myPort, int server, int async))
static pascal void DNRCompletionRoutine _ANSI_ARGS_ ((struct hostInfo *hostinfoPtr, DNRState *dnrStatePtr))
static void FreeSocketInfo _ANSI_ARGS_ ((TcpState *statePtr))
static OSErr GetHostFromString _ANSI_ARGS_ ((CONST char *name, ip_addr *address))
static OSErr GetLocalAddress _ANSI_ARGS_ ((unsigned long *addr))
static void InitMacTCPParamBlock _ANSI_ARGS_ ((TCPiopb *pBlock, int csCode))
static TcpState *NewSocketInfo _ANSI_ARGS_ ((StreamPtr stream))
static OSErr ResolveAddress _ANSI_ARGS_ ((ip_addr tcpAddress, Tcl_DString *dsPtr))
static void SocketCheckProc _ANSI_ARGS_ ((ClientData clientData, int flags))
static int SocketEventProc _ANSI_ARGS_ ((Tcl_Event *evPtr, int flags))
static void SocketFreeProc _ANSI_ARGS_ ((ClientData clientData))
static int TcpBlockMode _ANSI_ARGS_ ((ClientData instanceData, int mode))
static int TcpClose _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp))
static int TcpGetHandle _ANSI_ARGS_ ((ClientData instanceData, int direction, ClientData *handlePtr))
static int TcpGetOptionProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, Tcl_DString *dsPtr))
static int TcpInput _ANSI_ARGS_ ((ClientData instanceData, char *buf, int toRead, int *errorCodePtr))
static int TcpOutput _ANSI_ARGS_ ((ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr))
static int WaitForSocketEvent _ANSI_ARGS_ ((TcpState *infoPtr, int mask, int *errorCodePtr))
pascal void NotifyRoutine (StreamPtr tcpStream, unsigned short eventCode, Ptr userDataPtr, unsigned short terminReason, struct ICMPReport *icmpMsg)
static void InitSockets ()
void TclpFinalizeSockets ()
int TclpHasSockets (Tcl_Interp *interp)
static void SocketSetupProc (ClientData data, int flags)
static void SocketCheckProc (ClientData data, int flags)
static int SocketReady (TcpState *statePtr)
static void InitMacTCPParamBlock (TCPiopb *pBlock, int csCode)
static int TcpBlockMode (ClientData instanceData, int mode)
static int TcpClose (ClientData instanceData, Tcl_Interp *interp)
static void CloseCompletionRoutine (TCPiopb *pbPtr)
static void SocketFreeProc (ClientData clientData)
int TcpInput (ClientData instanceData, char *buf, int bufSize, int *errorCodePtr)
static int TcpGetHandle (ClientData instanceData, int direction, ClientData *handlePtr)
static int TcpOutput (ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr)
static int TcpGetOptionProc (ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, Tcl_DString *dsPtr)
static void TcpWatch (ClientData instanceData, int mask)
static TcpState * NewSocketInfo (StreamPtr tcpStream)
static void FreeSocketInfo (TcpState *statePtr)
Tcl_Channel Tcl_MakeTcpClientChannel (ClientData sock)
static TcpState * CreateSocket (Tcl_Interp *interp, int port, CONST char *host, CONST char *myaddr, int myport, int server, int async)
Tcl_Channel Tcl_OpenTcpClient (Tcl_Interp *interp, int port, CONST char *host, CONST char *myaddr, int myport, int async)
Tcl_Channel Tcl_OpenTcpServer (Tcl_Interp *interp, int port, CONST char *host, Tcl_TcpAcceptProc *acceptProc, ClientData acceptProcData)
static int SocketEventProc (Tcl_Event *evPtr, int flags)
static int WaitForSocketEvent (TcpState *statePtr, int mask, int *errorCodePtr)
static void TcpAccept (TcpState *statePtr)
CONST char * Tcl_GetHostName ()
static OSErr ResolveAddress (ip_addr tcpAddress, Tcl_DString *dsPtr)
static pascal void DNRCompletionRoutine (struct hostInfo *hostinfoPtr, DNRState *dnrStatePtr)
static pascal void CleanUpExitProc ()
static OSErr GetHostFromString (CONST char *name, ip_addr *address)
static void IOCompletionRoutine (TCPiopb *pbPtr)
static OSErr GetLocalAddress (unsigned long *addr)
static long GetBufferSize ()
int TclSockGetPort (Tcl_Interp *interp, char *string, char *proto, int *portPtr)
static void ClearZombieSockets ()
Variables
static int initialized = 0
static Tcl_ChannelType tcpChannelType
ResultUPP resultUPP = NULL
TCPIOCompletionUPP completeUPP = NULL
TCPIOCompletionUPP closeUPP = NULL
TCPNotifyUPP notifyUPP = NULL
static PortInfo portServices []
static Tcl_ThreadDataKey dataKey
static int socketsTestInited = false
static int hasSockets = false
static short driverRefNum = 0
static int socketNumber = 0
static int socketBufferSize = CHANNEL_BUF_SIZE
static ProcessSerialNumber applicationPSN

Define Documentation
#define CHANNEL_BUF_SIZE  8192

Definition at line 50 of file tclMacSock.c.
Referenced by GetBufferSize().#define Debugger()

Definition at line 43 of file tclMacSock.c.
Referenced by CloseCompletionRoutine(), CreateSocket(), DebuggerCmd(), IOCompletionRoutine(), SocketFreeProc(), TCL_VARARGS_DEF(), TcpAccept(), TcpClose(), TcpGetOptionProc(), and TcpInput().#define gestaltMacTCPVersion  'mtcp'

Definition at line 294 of file tclMacSock.c.
Referenced by InitSockets().#define TCP_ASYNC_CONNECT  (1<<1)

Definition at line 108 of file tclMacSock.c.
Referenced by CreateSocket(), IOCompletionRoutine(), TcpClose(), TcpGetOptionProc(), TcpInput(), TcpOutput(), WaitForConnect(), and WaitForSocketEvent().#define TCP_ASYNC_SOCKET  (1<<0)

Definition at line 107 of file tclMacSock.c.
Referenced by TcpBlockMode(), TcpBlockModeProc(), TcpInput(), TcpOutput(), WaitForConnect(), and WaitForSocketEvent().#define TCP_CONNECTED  (1<<2)

Definition at line 109 of file tclMacSock.c.
Referenced by CreateSocket(), IOCompletionRoutine(), SocketReady(), TcpAccept(), TcpClose(), and TcpGetOptionProc().#define TCP_LISTEN_CONNECT  (1<<5)

Definition at line 113 of file tclMacSock.c.
Referenced by IOCompletionRoutine(), SocketEventProc(), SocketReady(), TcpAccept(), and TcpClose().#define TCP_LISTENING  (1<<4)

Definition at line 111 of file tclMacSock.c.
Referenced by CreateSocket(), IOCompletionRoutine(), TcpAccept(), and TcpClose().#define TCP_PENDING  (1<<3)

Definition at line 110 of file tclMacSock.c.
Referenced by SocketCheckProc(), and SocketEventProc().#define TCP_RELEASE  (1<<7)

Definition at line 117 of file tclMacSock.c.
Referenced by ClearZombieSockets(), CloseCompletionRoutine(), IOCompletionRoutine(), SocketCheckProc(), SocketEventProc(), SocketFreeProc(), SocketSetupProc(), and TcpClose().#define TCP_REMOTE_CLOSED  (1<<6)

Definition at line 115 of file tclMacSock.c.
Referenced by CloseCompletionRoutine(), TcpInput(), and TcpOutput().#define TCP_SERVER_ZOMBIE  (1<<9)

Definition at line 119 of file tclMacSock.c.
Referenced by TcpAccept().#define TCP_WRITING  (1<<8)

Definition at line 118 of file tclMacSock.c.
Referenced by IOCompletionRoutine(), TcpClose(), TcpOutput(), and WaitForSocketEvent().
Function Documentation
static int WaitForSocketEvent _ANSI_ARGS_ ((TcpState *infoPtr, int mask, int *errorCodePtr)) [static]
static int TcpOutput _ANSI_ARGS_ ((ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr)) [static]
static int TcpInput _ANSI_ARGS_ ((ClientData instanceData, char *buf, int toRead, int *errorCodePtr)) [static]
static int TcpGetOptionProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, Tcl_DString *dsPtr)) [static]
static int TcpGetHandle _ANSI_ARGS_ ((ClientData instanceData, int direction, ClientData *handlePtr)) [static]
static int TcpClose _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp)) [static]
static int TcpBlockMode _ANSI_ARGS_ ((ClientData instanceData, int mode)) [static]
static void SocketFreeProc _ANSI_ARGS_ ((ClientData clientData)) [static]
static int SocketEventProc _ANSI_ARGS_ ((Tcl_Event *evPtr, int flags)) [static]
static void SocketCheckProc _ANSI_ARGS_ ((ClientData clientData, int flags)) [static]
static OSErr ResolveAddress _ANSI_ARGS_ ((ip_addr tcpAddress, Tcl_DString *dsPtr)) [static]
static TcpState* NewSocketInfo _ANSI_ARGS_ ((StreamPtr stream)) [static]
static void InitMacTCPParamBlock _ANSI_ARGS_ ((TCPiopb *pBlock, int csCode)) [static]
static OSErr GetLocalAddress _ANSI_ARGS_ ((unsigned long *addr)) [static]
static OSErr GetHostFromString _ANSI_ARGS_ ((CONST char *name, ip_addr *address)) [static]
static void FreeSocketInfo _ANSI_ARGS_ ((TcpState *statePtr)) [static]
static pascal void DNRCompletionRoutine _ANSI_ARGS_ ((struct hostInfo *hostinfoPtr, DNRState *dnrStatePtr)) [static]
static TcpState* CreateSocket _ANSI_ARGS_ ((Tcl_Interp *interp, int port, CONST char *host, CONST char *myAddr, int myPort, int server, int async)) [static]
static void CloseCompletionRoutine _ANSI_ARGS_ ((TCPiopb *pb)) [static]
static pascal void CleanUpExitProc _ANSI_ARGS_ ((void)) [static]
static pascal void CleanUpExitProc () [static]

Definition at line 2401 of file tclMacSock.c.
References NULL, ThreadSpecificData::socketList, and TCL_TSD_INIT.2402 {
2403     TCPiopb exitPB;
2404     TcpState *statePtr;
2405     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2406 
2407     while (tsdPtr->socketList != NULL) {
2408   statePtr = tsdPtr->socketList;
2409   tsdPtr->socketList = statePtr->nextPtr;
2410 
2411   /*
2412    * Close and Release the connection.
2413    */
2414 
2415   exitPB.ioCRefNum = driverRefNum;
2416   exitPB.csCode = TCPClose;
2417   exitPB.tcpStream = statePtr->tcpStream;
2418   exitPB.csParam.close.ulpTimeoutValue = 60 /* seconds */;
2419   exitPB.csParam.close.ulpTimeoutAction = 1 /* 1:abort 0:report */;
2420   exitPB.csParam.close.validityFlags = timeoutValue | timeoutAction;
2421   exitPB.ioCompletion = NULL; 
2422   PBControlSync((ParmBlkPtr) &exitPB);
2423 
2424   exitPB.ioCRefNum = driverRefNum;
2425   exitPB.csCode = TCPRelease;
2426   exitPB.tcpStream = statePtr->tcpStream;
2427   exitPB.ioCompletion = NULL; 
2428   PBControlSync((ParmBlkPtr) &exitPB);
2429     }
2430 }
static void ClearZombieSockets () [static]

Definition at line 2741 of file tclMacSock.c.
References NULL, SocketFreeProc(), ThreadSpecificData::socketList, TCL_TSD_INIT, and TCP_RELEASE.
Referenced by CreateSocket(), and TcpAccept().2742 {
2743     TcpState *statePtr;
2744     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2745 
2746     for (statePtr = tsdPtr->socketList; statePtr != NULL;
2747       statePtr = statePtr->nextPtr) {
2748   if (statePtr->flags & TCP_RELEASE) {
2749       SocketFreeProc(statePtr);
2750       return;
2751   }
2752     }
2753 }
static void CloseCompletionRoutine (TCPiopb * pbPtr) [static]

Definition at line 857 of file tclMacSock.c.
References Debugger, InitMacTCPParamBlock(), NULL, TCP_RELEASE, and TCP_REMOTE_CLOSED.
Referenced by InitSockets().859 {
860     TcpState *statePtr;
861     OSErr err;
862     
863     if (pbPtr->csCode == TCPClose) {
864   statePtr = (TcpState *) (pbPtr->csParam.close.userDataPtr);
865     } else {
866   statePtr = (TcpState *) (pbPtr->csParam.receive.userDataPtr);
867     }
868 
869     /*
870      * It's very bad if the statePtr is nNULL - we should probably panic...
871      */
872 
873     if (statePtr == NULL) {
874   Debugger();
875   return;
876     }
877     
878     WakeUpProcess(&statePtr->psn);
879 
880     /*
881      * If there is an error we assume the remote side has already
882      * close.  We are done closing as soon as we decide that the
883      * remote connection has closed.
884      */
885     
886     if (pbPtr->ioResult != noErr) {
887   statePtr->flags |= TCP_RELEASE;
888   return;
889     }
890     if (statePtr->flags & TCP_REMOTE_CLOSED) {
891   statePtr->flags |= TCP_RELEASE;
892   return;
893     }
894     
895     /*
896      * If we just did a recieve we need to return the buffers.
897      * Otherwise, attempt to recieve more data until we recieve an
898      * error (usually because we have no more data).
899      */
900 
901     if (statePtr->pb.csCode == TCPNoCopyRcv) {
902   InitMacTCPParamBlock(&statePtr->pb, TCPRcvBfrReturn);
903       statePtr->pb.tcpStream = statePtr->tcpStream;
904   statePtr->pb.ioCompletion = closeUPP; 
905   statePtr->pb.csParam.receive.rdsPtr = (Ptr) statePtr->rdsarray;
906       statePtr->pb.csParam.receive.userDataPtr = (Ptr) statePtr;
907   err = PBControlAsync((ParmBlkPtr) &statePtr->pb);
908     } else {
909   InitMacTCPParamBlock(&statePtr->pb, TCPNoCopyRcv);
910       statePtr->pb.tcpStream = statePtr->tcpStream;
911   statePtr->pb.ioCompletion = closeUPP; 
912   statePtr->pb.csParam.receive.commandTimeoutValue = 1;
913   statePtr->pb.csParam.receive.rdsPtr = (Ptr) statePtr->rdsarray;
914   statePtr->pb.csParam.receive.rdsLength = 5;
915       statePtr->pb.csParam.receive.userDataPtr = (Ptr) statePtr;
916   err = PBControlAsync((ParmBlkPtr) &statePtr->pb);
917     }
918 
919     if (err != noErr) {
920   statePtr->flags |= TCP_RELEASE;
921     }
922 }
static TcpState* CreateSocket (Tcl_Interp * interp, int port, CONST char * host, CONST char * myaddr, int myport, int server, int async) [static]

Definition at line 1678 of file tclMacSock.c.
References ckalloc, ckfree, ClearZombieSockets(), Debugger, EADDRINUSE, ECONNREFUSED, EHOSTUNREACH, EINPROGRESS, FreeSocketInfo(), GetHostFromString(), GetLocalAddress(), InitMacTCPParamBlock(), NewSocketInfo(), NULL, Tcl_PosixError(), Tcl_SetErrno(), TCP_ASYNC_CONNECT, TCP_CONNECTED, and TCP_LISTENING.
Referenced by Tcl_OpenTcpClient(), and Tcl_OpenTcpServer().1687 {
1688     ip_addr macAddr;
1689     OSErr err;
1690     TCPiopb pb;
1691     StreamPtr tcpStream;
1692     TcpState *statePtr;
1693     char * buffer;
1694     
1695     /*
1696      * Figure out the ip address from the host string.
1697      */
1698 
1699     if (host == NULL) {
1700   err = GetLocalAddress(&macAddr);
1701     } else {
1702   err = GetHostFromString(host, &macAddr);
1703     }
1704     if (err != noErr) {
1705   Tcl_SetErrno(EHOSTUNREACH);
1706   if (interp != (Tcl_Interp *) NULL) {
1707       Tcl_AppendResult(interp, "couldn't open socket: ",
1708                         Tcl_PosixError(interp), (char *) NULL);
1709   }
1710   return (TcpState *) NULL;
1711     }
1712     
1713     /*
1714      * Create a MacTCP stream and create the state used for socket
1715      * transactions from here on out.
1716      */
1717 
1718     ClearZombieSockets();
1719     buffer = ckalloc(socketBufferSize);
1720     InitMacTCPParamBlock(&pb, TCPCreate);
1721     pb.csParam.create.rcvBuff = buffer;
1722     pb.csParam.create.rcvBuffLen = socketBufferSize;
1723     pb.csParam.create.notifyProc = nil /* notifyUPP */;
1724     err = PBControlSync((ParmBlkPtr) &pb);
1725     if (err != noErr) {
1726         Tcl_SetErrno(0); /* TODO: set to ENOSR - maybe?*/
1727         if (interp != (Tcl_Interp *) NULL) {
1728       Tcl_AppendResult(interp, "couldn't open socket: ",
1729     Tcl_PosixError(interp), (char *) NULL);
1730         }
1731   return (TcpState *) NULL;
1732     }
1733 
1734     tcpStream = pb.tcpStream;
1735     statePtr = NewSocketInfo(tcpStream);
1736     statePtr->port = port;
1737     
1738     if (server) {
1739         /* 
1740          * Set up server connection.
1741          */
1742 
1743   InitMacTCPParamBlock(&statePtr->pb, TCPPassiveOpen);
1744   statePtr->pb.tcpStream = tcpStream;
1745   statePtr->pb.csParam.open.localPort = statePtr->port;
1746   statePtr->pb.ioCompletion = completeUPP; 
1747   statePtr->pb.csParam.open.userDataPtr = (Ptr) statePtr;
1748   statePtr->pb.csParam.open.ulpTimeoutValue = 100;
1749   statePtr->pb.csParam.open.ulpTimeoutAction  = 1 /* 1:abort 0:report */;
1750   statePtr->pb.csParam.open.commandTimeoutValue = 0 /* infinity */;
1751 
1752   statePtr->flags |= TCP_LISTENING;
1753   err = PBControlAsync((ParmBlkPtr) &(statePtr->pb));
1754 
1755   /*
1756    * If this is a server on port 0 then we need to wait until
1757    * the dynamic port allocation is made by the MacTcp driver.
1758    */
1759 
1760   if (statePtr->port == 0) {
1761       EventRecord dummy;
1762 
1763       while (statePtr->pb.csParam.open.localPort == 0) {
1764     WaitNextEvent(0, &dummy, 1, NULL);
1765     if (statePtr->pb.ioResult != 0) {
1766         break;
1767     }
1768       }
1769       statePtr->port = statePtr->pb.csParam.open.localPort;
1770   }
1771   Tcl_SetErrno(EINPROGRESS);
1772     } else {
1773   /*
1774    * Attempt to connect. The connect may fail at present with an
1775    * EINPROGRESS but at a later time it will complete. The caller
1776    * will set up a file handler on the socket if she is interested in
1777    * being informed when the connect completes.
1778    */
1779 
1780   InitMacTCPParamBlock(&statePtr->pb, TCPActiveOpen);
1781   
1782   statePtr->pb.tcpStream = tcpStream;
1783   statePtr->pb.csParam.open.remoteHost = macAddr;
1784   statePtr->pb.csParam.open.remotePort = port;
1785   statePtr->pb.csParam.open.localHost = 0;
1786   statePtr->pb.csParam.open.localPort = myport;
1787   statePtr->pb.csParam.open.userDataPtr = (Ptr) statePtr; 
1788   statePtr->pb.csParam.open.validityFlags   = timeoutValue | timeoutAction;
1789   statePtr->pb.csParam.open.ulpTimeoutValue   = 60 /* seconds */;
1790   statePtr->pb.csParam.open.ulpTimeoutAction  = 1 /* 1:abort 0:report */;
1791   statePtr->pb.csParam.open.commandTimeoutValue   = 0;
1792 
1793   statePtr->pb.ioCompletion = completeUPP;
1794   if (async) {
1795       statePtr->flags |= TCP_ASYNC_CONNECT;
1796       err = PBControlAsync((ParmBlkPtr) &(statePtr->pb));
1797       Tcl_SetErrno(EINPROGRESS);
1798   } else {
1799       err = PBControlSync((ParmBlkPtr) &(statePtr->pb));
1800   }
1801     }
1802     
1803     switch (err) {
1804   case noErr:
1805       if (!async) {
1806     statePtr->flags |= TCP_CONNECTED;
1807       }
1808       return statePtr;
1809   case duplicateSocket:
1810       Tcl_SetErrno(EADDRINUSE);
1811       break;
1812   case openFailed:
1813   case connectionTerminated:
1814       Tcl_SetErrno(ECONNREFUSED);
1815       break;
1816   case invalidStreamPtr:
1817   case connectionExists:
1818   default:
1819       /*
1820        * These cases should never occur.  However, we will fail
1821        * gracefully and hope Tcl can resume.  The alternative is to panic
1822        * which is probably a bit drastic.
1823        */
1824 
1825       Debugger();
1826       Tcl_SetErrno(err);
1827     }
1828 
1829     /*
1830      * We had error during the connection.  Release the stream
1831      * and file handle.  Also report to the interp.
1832      */
1833 
1834     pb.ioCRefNum = driverRefNum;
1835     pb.csCode = TCPRelease;
1836     pb.tcpStream = tcpStream;
1837     pb.ioCompletion = NULL; 
1838     err = PBControlSync((ParmBlkPtr) &pb);
1839 
1840     if (interp != (Tcl_Interp *) NULL) {
1841   Tcl_AppendResult(interp, "couldn't open socket: ",
1842       Tcl_PosixError(interp), (char *) NULL);
1843     }
1844 
1845     ckfree(buffer);
1846     FreeSocketInfo(statePtr);
1847     return (TcpState *) NULL;
1848 }
static pascal void DNRCompletionRoutine (struct hostInfo * hostinfoPtr, DNRState * dnrStatePtr) [static]

Definition at line 2374 of file tclMacSock.c.
References DNRState::done, and DNRState::psn.
Referenced by InitSockets().2377 {
2378     dnrStatePtr->done = true;
2379     WakeUpProcess(&(dnrStatePtr->psn));
2380 }
static void FreeSocketInfo (TcpState * statePtr) [static]

Definition at line 1597 of file tclMacSock.c.
References ckfree, TcpState::nextPtr, NULL, ThreadSpecificData::socketList, and TCL_TSD_INIT.
Referenced by CreateSocket(), SocketFreeProc(), and TcpClose().1599 {
1600     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1601 
1602     if (statePtr == tsdPtr->socketList) {
1603   tsdPtr->socketList = statePtr->nextPtr;
1604     } else {
1605   TcpState *p;
1606   for (p = tsdPtr->socketList; p != NULL; p = p->nextPtr) {
1607       if (p->nextPtr == statePtr) {
1608     p->nextPtr = statePtr->nextPtr;
1609     break;
1610       }
1611   }
1612     }
1613     
1614     if (statePtr->writeBuffer != (void *) NULL) {
1615         ckfree(statePtr->writeBuffer);
1616     }
1617     
1618     ckfree((char *) statePtr);
1619 }
static long GetBufferSize () [static]

Definition at line 2640 of file tclMacSock.c.
References CHANNEL_BUF_SIZE, and GetLocalAddress().
Referenced by InitSockets().2641 {
2642     UDPiopb iopb;
2643     OSErr err = noErr;
2644     long bufferSize;
2645   
2646     memset(&iopb, 0, sizeof(iopb));
2647     err = GetLocalAddress(&iopb.csParam.mtu.remoteHost);
2648     if (err != noErr) {
2649   return CHANNEL_BUF_SIZE;
2650     }
2651     iopb.ioCRefNum = driverRefNum;
2652     iopb.csCode = UDPMaxMTUSize;
2653     err = PBControlSync((ParmBlkPtr)&iopb);
2654     if (err != noErr) {
2655   return CHANNEL_BUF_SIZE;
2656     }
2657     bufferSize = (iopb.csParam.mtu.mtuSize * 4) + 1024;
2658     if (bufferSize < CHANNEL_BUF_SIZE) {
2659   bufferSize = CHANNEL_BUF_SIZE;
2660     }
2661     return bufferSize;
2662 }
static OSErr GetHostFromString (CONST char * name, ip_addr * address) [static]

Definition at line 2452 of file tclMacSock.c.
References DNRState::done, DNRState::hostInfo, NULL, DNRState::psn, TCL_OK, and TclpHasSockets().
Referenced by CreateSocket().2455 {
2456     OSErr err;
2457     int i;
2458     EventRecord dummy;
2459     DNRState dnrState;
2460   
2461     if (TclpHasSockets(NULL) != TCL_OK) {
2462   return 0;
2463     }
2464 
2465     /*
2466      * Call StrToAddr to get the ip number for the passed in domain
2467      * name.  The call is async, so we must wait for a callback to 
2468      * tell us when to continue.
2469      */
2470 
2471     for (i = 0; i < NUM_ALT_ADDRS; i++) {
2472   dnrState.hostInfo.addr[i] = 0;
2473     }
2474     dnrState.done = 0;
2475     GetCurrentProcess(&(dnrState.psn));
2476     err = StrToAddr((char*)name, &dnrState.hostInfo, resultUPP, (Ptr) &dnrState);
2477     if (err == cacheFault) {
2478   while (!dnrState.done) {
2479       WaitNextEvent(0, &dummy, 1, NULL);
2480   }
2481     }
2482     
2483     /*
2484      * For some reason MacTcp may return a cachFault a second time via
2485      * the hostinfo block.  This seems to be a bug in MacTcp.  In this case 
2486      * we run StrToAddr again - which seems to then work just fine.
2487      */
2488 
2489     if (dnrState.hostInfo.rtnCode == cacheFault) {
2490   dnrState.done = 0;
2491   err = StrToAddr((char*)name, &dnrState.hostInfo, resultUPP, (Ptr) &dnrState);
2492   if (err == cacheFault) {
2493       while (!dnrState.done) {
2494     WaitNextEvent(0, &dummy, 1, NULL);
2495       }
2496   }
2497     }
2498 
2499     if (dnrState.hostInfo.rtnCode == noErr) {
2500   *address = dnrState.hostInfo.addr[0];
2501     }
2502     
2503     return dnrState.hostInfo.rtnCode;
2504 }
static OSErr GetLocalAddress (unsigned long * addr) [static]

Definition at line 2595 of file tclMacSock.c.
Referenced by CreateSocket(), GetBufferSize(), and Tcl_GetHostName().2597 {
2598     struct GetAddrParamBlock pBlock;
2599     OSErr err = noErr;
2600     static unsigned long localAddress = 0;
2601 
2602     if (localAddress == 0) {
2603   memset(&pBlock, 0, sizeof(pBlock));
2604   pBlock.ioResult = 1;
2605   pBlock.csCode = ipctlGetAddr;
2606   pBlock.ioCRefNum = driverRefNum;
2607   err = PBControlSync((ParmBlkPtr) &pBlock);
2608 
2609   if (err != noErr) {
2610       return err;
2611   }
2612   localAddress = pBlock.ourAddress;
2613     }
2614     
2615     *addr = localAddress;
2616     return noErr;
2617 }
static void InitMacTCPParamBlock (TCPiopb * pBlock, int csCode) [static]

Definition at line 650 of file tclMacSock.c.
Referenced by CloseCompletionRoutine(), CreateSocket(), IOCompletionRoutine(), SocketFreeProc(), TcpAccept(), TcpClose(), TcpInput(), and TcpOutput().653 {
654     memset(pBlock, 0, sizeof(TCPiopb));
655     pBlock->ioResult = 1;
656     pBlock->ioCRefNum = driverRefNum;
657     pBlock->csCode = (short) csCode;
658 }
static void InitSockets () [static]

Definition at line 296 of file tclMacSock.c.
References CleanUpExitProc(), CloseCompletionRoutine(), DNRCompletionRoutine(), gestaltMacTCPVersion, GetBufferSize(), initialized, IOCompletionRoutine(), NotifyRoutine(), NULL, SocketCheckProc, ThreadSpecificData::socketList, SocketSetupProc, Tcl_CreateEventSource(), TCL_TSD_INIT, TclMacInstallExitToShellPatch(), and TclThreadDataKeyGet().
Referenced by Tcl_GetHostName(), TclpHasSockets(), and TcpThreadActionProc().297 {
298     ParamBlockRec pb; 
299     OSErr err;
300     long response;
301     ThreadSpecificData *tsdPtr;
302     
303     if (! initialized) {
304   /*
305    * Do process wide initialization.
306    */
307 
308   initialized = 1;
309       
310   if (Gestalt(gestaltMacTCPVersion, &response) == noErr) {
311       hasSockets = true;
312   } else {
313       hasSockets = false;
314   }
315     
316   if (!hasSockets) {
317       return;
318   }
319     
320   /*
321    * Load MacTcp driver and name server resolver.
322    */
323       
324         
325   pb.ioParam.ioCompletion = 0L; 
326   pb.ioParam.ioNamePtr = "\p.IPP"; 
327   pb.ioParam.ioPermssn = fsCurPerm; 
328   err = PBOpenSync(&pb); 
329   if (err != noErr) {
330       hasSockets = 0;
331       return;
332   }
333   driverRefNum = pb.ioParam.ioRefNum; 
334       
335   socketBufferSize = GetBufferSize();
336   err = OpenResolver(NULL);
337   if (err != noErr) {
338       hasSockets = 0;
339       return;
340   }
341     
342   GetCurrentProcess(&applicationPSN);
343   /*
344    * Create UPP's for various callback routines.
345    */
346     
347   resultUPP = NewResultProc(DNRCompletionRoutine);
348   completeUPP = NewTCPIOCompletionProc(IOCompletionRoutine);
349   closeUPP = NewTCPIOCompletionProc(CloseCompletionRoutine);
350   notifyUPP = NewTCPNotifyProc(NotifyRoutine);
351     
352   /*
353    * Install an ExitToShell patch.  We use this patch instead
354    * of the Tcl exit mechanism because we need to ensure that
355    * these routines are cleaned up even if we crash or are forced
356    * to quit.  There are some circumstances when the Tcl exit
357    * handlers may not fire.
358    */
359     
360   TclMacInstallExitToShellPatch(CleanUpExitProc);
361     }
362 
363     /*
364      * Do per-thread initialization.
365      */
366 
367     tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
368     if (tsdPtr == NULL) {
369   tsdPtr = TCL_TSD_INIT(&dataKey);
370   tsdPtr->socketList = NULL;
371   Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
372     }
373 }
static void IOCompletionRoutine (TCPiopb * pbPtr) [static]

Definition at line 2529 of file tclMacSock.c.
References Debugger, InitMacTCPParamBlock(), TCL_READABLE, TCL_WRITABLE, TCP_ASYNC_CONNECT, TCP_CONNECTED, TCP_LISTEN_CONNECT, TCP_LISTENING, TCP_RELEASE, and TCP_WRITING.
Referenced by InitSockets().2531 {
2532     TcpState *statePtr;
2533     
2534     if (pbPtr->csCode == TCPSend) {
2535       statePtr = (TcpState *) pbPtr->csParam.send.userDataPtr;
2536     } else {
2537   statePtr = (TcpState *) pbPtr->csParam.open.userDataPtr;
2538     }
2539     
2540     /*
2541      * Always wake the process in case it's in WaitNextEvent.
2542      * If an error has a occured - just return.  We will deal
2543      * with the problem later.
2544      */
2545 
2546     WakeUpProcess(&statePtr->psn);
2547     if (pbPtr->ioResult != noErr) {
2548   return;
2549     }
2550     
2551     if (statePtr->flags & TCP_ASYNC_CONNECT) {
2552   statePtr->flags &= ~TCP_ASYNC_CONNECT;
2553   statePtr->flags |= TCP_CONNECTED;
2554   statePtr->checkMask |= TCL_READABLE & TCL_WRITABLE;
2555     } else if (statePtr->flags & TCP_LISTENING) {
2556   if (statePtr->port == 0) {
2557       Debugger();
2558   }
2559   statePtr->flags &= ~TCP_LISTENING;
2560   statePtr->flags |= TCP_LISTEN_CONNECT;
2561   statePtr->checkMask |= TCL_READABLE;
2562     } else if (statePtr->flags & TCP_WRITING) {
2563   statePtr->flags &= ~TCP_WRITING;
2564   statePtr->checkMask |= TCL_WRITABLE;
2565   if (!(statePtr->flags & TCP_CONNECTED)) {
2566       InitMacTCPParamBlock(&statePtr->pb, TCPClose);
2567           statePtr->pb.tcpStream = statePtr->tcpStream;
2568           statePtr->pb.ioCompletion = closeUPP; 
2569           statePtr->pb.csParam.close.userDataPtr = (Ptr) statePtr;
2570           if (PBControlAsync((ParmBlkPtr) &statePtr->pb) != noErr) {
2571           statePtr->flags |= TCP_RELEASE;
2572           }
2573   }
2574     }
2575 }
static TcpState* NewSocketInfo (StreamPtr tcpStream) [static]

Definition at line 1558 of file tclMacSock.c.
References ckalloc, NULL, ThreadSpecificData::socketList, and TCL_TSD_INIT.
Referenced by CreateSocket(), Tcl_MakeTcpClientChannel(), and TcpAccept().1560 {
1561     TcpState *statePtr;
1562     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1563 
1564     statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
1565     statePtr->tcpStream = tcpStream;
1566     statePtr->psn = applicationPSN;
1567     statePtr->flags = 0;
1568     statePtr->checkMask = 0;
1569     statePtr->watchMask = 0;
1570     statePtr->acceptProc = (Tcl_TcpAcceptProc *) NULL;
1571     statePtr->acceptProcData = (ClientData) NULL;
1572     statePtr->writeBuffer = (void *) NULL;
1573     statePtr->writeBufferSize = 0;
1574     statePtr->nextPtr = tsdPtr->socketList;
1575     tsdPtr->socketList = statePtr;
1576     return statePtr;
1577 }
pascal void NotifyRoutine (StreamPtr tcpStream, unsigned short eventCode, Ptr userDataPtr, unsigned short terminReason, struct ICMPReport * icmpMsg)

Definition at line 2773 of file tclMacSock.c.
Referenced by InitSockets().2779 {
2780     StreamPtr localTcpStream;
2781     unsigned short localEventCode;
2782     unsigned short localTerminReason;
2783     struct ICMPReport localIcmpMsg;
2784 
2785     localTcpStream = tcpStream;
2786     localEventCode = eventCode;
2787     localTerminReason = terminReason;
2788     localIcmpMsg = *icmpMsg;
2789         
2790 }
static OSErr ResolveAddress (ip_addr tcpAddress, Tcl_DString * dsPtr) [static]

Definition at line 2311 of file tclMacSock.c.
References DNRState::done, DNRState::hostInfo, NULL, DNRState::psn, and Tcl_DStringAppend().
Referenced by Tcl_GetHostName(), and TcpGetOptionProc().2314 {
2315     int i;
2316     EventRecord dummy;
2317     DNRState dnrState;
2318     OSErr err;
2319 
2320     /*
2321      * Call AddrToName to resolve our ip address to our domain name.
2322      * The call is async, so we must wait for a callback to tell us
2323      * when to continue.
2324      */
2325 
2326      for (i = 0; i < NUM_ALT_ADDRS; i++) {
2327   dnrState.hostInfo.addr[i] = 0;
2328      }
2329     dnrState.done = 0;
2330     GetCurrentProcess(&(dnrState.psn));
2331     err = AddrToName(tcpAddress, &dnrState.hostInfo, resultUPP, (Ptr) &dnrState);
2332     if (err == cacheFault) {
2333   while (!dnrState.done) {
2334       WaitNextEvent(0, &dummy, 1, NULL);
2335   }
2336     }
2337     
2338     /*
2339      * If there is no error in finding the domain name we set the
2340      * result into the dynamic string.  We also work around a bug in
2341      * MacTcp where an extranious '.' may be found at the end of the name.
2342      */
2343 
2344     if (dnrState.hostInfo.rtnCode == noErr) {
2345   i = strlen(dnrState.hostInfo.cname) - 1;
2346   if (dnrState.hostInfo.cname[i] == '.') {
2347       dnrState.hostInfo.cname[i] = '\0';
2348   }
2349   Tcl_DStringAppend(dsPtr, dnrState.hostInfo.cname, -1);
2350     }
2351     
2352     return dnrState.hostInfo.rtnCode;
2353 }
static void SocketCheckProc (ClientData data, int flags) [static]

Definition at line 501 of file tclMacSock.c.
References ckalloc, SocketEvent::header, TcpState::nextPtr, NULL, Tcl_Event::proc, SocketEventProc, SocketFreeProc(), ThreadSpecificData::socketList, SocketReady(), SocketEvent::statePtr, TCL_FILE_EVENTS, TCL_QUEUE_TAIL, Tcl_QueueEvent(), TCL_TSD_INIT, TCP_PENDING, TCP_RELEASE, and SocketEvent::tcpStream.504 {
505     TcpState *statePtr;
506     SocketEvent *evPtr;
507     TcpState dummyState;
508     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
509 
510     if (!(flags & TCL_FILE_EVENTS)) {
511   return;
512     }
513     
514     /*
515      * Queue events for any ready sockets that don't already have events
516      * queued (caused by persistent states that won't generate WinSock
517      * events).
518      */
519 
520     for (statePtr = tsdPtr->socketList; statePtr != NULL;
521       statePtr = statePtr->nextPtr) {
522   /*
523    * Check to see if this socket is dead and needs to be cleaned
524    * up.  We use a dummy statePtr whose only valid field is the
525    * nextPtr to allow the loop to continue even if the element
526    * is deleted.
527    */
528 
529   if (statePtr->flags & TCP_RELEASE) {
530       if (!(statePtr->flags & TCP_PENDING)) {
531     dummyState.nextPtr = statePtr->nextPtr;
532     SocketFreeProc(statePtr);
533     statePtr = &dummyState;
534       }
535       continue;
536   }
537 
538   if (!(statePtr->flags & TCP_PENDING) && SocketReady(statePtr)) {
539       statePtr->flags |= TCP_PENDING;
540       evPtr = (SocketEvent *) ckalloc(sizeof(SocketEvent));
541       evPtr->header.proc = SocketEventProc;
542       evPtr->statePtr = statePtr;
543       evPtr->tcpStream = statePtr->tcpStream;
544       Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
545   }
546     }
547 }
static int SocketEventProc (Tcl_Event * evPtr, int flags) [static]

Definition at line 1980 of file tclMacSock.c.
References NULL, SocketFreeProc(), ThreadSpecificData::socketList, SocketEvent::statePtr, TCL_FILE_EVENTS, Tcl_NotifyChannel(), TCL_READABLE, TCL_TSD_INIT, TCP_LISTEN_CONNECT, TCP_PENDING, TCP_RELEASE, TcpAccept(), and SocketEvent::tcpStream.1984 {
1985     TcpState *statePtr;
1986     SocketEvent *eventPtr = (SocketEvent *) evPtr;
1987     int mask = 0;
1988     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1989 
1990     if (!(flags & TCL_FILE_EVENTS)) {
1991   return 0;
1992     }
1993 
1994     /*
1995      * Find the specified socket on the socket list.
1996      */
1997 
1998     for (statePtr = tsdPtr->socketList; statePtr != NULL;
1999       statePtr = statePtr->nextPtr) {
2000   if ((statePtr == eventPtr->statePtr) && 
2001     (statePtr->tcpStream == eventPtr->tcpStream)) {
2002       break;
2003   }
2004     }
2005 
2006     /*
2007      * Discard events that have gone stale.
2008      */
2009 
2010     if (!statePtr) {
2011   return 1;
2012     }
2013     statePtr->flags &= ~(TCP_PENDING);
2014     if (statePtr->flags & TCP_RELEASE) {
2015   SocketFreeProc(statePtr);
2016   return 1;
2017     }
2018 
2019 
2020     /*
2021      * Handle connection requests directly.
2022      */
2023 
2024     if (statePtr->flags & TCP_LISTEN_CONNECT) {
2025   if (statePtr->checkMask & TCL_READABLE) {
2026       TcpAccept(statePtr);
2027   }
2028   return 1;
2029     }
2030 
2031     /*
2032      * Mask off unwanted events then notify the channel.
2033      */
2034 
2035     mask = statePtr->checkMask & statePtr->watchMask;
2036     if (mask) {
2037   Tcl_NotifyChannel(statePtr->channel, mask);
2038     }
2039     return 1;
2040 }
static void SocketFreeProc (ClientData clientData) [static]

Definition at line 941 of file tclMacSock.c.
References ckfree, Debugger, FreeSocketInfo(), InitMacTCPParamBlock(), and TCP_RELEASE.
Referenced by ClearZombieSockets(), SocketCheckProc(), SocketEventProc(), and TcpClose().943 {
944     TcpState *statePtr = (TcpState *) clientData;
945     OSErr err;
946     TCPiopb statusPB;
947 
948     /*
949      * Get the status of this connection.  We need to do a
950      * few tests to see if it's OK to release the stream now.
951      */
952 
953     if (!(statePtr->flags & TCP_RELEASE)) {
954   return;
955     }
956     statusPB.ioCRefNum = driverRefNum;
957     statusPB.tcpStream = statePtr->tcpStream;
958     statusPB.csCode = TCPStatus;
959     err = PBControlSync((ParmBlkPtr) &statusPB);
960     if ((statusPB.csParam.status.connectionState == 0) ||
961   (statusPB.csParam.status.connectionState == 2)) {
962   /*
963    * If the conection state is 0 then this was a client
964    * connection and it's closed.  If it is 2 then this a
965    * server client and we may release it.  If it isn't
966    * one of those values then we return and we'll try to
967    * clean up later.
968    */
969 
970     } else {
971   return;
972     }
973     
974     /*
975      * The Close request is made async.  We know it's
976      * OK to release the socket when the TCP_RELEASE flag
977      * gets set.
978      */
979 
980     InitMacTCPParamBlock(&statePtr->pb, TCPRelease);
981     statePtr->pb.tcpStream = statePtr->tcpStream;
982     err = PBControlSync((ParmBlkPtr) &statePtr->pb);
983     if (err != noErr) {
984         Debugger(); /* Ignoreing leaves stranded stream.  Is there an
985            alternative?  */
986     }
987 
988     /*
989      * Free the buffer space used by the socket and the 
990      * actual socket state data structure.
991      */
992 
993     ckfree((char *) statePtr->pb.csParam.create.rcvBuff);
994     FreeSocketInfo(statePtr);
995 }
static int SocketReady (TcpState * statePtr) [static]

Definition at line 569 of file tclMacSock.c.
References TCL_READABLE, TCL_WRITABLE, TCP_CONNECTED, and TCP_LISTEN_CONNECT.
Referenced by SocketCheckProc(), and SocketSetupProc().571 {
572     TCPiopb statusPB;
573     int foundSomething = 0;
574     int didStatus = 0;
575     int amount;
576     OSErr err;
577 
578     if (statePtr->flags & TCP_LISTEN_CONNECT) {
579   foundSomething = 1;
580   statePtr->checkMask |= TCL_READABLE;
581     }
582     if (statePtr->watchMask & TCL_READABLE) {
583   if (statePtr->checkMask & TCL_READABLE) {
584       foundSomething = 1;
585   } else if (statePtr->flags & TCP_CONNECTED) {
586       statusPB.ioCRefNum = driverRefNum;
587       statusPB.tcpStream = statePtr->tcpStream;
588       statusPB.csCode = TCPStatus;
589       err = PBControlSync((ParmBlkPtr) &statusPB);
590       didStatus = 1;
591 
592       /*
593        * We make the fchannel readable if 1) we get an error,
594        * 2) there is more data available, or 3) we detect
595        * that a close from the remote connection has arrived.
596        */
597 
598       if ((err != noErr) ||
599         (statusPB.csParam.status.amtUnreadData > 0) ||
600         (statusPB.csParam.status.connectionState == 14)) {
601     statePtr->checkMask |= TCL_READABLE;
602     foundSomething = 1;
603       }
604   }
605     }
606     if (statePtr->watchMask & TCL_WRITABLE) {
607   if (statePtr->checkMask & TCL_WRITABLE) {
608       foundSomething = 1;
609   } else if (statePtr->flags & TCP_CONNECTED) {
610       if (!didStatus) {
611     statusPB.ioCRefNum = driverRefNum;
612     statusPB.tcpStream = statePtr->tcpStream;
613     statusPB.csCode = TCPStatus;
614     err = PBControlSync((ParmBlkPtr) &statusPB);
615       }
616 
617       /*
618        * If there is an error or there if there is room to
619        * send more data we make the channel writeable.
620        */
621 
622       amount = statusPB.csParam.status.sendWindow - 
623     statusPB.csParam.status.amtUnackedData;
624       if ((err != noErr) || (amount > 0)) {
625     statePtr->checkMask |= TCL_WRITABLE;
626     foundSomething = 1;
627       }
628   }
629     }
630     return foundSomething;
631 }
static void SocketSetupProc (ClientData data, int flags) [static]

Definition at line 455 of file tclMacSock.c.
References NULL, ThreadSpecificData::socketList, SocketReady(), TCL_FILE_EVENTS, Tcl_SetMaxBlockTime(), TCL_TSD_INIT, and TCP_RELEASE.458 {
459     TcpState *statePtr;
460     Tcl_Time blockTime = { 0, 0 };
461     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
462 
463     if (!(flags & TCL_FILE_EVENTS)) {
464   return;
465     }
466     
467     /*
468      * Check to see if there is a ready socket.  If so, poll.
469      */
470 
471     for (statePtr = tsdPtr->socketList; statePtr != NULL;
472       statePtr = statePtr->nextPtr) {
473   if (statePtr->flags & TCP_RELEASE) {
474       continue;
475   }
476   if (SocketReady(statePtr)) {
477       Tcl_SetMaxBlockTime(&blockTime);
478       break;
479   }
480     }
481 }
CONST char* Tcl_GetHostName ()

Definition at line 2253 of file tclMacSock.c.
References GetLocalAddress(), hostname, hostnameInited, NULL, ResolveAddress(), Tcl_DStringFree(), Tcl_DStringInit(), TCL_OK, and TclpHasSockets().
Referenced by InfoHostnameCmd().2254 {
2255     static int  hostnameInited = 0;
2256     static char hostname[255];
2257     ip_addr ourAddress;
2258     Tcl_DString dString;
2259     OSErr err;
2260     
2261     if (hostnameInited) {
2262         return hostname;
2263     }
2264     
2265     if (TclpHasSockets(NULL) == TCL_OK) {
2266   err = GetLocalAddress(&ourAddress);
2267   if (err == noErr) {
2268       /*
2269        * Search for the doman name and return it if found.  Otherwise, 
2270        * just print the IP number to a string and return that.
2271        */
2272 
2273       Tcl_DStringInit(&dString);
2274       err = ResolveAddress(ourAddress, &dString);
2275       if (err == noErr) {
2276     strcpy(hostname, dString.string);
2277       } else {
2278     sprintf(hostname, "%d.%d.%d.%d", ourAddress>>24, ourAddress>>16 & 0xff,
2279         ourAddress>>8 & 0xff, ourAddress & 0xff);
2280       }
2281       Tcl_DStringFree(&dString);
2282       
2283       hostnameInited = 1;
2284       return hostname;
2285   }
2286     }
2287 
2288     hostname[0] = '\0';
2289     hostnameInited = 1;
2290     return hostname;
2291 }
Tcl_Channel Tcl_MakeTcpClientChannel (ClientData sock)

Definition at line 1638 of file tclMacSock.c.
References NewSocketInfo(), NULL, Tcl_CreateChannel(), TCL_OK, TCL_READABLE, Tcl_SetChannelBufferSize(), Tcl_SetChannelOption(), TCL_WRITABLE, TclpHasSockets(), and tcpChannelType.1640 {
1641     TcpState *statePtr;
1642     char channelName[20];
1643 
1644     if (TclpHasSockets(NULL) != TCL_OK) {
1645   return NULL;
1646     }
1647   
1648     statePtr = NewSocketInfo((StreamPtr) sock);
1649     /* TODO: do we need to set the port??? */
1650     
1651     sprintf(channelName, "sock%d", socketNumber++);
1652     
1653     statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
1654             (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
1655     Tcl_SetChannelBufferSize(statePtr->channel, socketBufferSize);
1656     Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf");
1657     return statePtr->channel;
1658 }
Tcl_Channel Tcl_OpenTcpClient (Tcl_Interp * interp, int port, CONST char * host, CONST char * myaddr, int myport, int async)

Definition at line 1868 of file tclMacSock.c.
References CreateSocket(), NULL, Tcl_CreateChannel(), TCL_OK, TCL_READABLE, Tcl_SetChannelBufferSize(), Tcl_SetChannelOption(), TCL_WRITABLE, TclpHasSockets(), and tcpChannelType.
Referenced by Tcl_SocketObjCmd().1878 {
1879     TcpState *statePtr;
1880     char channelName[20];
1881 
1882     if (TclpHasSockets(interp) != TCL_OK) {
1883   return NULL;
1884     }
1885   
1886     /*
1887      * Create a new client socket and wrap it in a channel.
1888      */
1889 
1890     statePtr = CreateSocket(interp, port, host, myaddr, myport, 0, async);
1891     if (statePtr == NULL) {
1892   return NULL;
1893     }
1894     
1895     sprintf(channelName, "sock%d", socketNumber++);
1896 
1897     statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
1898             (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
1899     Tcl_SetChannelBufferSize(statePtr->channel, socketBufferSize);
1900     Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf");
1901     return statePtr->channel;
1902 }
Tcl_Channel Tcl_OpenTcpServer (Tcl_Interp * interp, int port, CONST char * host, Tcl_TcpAcceptProc * acceptProc, ClientData acceptProcData)

Definition at line 1921 of file tclMacSock.c.
References CreateSocket(), NULL, Tcl_CreateChannel(), TCL_OK, Tcl_SetChannelBufferSize(), Tcl_SetChannelOption(), TclpHasSockets(), and tcpChannelType.
Referenced by Tcl_SocketObjCmd().1929 {
1930     TcpState *statePtr;
1931     char channelName[20];
1932 
1933     if (TclpHasSockets(interp) != TCL_OK) {
1934   return NULL;
1935     }
1936 
1937     /*
1938      * Create a new client socket and wrap it in a channel.
1939      */
1940 
1941     statePtr = CreateSocket(interp, port, host, NULL, 0, 1, 1);
1942     if (statePtr == NULL) {
1943   return NULL;
1944     }
1945 
1946     statePtr->acceptProc = acceptProc;
1947     statePtr->acceptProcData = acceptProcData;
1948 
1949     sprintf(channelName, "sock%d", socketNumber++);
1950 
1951     statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
1952             (ClientData) statePtr, 0);
1953     Tcl_SetChannelBufferSize(statePtr->channel, socketBufferSize);
1954     Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf");
1955     return statePtr->channel;
1956 }
void TclpFinalizeSockets ()

Definition at line 392 of file tclMacSock.c.
References NULL, SocketCheckProc, SocketSetupProc, Tcl_DeleteEventSource(), and TclThreadDataKeyGet().
Referenced by InitSockets(), SocketExitHandler(), and TclFinalizeIOSubsystem().393 {
394     ThreadSpecificData *tsdPtr;
395 
396     tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
397     if (tsdPtr != NULL) {
398   Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
399     }
400 }
int TclpHasSockets (Tcl_Interp * interp)

Definition at line 422 of file tclMacSock.c.
References InitSockets(), NULL, TCL_ERROR, and TCL_OK.
Referenced by GetHostFromString(), Tcl_GetHostName(), Tcl_MakeTcpClientChannel(), Tcl_OpenTcpClient(), Tcl_OpenTcpServer(), and Tcl_SocketObjCmd().424 {
425     InitSockets();
426 
427     if (hasSockets) {
428   return TCL_OK;
429     }
430     if (interp != NULL) {
431   Tcl_AppendResult(interp, "sockets are not available on this system",
432     NULL);
433     }
434     return TCL_ERROR;
435 }
int TclSockGetPort (Tcl_Interp * interp, char * string, char * proto, int * portPtr)

Definition at line 2685 of file tclMacSock.c.
References PortInfo::name, NULL, portServices, TCL_ERROR, Tcl_GetInt(), and TCL_OK.2691 {
2692     PortInfo *portInfoPtr = NULL;
2693     
2694     if (Tcl_GetInt(interp, string, portPtr) == TCL_OK) {
2695   if (*portPtr > 0xFFFF) {
2696       Tcl_AppendResult(interp, "couldn't open socket: port number too high",
2697                 (char *) NULL);
2698       return TCL_ERROR;
2699   }
2700   if (*portPtr < 0) {
2701       Tcl_AppendResult(interp, "couldn't open socket: negative port number",
2702                 (char *) NULL);
2703       return TCL_ERROR;
2704   }
2705   return TCL_OK;
2706     }
2707     for (portInfoPtr = portServices; portInfoPtr->name != NULL; portInfoPtr++) {
2708   if (!strcmp(portInfoPtr->name, string)) {
2709       break;
2710   }
2711     }
2712     if (portInfoPtr != NULL && portInfoPtr->name != NULL) {
2713   *portPtr = portInfoPtr->port;
2714   Tcl_ResetResult(interp);
2715   return TCL_OK;
2716     }
2717     
2718     return TCL_ERROR;
2719 }
static void TcpAccept (TcpState * statePtr) [static]

Definition at line 2151 of file tclMacSock.c.
References TcpState::channel, ckalloc, ClearZombieSockets(), Debugger, TcpState::flags, InitMacTCPParamBlock(), NewSocketInfo(), NULL, Tcl_CreateChannel(), TCL_READABLE, Tcl_SetChannelBufferSize(), Tcl_SetChannelOption(), TCL_WRITABLE, TCP_CONNECTED, TCP_LISTEN_CONNECT, TCP_LISTENING, TCP_SERVER_ZOMBIE, tcpChannelType, and TcpState::tcpStream.
Referenced by SocketEventProc(), and Tcl_OpenTcpServer().2153 {
2154     TcpState *newStatePtr;
2155     StreamPtr tcpStream;
2156     char remoteHostname[255];
2157     OSErr err;
2158     ip_addr remoteAddress;
2159     long remotePort;
2160     char channelName[20];
2161     
2162     statePtr->flags &= ~TCP_LISTEN_CONNECT;
2163     statePtr->checkMask &= ~TCL_READABLE;
2164 
2165     /*
2166      * Transfer sever stream to new connection.
2167      */
2168 
2169     tcpStream = statePtr->tcpStream;
2170     newStatePtr = NewSocketInfo(tcpStream);
2171     newStatePtr->tcpStream = tcpStream;
2172     sprintf(channelName, "sock%d", socketNumber++);
2173 
2174 
2175     newStatePtr->flags |= TCP_CONNECTED;
2176     newStatePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
2177             (ClientData) newStatePtr, (TCL_READABLE | TCL_WRITABLE));
2178     Tcl_SetChannelBufferSize(newStatePtr->channel, socketBufferSize);
2179     Tcl_SetChannelOption(NULL, newStatePtr->channel, "-translation",
2180       "auto crlf");
2181 
2182     remoteAddress = statePtr->pb.csParam.open.remoteHost;
2183     remotePort = statePtr->pb.csParam.open.remotePort;
2184 
2185     /*
2186      * Reopen passive connect.  Make new tcpStream the server.
2187      */
2188 
2189     ClearZombieSockets();
2190     InitMacTCPParamBlock(&statePtr->pb, TCPCreate);
2191     statePtr->pb.csParam.create.rcvBuff = ckalloc(socketBufferSize);
2192     statePtr->pb.csParam.create.rcvBuffLen = socketBufferSize;
2193     err = PBControlSync((ParmBlkPtr) &statePtr->pb);
2194     if (err != noErr) {
2195   /* 
2196    * Hmmm...  We can't reopen the server.  We'll go ahead
2197    * an continue - but we are kind of broken now...
2198    */
2199    Debugger();
2200    statePtr->tcpStream = -1;
2201    statePtr->flags |= TCP_SERVER_ZOMBIE;
2202     }
2203 
2204     tcpStream = statePtr->tcpStream = statePtr->pb.tcpStream;
2205     
2206     InitMacTCPParamBlock(&statePtr->pb, TCPPassiveOpen);
2207     statePtr->pb.tcpStream = tcpStream;
2208     statePtr->pb.csParam.open.localHost = 0;
2209     statePtr->pb.csParam.open.localPort = statePtr->port;
2210     statePtr->pb.ioCompletion = completeUPP; 
2211     statePtr->pb.csParam.open.userDataPtr = (Ptr) statePtr;
2212     statePtr->flags |= TCP_LISTENING;
2213     err = PBControlAsync((ParmBlkPtr) &(statePtr->pb));
2214     /*
2215      * TODO: deal with case where we can't recreate server socket...
2216      */
2217 
2218     /*
2219      * Finally we run the accept procedure.  We must do this last to make
2220      * sure we are in a nice clean state.  This Tcl code can do anything
2221      * including closing the server or client sockets we've just delt with.
2222      */
2223 
2224     if (statePtr->acceptProc != NULL) {
2225   sprintf(remoteHostname, "%d.%d.%d.%d", remoteAddress>>24,
2226     remoteAddress>>16 & 0xff, remoteAddress>>8 & 0xff,
2227     remoteAddress & 0xff);
2228     
2229   (statePtr->acceptProc)(statePtr->acceptProcData, newStatePtr->channel, 
2230       remoteHostname, remotePort);
2231     }
2232 }
static int TcpBlockMode (ClientData instanceData, int mode) [static]

Definition at line 677 of file tclMacSock.c.
References TCL_MODE_BLOCKING, and TCP_ASYNC_SOCKET.680 {
681     TcpState *statePtr = (TcpState *) instanceData;
682     
683     if (mode == TCL_MODE_BLOCKING) {
684   statePtr->flags &= ~TCP_ASYNC_SOCKET;
685     } else {
686   statePtr->flags |= TCP_ASYNC_SOCKET;
687     }
688     return 0;
689 }
static int TcpClose (ClientData instanceData, Tcl_Interp * interp) [static]

Definition at line 708 of file tclMacSock.c.
References ckfree, Debugger, FreeSocketInfo(), InitMacTCPParamBlock(), NULL, panic, SocketFreeProc(), TCP_ASYNC_CONNECT, TCP_CONNECTED, TCP_LISTEN_CONNECT, TCP_LISTENING, TCP_RELEASE, and TCP_WRITING.711 {
712     TcpState *statePtr = (TcpState *) instanceData;
713     StreamPtr tcpStream;
714     TCPiopb closePB;
715     OSErr err;
716 
717     tcpStream = statePtr->tcpStream;
718     statePtr->flags &= ~TCP_CONNECTED;
719     
720     /*
721      * If this is a server socket we can't use the statePtr
722      * param block because it is in use.  However, we can 
723      * close syncronously.
724      */
725 
726     if ((statePtr->flags & TCP_LISTENING) ||
727       (statePtr->flags & TCP_LISTEN_CONNECT)) {
728   InitMacTCPParamBlock(&closePB, TCPClose);
729       closePB.tcpStream = tcpStream;
730       closePB.ioCompletion = NULL; 
731   closePB.csParam.close.ulpTimeoutValue = 60 /* seconds */;
732   closePB.csParam.close.ulpTimeoutAction = 1 /* 1:abort 0:report */;
733   closePB.csParam.close.validityFlags = timeoutValue | timeoutAction;
734       err = PBControlSync((ParmBlkPtr) &closePB);
735       if (err != noErr) {
736           Debugger();
737           goto afterRelease;
738             /* panic("error closing server socket"); */
739       }
740   statePtr->flags |= TCP_RELEASE;
741 
742   /*
743    * Server sockets are closed sync.  Therefor, we know it is OK to
744    * release the socket now.
745    */
746 
747   InitMacTCPParamBlock(&statePtr->pb, TCPRelease);
748   statePtr->pb.tcpStream = statePtr->tcpStream;
749   err = PBControlSync((ParmBlkPtr) &statePtr->pb);
750   if (err != noErr) {
751             panic("error releasing server socket");
752   }
753 
754   /*
755    * Free the buffer space used by the socket and the 
756    * actual socket state data structure.
757    */
758       afterRelease:
759         
760         /*
761          * Have to check whether the pointer is NULL, since we could get here
762          * on a failed socket open, and then the rcvBuff would never have been
763          * allocated.
764          */
765          
766         if (err == noErr) {
767       ckfree((char *) statePtr->pb.csParam.create.rcvBuff);
768   }
769   FreeSocketInfo(statePtr);
770   return 0;
771     }
772 
773     /*
774      * If this socket is in the midddle on async connect we can just
775      * abort the connect and release the stream right now.
776      */
777  
778     if (statePtr->flags & TCP_ASYNC_CONNECT) {
779   InitMacTCPParamBlock(&closePB, TCPClose);
780       closePB.tcpStream = tcpStream;
781       closePB.ioCompletion = NULL; 
782       err = PBControlSync((ParmBlkPtr) &closePB);
783       if (err == noErr) {
784       statePtr->flags |= TCP_RELEASE;
785 
786       InitMacTCPParamBlock(&closePB, TCPRelease);
787           closePB.tcpStream = tcpStream;
788           closePB.ioCompletion = NULL; 
789 
790       err = PBControlSync((ParmBlkPtr) &closePB);
791   }
792 
793   /*
794    * Free the buffer space used by the socket and the 
795    * actual socket state data structure.  However, if the
796    * RELEASE returns an error, then the rcvBuff is usually
797    * bad, so we can't release it.  I think this means we will
798    * leak the buffer, so in the future, we may want to track the
799    * buffers separately, and nuke them on our own (or just not
800    * use MacTCP!).
801    */
802 
803         if (err == noErr) {
804       ckfree((char *) closePB.csParam.create.rcvBuff);
805   }
806   
807   FreeSocketInfo(statePtr);
808   return err;
809     }
810 
811     /*
812      * Client sockets:
813      * If a background write is in progress, don't close
814      * the socket yet.  The completion routine for the 
815      * write will take care of it.
816      */
817     
818     if (!(statePtr->flags & TCP_WRITING)) {
819   InitMacTCPParamBlock(&statePtr->pb, TCPClose);
820       statePtr->pb.tcpStream = tcpStream;
821       statePtr->pb.ioCompletion = closeUPP; 
822       statePtr->pb.csParam.close.userDataPtr = (Ptr) statePtr;
823       err = PBControlAsync((ParmBlkPtr) &statePtr->pb);
824       if (err != noErr) {
825       Debugger();
826       statePtr->flags |= TCP_RELEASE;
827             /* return 0; */
828       }
829     }
830 
831     SocketFreeProc(instanceData);
832     return 0;
833 }
static int TcpGetHandle (ClientData instanceData, int direction, ClientData * handlePtr) [static]

Definition at line 1170 of file tclMacSock.c.
References TCL_OK.1174 {
1175     TcpState *statePtr = (TcpState *) instanceData;
1176 
1177     *handlePtr = (ClientData) statePtr->tcpStream;
1178     return TCL_OK;
1179 }
static int TcpGetOptionProc (ClientData instanceData, Tcl_Interp * interp, CONST char * optionName, Tcl_DString * dsPtr) [static]

Definition at line 1344 of file tclMacSock.c.
References CONST, Debugger, NULL, ResolveAddress(), size_t(), Tcl_DString::string, Tcl_BadChannelOption(), Tcl_DStringAppend(), Tcl_DStringAppendElement(), Tcl_DStringEndSublist(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringSetLength(), Tcl_DStringStartSublist(), TCL_ERROR, TCL_OK, TCL_WRITABLE, TCP_ASYNC_CONNECT, TCP_CONNECTED, and WaitForSocketEvent().1353 {
1354     TcpState *statePtr = (TcpState *) instanceData;
1355     int doPeerName = false, doSockName = false, doError = false, doAll = false;
1356     ip_addr tcpAddress;
1357     char buffer[128];
1358     OSErr err;
1359     Tcl_DString dString;
1360     TCPiopb statusPB;
1361     int errorCode;
1362     size_t len = 0;
1363 
1364     /*
1365      * If an asynchronous connect is in progress, attempt to wait for it
1366      * to complete before accessing the socket state.
1367      */
1368     
1369     if ((statePtr->flags & TCP_ASYNC_CONNECT)
1370       && ! WaitForSocketEvent(statePtr, TCL_WRITABLE, &errorCode)) {
1371   if (interp) {
1372       /*
1373        * fix the error message.
1374        */
1375 
1376       Tcl_AppendResult(interp, "connect is in progress and can't wait",
1377           NULL);
1378   }
1379   return TCL_ERROR;
1380     }
1381             
1382     /*
1383      * Determine which options we need to do.  Do all of them
1384      * if optionName is NULL.
1385      */
1386 
1387     if (optionName == (CONST char *) NULL || optionName[0] == '\0') {
1388         doAll = true;
1389     } else {
1390   len = strlen(optionName);
1391   if (!strncmp(optionName, "-peername", len)) {
1392       doPeerName = true;
1393   } else if (!strncmp(optionName, "-sockname", len)) {
1394       doSockName = true;
1395   } else if (!strncmp(optionName, "-error", len)) {
1396       /* SF Bug #483575 */
1397       doError = true;
1398   } else {
1399       return Tcl_BadChannelOption(interp, optionName, 
1400             "error peername sockname");
1401   }
1402     }
1403 
1404     /*
1405      * SF Bug #483575
1406      *
1407      * Return error information. Currently we ignore
1408      * this option. IOW, we always return the empty
1409      * string, signaling 'no error'.
1410      *
1411      * FIXME: Get a mac/socket expert to write a correct
1412      * FIXME: implementation.
1413      */
1414 
1415     if (doAll || doError) {
1416   if (doAll) {
1417       Tcl_DStringAppendElement(dsPtr, "-error");
1418       Tcl_DStringAppendElement(dsPtr, "");
1419   } else {
1420       Tcl_DStringAppend (dsPtr, "", -1);
1421       return TCL_OK;
1422   }
1423     }
1424 
1425     /*
1426      * Get status on the stream.  Make sure to use a new pb struct because
1427      * the struct in the statePtr may be part of an asyncronous call.
1428      */
1429 
1430     statusPB.ioCRefNum = driverRefNum;
1431     statusPB.tcpStream = statePtr->tcpStream;
1432     statusPB.csCode = TCPStatus;
1433     err = PBControlSync((ParmBlkPtr) &statusPB);
1434     if ((err == connectionDoesntExist) ||
1435   ((err == noErr) && (statusPB.csParam.status.connectionState == 14))) {
1436   /*
1437    * The socket was probably closed on the other side of the connection.
1438    */
1439 
1440   if (interp) {
1441       Tcl_AppendResult(interp, "can't access socket info: ",
1442            "connection reset by peer", NULL);
1443   }
1444   return TCL_ERROR;
1445     } else if (err != noErr) {
1446   if (interp) { 
1447       Tcl_AppendResult(interp, "unknown socket error", NULL);
1448   }
1449   Debugger();
1450   return TCL_ERROR;
1451     }
1452 
1453 
1454     /*
1455      * Get the sockname for the socket.
1456      */
1457 
1458     Tcl_DStringInit(&dString);
1459     if (doAll || doSockName) {
1460   if (doAll) {
1461       Tcl_DStringAppendElement(dsPtr, "-sockname");
1462       Tcl_DStringStartSublist(dsPtr);
1463   }
1464   tcpAddress = statusPB.csParam.status.localHost;
1465   sprintf(buffer, "%d.%d.%d.%d", tcpAddress>>24,
1466     tcpAddress>>16 & 0xff, tcpAddress>>8 & 0xff,
1467     tcpAddress & 0xff);
1468   Tcl_DStringAppendElement(dsPtr, buffer);
1469   if (ResolveAddress(tcpAddress, &dString) == noErr) {
1470       Tcl_DStringAppendElement(dsPtr, dString.string);
1471   } else {
1472       Tcl_DStringAppendElement(dsPtr, "<unknown>");
1473   }
1474   sprintf(buffer, "%d", statusPB.csParam.status.localPort);
1475   Tcl_DStringAppendElement(dsPtr, buffer);
1476   if (doAll) {
1477       Tcl_DStringEndSublist(dsPtr);
1478   }
1479     }
1480 
1481     /*
1482      * Get the peername for the socket.
1483      */
1484 
1485     if ((doAll || doPeerName) && (statePtr->flags & TCP_CONNECTED)) {
1486   if (doAll) {
1487       Tcl_DStringAppendElement(dsPtr, "-peername");
1488       Tcl_DStringStartSublist(dsPtr);
1489   }
1490   tcpAddress = statusPB.csParam.status.remoteHost;
1491   sprintf(buffer, "%d.%d.%d.%d", tcpAddress>>24,
1492     tcpAddress>>16 & 0xff, tcpAddress>>8 & 0xff,
1493     tcpAddress & 0xff);
1494   Tcl_DStringAppendElement(dsPtr, buffer);
1495   Tcl_DStringSetLength(&dString, 0);
1496   if (ResolveAddress(tcpAddress, &dString) == noErr) {
1497       Tcl_DStringAppendElement(dsPtr, dString.string);
1498   } else {
1499       Tcl_DStringAppendElement(dsPtr, "<unknown>");
1500   }
1501   sprintf(buffer, "%d", statusPB.csParam.status.remotePort);
1502   Tcl_DStringAppendElement(dsPtr, buffer);
1503   if (doAll) {
1504       Tcl_DStringEndSublist(dsPtr);
1505   }
1506     }
1507 
1508     Tcl_DStringFree(&dString);
1509     return TCL_OK;
1510 }
int TcpInput (ClientData instanceData, char * buf, int bufSize, int * errorCodePtr)

Definition at line 1018 of file tclMacSock.c.
References Debugger, EINVAL, ENOTCONN, errno, ESHUTDOWN, EWOULDBLOCK, InitMacTCPParamBlock(), TCL_READABLE, TCP_ASYNC_CONNECT, TCP_ASYNC_SOCKET, TCP_REMOTE_CLOSED, and WaitForSocketEvent().1024 {
1025     TcpState *statePtr = (TcpState *) instanceData;
1026     StreamPtr tcpStream;
1027     OSErr err;
1028     TCPiopb statusPB;
1029     int toRead, dataAvail;
1030 
1031     *errorCodePtr = 0;
1032     errno = 0;
1033     tcpStream = statePtr->tcpStream;
1034 
1035     if (bufSize == 0) {
1036         return 0;
1037     }
1038     toRead = bufSize;
1039 
1040     /*
1041      * First check to see if EOF was already detected, to prevent
1042      * calling the socket stack after the first time EOF is detected.
1043      */
1044 
1045     if (statePtr->flags & TCP_REMOTE_CLOSED) {
1046   return 0;
1047     }
1048 
1049     /*
1050      * If an asynchronous connect is in progress, attempt to wait for it
1051      * to complete before reading.
1052      */
1053     
1054     if ((statePtr->flags & TCP_ASYNC_CONNECT)
1055       && ! WaitForSocketEvent(statePtr, TCL_READABLE, errorCodePtr)) {
1056   return -1;
1057     }
1058 
1059     /*
1060      * No EOF, and it is connected, so try to read more from the socket.
1061      * If the socket is blocking, we keep trying until there is data
1062      * available or the socket is closed.
1063      */
1064 
1065     while (1) {
1066 
1067   statusPB.ioCRefNum = driverRefNum;
1068   statusPB.tcpStream = tcpStream;
1069   statusPB.csCode = TCPStatus;
1070   err = PBControlSync((ParmBlkPtr) &statusPB);
1071   if (err != noErr) {
1072       Debugger();
1073       statePtr->flags |= TCP_REMOTE_CLOSED;
1074       return 0; /* EOF */
1075   }
1076   dataAvail = statusPB.csParam.status.amtUnreadData;
1077   if (dataAvail < bufSize) {
1078       toRead = dataAvail;
1079   } else {
1080       toRead = bufSize;
1081   }
1082   if (toRead != 0) {
1083       /*
1084        * Try to read the data.
1085        */
1086       
1087       InitMacTCPParamBlock(&statusPB, TCPRcv);
1088       statusPB.tcpStream = tcpStream;
1089       statusPB.csParam.receive.rcvBuff = buf;
1090       statusPB.csParam.receive.rcvBuffLen = toRead;
1091       err = PBControlSync((ParmBlkPtr) &statusPB);
1092 
1093       statePtr->checkMask &= ~TCL_READABLE;
1094       switch (err) {
1095     case noErr:
1096         /*
1097          * The channel remains readable only if this read succeds
1098          * and we had more data then the size of the buffer we were
1099          * trying to fill.  Use the info from the call to status to
1100          * determine this.
1101          */
1102 
1103         if (dataAvail > bufSize) {
1104       statePtr->checkMask |= TCL_READABLE;
1105         }
1106         return statusPB.csParam.receive.rcvBuffLen;
1107     case connectionClosing:
1108         *errorCodePtr = errno = ESHUTDOWN;
1109         statePtr->flags |= TCP_REMOTE_CLOSED;
1110         return 0;
1111     case connectionDoesntExist:
1112     case connectionTerminated:
1113         *errorCodePtr = errno = ENOTCONN;
1114         statePtr->flags |= TCP_REMOTE_CLOSED;
1115         return 0;
1116     case invalidStreamPtr:
1117     default:
1118         *errorCodePtr = EINVAL;
1119         return -1;
1120       }
1121   }
1122 
1123   /*
1124    * No data is available, so check the connection state to
1125    * see why this is the case.  
1126    */
1127 
1128   if (statusPB.csParam.status.connectionState == 14) {
1129       statePtr->flags |= TCP_REMOTE_CLOSED;
1130       return 0;
1131   }
1132   if (statusPB.csParam.status.connectionState != 8) {
1133       Debugger();
1134   }
1135   statePtr->checkMask &= ~TCL_READABLE;
1136   if (statePtr->flags & TCP_ASYNC_SOCKET) {
1137       *errorCodePtr = EWOULDBLOCK;
1138       return -1;
1139   }
1140 
1141   /*
1142    * In the blocking case, wait until the file becomes readable
1143    * or closed and try again.
1144    */
1145 
1146   if (!WaitForSocketEvent(statePtr, TCL_READABLE, errorCodePtr)) {
1147       return -1;
1148   }
1149     }
1150 }
static int TcpOutput (ClientData instanceData, CONST char * buf, int toWrite, int * errorCodePtr) [static]

Definition at line 1200 of file tclMacSock.c.
References ckalloc, ckfree, ENOTCONN, EPIPE, errno, ESHUTDOWN, EWOULDBLOCK, InitMacTCPParamBlock(), NULL, TCL_WRITABLE, TCP_ASYNC_CONNECT, TCP_ASYNC_SOCKET, TCP_REMOTE_CLOSED, TCP_WRITING, and WaitForSocketEvent().1205 {
1206     TcpState *statePtr = (TcpState *) instanceData;
1207     StreamPtr tcpStream;
1208     OSErr err;
1209     int amount;
1210     TCPiopb statusPB;
1211 
1212     *errorCodePtr = 0;
1213     tcpStream = statePtr->tcpStream;
1214 
1215     /*
1216      * If an asynchronous connect is in progress, attempt to wait for it
1217      * to complete before writing.
1218      */
1219     
1220     if ((statePtr->flags & TCP_ASYNC_CONNECT)
1221       && ! WaitForSocketEvent(statePtr, TCL_WRITABLE, errorCodePtr)) {
1222   return -1;
1223     }
1224 
1225     /*
1226      * Loop until we have written some data, or an error occurs.
1227      */
1228 
1229     while (1) {
1230   statusPB.ioCRefNum = driverRefNum;
1231   statusPB.tcpStream = tcpStream;
1232   statusPB.csCode = TCPStatus;
1233   err = PBControlSync((ParmBlkPtr) &statusPB);
1234   if ((err == connectionDoesntExist) || ((err == noErr) && 
1235     (statusPB.csParam.status.connectionState == 14))) {
1236       /*
1237        * The remote connection is gone away.  Report an error
1238        * and don't write anything.
1239        */
1240 
1241       *errorCodePtr = errno = EPIPE;
1242       return -1;
1243   } else if (err != noErr) {
1244       return -1;
1245   }
1246   amount = statusPB.csParam.status.sendWindow
1247       - statusPB.csParam.status.amtUnackedData;
1248 
1249   /*
1250    * Attempt to write the data to the socket if a background
1251    * write isn't in progress and there is room in the output buffers.
1252    */
1253 
1254   if (!(statePtr->flags & TCP_WRITING) && amount > 0) {
1255       if (toWrite < amount) {
1256     amount = toWrite;
1257       }
1258 
1259             /* We need to copy the data, otherwise the caller may overwrite
1260              * the buffer in the middle of our asynchronous call
1261              */
1262              
1263             if (amount > statePtr->writeBufferSize) {
1264                 /* 
1265                  * need to grow write buffer 
1266                  */
1267                  
1268                 if (statePtr->writeBuffer != (void *) NULL) {
1269                     ckfree(statePtr->writeBuffer);
1270                 }
1271                 statePtr->writeBuffer = (void *) ckalloc(amount);
1272                 statePtr->writeBufferSize = amount;
1273             }
1274             memcpy(statePtr->writeBuffer, buf, amount);
1275             statePtr->dataSegment[0].ptr = statePtr->writeBuffer;
1276 
1277       statePtr->dataSegment[0].length = amount;
1278       statePtr->dataSegment[1].length = 0;
1279       InitMacTCPParamBlock(&statePtr->pb, TCPSend);
1280       statePtr->pb.ioCompletion = completeUPP;
1281       statePtr->pb.tcpStream = tcpStream;
1282       statePtr->pb.csParam.send.wdsPtr = (Ptr) statePtr->dataSegment;
1283       statePtr->pb.csParam.send.pushFlag = 1;
1284       statePtr->pb.csParam.send.userDataPtr = (Ptr) statePtr;
1285       statePtr->flags |= TCP_WRITING;
1286       err = PBControlAsync((ParmBlkPtr) &(statePtr->pb));
1287       switch (err) {
1288     case noErr:
1289         return amount;
1290     case connectionClosing:
1291         *errorCodePtr = errno = ESHUTDOWN;
1292         statePtr->flags |= TCP_REMOTE_CLOSED;
1293         return -1;
1294     case connectionDoesntExist:
1295     case connectionTerminated:
1296         *errorCodePtr = errno = ENOTCONN;
1297         statePtr->flags |= TCP_REMOTE_CLOSED;
1298         return -1;
1299     case invalidStreamPtr:
1300     default:
1301         return -1;
1302       }
1303 
1304   }
1305 
1306   /*
1307    * The socket wasn't writable.  In the non-blocking case, return
1308    * immediately, otherwise wait  until the file becomes writable
1309    * or closed and try again.
1310    */
1311 
1312   if (statePtr->flags & TCP_ASYNC_SOCKET) {
1313       statePtr->checkMask &= ~TCL_WRITABLE;
1314       *errorCodePtr = EWOULDBLOCK;
1315       return -1;
1316   } else if (!WaitForSocketEvent(statePtr, TCL_WRITABLE, errorCodePtr)) {
1317       return -1;
1318   }
1319     }
1320 }
static void TcpWatch (ClientData instanceData, int mask) [static]

Definition at line 1529 of file tclMacSock.c.1534 {
1535     TcpState *statePtr = (TcpState *) instanceData;
1536 
1537     statePtr->watchMask = mask;
1538 }
static int WaitForSocketEvent (TcpState * statePtr, int mask, int * errorCodePtr) [static]

Definition at line 2060 of file tclMacSock.c.
References EWOULDBLOCK, NULL, TCL_READABLE, TCL_WRITABLE, TCP_ASYNC_CONNECT, TCP_ASYNC_SOCKET, and TCP_WRITING.
Referenced by TcpGetOptionProc(), TcpInput(), TcpInputProc(), TcpOutput(), and TcpOutputProc().2064 {
2065     OSErr err;
2066     TCPiopb statusPB;
2067     EventRecord dummy;
2068 
2069     /*
2070      * Loop until we get the specified condition, unless the socket is
2071      * asynchronous.
2072      */
2073     
2074     do {
2075   statusPB.ioCRefNum = driverRefNum;
2076   statusPB.tcpStream = statePtr->tcpStream;
2077   statusPB.csCode = TCPStatus;
2078   err = PBControlSync((ParmBlkPtr) &statusPB);
2079   if (err != noErr) {
2080             /*
2081              * I am not sure why it is right to return 1 - indicating success
2082              * for synchronous sockets when an attempt to get status on the
2083              * driver yeilds an error.   But it is CERTAINLY wrong for async
2084              * sockect which have not yet connected.
2085              */
2086              
2087       if (statePtr->flags & TCP_ASYNC_CONNECT) {
2088           *errorCodePtr = EWOULDBLOCK;
2089           return 0;
2090       } else {
2091           statePtr->checkMask |= (TCL_READABLE | TCL_WRITABLE);
2092           return 1;
2093       }
2094   }
2095   statePtr->checkMask = 0;
2096   
2097   /*
2098    * The "6" below is the "connection being established" flag.  I couldn't
2099    * find a define for this in MacTCP.h, but that's what the programmer's
2100    * guide says.
2101    */
2102    
2103   if ((statusPB.csParam.status.connectionState != 0)
2104           && (statusPB.csParam.status.connectionState != 4)
2105           && (statusPB.csParam.status.connectionState != 6)) {
2106       if (statusPB.csParam.status.amtUnreadData > 0) {
2107           statePtr->checkMask |= TCL_READABLE;
2108       }
2109       if (!(statePtr->flags & TCP_WRITING)
2110         && (statusPB.csParam.status.sendWindow - 
2111           statusPB.csParam.status.amtUnackedData) > 0) {
2112           statePtr->flags &= ~(TCP_ASYNC_CONNECT);
2113           statePtr->checkMask |= TCL_WRITABLE;
2114       }
2115       if (mask & statePtr->checkMask) {
2116           return 1;
2117       }
2118         } else {
2119             break;
2120         }
2121         
2122   /*
2123    * Call the system to let other applications run while we
2124    * are waiting for this event to occur.
2125    */
2126   
2127   WaitNextEvent(0, &dummy, 1, NULL);
2128     } while (!(statePtr->flags & TCP_ASYNC_SOCKET));
2129     *errorCodePtr = EWOULDBLOCK;
2130     return 0;
2131 } 

Variable Documentation
ProcessSerialNumber applicationPSN [static]

Definition at line 272 of file tclMacSock.c.TCPIOCompletionUPP closeUPP = NULL

Definition at line 217 of file tclMacSock.c.TCPIOCompletionUPP completeUPP = NULL

Definition at line 216 of file tclMacSock.c.Tcl_ThreadDataKey dataKey [static]

Definition at line 261 of file tclMacSock.c.short driverRefNum = 0 [static]

Definition at line 269 of file tclMacSock.c.int hasSockets = false [static]

Definition at line 268 of file tclMacSock.c.int initialized = 0 [static]

Definition at line 34 of file tclMacSock.c.TCPNotifyUPP notifyUPP = NULL

Definition at line 218 of file tclMacSock.c.PortInfo portServices[] [static]
Initial value: {
    {"echo",    7},
    {"discard",   9},
    {"systat",    11},
    {"daytime",   13},
    {"netstat",   15},
    {"chargen",   19},
    {"ftp-data",  20},
    {"ftp",   21},
    {"telnet",    23},
    {"telneto",   24},
    {"smtp",    25},
    {"time",    37},
    {"whois",   43},
    {"domain",    53},
    {"gopher",    70},
    {"finger",    79},
    {"hostnames", 101},
    {"sunrpc",    111},
    {"nntp",    119},
    {"exec",    512},
    {"login",   513},
    {"shell",   514},
    {"printer",   515},
    {"courier",   530},
    {"uucp",    540},
    {NULL,    0},
}
Definition at line 224 of file tclMacSock.c.
Referenced by TclSockGetPort().ResultUPP resultUPP = NULL

Definition at line 215 of file tclMacSock.c.int socketBufferSize = CHANNEL_BUF_SIZE [static]

Definition at line 271 of file tclMacSock.c.int socketNumber = 0 [static]

Definition at line 270 of file tclMacSock.c.int socketsTestInited = false [static]

Definition at line 267 of file tclMacSock.c.Tcl_ChannelType tcpChannelType [static]
Initial value: {
    "tcp",      
    (Tcl_ChannelTypeVersion)TcpBlockMode,   
    TcpClose,     
    TcpInput,     
    TcpOutput,      
    NULL,     
    NULL,     
    TcpGetOptionProc,   
    TcpWatch,     
    TcpGetHandle    
}
Definition at line 196 of file tclMacSock.c.
Referenced by MakeTcpClientChannelMode(), Tcl_GetOpenFile(), Tcl_MakeTcpClientChannel(), Tcl_OpenTcpClient(), Tcl_OpenTcpServer(), and TcpAccept().

mac/tclMacTest.c File Reference
#include "tclInt.h"
#include "tclMacInt.h"
#include "tclMacPort.h"
#include "Files.h"
#include <Errors.h>
#include <Resources.h>
#include <Script.h>
#include <Strings.h>
#include <FSpCompat.h>
Defines
#define TCL_TEST
#define USE_COMPAT_CONST
Functions
int TclplatformtestInit _ANSI_ARGS_ ((Tcl_Interp *interp))
static int DebuggerCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv))
int TclplatformtestInit (Tcl_Interp *interp)
static int DebuggerCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int WriteTextResource (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)

Define Documentation
#define TCL_TEST

Definition at line 15 of file tclMacTest.c.#define USE_COMPAT_CONST

Definition at line 16 of file tclMacTest.c.
Function Documentation
static int DebuggerCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)) [static]
int TclplatformtestInit _ANSI_ARGS_ ((Tcl_Interp *interp))
static int DebuggerCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 88 of file tclMacTest.c.
References Debugger, and TCL_OK.
Referenced by TclplatformtestInit().93 {
94     Debugger();
95     return TCL_OK;
96 }
int TclplatformtestInit (Tcl_Interp * interp)

Definition at line 56 of file tclMacTest.c.
References DebuggerCmd(), NULL, Tcl_CreateCommand(), TCL_OK, and WriteTextResource().
Referenced by Tcltest_Init().58 {
59     /*
60      * Add commands for platform specific tests on MacOS here.
61      */
62     
63     Tcl_CreateCommand(interp, "debugger", DebuggerCmd,
64             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
65     Tcl_CreateCommand(interp, "testWriteTextResource", WriteTextResource,
66             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
67 
68     return TCL_OK;
69 }
static int WriteTextResource (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 117 of file tclMacTest.c.
References CONST, FSpLocationFromPath(), NULL, TCL_ERROR, and TCL_OK.
Referenced by TclplatformtestInit().122 {
123     char *errNum = "wrong # args: ";
124     char *errBad = "bad argument: ";
125     char *errStr;
126     CONST char *fileName = NULL, *rsrcName = NULL;
127     CONST char *data = NULL;
128     int rsrcID = -1, i, protectIt = 0;
129     short fileRef = -1;
130     OSErr err;
131     Handle dataHandle;
132     Str255 resourceName;
133     FSSpec fileSpec;
134 
135     /*
136      * Process the arguments.
137      */
138     for (i = 1 ; i < argc ; i++) {
139   if (!strcmp(argv[i], "-rsrc")) {
140       rsrcName = argv[i + 1];
141       i++;
142   } else if (!strcmp(argv[i], "-rsrcid")) {
143       rsrcID = atoi(argv[i + 1]);
144       i++;
145   } else if (!strcmp(argv[i], "-file")) {
146       fileName = argv[i + 1];
147       i++;
148   } else if (!strcmp(argv[i], "-protected")) {
149       protectIt = 1;
150   } else {
151       data = argv[i];
152   }
153     }
154   
155     if ((rsrcName == NULL && rsrcID < 0) ||
156       (fileName == NULL) || (data == NULL)) {
157       errStr = errBad;
158       goto sourceFmtErr;
159     }
160 
161     /*
162      * Open the resource file.
163      */
164     err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
165     if (!(err == noErr || err == fnfErr)) {
166   Tcl_AppendResult(interp, "couldn't validate file name", (char *) NULL);
167   return TCL_ERROR;
168     }
169     
170     if (err == fnfErr) {
171   FSpCreateResFile(&fileSpec, 'WIsH', 'rsrc', smSystemScript);
172     }
173     fileRef = FSpOpenResFile(&fileSpec, fsRdWrPerm);
174     if (fileRef == -1) {
175   Tcl_AppendResult(interp, "couldn't open resource file", (char *) NULL);
176   return TCL_ERROR;
177     }
178     
179     UseResFile(fileRef);
180 
181     /*
182      * Prepare data needed to create resource.
183      */
184     if (rsrcID < 0) {
185   rsrcID = UniqueID('TEXT');
186     }
187     
188     strcpy((char *) resourceName, rsrcName);
189     c2pstr((char *) resourceName);
190     
191     dataHandle = NewHandle(strlen(data));
192     HLock(dataHandle);
193     strcpy(*dataHandle, data);
194     HUnlock(dataHandle);
195      
196     /*
197      * Add the resource to the file and close it.
198      */
199     AddResource(dataHandle, 'TEXT', rsrcID, resourceName);
200     
201     UpdateResFile(fileRef);
202     if (protectIt) {
203         SetResAttrs(Get1Resource('TEXT', rsrcID), resProtected);
204     }
205     
206     CloseResFile(fileRef);
207     return TCL_OK;
208     
209     sourceFmtErr:
210     Tcl_AppendResult(interp, errStr, "error in \"", argv[0], "\"",
211       (char *) NULL);
212     return TCL_ERROR;
213 }

mac/tclMacThrd.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include "tclMacInt.h"
#include <Threads.h>
#include <Gestalt.h>
Classes
struct TclMacThrdData
Defines
#define TCL_MAC_THRD_DEFAULT_STACK  (256*1024)
#define TCL_MAC_INITIAL_KEYSIZE  32
Functions
TclMacThrdData * GetThreadDataStruct (Tcl_ThreadDataKey keyVal)
TclMacThrdData * RemoveThreadDataStruct (Tcl_ThreadDataKey keyVal)
int TclMacHaveThreads (void)
int Tcl_CreateThread (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags)
int Tcl_JoinThread (Tcl_ThreadId threadId, int *result)
void TclpThreadExit (int status)
Tcl_ThreadId Tcl_GetCurrentThread ()
void TclpInitLock ()
void TclpInitUnlock ()
void TclpMasterLock ()
void TclpMasterUnlock ()
Tcl_Mutex * Tcl_GetAllocMutex ()
Variables
static TclMacThrdData ** tclMacDataKeyArray
static int maxNumKeys = 0
static int keyCounter = 0

Define Documentation
#define TCL_MAC_INITIAL_KEYSIZE  32

Definition at line 36 of file tclMacThrd.c.#define TCL_MAC_THRD_DEFAULT_STACK  (256*1024)

Definition at line 21 of file tclMacThrd.c.
Referenced by Tcl_CreateThread().
Function Documentation
TclMacThrdData* GetThreadDataStruct (Tcl_ThreadDataKey keyVal)
TclMacThrdData* RemoveThreadDataStruct (Tcl_ThreadDataKey keyVal)
int Tcl_CreateThread (Tcl_ThreadId * idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags)

Definition at line 113 of file tclMacThrd.c.
References NULL, TCL_ERROR, TCL_MAC_THRD_DEFAULT_STACK, TCL_OK, TCL_THREAD_JOINABLE, TCL_THREAD_STACK_DEFAULT, and TclMacHaveThreads().120 {
121     if (!TclMacHaveThreads()) {
122         return TCL_ERROR;
123     }
124 
125     if (stackSize == TCL_THREAD_STACK_DEFAULT) {
126         stackSize = TCL_MAC_THRD_DEFAULT_STACK;
127     }
128 
129 #if TARGET_CPU_68K && TARGET_RT_MAC_CFM
130     {
131         ThreadEntryProcPtr entryProc;
132         entryProc = NewThreadEntryUPP(proc);
133         
134         NewThread(kCooperativeThread, entryProc, (void *) clientData, 
135             stackSize, kCreateIfNeeded, NULL, (ThreadID *) idPtr);
136     }
137 #else
138     NewThread(kCooperativeThread, proc, (void *) clientData, 
139         stackSize, kCreateIfNeeded, NULL, (ThreadID *) idPtr);
140 #endif        
141     if ((ThreadID) *idPtr == kNoThreadID) {
142         return TCL_ERROR;
143     } else {
144         if (flags & TCL_THREAD_JOINABLE) {
145       TclRememberJoinableThread (*idPtr);
146   }
147 
148         return TCL_OK;
149     }
150 
151 }
Tcl_Mutex* Tcl_GetAllocMutex ()

Definition at line 381 of file tclMacThrd.c.
References NULL.382 {
383     /* There is nothing to do on the Mac */
384     return NULL;
385 }
Tcl_ThreadId Tcl_GetCurrentThread ()

Definition at line 234 of file tclMacThrd.c.
References TclMacHaveThreads().
Referenced by ExprRandFunc(), InitSockets(), Tcl_AsyncCreate(), Tcl_CreateInterp(), TCL_DECLARE_MUTEX(), Tcl_SpliceChannel(), TclpCreateCommandChannel(), TclpThreadExit(), TclWinOpenConsoleChannel(), TclWinOpenSerialChannel(), and TestmainthreadCmd().235 {
236 #ifdef TCL_THREADS
237     ThreadID curThread;
238 
239     if (!TclMacHaveThreads()) {
240         return (Tcl_ThreadId) 0;
241     } else {
242         GetCurrentThread(&curThread);
243         return (Tcl_ThreadId) curThread;
244     }
245 #else
246     return (Tcl_ThreadId) 0;
247 #endif
248 }
int Tcl_JoinThread (Tcl_ThreadId threadId, int* result)

Definition at line 171 of file tclMacThrd.c.
References TCL_ERROR, and TclMacHaveThreads().
Referenced by Tcl_FinalizeNotifier().176 {
177     if (!TclMacHaveThreads()) {
178         return TCL_ERROR;
179     }
180 
181     return TclJoinThread (threadId, result);
182 }
int TclMacHaveThreads (void)

Definition at line 78 of file tclMacThrd.c.
References initialized.
Referenced by Tcl_AlertNotifier(), Tcl_CreateThread(), Tcl_GetCurrentThread(), Tcl_InitNotifier(), Tcl_JoinThread(), Tcl_Sleep(), Tcl_WaitForEvent(), and TclpThreadExit().79 {
80     static initialized = false;
81     static int tclMacHaveThreads = false;
82     long response = 0;
83     OSErr err = noErr;
84     
85     if (!initialized) {
86   err = Gestalt(gestaltThreadMgrAttr, &response);
87   if (err == noErr) {
88       tclMacHaveThreads = response | (1 << gestaltThreadMgrPresent);
89   }
90     }
91 
92     return tclMacHaveThreads;
93 }
void TclpInitLock ()

Definition at line 271 of file tclMacThrd.c.
Referenced by Tcl_Finalize(), Tcl_GetTime(), TclFindEncodings(), and TclInitSubsystems().272 {
273 #ifdef TCL_THREADS
274     /* There is nothing to do on the Mac. */;
275 #endif
276 }
void TclpInitUnlock ()

Definition at line 297 of file tclMacThrd.c.
Referenced by Tcl_GetTime(), TclFindEncodings(), and TclInitSubsystems().298 {
299 #ifdef TCL_THREADS
300     /* There is nothing to do on the Mac */;
301 #endif
302 }
void TclpMasterLock ()

Definition at line 327 of file tclMacThrd.c.
Referenced by TclFinalizeSynchronization(), and TclFinalizeThreadData().328 {
329 #ifdef TCL_THREADS
330     /* There is nothing to do on the Mac */;
331 #endif
332 }
void TclpMasterUnlock ()

Definition at line 353 of file tclMacThrd.c.
Referenced by TclFinalizeThreadData().354 {
355 #ifdef TCL_THREADS
356     /* There is nothing to do on the Mac */
357 #endif
358 }
void TclpThreadExit (int status)

Definition at line 201 of file tclMacThrd.c.
References NULL, and TclMacHaveThreads().
Referenced by Tcl_ExitThread().203 {
204     ThreadID curThread;
205     
206     if (!TclMacHaveThreads()) {
207         return;
208     }
209     
210     GetCurrentThread(&curThread);
211     TclSignalExitThread ((Tcl_ThreadId) curThread, status);
212 
213     DisposeThread(curThread, NULL, false);
214 }

Variable Documentation
int keyCounter = 0 [static]

Definition at line 46 of file tclMacThrd.c.int maxNumKeys = 0 [static]

Definition at line 45 of file tclMacThrd.c.TclMacThrdData** tclMacDataKeyArray [static]

Definition at line 35 of file tclMacThrd.c.

mac/tclMacThrd.h File Reference

mac/tclMacTime.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include "tclMacInt.h"
#include <OSUtils.h>
#include <Timer.h>
#include <time.h>
Defines
#define HOUR(x)  ((time_t) (3600 * x))
#define tZONE  0
#define tDAYZONE  1
Functions
TCL_DECLARE_MUTEX (gmtMutex)
static void SubtractUnsignedWide _ANSI_ARGS_ ((UnsignedWide *x, UnsignedWide *y, UnsignedWide *result))
long TclpGetGMTOffset ()
unsigned long TclpGetSeconds ()
unsigned long TclpGetClicks ()
int TclpGetTimeZone (unsigned long currentTime)
void Tcl_GetTime (Tcl_Time *timePtr)
tm * TclpGetDate (TclpTime_t time, int useGMT)
char * TclpGetTZName (int dst)
Variables
static int initalized = false
static unsigned long baseSeconds
static UnsignedWide microOffset
static int gmt_initialized = false
static long gmt_offset
static int gmt_isdst
TABLE
static TABLE invTimezoneTable []

Define Documentation
#define HOUR(x)  ((time_t) (3600 * x))

Definition at line 44 of file tclMacTime.c.#define tDAYZONE  1

Definition at line 47 of file tclMacTime.c.#define tZONE  0

Definition at line 46 of file tclMacTime.c.
Function Documentation
static void SubtractUnsignedWide _ANSI_ARGS_ ((UnsignedWide *x, UnsignedWide *y, UnsignedWide *result)) [static]
TCL_DECLARE_MUTEX (gmtMutex)

Definition at line 33 of file tclMacTime.c.37                       {
38     char        *name;
39     int         type;
40     time_t      value;
41 } TABLE;
void Tcl_GetTime (Tcl_Time * timePtr)

Definition at line 269 of file tclMacTime.c.
References baseSeconds, initalized, microOffset, Tcl_Time::sec, tcl_mac_epoch_offset, TclpGetGMTOffset(), and Tcl_Time::usec.
Referenced by GetTimesCmd(), Tcl_CreateTimerHandler(), TCL_DECLARE_MUTEX(), Tcl_SetTimer(), Tcl_Sleep(), Tcl_TimeObjCmd(), TclCleanupByteCode(), TclInitByteCodeObj(), TclpGetClicks(), TclpGetSeconds(), TclpGetTime(), TclUnixWaitForFile(), TestwinclockCmd(), TimerCheckProc(), TimerHandlerEventProc(), and TimerSetupProc().271 {
272     UnsignedWide micro;
273 #ifndef NO_LONG_LONG
274     long long *microPtr;
275 #endif
276   
277     if (initalized == false) {
278   GetDateTime(&baseSeconds);
279   /*
280    * Remove the local offset that ReadDateTime() adds.
281    */
282   baseSeconds -= TclpGetGMTOffset() - tcl_mac_epoch_offset;
283   Microseconds(&microOffset);
284   initalized = true;
285     }
286 
287     Microseconds(&micro);
288 
289 #ifndef NO_LONG_LONG
290     microPtr = (long long *) &micro;
291     *microPtr -= *((long long *) &microOffset);
292     timePtr->sec = baseSeconds + (*microPtr / 1000000);
293     timePtr->usec = *microPtr % 1000000;
294 #else
295     SubtractUnsignedWide(&micro, &microOffset, &micro);
296 
297     /*
298      * This lovely computation is equal to: base + (micro / 1000000)
299      * For the .hi part the ratio of 0x100000000 / 1000000 has been
300      * reduced to avoid overflow.  This computation certainly has 
301      * problems as the .hi part gets large.  However, your application
302      * would have to run for a long time to make that happen.
303      */
304 
305     timePtr->sec = baseSeconds + (micro.lo / 1000000) + 
306       (long) (micro.hi * ((double) 33554432.0 / 15625.0));
307     timePtr->usec = micro.lo % 1000000;
308 #endif
309 }
unsigned long TclpGetClicks ()

Definition at line 207 of file tclMacTime.c.
Referenced by ExprRandFunc(), and TCL_DECLARE_MUTEX().208 {
209     UnsignedWide micros;
210 
211     Microseconds(&micros);
212     return micros.lo;
213 }
struct tm* TclpGetDate (TclpTime_t time, int useGMT)

Definition at line 333 of file tclMacTime.c.
References gmt_isdst, tcl_mac_epoch_offset, and TclpGetGMTOffset().
Referenced by Convert(), DSTcorrect(), FormatClock(), NamedDay(), NamedMonth(), RelativeMonth(), and TclGetDate().336 {
337     const time_t *tp = (const time_t *)time;
338     DateTimeRec dtr;
339     unsigned long offset=0L;
340     static struct tm statictime;
341     static const short monthday[12] =
342         {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
343       
344   if(useGMT)
345     SecondsToDate(*tp - tcl_mac_epoch_offset, &dtr);
346   else
347     SecondsToDate(*tp + TclpGetGMTOffset() - tcl_mac_epoch_offset, &dtr);
348   
349     statictime.tm_sec = dtr.second;
350     statictime.tm_min = dtr.minute;
351     statictime.tm_hour = dtr.hour;
352     statictime.tm_mday = dtr.day;
353     statictime.tm_mon = dtr.month - 1;
354     statictime.tm_year = dtr.year - 1900;
355     statictime.tm_wday = dtr.dayOfWeek - 1;
356     statictime.tm_yday = monthday[statictime.tm_mon]
357   + statictime.tm_mday - 1;
358     if (1 < statictime.tm_mon && !(statictime.tm_year & 3)) {
359   ++statictime.tm_yday;
360     }
361     if(useGMT)
362       statictime.tm_isdst = 0;
363     else
364       statictime.tm_isdst = gmt_isdst;
365     gmt_lastGetDateUseGMT=useGMT; /* hack to make TclpGetTZName below work */
366     return(&statictime);
367 }
long TclpGetGMTOffset ()

Definition at line 140 of file tclMacTime.c.
References gmt_initialized, gmt_isdst, gmt_offset, Tcl_MutexLock, and Tcl_MutexUnlock.
Referenced by Tcl_GetTime(), TclpGetDate(), TclpGetSeconds(), TclpGetTimeZone(), TclpGetTZName(), TclpObjStatAlias(), and TclpUtime().141 {
142     if (gmt_initialized == false) {
143   MachineLocation loc;
144   
145     Tcl_MutexLock(&gmtMutex);
146   ReadLocation(&loc);
147   gmt_offset = loc.u.gmtDelta & 0x00ffffff;
148   if (gmt_offset & 0x00800000) {
149       gmt_offset = gmt_offset | 0xff000000;
150   }
151   gmt_isdst=(loc.u.dlsDelta < 0);
152   gmt_initialized = true;
153     Tcl_MutexUnlock(&gmtMutex);
154     }
155   return (gmt_offset);
156 }
unsigned long TclpGetSeconds ()

Definition at line 179 of file tclMacTime.c.
References tcl_mac_epoch_offset, and TclpGetGMTOffset().
Referenced by TCL_DECLARE_MUTEX().180 {
181     unsigned long seconds;
182 
183     GetDateTime(&seconds);
184   return (seconds - TclpGetGMTOffset() + tcl_mac_epoch_offset);
185 }
int TclpGetTimeZone (unsigned long currentTime)

Definition at line 233 of file tclMacTime.c.
References gmt_isdst, and TclpGetGMTOffset().
Referenced by RelativeMonth(), and TCL_DECLARE_MUTEX().235 {
236     long offset;
237 
238     /*
239      * Convert the Mac offset from seconds to minutes and
240      * add an hour if we have daylight savings time.
241      */
242     offset = -TclpGetGMTOffset();
243     offset /= 60;
244     if (gmt_isdst) {
245   offset += 60;
246     }
247     
248     return offset;
249 }
char* TclpGetTZName (int dst)

Definition at line 386 of file tclMacTime.c.
References gmt_isdst, HOUR, invTimezoneTable, _TABLE::name, TclpGetGMTOffset(), _TABLE::type, and _TABLE::value.
Referenced by _fmt().387 {
388     register TABLE *tp;
389   long zonevalue=-TclpGetGMTOffset();
390     
391     if (gmt_isdst)
392         zonevalue += HOUR(1);
393 
394   if(gmt_lastGetDateUseGMT) /* hack: if last TclpGetDate was called */
395     zonevalue=0;          /* with useGMT==1 then we're using GMT  */
396 
397     for (tp = invTimezoneTable; tp->name; tp++) {
398         if ((tp->value == zonevalue) && (tp->type == dst)) break;
399     }
400   if(!tp->name)
401     tp = invTimezoneTable; /* default to unknown */
402 
403     return tp->name;
404 }

Variable Documentation
unsigned long baseSeconds [static]

Definition at line 27 of file tclMacTime.c.
Referenced by Tcl_GetTime().int gmt_initialized = false [static]

Definition at line 30 of file tclMacTime.c.
Referenced by TclpGetGMTOffset().int gmt_isdst [static]

Definition at line 32 of file tclMacTime.c.
Referenced by TclpGetDate(), TclpGetGMTOffset(), TclpGetTimeZone(), and TclpGetTZName().long gmt_offset [static]

Definition at line 31 of file tclMacTime.c.
Referenced by TclpGetGMTOffset(), and TclpUtime().int initalized = false [static]

Definition at line 26 of file tclMacTime.c.
Referenced by Tcl_GetTime().TABLE invTimezoneTable[] [static]

Definition at line 54 of file tclMacTime.c.
Referenced by TclpGetTZName().UnsignedWide microOffset [static]

Definition at line 28 of file tclMacTime.c.
Referenced by Tcl_GetTime().TABLE

Definition at line 41 of file tclMacTime.c.

mac/tclMacUnix.c File Reference
#include <Files.h>
#include <Strings.h>
#include <TextUtils.h>
#include <Finder.h>
#include <FSpCompat.h>
#include <Aliases.h>
#include <Errors.h>
#include "tclInt.h"
#include "tclMacInt.h"
#include "FileCopy.h"
#include "MoreFiles.h"
#include "MoreFilesExtras.h"
Defines
#define kIsInvisible  0x4000
#define kIsAlias  0x8000
#define usageErr  500
#define noSourceErr  501
#define isDirErr  502
#define STRING_LENGTH  80
#define CR  '\n'
Functions
int Tcl_EchoCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
int Tcl_LsObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])

Define Documentation
#define CR  '\n'
#define isDirErr  502

Definition at line 52 of file tclMacUnix.c.#define kIsAlias  0x8000

Definition at line 44 of file tclMacUnix.c.
Referenced by CreateAliasFile(), and Tcl_LsObjCmd().#define kIsInvisible  0x4000

Definition at line 41 of file tclMacUnix.c.
Referenced by GetFileFinderAttributes(), NativeMatchType(), SetFileFinderAttributes(), and Tcl_LsObjCmd().#define noSourceErr  501

Definition at line 51 of file tclMacUnix.c.#define STRING_LENGTH  80

Referenced by Tcl_LsObjCmd().#define usageErr  500

Definition at line 50 of file tclMacUnix.c.
Function Documentation
int Tcl_EchoCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv)

Definition at line 73 of file tclMacUnix.c.
References NULL, TCL_ERROR, Tcl_GetChannel(), Tcl_GetChannelName(), TCL_OK, Tcl_PosixError(), and Tcl_WriteChars().78 {
79     Tcl_Channel chan;
80     int mode, result, i;
81 
82     chan = Tcl_GetChannel(interp, "stdout", &mode);
83     if (chan == (Tcl_Channel) NULL) {
84         return TCL_ERROR;
85     }
86     for (i = 1; i < argc; i++) {
87   result = Tcl_WriteChars(chan, argv[i], -1);
88   if (result < 0) {
89       Tcl_AppendResult(interp, "echo: ", Tcl_GetChannelName(chan),
90         ": ", Tcl_PosixError(interp), (char *) NULL);
91       return TCL_ERROR;
92   }
93         if (i < (argc - 1)) {
94       Tcl_WriteChars(chan, " ", -1);
95   }
96     }
97     Tcl_WriteChars(chan, "\n", -1);
98     return TCL_OK;
99 }
int Tcl_LsObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])

Definition at line 118 of file tclMacUnix.c.
References kIsAlias, kIsInvisible, NULL, STRING_LENGTH, Tcl_DecrRefCount, TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_GlobObjCmd(), Tcl_IncrRefCount, Tcl_ListObjGetElements(), Tcl_NewStringObj(), TCL_OK, Tcl_ResetResult(), and Tcl_SetObjLength().123 {
124 #define STRING_LENGTH 80
125 #define CR '\n'
126     int i, j;
127     int fieldLength, len = 0, maxLen = 0, perLine;
128     OSErr err;
129     CInfoPBRec paramBlock;
130     HFileInfo *hpb = (HFileInfo *)&paramBlock;
131     DirInfo *dpb = (DirInfo *)&paramBlock;
132     char theFile[256];
133     char theLine[STRING_LENGTH + 2];
134     int fFlag = false, pFlag = false, aFlag = false, lFlag = false,
135   cFlag = false, hFlag = false;
136     char *argv;
137     Tcl_Obj *newObjv[2], *resultObjPtr;
138 
139     /*
140      * Process command flags.  End if argument doesn't start
141      * with a dash or is a dash by itself.  The remaining arguments
142      * should be files.
143      */
144     for (i = 1; i < objc; i++) {
145       argv = Tcl_GetString(objv[i]);
146   if (argv[0] != '-') {
147       break;
148   }
149     
150   if (!strcmp(argv, "-")) {
151       i++;
152       break;
153   }
154     
155   for (j = 1 ; argv[j] ; ++j) {
156       switch(argv[j]) {
157       case 'a':
158       case 'A':
159     aFlag = true;
160     break;
161       case '1':
162     cFlag = false;
163     break;
164       case 'C':
165     cFlag = true;
166     break;
167       case 'F':
168     fFlag = true;
169     break;
170       case 'H':
171     hFlag = true;
172     break;
173       case 'p':
174     pFlag = true;
175     break;
176       case 'l':
177     pFlag = false;
178     lFlag = true;
179     break;
180       default:
181     Tcl_AppendResult(interp, "error - unknown flag ",
182       "usage: ls -apCFHl1 ?files? ", NULL);
183     return TCL_ERROR;
184       }
185   }
186     }
187 
188     objv += i;
189     objc -= i;
190 
191     /*
192      * No file specifications means we search for all files.
193      * Glob will be doing most of the work.
194      */
195      if (!objc) {
196   objc = 1;
197   newObjv[0] = Tcl_NewStringObj("*", -1);
198   newObjv[1] = NULL;
199   objv = newObjv;
200     }
201 
202     if (Tcl_GlobObjCmd(NULL, interp, objc + 1, objv - 1) != TCL_OK) {
203       Tcl_ResetResult(interp);
204       return TCL_ERROR;
205     }
206 
207     resultObjPtr = Tcl_GetObjResult(interp);
208     Tcl_IncrRefCount(resultObjPtr);
209     if (Tcl_ListObjGetElements(interp, resultObjPtr, &objc, (Tcl_Obj ***)&objv) != TCL_OK) {
210       Tcl_DecrRefCount(resultObjPtr);
211       return TCL_ERROR;
212     }
213 
214     Tcl_ResetResult(interp);
215 
216     /*
217      * There are two major methods for listing files: the long
218      * method and the normal method.
219      */
220     if (lFlag) {
221   char  creator[5], type[5], time[16], date[16];
222   char  lineTag;
223   long  size;
224   unsigned short flags;
225   Tcl_Obj *objPtr;
226   char *string;
227   int length;
228 
229   /*
230    * Print the header for long listing.
231    */
232   if (hFlag) {
233       sprintf(theLine, "T %7s %8s %8s %4s %4s %6s %s",
234         "Size", "ModTime", "ModDate",
235         "CRTR", "TYPE", "Flags", "Name");
236       Tcl_AppendResult(interp, theLine, "\n", NULL);
237       Tcl_AppendResult(interp,
238         "-------------------------------------------------------------\n",
239         NULL);
240   }
241     
242   for (i = 0; i < objc; i++) {
243       strcpy(theFile, Tcl_GetString(objv[i]));
244       
245       c2pstr(theFile);
246       hpb->ioCompletion = NULL;
247       hpb->ioVRefNum = 0;
248       hpb->ioFDirIndex = 0;
249       hpb->ioNamePtr = (StringPtr) theFile;
250       hpb->ioDirID = 0L;
251       err = PBGetCatInfoSync(&paramBlock);
252       p2cstr((StringPtr) theFile);
253 
254       if (hpb->ioFlAttrib & 16) {
255     /*
256      * For directories use zero as the size, use no Creator
257      * type, and use 'DIR ' as the file type.
258      */
259     if ((aFlag == false) && (dpb->ioDrUsrWds.frFlags & 0x1000)) {
260         continue;
261     }
262     lineTag = 'D';
263     size = 0;
264     IUTimeString(dpb->ioDrMdDat, false, (unsigned char *)time);
265     p2cstr((StringPtr)time);
266     IUDateString(dpb->ioDrMdDat, shortDate, (unsigned char *)date);
267     p2cstr((StringPtr)date);
268     strcpy(creator, "    ");
269     strcpy(type, "DIR ");
270     flags = dpb->ioDrUsrWds.frFlags;
271     if (fFlag || pFlag) {
272         strcat(theFile, ":");
273     }
274       } else {
275     /*
276      * All information for files should be printed.  This
277      * includes size, modtime, moddate, creator type, file
278      * type, flags, anf file name.
279      */
280     if ((aFlag == false) &&
281       (hpb->ioFlFndrInfo.fdFlags & kIsInvisible)) {
282         continue;
283     }
284     lineTag = 'F';
285     size = hpb->ioFlLgLen + hpb->ioFlRLgLen;
286     IUTimeString(hpb->ioFlMdDat, false, (unsigned char *)time);
287     p2cstr((StringPtr)time);
288     IUDateString(hpb->ioFlMdDat, shortDate, (unsigned char *)date);
289     p2cstr((StringPtr)date);
290     strncpy(creator, (char *) &hpb->ioFlFndrInfo.fdCreator, 4);
291     creator[4] = 0;
292     strncpy(type, (char *) &hpb->ioFlFndrInfo.fdType, 4);
293     type[4] = 0;
294     flags = hpb->ioFlFndrInfo.fdFlags;
295     if (fFlag) {
296         if (hpb->ioFlFndrInfo.fdFlags & kIsAlias) {
297       strcat(theFile, "@");
298         } else if (hpb->ioFlFndrInfo.fdType == 'APPL') {
299       strcat(theFile, "*");
300         }
301     }
302       }
303       
304       sprintf(theLine, "%c %7ld %8s %8s %-4.4s %-4.4s 0x%4.4X %s",
305         lineTag, size, time, date, creator, type, flags, theFile);
306              
307       Tcl_AppendResult(interp, theLine, "\n", NULL);
308       
309   }
310     
311   objPtr = Tcl_GetObjResult(interp);
312   string = Tcl_GetStringFromObj(objPtr, &length);
313   if ((length > 0) && (string[length - 1] == '\n')) {
314       Tcl_SetObjLength(objPtr, length - 1);
315   }
316     } else {
317   /*
318    * Not in long format. We only print files names.  If the
319    * -C flag is set we need to print in multiple coloumns.
320    */
321   int argCount, linePos;
322   Boolean needNewLine = false;
323 
324   /*
325    * Fiend the field length: the length each string printed
326    * to the terminal will be.
327    */
328   if (!cFlag) {
329       perLine = 1;
330       fieldLength = STRING_LENGTH;
331   } else {
332       for (i = 0; i < objc; i++) {
333         argv = Tcl_GetString(objv[i]);
334     len = strlen(argv);
335     if (len > maxLen) {
336         maxLen = len;
337     }
338       }
339       fieldLength = maxLen + 3;
340       perLine = STRING_LENGTH / fieldLength;
341   }
342 
343   argCount = 0;
344   linePos = 0;
345   memset(theLine, ' ', STRING_LENGTH);
346   while (argCount < objc) {
347       strcpy(theFile, Tcl_GetString(objv[argCount]));
348       
349       c2pstr(theFile);
350       hpb->ioCompletion = NULL;
351       hpb->ioVRefNum = 0;
352       hpb->ioFDirIndex = 0;
353       hpb->ioNamePtr = (StringPtr) theFile;
354       hpb->ioDirID = 0L;
355       err = PBGetCatInfoSync(&paramBlock);
356       p2cstr((StringPtr) theFile);
357 
358       if (hpb->ioFlAttrib & 16) {
359     /*
360      * Directory. If -a show hidden files.  If -f or -p
361      * denote that this is a directory.
362      */
363     if ((aFlag == false) && (dpb->ioDrUsrWds.frFlags & 0x1000)) {
364         argCount++;
365         continue;
366     }
367     if (fFlag || pFlag) {
368         strcat(theFile, ":");
369     }
370       } else {
371     /*
372      * File: If -a show hidden files, if -f show links
373      * (aliases) and executables (APPLs).
374      */
375     if ((aFlag == false) &&
376       (hpb->ioFlFndrInfo.fdFlags & kIsInvisible)) {
377         argCount++;
378         continue;
379     }
380     if (fFlag) {
381         if (hpb->ioFlFndrInfo.fdFlags & kIsAlias) {
382       strcat(theFile, "@");
383         } else if (hpb->ioFlFndrInfo.fdType == 'APPL') {
384       strcat(theFile, "*");
385         }
386     }
387       }
388 
389       /*
390        * Print the item, taking into account multi-
391        * coloum output.
392        */
393       strncpy(theLine + (linePos * fieldLength), theFile,
394         strlen(theFile));
395       linePos++;
396       
397       if (linePos == perLine) {
398     theLine[STRING_LENGTH] = '\0';
399     if (needNewLine) {
400         Tcl_AppendResult(interp, "\n", theLine, NULL);
401     } else {
402         Tcl_AppendResult(interp, theLine, NULL);
403         needNewLine = true;
404     }
405     linePos = 0;
406     memset(theLine, ' ', STRING_LENGTH);
407       }
408       
409       argCount++;
410   }
411     
412   if (linePos != 0) {
413       theLine[STRING_LENGTH] = '\0';
414       if (needNewLine) {
415     Tcl_AppendResult(interp, "\n", theLine, NULL);
416       } else {
417     Tcl_AppendResult(interp, theLine, NULL);
418       }
419   }
420     }
421 
422     Tcl_DecrRefCount(resultObjPtr);
423       
424     return TCL_OK;
425 }

mac/tclMacUtil.c File Reference
#include "tcl.h"
#include "tclInt.h"
#include "tclMacInt.h"
#include "tclMath.h"
#include "tclMacPort.h"
#include <Aliases.h>
#include <Errors.h>
#include <Files.h>
#include <Folders.h>
#include <FSpCompat.h>
#include <Strings.h>
#include <TextUtils.h>
#include <MoreFilesExtras.h>
#include <FileCopy.h>
#include <MoreFiles.h>
Functions
int FSpGetDefaultDir (FSSpecPtr dirSpec)
int FSpSetDefaultDir (FSSpecPtr dirSpec)
OSErr FSpFindFolder (short vRefNum, OSType folderType, Boolean createFolder, FSSpec *spec)
static int FSpLocationFromPathAlias _ANSI_ARGS_ ((int length, CONST char *path, FSSpecPtr fileSpecPtr, Boolean resolveLink))
int FSpLocationFromPath (int length, CONST char *path, FSSpecPtr fileSpecPtr)
int FSpLLocationFromPath (int length, CONST char *path, FSSpecPtr fileSpecPtr)
static int FSpLocationFromPathAlias (int length, CONST char *path, FSSpecPtr fileSpecPtr, Boolean resolveLink)
OSErr FSpPathFromLocation (FSSpec *spec, int *length, Handle *fullPath)
void GetGlobalMouseTcl (Point *mouse)
pascal OSErr FSpGetDirectoryIDTcl (CONST FSSpec *spec, long *theDirID, Boolean *isDirectory)
pascal short FSpOpenResFileCompatTcl (CONST FSSpec *spec, SignedByte permission)
pascal void FSpCreateResFileCompatTcl (CONST FSSpec *spec, OSType creator, OSType fileType, ScriptCode scriptTag)

Function Documentation
static int FSpLocationFromPathAlias _ANSI_ARGS_ ((int length, CONST char *path, FSSpecPtr fileSpecPtr, Boolean resolveLink)) [static]
pascal void FSpCreateResFileCompatTcl (CONST FSSpec * spec, OSType creator, OSType fileType, ScriptCode scriptTag)

Definition at line 509 of file tclMacUtil.c.
Referenced by tclOSAStore().512 {
513   FSpCreateResFileCompat (spec,creator,fileType,scriptTag);
514 }
OSErr FSpFindFolder (short vRefNum, OSType folderType, Boolean createFolder, FSSpec * spec)

Definition at line 162 of file tclMacUtil.c.
Referenced by FileRCVariables(), and MakeFolderEnvVar().167 {
168     short foundVRefNum;
169     long foundDirID;
170     OSErr err;
171 
172     err = FindFolder(vRefNum, folderType, createFolder,
173       &foundVRefNum, &foundDirID);
174     if (err != noErr) {
175   return err;
176     }
177     
178     err = FSMakeFSSpecCompat(foundVRefNum, foundDirID, "\p", spec);
179     return err;
180 }
int FSpGetDefaultDir (FSSpecPtr dirSpec)

Definition at line 90 of file tclMacUtil.c.
References NULL.
Referenced by SystemVariables(), and TclpGetCwd().92 {
93     OSErr err;
94     short vRefNum = 0;
95     long int dirID = 0;
96 
97     err = HGetVol(NULL, &vRefNum, &dirID);
98   
99     if (err == noErr) {
100   err = FSMakeFSSpecCompat(vRefNum, dirID, (ConstStr255Param) NULL,
101     dirSpec);
102     }
103   
104     return err;
105 }
pascal OSErr FSpGetDirectoryIDTcl (CONST FSSpec * spec, long * theDirID, Boolean * isDirectory)

Definition at line 498 of file tclMacUtil.c.500 {
501   return(FSpGetDirectoryID(spec, theDirID, isDirectory));
502 }
int FSpLLocationFromPath (int length, CONST char * path, FSSpecPtr fileSpecPtr)

Definition at line 234 of file tclMacUtil.c.
References FALSE, and FSpLocationFromPathAlias().
Referenced by DoCopyFile(), DoRenameFile(), FspLLocationFromFsPath(), GetFileFinderAttributes(), GetFileReadOnly(), SetFileFinderAttributes(), SetFileReadOnly(), TclpDeleteFile(), and TclpObjNormalizePath().238 {
239   return FSpLocationFromPathAlias(length, path, fileSpecPtr, FALSE);
240 }
int FSpLocationFromPath (int length, CONST char * path, FSSpecPtr fileSpecPtr)

Definition at line 206 of file tclMacUtil.c.
References FSpLocationFromPathAlias(), and TRUE.
Referenced by DoCopyDirectory(), DoCreateDirectory(), DoRemoveDirectory(), FspLocationFromFsPath(), GetFileSpecs(), OpenFileChannel(), Tcl_MacEvalResource(), Tcl_ResourceObjCmd(), TclMacFOpenHack(), tclOSALoad(), tclOSAStore(), TclpDlopen(), TclpMatchInDirectory(), TclpReadlink(), and WriteTextResource().210 {
211   return FSpLocationFromPathAlias(length, path, fileSpecPtr, TRUE);
212 }
static int FSpLocationFromPathAlias (int length, CONST char * path, FSSpecPtr fileSpecPtr, Boolean resolveLink) [static]

Definition at line 243 of file tclMacUtil.c.
References FALSE, and NULL.
Referenced by FSpLLocationFromPath(), and FSpLocationFromPath().248 {
249     Str255 fileName;
250     OSErr err;
251     short vRefNum;
252     long dirID;
253     int pos, cur;
254     Boolean isDirectory;
255     Boolean wasAlias=FALSE;
256     FSSpec lastFileSpec;
257 
258     /*
259      * Check to see if this is a full path.  If partial
260      * we assume that path starts with the current working
261      * directory.  (Ie. volume & dir = 0)
262      */
263     vRefNum = 0;
264     dirID = 0;
265     cur = 0;
266     if (length == 0) {
267         return fnfErr;
268     }
269     if (path[cur] == ':') {
270   cur++;
271   if (cur >= length) {
272       /*
273        * If path = ":", just return current directory.
274        */
275       FSMakeFSSpecCompat(0, 0, NULL, fileSpecPtr);
276       return noErr;
277   }
278     } else {
279   while (path[cur] != ':' && cur < length) {
280       cur++;
281   }
282   if (cur > 255) {
283       return bdNamErr;
284   }
285   if (cur < length) {
286       /*
287        * This is a full path
288        */
289       cur++;
290       strncpy((char *) fileName + 1, path, cur);
291       fileName[0] = cur;
292       err = FSMakeFSSpecCompat(0, 0, fileName, fileSpecPtr);
293       if (err != noErr) return err;
294       FSpGetDirectoryID(fileSpecPtr, &dirID, &isDirectory);
295       vRefNum = fileSpecPtr->vRefNum;
296   } else {
297       cur = 0;
298   }
299     }
300     
301     isDirectory = 1;
302     while (cur < length) {
303   if (!isDirectory) {
304       return dirNFErr;
305   }
306   pos = cur;
307   while (path[pos] != ':' && pos < length) {
308       pos++;
309   }
310   if (pos == cur) {
311       /* Move up one dir */
312       /* cur++; */
313       strcpy((char *) fileName + 1, "::");
314       fileName[0] = 2;
315   } else if (pos - cur > 255) {
316       return bdNamErr;
317   } else {
318       strncpy((char *) fileName + 1, &path[cur], pos - cur);
319       fileName[0] = pos - cur;
320   }
321   err = FSMakeFSSpecCompat(vRefNum, dirID, fileName, fileSpecPtr);
322   if (err != noErr) return err;
323   lastFileSpec=*fileSpecPtr;
324   err = ResolveAliasFile(fileSpecPtr, true, &isDirectory, &wasAlias);
325   if (err != noErr) {
326       /* ignore alias resolve errors on last path component */
327       if (pos < length) return err;
328       else *fileSpecPtr=lastFileSpec;
329   }
330   FSpGetDirectoryID(fileSpecPtr, &dirID, &isDirectory);
331   vRefNum = fileSpecPtr->vRefNum;
332   cur = pos;
333   if (path[cur] == ':') {
334       cur++;
335   }
336     }
337     
338     if(!resolveLink && wasAlias)
339       *fileSpecPtr=lastFileSpec;
340     
341     return noErr;
342 }
pascal short FSpOpenResFileCompatTcl (CONST FSSpec * spec, SignedByte permission)

Definition at line 504 of file tclMacUtil.c.
Referenced by tclOSALoad(), and tclOSAStore().505 {
506   return(FSpOpenResFileCompat(spec,permission));
507 }
OSErr FSpPathFromLocation (FSSpec * spec, int * length, Handle * fullPath)

Definition at line 364 of file tclMacUtil.c.
References NULL, and void().
Referenced by FileRCVariables(), MakeFolderEnvVar(), SystemVariables(), TclMacFOpenHack(), TclpFindExecutable(), TclpGetCwd(), TclpObjNormalizePath(), and TclpReadlink().368 {
369     OSErr err;
370     FSSpec tempSpec;
371     CInfoPBRec pb;
372   
373     *fullPath = NULL;
374   
375     /* 
376      * Make a copy of the input FSSpec that can be modified.
377      */
378     BlockMoveData(spec, &tempSpec, sizeof(FSSpec));
379   
380     if (tempSpec.parID == fsRtParID) {
381   /* 
382    * The object is a volume.  Add a colon to make it a full 
383    * pathname.  Allocate a handle for it and we are done.
384    */
385   tempSpec.name[0] += 2;
386   tempSpec.name[tempSpec.name[0] - 1] = ':';
387   tempSpec.name[tempSpec.name[0]] = '\0';
388     
389   err = PtrToHand(&tempSpec.name[1], fullPath, tempSpec.name[0]);
390     } else {
391   /* 
392    * The object isn't a volume.  Is the object a file or a directory? 
393    */
394   pb.dirInfo.ioNamePtr = tempSpec.name;
395   pb.dirInfo.ioVRefNum = tempSpec.vRefNum;
396   pb.dirInfo.ioDrDirID = tempSpec.parID;
397   pb.dirInfo.ioFDirIndex = 0;
398   err = PBGetCatInfoSync(&pb);
399 
400   if ((err == noErr) || (err == fnfErr)) {
401       /* 
402        * If the file doesn't currently exist we start over.  If the
403        * directory exists everything will work just fine.  Otherwise we
404        * will just fail later.  If the object is a directory, append a
405        * colon so full pathname ends with colon, but only if the name is
406        * not empty.  NavServices returns FSSpec's with the parent ID set,
407        * but the name empty...
408        */
409       if (err == fnfErr) {
410     BlockMoveData(spec, &tempSpec, sizeof(FSSpec));
411       } else if ( (pb.hFileInfo.ioFlAttrib & ioDirMask) != 0 ) {
412           if (tempSpec.name[0] > 0) {
413         tempSpec.name[0] += 1;
414         tempSpec.name[tempSpec.name[0]] = ':';
415     }
416       }
417       
418       /* 
419        * Create a new Handle for the object - make it a C string.
420        */
421       tempSpec.name[0] += 1;
422       tempSpec.name[tempSpec.name[0]] = '\0';
423       err = PtrToHand(&tempSpec.name[1], fullPath, tempSpec.name[0]);
424       if (err == noErr) {
425     /* 
426      * Get the ancestor directory names - loop until we have an 
427      * error or find the root directory.
428      */
429     pb.dirInfo.ioNamePtr = tempSpec.name;
430     pb.dirInfo.ioVRefNum = tempSpec.vRefNum;
431     pb.dirInfo.ioDrParID = tempSpec.parID;
432     do {
433         pb.dirInfo.ioFDirIndex = -1;
434         pb.dirInfo.ioDrDirID = pb.dirInfo.ioDrParID;
435         err = PBGetCatInfoSync(&pb);
436         if (err == noErr) {
437       /* 
438        * Append colon to directory name and add 
439        * directory name to beginning of fullPath.
440        */
441       ++tempSpec.name[0];
442       tempSpec.name[tempSpec.name[0]] = ':';
443             
444       (void) Munger(*fullPath, 0, NULL, 0, &tempSpec.name[1],
445         tempSpec.name[0]);
446       err = MemError();
447         }
448     } while ( (err == noErr) &&
449       (pb.dirInfo.ioDrDirID != fsRtDirID) );
450       }
451   }
452     }
453     
454     /*
455      * On error Dispose the handle, set it to NULL & return the err.
456      * Otherwise, set the length & return.
457      */
458     if (err == noErr) {
459   *length = GetHandleSize(*fullPath) - 1;
460     } else {
461   if ( *fullPath != NULL ) {
462       DisposeHandle(*fullPath);
463   }
464   *fullPath = NULL;
465   *length = 0;
466     }
467 
468     return err;
469 }
int FSpSetDefaultDir (FSSpecPtr dirSpec)

Definition at line 125 of file tclMacUtil.c.
References NULL.
Referenced by TclpObjChdir().127 {
128     OSErr err;
129 
130     /*
131      * The following special case is needed to work around a bug
132      * in the Macintosh OS.  (Acutally PC Exchange.)
133      */
134     
135     if (dirSpec->parID == fsRtParID) {
136   err = HSetVol(NULL, dirSpec->vRefNum, fsRtDirID);
137     } else {
138   err = HSetVol(dirSpec->name, dirSpec->vRefNum, dirSpec->parID);
139     }
140     
141     return err;
142 }
void GetGlobalMouseTcl (Point * mouse)

Definition at line 489 of file tclMacUtil.c.
Referenced by HandleMacEvents(), and Tcl_WaitForEvent().491 {
492     EventRecord event;
493     
494     OSEventAvail(0, &event);
495     *mouse = event.where;
496 }

macosx/tclMacOSXBundle.c File Reference
#include "tclPort.h"
Functions
int Tcl_MacOSXOpenBundleResources (Tcl_Interp *interp, CONST char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath)
int Tcl_MacOSXOpenVersionedBundleResources (Tcl_Interp *interp, CONST char *bundleName, CONST char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath)

Function Documentation
int Tcl_MacOSXOpenBundleResources (Tcl_Interp * interp, CONST char * bundleName, int hasResourceFile, int maxPathLen, char * libraryPath)

Definition at line 83 of file tclMacOSXBundle.c.
References NULL, and Tcl_MacOSXOpenVersionedBundleResources().89 {
90     return Tcl_MacOSXOpenVersionedBundleResources(interp, bundleName,
91           NULL, hasResourceFile, maxPathLen, libraryPath);
92 }
int Tcl_MacOSXOpenVersionedBundleResources (Tcl_Interp * interp, CONST char * bundleName, CONST char * bundleVersion, int hasResourceFile, int maxPathLen, char * libraryPath)

Definition at line 117 of file tclMacOSXBundle.c.
References FALSE, initialized, NULL, TCL_ERROR, TCL_OK, and TRUE.
Referenced by Tcl_MacOSXOpenBundleResources().124 {
125 #ifdef HAVE_COREFOUNDATION
126     CFBundleRef bundleRef;
127     CFStringRef bundleNameRef;
128     CFURLRef libURL;
129 
130     libraryPath[0] = '\0';
131 
132     bundleNameRef = CFStringCreateWithCString(NULL,
133       bundleName, kCFStringEncodingUTF8);
134 
135     bundleRef = CFBundleGetBundleWithIdentifier(bundleNameRef);
136     CFRelease(bundleNameRef);
137 
138     if (bundleVersion && bundleRef) {
139         /* create bundle from bundleVersion subdirectory of 'Versions' */
140       CFBundleRef versionedBundleRef = NULL;
141   CFURLRef versionedBundleURL = NULL;
142   CFStringRef bundleVersionRef = CFStringCreateWithCString(NULL,
143     bundleVersion, kCFStringEncodingUTF8);
144   CFURLRef bundleURL = CFBundleCopyBundleURL(bundleRef);
145   if (bundleURL) {
146       CFStringRef bundleTailRef = CFURLCopyLastPathComponent(bundleURL);
147       if (bundleTailRef) {
148     if (CFStringCompare(bundleTailRef,bundleVersionRef,0)
149       == kCFCompareEqualTo) {
150         versionedBundleRef = bundleRef;
151     }
152     CFRelease(bundleTailRef);
153       }
154   }
155   if (bundleURL && !versionedBundleRef) {
156       CFURLRef versURL = CFURLCreateCopyAppendingPathComponent(NULL,
157             bundleURL, CFSTR("Versions"), TRUE);
158       if (versURL) {
159     versionedBundleURL = CFURLCreateCopyAppendingPathComponent(
160       NULL, versURL, bundleVersionRef, TRUE);
161     CFRelease(versURL);
162       }
163       CFRelease(bundleURL);
164   }
165   CFRelease(bundleVersionRef);
166   if (versionedBundleURL) {
167       versionedBundleRef = CFBundleCreate(NULL, versionedBundleURL);
168       CFRelease(versionedBundleURL);
169   }
170   bundleRef = versionedBundleRef;
171     }
172 
173     if (bundleRef) {  
174   if (hasResourceFile) {
175       /* Dynamically acquire address for CFBundleOpenBundleResourceMap
176        * symbol, since it is only present in full CoreFoundation
177        * on Mac OS X and not in CFLite on pure Darwin. */
178       static int initialized = FALSE;
179       static short (*openresourcemap)(CFBundleRef) = NULL;
180       if(!initialized) {
181     NSSymbol nsSymbol = NULL;
182     if(NSIsSymbolNameDefinedWithHint("_CFBundleOpenBundleResourceMap", "CoreFoundation")) {
183         nsSymbol = NSLookupAndBindSymbolWithHint("_CFBundleOpenBundleResourceMap", "CoreFoundation");
184         if(nsSymbol) {
185       openresourcemap = NSAddressOfSymbol(nsSymbol);
186         }
187     }
188     initialized = TRUE;
189       }
190       if (openresourcemap) {
191     short refNum;
192     refNum = openresourcemap(bundleRef);
193       }
194   }
195 
196   libURL = CFBundleCopyResourceURL(bundleRef,
197     CFSTR("Scripts"), NULL, NULL);
198 
199   if (libURL) {
200       /*
201        * FIXME: This is a quick fix, it is probably not right
202        * for internationalization.
203        */
204 
205       CFURLGetFileSystemRepresentation(libURL, TRUE,
206         (unsigned char*) libraryPath, maxPathLen);
207       CFRelease(libURL);
208   }
209     }
210     
211     if (libraryPath[0]) {
212         return TCL_OK;
213     } else {
214   return TCL_ERROR;
215     }
216 #else  /* HAVE_COREFOUNDATION */
217     return TCL_ERROR;
218 #endif /* HAVE_COREFOUNDATION */
219 }

macosx/tclMacOSXNotify.c File Reference
#include "tclInt.h"
#include "tclPort.h"

tools/man2tcl.c File Reference
#include <stdio.h>
#include <string.h>
#include <ctype.h>
#include <errno.h>
Defines
#define MAX_LINE_SIZE  1000
Functions
static void DoMacro (char *line)
static void DoText (char *line)
static void QuoteText (char *string, int count)
int main (int argc, char **argv)
Variables
static char sccsid [] = "@(#) man2tcl.c 1.3 95/08/12 17:34:08"
int errno
static int lineNumber
static int status
static int writeOutput

Define Documentation
#define MAX_LINE_SIZE  1000

Referenced by main().
Function Documentation
static void DoMacro (char * line) [static]

Definition at line 194 of file man2tcl.c.
References lineNumber, QuoteText(), status, and writeOutput.
Referenced by main().197 {
198     char *p, *end;
199 
200     /*
201      * If there is no macro name, then just skip the whole line.
202      */
203 
204     if ((line[1] == 0) || (isspace(line[1]))) {
205   return;
206     }
207 
208     if (writeOutput) {
209   printf("macro");
210     }
211     if (*line != '.') {
212   if (writeOutput) {
213       printf("2");
214   }
215     }
216 
217     /*
218      * Parse the arguments to the macro (including the name), in order.
219      */
220 
221     p = line+1;
222     while (1) {
223   if (writeOutput) {
224       putc(' ', stdout);
225   }
226   if (*p == '"')  {
227       /*
228        * The argument is delimited by quotes.
229        */
230 
231       for (end = p+1; *end != '"'; end++) {
232     if (*end == 0) {
233         fprintf(stderr,
234       "Unclosed quote in macro call on line %d.\n",
235       lineNumber);
236         status = 1;
237         break;
238     }
239       }
240       QuoteText(p+1, (end-(p+1)));
241   } else {
242       for (end = p+1;  (*end != 0) && !isspace(*end); end++) {
243     /* Empty loop body. */
244       }
245       QuoteText(p, end-p);
246   }
247   if (*end == 0) {
248       break;
249   }
250   p = end+1;
251   while (isspace(*p)) {
252       /*
253        * Skip empty space before next argument.
254        */
255 
256       p++;
257   }
258   if (*p == 0) {
259       break;
260   }
261     }
262     if (writeOutput) {
263   putc('\n', stdout);
264     }
265 }
static void DoText (char * line) [static]

Definition at line 286 of file man2tcl.c.
References lineNumber, QuoteText(), status, and writeOutput.
Referenced by main().288 {
289     char *p, *end;
290 
291     /*
292      * Divide the line up into pieces consisting of backslash sequences,
293      * tabs, and other text.
294      */
295 
296     p = line;
297     while (*p != 0) {
298   if (*p == '\t') {
299       if (writeOutput) {
300     printf("tab\n");
301       }
302       p++;
303   } else if (*p != '\\') {
304       /*
305        * Ordinary text.
306        */
307 
308       for (end = p+1; (*end != '\\') && (*end != 0); end++) {
309     /* Empty loop body. */
310       }
311       if (writeOutput) {
312     printf("text ");
313       }
314       QuoteText(p, end-p);
315       if (writeOutput) {
316     putc('\n', stdout);
317       }
318       p = end;
319   } else {
320       /*
321        * A backslash sequence.  There are particular ones
322        * that we understand;  output an error message for
323        * anything else and just ignore the backslash.
324        */
325 
326       p++;
327       if (*p == 'f') {
328     /*
329      * Font change.
330      */
331 
332     if (writeOutput) {
333         printf("font %c\n", p[1]);
334     }
335     p += 2;
336       } else if (*p == '-') {
337     if (writeOutput) {
338         printf("dash\n");
339     }
340     p++;
341       } else if (*p == 'e') {
342     if (writeOutput) {
343         printf("text \\\\\n");
344     }
345     p++;
346       } else if (*p == '.') {
347     if (writeOutput) {
348         printf("text .\n");
349     }
350     p++;
351       } else if (*p == '&') {
352     p++;
353       } else if (*p == '(') {
354     if ((p[1] == 0) || (p[2] == 0)) {
355         fprintf(stderr, "Bad \\( sequence on line %d.\n",
356           lineNumber);
357         status = 1;
358     } else {
359         if (writeOutput) {
360       printf("char {\\(%c%c}\n", p[1], p[2]);
361         }
362         p += 3;
363     }
364       } else if (*p != 0) {
365     if (writeOutput) {
366         printf("char {\\%c}\n", *p);
367     }
368     p++;
369       }
370   }
371     }
372     if (writeOutput) {
373   printf("newline\n");
374     }
375 }
int main (int argc, char ** argv)

Definition at line 93 of file man2tcl.c.
References DoMacro(), DoText(), errno, fopen, lineNumber, MAX_LINE_SIZE, NULL, SEEK_SET, status, and writeOutput.96 {
97     FILE *f;
98 #define MAX_LINE_SIZE 1000
99     char line[MAX_LINE_SIZE];
100     char *p;
101 
102     /*
103      * Find the file to read, and open it if it isn't stdin.
104      */
105 
106     if (argc == 1) {
107   f = stdin;
108     } else if (argc == 2) {
109   f = fopen(argv[1], "r");
110   if (f == NULL) {
111       fprintf(stderr, "Couldn't read \"%s\": %s\n", argv[1],
112         strerror(errno));
113       exit(1);
114   }
115     } else {
116   fprintf(stderr, "Usage: %s ?fileName?\n", argv[0]);
117     }
118 
119     /*
120      * Make two passes over the file.  In the first pass, just check
121      * to make sure we can handle everything.  If there are problems,
122      * generate output and stop.  If everything is OK, make a second
123      * pass to actually generate output.
124      */
125 
126     for (writeOutput = 0; writeOutput < 2; writeOutput++) {
127   lineNumber = 0;
128   status = 0;
129   while (fgets(line, MAX_LINE_SIZE, f) != NULL) {
130       for (p = line; *p != 0; p++) {
131     if (*p == '\n') {
132         *p = 0;
133         break;
134     }
135       }
136       lineNumber++;
137     
138       if ((line[0] == '\'') && (line[1] == '\\') && (line[2] == '\"')) {
139     /* 
140      * This line is a comment.  Ignore it.
141      */
142     
143     continue;
144       }
145     
146       if (strlen(line) >= MAX_LINE_SIZE -1) {
147     fprintf(stderr, "Too long line. Max is %d chars.\n",
148       MAX_LINE_SIZE - 1);
149     exit(1);
150       }
151 
152       if ((line[0] == '.') || (line[0] == '\'')) {
153     /*
154      * This line is a macro invocation.
155      */
156     
157     DoMacro(line);
158       } else {
159     /*
160      * This line is text, possibly with formatting characters
161      * embedded in it.
162      */
163     
164     DoText(line);
165       }
166   }
167   if (status != 0) {
168       break;
169   }
170   fseek(f, 0, SEEK_SET);
171     }
172     exit(status);
173 }
static void QuoteText (char * string, int count) [static]

Definition at line 396 of file man2tcl.c.
References writeOutput.
Referenced by DoMacro(), and DoText().399 {
400     if (count == 0) {
401   if (writeOutput) {
402       printf("{}");
403   }
404   return;
405     }
406     for ( ; count > 0; string++, count--) {
407   if ((*string == '$') || (*string == '[') || (*string == '{')
408     || (*string == ' ') || (*string == ';') || (*string == '\\')
409     || (*string == '"') || (*string == '\t')) {
410       if (writeOutput) {
411     putc('\\', stdout);
412       }
413   }
414   if (writeOutput) {
415       putc(*string, stdout);
416   }
417     }
418 }

Variable Documentation
int errno
int lineNumber [static]

Definition at line 48 of file man2tcl.c.
Referenced by DoMacro(), DoText(), and main().char sccsid[] = "@(#) man2tcl.c 1.3 95/08/12 17:34:08" [static]

Definition at line 22 of file man2tcl.c.int status [static]

Definition at line 55 of file man2tcl.c.
Referenced by CompileRegexp(), DoMacro(), DoText(), GetStatBuf(), main(), RegExpExecUniChar(), SerialGetOptionProc(), Tcl_ReapDetachedProcs(), Tcl_WaitForEvent(), TclpCreateProcess(), TclpDlopen(), TclWinCPUID(), TestwincpuidCmd(), and waitpid().int writeOutput [static]

Definition at line 63 of file man2tcl.c.
Referenced by DoMacro(), DoText(), main(), and QuoteText().

unix/dltest/pkga.c File Reference
#include "tcl.h"
Functions
static int Pkga_EqObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
static int Pkga_EqObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int Pkga_QuoteObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Pkga_Init (Tcl_Interp *interp)

Function Documentation
static int Pkga_EqObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])) [static]
static int Pkga_EqObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 44 of file pkga.c.
References CONST, TCL_ERROR, Tcl_GetStringFromObj(), Tcl_NewIntObj(), TCL_OK, Tcl_SetObjResult(), Tcl_UtfNcmp(), and Tcl_WrongNumArgs().
Referenced by Pkga_Init().49 {
50     int result;
51     CONST char *str1, *str2;
52     int len1, len2;
53 
54     if (objc != 3) {
55   Tcl_WrongNumArgs(interp, 1, objv,  "string1 string2");
56   return TCL_ERROR;
57     }
58 
59     str1 = Tcl_GetStringFromObj(objv[1], &len1);
60     str2 = Tcl_GetStringFromObj(objv[2], &len2);
61     if (len1 == len2) {
62   result = (Tcl_UtfNcmp(str1, str2, len1) == 0);
63     } else {
64   result = 0;
65     }
66     Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
67     return TCL_OK;
68 }
int Pkga_Init (Tcl_Interp * interp)

Definition at line 120 of file pkga.c.
References NULL, Pkga_EqObjCmd(), Pkga_QuoteObjCmd(), Tcl_CreateObjCommand(), TCL_ERROR, Tcl_InitStubs, TCL_OK, Tcl_PkgProvide(), and TCL_VERSION.123 {
124     int code;
125 
126     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
127   return TCL_ERROR;
128     }
129     code = Tcl_PkgProvide(interp, "Pkga", "1.0");
130     if (code != TCL_OK) {
131   return code;
132     }
133     Tcl_CreateObjCommand(interp, "pkga_eq", Pkga_EqObjCmd,
134       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
135     Tcl_CreateObjCommand(interp, "pkga_quote", Pkga_QuoteObjCmd,
136       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
137     return TCL_OK;
138 }
static int Pkga_QuoteObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 88 of file pkga.c.
References TCL_ERROR, TCL_OK, Tcl_SetObjResult(), and Tcl_WrongNumArgs().
Referenced by Pkga_Init().93 {
94     if (objc != 2) {
95   Tcl_WrongNumArgs(interp, 1, objv, "value");
96   return TCL_ERROR;
97     }
98     Tcl_SetObjResult(interp, objv[1]);
99     return TCL_OK;
100 }

unix/dltest/pkgb.c File Reference
#include "tcl.h"
Functions
static int Pkgb_SubObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
static int Pkgb_SubObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int Pkgb_UnsafeObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Pkgb_Init (Tcl_Interp *interp)
int Pkgb_SafeInit (Tcl_Interp *interp)

Function Documentation
static int Pkgb_SubObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])) [static]
int Pkgb_Init (Tcl_Interp * interp)

Definition at line 110 of file pkgb.c.
References NULL, Pkgb_SubObjCmd(), Pkgb_UnsafeObjCmd(), Tcl_CreateObjCommand(), TCL_ERROR, Tcl_InitStubs, TCL_OK, Tcl_PkgProvide(), and TCL_VERSION.113 {
114     int code;
115 
116     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
117   return TCL_ERROR;
118     }
119     code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
120     if (code != TCL_OK) {
121   return code;
122     }
123     Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd,
124       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
125     Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd,
126       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
127     return TCL_OK;
128 }
int Pkgb_SafeInit (Tcl_Interp * interp)

Definition at line 148 of file pkgb.c.
References NULL, Pkgb_SubObjCmd(), Tcl_CreateObjCommand(), TCL_ERROR, Tcl_InitStubs, TCL_OK, Tcl_PkgProvide(), and TCL_VERSION.151 {
152     int code;
153 
154     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
155   return TCL_ERROR;
156     }
157     code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
158     if (code != TCL_OK) {
159       return code;
160     }
161     Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, (ClientData) 0,
162       (Tcl_CmdDeleteProc *) NULL);
163     return TCL_OK;
164 }
static int Pkgb_SubObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 44 of file pkgb.c.
References TCL_ERROR, Tcl_GetIntFromObj(), Tcl_NewIntObj(), TCL_OK, Tcl_SetObjResult(), and Tcl_WrongNumArgs().
Referenced by Pkgb_Init(), and Pkgb_SafeInit().49 {
50     int first, second;
51 
52     if (objc != 3) {
53   Tcl_WrongNumArgs(interp, 1, objv, "num num");
54         return TCL_ERROR;
55     }
56     if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
57       || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
58         return TCL_ERROR;
59     }
60     Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second));
61     return TCL_OK;
62 }
static int Pkgb_UnsafeObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 82 of file pkgb.c.
References Tcl_NewStringObj(), TCL_OK, and Tcl_SetObjResult().
Referenced by Pkgb_Init().87 {
88     Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
89     return TCL_OK;
90 }

unix/dltest/pkgc.c File Reference
#include "tcl.h"
Functions
static int Pkgc_SubObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
static int Pkgc_SubObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int Pkgc_UnsafeObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Pkgc_Init (Tcl_Interp *interp)
int Pkgc_SafeInit (Tcl_Interp *interp)

Function Documentation
static int Pkgc_SubObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])) [static]
int Pkgc_Init (Tcl_Interp * interp)

Definition at line 110 of file pkgc.c.
References NULL, Pkgc_SubObjCmd(), Pkgc_UnsafeObjCmd(), Tcl_CreateObjCommand(), TCL_ERROR, Tcl_InitStubs, TCL_OK, Tcl_PkgProvide(), and TCL_VERSION.113 {
114     int code;
115 
116     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
117   return TCL_ERROR;
118     }
119     code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
120     if (code != TCL_OK) {
121   return code;
122     }
123     Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd,
124       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
125     Tcl_CreateObjCommand(interp, "pkgc_unsafe", Pkgc_UnsafeObjCmd,
126       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
127     return TCL_OK;
128 }
int Pkgc_SafeInit (Tcl_Interp * interp)

Definition at line 148 of file pkgc.c.
References NULL, Pkgc_SubObjCmd(), Tcl_CreateObjCommand(), TCL_ERROR, Tcl_InitStubs, TCL_OK, Tcl_PkgProvide(), and TCL_VERSION.151 {
152     int code;
153 
154     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
155   return TCL_ERROR;
156     }
157     code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
158     if (code != TCL_OK) {
159       return code;
160     }
161     Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd, (ClientData) 0,
162       (Tcl_CmdDeleteProc *) NULL);
163     return TCL_OK;
164 }
static int Pkgc_SubObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 44 of file pkgc.c.
References TCL_ERROR, Tcl_GetIntFromObj(), Tcl_NewIntObj(), TCL_OK, Tcl_SetObjResult(), and Tcl_WrongNumArgs().
Referenced by Pkgc_Init(), and Pkgc_SafeInit().49 {
50     int first, second;
51 
52     if (objc != 3) {
53   Tcl_WrongNumArgs(interp, 1, objv, "num num");
54   return TCL_ERROR;
55     }
56     if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
57       || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
58   return TCL_ERROR;
59     }
60     Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second));
61     return TCL_OK;
62 }
static int Pkgc_UnsafeObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 82 of file pkgc.c.
References Tcl_NewStringObj(), TCL_OK, and Tcl_SetObjResult().
Referenced by Pkgc_Init().87 {
88     Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
89     return TCL_OK;
90 }

unix/dltest/pkgd.c File Reference
#include "tcl.h"
Functions
static int Pkgd_SubObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
static int Pkgd_SubObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
static int Pkgd_UnsafeObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, objv)
int Pkgd_Init (Tcl_Interp *interp)
int Pkgd_SafeInit (Tcl_Interp *interp)

Function Documentation
static int Pkgd_SubObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])) [static]
int Pkgd_Init (Tcl_Interp * interp)

Definition at line 111 of file pkgd.c.
References NULL, Pkgd_SubObjCmd(), Pkgd_UnsafeObjCmd(), Tcl_CreateObjCommand(), TCL_ERROR, Tcl_InitStubs, TCL_OK, Tcl_PkgProvide(), and TCL_VERSION.114 {
115     int code;
116 
117     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
118   return TCL_ERROR;
119     }
120     code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
121     if (code != TCL_OK) {
122   return code;
123     }
124     Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd,
125       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
126     Tcl_CreateObjCommand(interp, "pkgd_unsafe", Pkgd_UnsafeObjCmd,
127       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
128     return TCL_OK;
129 }
int Pkgd_SafeInit (Tcl_Interp * interp)

Definition at line 149 of file pkgd.c.
References NULL, Pkgd_SubObjCmd(), Tcl_CreateObjCommand(), TCL_ERROR, Tcl_InitStubs, TCL_OK, Tcl_PkgProvide(), and TCL_VERSION.152 {
153     int code;
154 
155     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
156   return TCL_ERROR;
157     }
158     code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
159     if (code != TCL_OK) {
160   return code;
161     }
162     Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd, (ClientData) 0,
163       (Tcl_CmdDeleteProc *) NULL);
164     return TCL_OK;
165 }
static int Pkgd_SubObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 45 of file pkgd.c.
References TCL_ERROR, Tcl_GetIntFromObj(), Tcl_NewIntObj(), TCL_OK, Tcl_SetObjResult(), and Tcl_WrongNumArgs().
Referenced by Pkgd_Init(), and Pkgd_SafeInit().50 {
51     int first, second;
52 
53     if (objc != 3) {
54   Tcl_WrongNumArgs(interp, 1, objv, "num num");
55   return TCL_ERROR;
56     }
57     if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
58       || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
59   return TCL_ERROR;
60     }
61     Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second));
62     return TCL_OK;
63 }
static int Pkgd_UnsafeObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 83 of file pkgd.c.
References Tcl_NewStringObj(), TCL_OK, and Tcl_SetObjResult().
Referenced by Pkgd_Init().88 {
89     Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
90     return TCL_OK;
91 }

unix/dltest/pkge.c File Reference
#include "tcl.h"
Functions
int Pkge_Init (Tcl_Interp *interp)

Function Documentation
int Pkge_Init (Tcl_Interp * interp)

Definition at line 37 of file pkge.c.
References NULL, TCL_ERROR, Tcl_Eval(), Tcl_InitStubs, and TCL_VERSION.40 {
41     static char script[] = "if 44 {open non_existent}";
42     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
43   return TCL_ERROR;
44     }
45     return Tcl_Eval(interp, script);
46 }

unix/dltest/pkgf.c File Reference
#include "tcl.h"
Functions
static int Pkgd_SubCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int argc, char **argv))
int Pkgf_Init (Tcl_Interp *interp)

Function Documentation
static int Pkgd_SubCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)) [static]
int Pkgf_Init (Tcl_Interp * interp)

Definition at line 44 of file pkgf.c.
References NULL, TCL_ERROR, Tcl_Eval(), Tcl_InitStubs, and TCL_VERSION.47 {
48     static char script[] = "if 44 {open non_existent}";
49     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
50   return TCL_ERROR;
51     }
52     return Tcl_Eval(interp, script);
53 }

unix/tclAppInit.c File Reference
#include "tcl.h"
Defines
#define TCL_LOCAL_APPINIT  Tcl_AppInit
Functions
int main (int argc, char **argv)
int Tcl_AppInit (Tcl_Interp *interp)

Define Documentation
#define TCL_LOCAL_APPINIT  Tcl_AppInit

Referenced by main().
Function Documentation
int main (int argc, char ** argv)

Definition at line 56 of file tclAppInit.c.
References _ANSI_ARGS_, TCL_LOCAL_APPINIT, and Tcl_Main().59 {
60     /*
61      * The following #if block allows you to change the AppInit
62      * function by using a #define of TCL_LOCAL_APPINIT instead
63      * of rewriting this entire file.  The #if checks for that
64      * #define and uses Tcl_AppInit if it doesn't exist.
65      */
66 
67 #ifndef TCL_LOCAL_APPINIT
68 #define TCL_LOCAL_APPINIT Tcl_AppInit    
69 #endif
70     extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp));
71 
72     /*
73      * The following #if block allows you to change how Tcl finds the startup
74      * script, prime the library or encoding paths, fiddle with the argv,
75      * etc., without needing to rewrite Tcl_Main()
76      */
77 
78 #ifdef TCL_LOCAL_MAIN_HOOK
79     extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));
80 #endif
81 
82 #ifdef TCL_XT_TEST
83     XtToolkitInitialize();
84 #endif
85 
86 #ifdef TCL_LOCAL_MAIN_HOOK
87     TCL_LOCAL_MAIN_HOOK(&argc, &argv);
88 #endif
89 
90     Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
91 
92     return 0;     /* Needed only to prevent compiler warning. */
93 }
int Tcl_AppInit (Tcl_Interp * interp)

Definition at line 115 of file tclAppInit.c.
References NULL, Procbodytest_Init(), Procbodytest_SafeInit(), TCL_ERROR, TCL_GLOBAL_ONLY, Tcl_Init(), TCL_OK, Tcl_SetVar(), Tcl_StaticPackage(), TclObjTest_Init(), Tcltest_Init(), and Tclxttest_Init().117 {
118     if (Tcl_Init(interp) == TCL_ERROR) {
119   return TCL_ERROR;
120     }
121 
122 #ifdef TCL_TEST
123 #ifdef TCL_XT_TEST
124      if (Tclxttest_Init(interp) == TCL_ERROR) {
125    return TCL_ERROR;
126      }
127 #endif
128     if (Tcltest_Init(interp) == TCL_ERROR) {
129   return TCL_ERROR;
130     }
131     Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
132             (Tcl_PackageInitProc *) NULL);
133     if (TclObjTest_Init(interp) == TCL_ERROR) {
134   return TCL_ERROR;
135     }
136 #ifdef TCL_THREADS
137     if (TclThread_Init(interp) == TCL_ERROR) {
138   return TCL_ERROR;
139     }
140 #endif
141     if (Procbodytest_Init(interp) == TCL_ERROR) {
142   return TCL_ERROR;
143     }
144     Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
145             Procbodytest_SafeInit);
146 #endif /* TCL_TEST */
147 
148     /*
149      * Call the init procedures for included packages.  Each call should
150      * look like this:
151      *
152      * if (Mod_Init(interp) == TCL_ERROR) {
153      *     return TCL_ERROR;
154      * }
155      *
156      * where "Mod" is the name of the module.
157      */
158 
159     /*
160      * Call Tcl_CreateCommand for application-specific commands, if
161      * they weren't already created by the init procedures called above.
162      */
163 
164     /*
165      * Specify a user-specific startup file to invoke if the application
166      * is run interactively.  Typically the startup file is "~/.apprc"
167      * where "app" is the name of the application.  If this line is deleted
168      * then no user-specific startup file will be run under any conditions.
169      */
170 
171 #ifdef DJGPP
172     Tcl_SetVar(interp, "tcl_rcFileName", "~/tclsh.rc", TCL_GLOBAL_ONLY);
173 #else
174     Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);
175 #endif
176     return TCL_OK;
177 }

win/tclAppInit.c File Reference
#include "tcl.h"
#include <windows.h>
#include <locale.h>
Defines
#define TCL_LOCAL_APPINIT  Tcl_AppInit
Functions
static void setargv _ANSI_ARGS_ ((int *argcPtr, char ***argvPtr))
static BOOL __stdcall sigHandler (DWORD fdwCtrlType)
static void AppInitExitHandler (ClientData clientData)
int main (int argc, char **argv)
int Tcl_AppInit (Tcl_Interp *interp)
static void setargv (int *argcPtr, char ***argvPtr)
int asyncExit (ClientData clientData, Tcl_Interp *interp, int code)
Variables
static Tcl_AsyncProc asyncExit
static char ** argvSave = NULL
static Tcl_AsyncHandler exitToken = NULL
static DWORD exitErrorCode = 0

Define Documentation
#define TCL_LOCAL_APPINIT  Tcl_AppInit

Function Documentation
static void setargv _ANSI_ARGS_ ((int *argcPtr, char ***argvPtr)) [static]
static void AppInitExitHandler (ClientData clientData) [static]

Definition at line 245 of file tclAppInit.c.
References ckfree, NULL, and Tcl_AsyncDelete().
Referenced by Tcl_AppInit().247 {
248     if (argvSave != NULL) {
249         ckfree((char *)argvSave);
250         argvSave = NULL;
251     }
252 
253     if (exitToken != NULL) {
254         /*
255          * This should be safe to do even if we
256          * are in an async exit right now.
257          */
258         Tcl_AsyncDelete(exitToken);
259         exitToken = NULL;
260     }
261 }
int asyncExit (ClientData clientData, Tcl_Interp * interp, int code)

Definition at line 397 of file tclAppInit.c.
References Tcl_Exit().398 {
399     Tcl_Exit((int)exitErrorCode);
400 
401     /* NOTREACHED */
402     return code;
403 }
int main (int argc, char ** argv)

Definition at line 59 of file tclAppInit.c.
References _ANSI_ARGS_, NULL, setargv(), TCL_LOCAL_APPINIT, and Tcl_Main().62 {
63     /*
64      * The following #if block allows you to change the AppInit
65      * function by using a #define of TCL_LOCAL_APPINIT instead
66      * of rewriting this entire file.  The #if checks for that
67      * #define and uses Tcl_AppInit if it doesn't exist.
68      */
69 
70 #ifndef TCL_LOCAL_APPINIT
71 #define TCL_LOCAL_APPINIT Tcl_AppInit
72 #endif
73     extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp));
74 
75     /*
76      * The following #if block allows you to change how Tcl finds the startup
77      * script, prime the library or encoding paths, fiddle with the argv,
78      * etc., without needing to rewrite Tcl_Main()
79      */
80 
81 #ifdef TCL_LOCAL_MAIN_HOOK
82     extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));
83 #endif
84 
85     char buffer[MAX_PATH +1];
86     char *p;
87     /*
88      * Set up the default locale to be standard "C" locale so parsing
89      * is performed correctly.
90      */
91 
92     setlocale(LC_ALL, "C");
93     setargv(&argc, &argv);
94 
95     /*
96      * Save this for later, so we can free it.
97      */
98     argvSave = argv;
99 
100     /*
101      * Replace argv[0] with full pathname of executable, and forward
102      * slashes substituted for backslashes.
103      */
104 
105     GetModuleFileName(NULL, buffer, sizeof(buffer));
106     argv[0] = buffer;
107     for (p = buffer; *p != '\0'; p++) {
108   if (*p == '\\') {
109       *p = '/';
110   }
111     }
112 
113 #ifdef TCL_LOCAL_MAIN_HOOK
114     TCL_LOCAL_MAIN_HOOK(&argc, &argv);
115 #endif
116 
117     Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
118 
119     return 0;     /* Needed only to prevent compiler warning. */
120 }
static void setargv (int * argcPtr, char *** argvPtr) [static]

Definition at line 291 of file tclAppInit.c.
References NULL, and Tcl_Alloc().
Referenced by main().294 {
295     char *cmdLine, *p, *arg, *argSpace;
296     char **argv;
297     int argc, size, inquote, copy, slashes;
298 
299     cmdLine = GetCommandLine(); /* INTL: BUG */
300 
301     /*
302      * Precompute an overly pessimistic guess at the number of arguments
303      * in the command line by counting non-space spans.
304      */
305 
306     size = 2;
307     for (p = cmdLine; *p != '\0'; p++) {
308   if ((*p == ' ') || (*p == '\t')) {  /* INTL: ISO space. */
309       size++;
310       while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
311     p++;
312       }
313       if (*p == '\0') {
314     break;
315       }
316   }
317     }
318     argSpace = (char *) Tcl_Alloc(
319       (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1));
320     argv = (char **) argSpace;
321     argSpace += size * sizeof(char *);
322     size--;
323 
324     p = cmdLine;
325     for (argc = 0; argc < size; argc++) {
326   argv[argc] = arg = argSpace;
327   while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
328       p++;
329   }
330   if (*p == '\0') {
331       break;
332   }
333 
334   inquote = 0;
335   slashes = 0;
336   while (1) {
337       copy = 1;
338       while (*p == '\\') {
339     slashes++;
340     p++;
341       }
342       if (*p == '"') {
343     if ((slashes & 1) == 0) {
344         copy = 0;
345         if ((inquote) && (p[1] == '"')) {
346       p++;
347       copy = 1;
348         } else {
349       inquote = !inquote;
350         }
351                 }
352                 slashes >>= 1;
353             }
354 
355             while (slashes) {
356     *arg = '\\';
357     arg++;
358     slashes--;
359       }
360 
361       if ((*p == '\0')
362         || (!inquote && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
363     break;
364       }
365       if (copy != 0) {
366     *arg = *p;
367     arg++;
368       }
369       p++;
370         }
371   *arg = '\0';
372   argSpace = arg + 1;
373     }
374     argv[argc] = NULL;
375 
376     *argcPtr = argc;
377     *argvPtr = argv;
378 }
BOOL __stdcall sigHandler (DWORD fdwCtrlType) [static]

Definition at line 426 of file tclAppInit.c.
References FALSE, Tcl_AsyncMark(), and TRUE.
Referenced by Tcl_AppInit().427 {
428     HANDLE hStdIn;
429 
430     if (!exitToken) {
431   /* Async token must have been destroyed, punt gracefully. */
432   return FALSE;
433     }
434 
435     /*
436      * If Tcl is currently executing some bytecode or in the eventloop,
437      * this will cause Tcl to enter asyncExit at the next command
438      * boundry.
439      */
440     exitErrorCode = fdwCtrlType;
441     Tcl_AsyncMark(exitToken);
442 
443     /*
444      * This will cause Tcl_Gets in Tcl_Main() to drop-out with an <EOF>
445      * should it be blocked on input and our Tcl_AsyncMark didn't grab
446      * the attention of the interpreter.
447      */
448     hStdIn = GetStdHandle(STD_INPUT_HANDLE);
449     if (hStdIn) {
450   CloseHandle(hStdIn);
451     }
452 
453     /* indicate to the OS not to call the default terminator */
454     return TRUE;
455 }
int Tcl_AppInit (Tcl_Interp * interp)

Definition at line 143 of file tclAppInit.c.
References AppInitExitHandler(), NULL, Procbodytest_Init(), Procbodytest_SafeInit(), Registry_Init(), sigHandler(), Tcl_AsyncCreate(), Tcl_CreateExitHandler(), TCL_ERROR, TCL_GLOBAL_ONLY, Tcl_Init(), TCL_OK, Tcl_SetVar(), Tcl_StaticPackage(), TclObjTest_Init(), Tcltest_Init(), and TRUE.145 {
146     if (Tcl_Init(interp) == TCL_ERROR) {
147   return TCL_ERROR;
148     }
149 
150     /*
151      * Install a signal handler to the win32 console tclsh is running in.
152      */
153     SetConsoleCtrlHandler(sigHandler, TRUE);
154     exitToken = Tcl_AsyncCreate(asyncExit, NULL);
155 
156     /*
157      * This exit handler will be used to free the
158      * resources allocated in this file.
159      */
160     Tcl_CreateExitHandler(AppInitExitHandler, NULL);
161 
162 #ifdef TCL_TEST
163     if (Tcltest_Init(interp) == TCL_ERROR) {
164   return TCL_ERROR;
165     }
166     Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
167             (Tcl_PackageInitProc *) NULL);
168     if (TclObjTest_Init(interp) == TCL_ERROR) {
169   return TCL_ERROR;
170     }
171 #ifdef TCL_THREADS
172     if (TclThread_Init(interp) == TCL_ERROR) {
173   return TCL_ERROR;
174     }
175 #endif
176     if (Procbodytest_Init(interp) == TCL_ERROR) {
177   return TCL_ERROR;
178     }
179     Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
180             Procbodytest_SafeInit);
181 #endif /* TCL_TEST */
182 
183 #if defined(STATIC_BUILD) && defined(TCL_USE_STATIC_PACKAGES)
184     {
185   extern Tcl_PackageInitProc Registry_Init;
186   extern Tcl_PackageInitProc Dde_Init;
187 
188   if (Registry_Init(interp) == TCL_ERROR) {
189       return TCL_ERROR;
190   }
191   Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
192 
193   if (Dde_Init(interp) == TCL_ERROR) {
194       return TCL_ERROR;
195   }
196   Tcl_StaticPackage(interp, "dde", Dde_Init, NULL);
197    }
198 #endif
199 
200     /*
201      * Call the init procedures for included packages.  Each call should
202      * look like this:
203      *
204      * if (Mod_Init(interp) == TCL_ERROR) {
205      *     return TCL_ERROR;
206      * }
207      *
208      * where "Mod" is the name of the module.
209      */
210 
211     /*
212      * Call Tcl_CreateCommand for application-specific commands, if
213      * they weren't already created by the init procedures called above.
214      */
215 
216     /*
217      * Specify a user-specific startup file to invoke if the application
218      * is run interactively.  Typically the startup file is "~/.apprc"
219      * where "app" is the name of the application.  If this line is deleted
220      * then no user-specific startup file will be run under any conditions.
221      */
222 
223     Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY);
224     return TCL_OK;
225 }

Variable Documentation
char** argvSave = NULL [static]

Definition at line 36 of file tclAppInit.c.Tcl_AsyncProc asyncExit [static]

Definition at line 33 of file tclAppInit.c.DWORD exitErrorCode = 0 [static]

Definition at line 38 of file tclAppInit.c.Tcl_AsyncHandler exitToken = NULL [static]

Definition at line 37 of file tclAppInit.c.

unix/tclLoadAix.c File Reference
#include <stdio.h>
#include <errno.h>
#include <string.h>
#include <stdlib.h>
#include <sys/types.h>
#include <sys/ldr.h>
#include <a.out.h>
#include <ldfcn.h>
#include "../compat/dlfcn.h"
Classes
struct Export
struct Cdtor
struct Module
Typedefs
typedef struct Export * ExportPtr
typedef struct Cdtor * CdtorPtr
typedef Module * ModulePtr
Functions
static void caterr (char *)
static int readExports (ModulePtr)
static void terminate (void)
static void * findMain (void)
VOID * dlopen (const char *path, int mode)
VOID * dlsym (void *handle, const char *symbol)
char * dlerror (void)
int dlclose (void *handle)
Variables
static ModulePtr modList
static char errbuf [BUFSIZ]
static int errvalid

Typedef Documentation
typedef  struct Cdtor * CdtorPtr
typedef  struct Export * ExportPtr
typedef struct Module * ModulePtr

Function Documentation
static void caterr (char *) [static]

Definition at line 210 of file tclLoadAix.c.211 {
212   register char *p = s;
213 
214   while (*p >= '0' && *p <= '9')
215     p++;
216   switch(atoi(s)) {   /* INTL: "C", UTF safe. */
217   case L_ERROR_TOOMANY:
218     strcat(errbuf, "to many errors");
219     break;
220   case L_ERROR_NOLIB:
221     strcat(errbuf, "can't load library");
222     strcat(errbuf, p);
223     break;
224   case L_ERROR_UNDEF:
225     strcat(errbuf, "can't find symbol");
226     strcat(errbuf, p);
227     break;
228   case L_ERROR_RLDBAD:
229     strcat(errbuf, "bad RLD");
230     strcat(errbuf, p);
231     break;
232   case L_ERROR_FORMAT:
233     strcat(errbuf, "bad exec format in");
234     strcat(errbuf, p);
235     break;
236   case L_ERROR_ERRNO:
237     strcat(errbuf, strerror(atoi(++p)));  /* INTL: "C", UTF safe. */
238     break;
239   default:
240     strcat(errbuf, s);
241     break;
242   }
243 }
int dlclose (void * handle)

Definition at line 273 of file tclLoadAix.c.
References Module::cdtors, Module::entry, errno, errvalid, Module::exports, Module::info, modList, Export::name, Module::nExports, Module::next, Module::refCnt, and Cdtor::term.
Referenced by TclpUnloadFile(), and terminate().274 {
275   register ModulePtr mp = (ModulePtr)handle;
276   int result;
277   register ModulePtr mp1;
278 
279   if (--mp->refCnt > 0)
280     return 0;
281   if (mp->info && mp->info->fini)
282     (*mp->info->fini)();
283   if (mp->cdtors)
284     while (mp->cdtors->term) {
285       (*mp->cdtors->term)();
286       mp->cdtors++;
287     }
288   result = unload(mp->entry);
289   if (result == -1) {
290     errvalid++;
291     strcpy(errbuf, strerror(errno));
292   }
293   if (mp->exports) {
294     register ExportPtr ep;
295     register int i;
296     for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
297       if (ep->name)
298         free(ep->name);
299     free(mp->exports);
300   }
301   if (mp == modList)
302     modList = mp->next;
303   else {
304     for (mp1 = modList; mp1; mp1 = mp1->next)
305       if (mp1->next == mp) {
306         mp1->next = mp->next;
307         break;
308       }
309   }
310   free(mp->name);
311   free(mp);
312   return result;
313 }
char* dlerror (void)

Definition at line 264 of file tclLoadAix.c.
References errvalid, and NULL.
Referenced by TclpDlopen().265 {
266   if (errvalid) {
267     errvalid = 0;
268     return errbuf;
269   }
270   return NULL;
271 }
VOID* dlopen (const char * path, int mode)

Definition at line 95 of file tclLoadAix.c.
References findMain(), modList, Module::name, Module::next, NULL, Module::refCnt, terminate(), and VOID.
Referenced by TclpDlopen(), and TclpInitPlatform().96 {
97   register ModulePtr mp;
98   static void *mainModule;
99 
100   /*
101    * Upon the first call register a terminate handler that will
102    * close all libraries. Also get a reference to the main module
103    * for use with loadbind.
104    */
105   if (!mainModule) {
106     if ((mainModule = findMain()) == NULL)
107       return NULL;
108     atexit(terminate);
109   }
110   /*
111    * Scan the list of modules if we have the module already loaded.
112    */
113   for (mp = modList; mp; mp = mp->next)
114     if (strcmp(mp->name, path) == 0) {
115       mp->refCnt++;
116       return (VOID *) mp;
117     }
118   if ((mp = (ModulePtr)calloc(1, sizeof(*mp))) == NULL) {
119     errvalid++;
120     strcpy(errbuf, "calloc: ");
121     strcat(errbuf, strerror(errno));
122     return (VOID *) NULL;
123   }
124   mp->name = malloc((unsigned) (strlen(path) + 1));
125   strcpy(mp->name, path);
126   /*
127    * load should be declared load(const char *...). Thus we
128    * cast the path to a normal char *. Ugly.
129    */
130   if ((mp->entry = (void *)load((char *)path, L_NOAUTODEFER, NULL)) == NULL) {
131     free(mp->name);
132     free(mp);
133     errvalid++;
134     strcpy(errbuf, "dlopen: ");
135     strcat(errbuf, path);
136     strcat(errbuf, ": ");
137     /*
138      * If AIX says the file is not executable, the error
139      * can be further described by querying the loader about
140      * the last error.
141      */
142     if (errno == ENOEXEC) {
143       char *tmp[BUFSIZ/sizeof(char *)];
144       if (loadquery(L_GETMESSAGES, tmp, sizeof(tmp)) == -1)
145         strcpy(errbuf, strerror(errno));
146       else {
147         char **p;
148         for (p = tmp; *p; p++)
149           caterr(*p);
150       }
151     } else
152       strcat(errbuf, strerror(errno));
153     return (VOID *) NULL;
154   }
155   mp->refCnt = 1;
156   mp->next = modList;
157   modList = mp;
158   if (loadbind(0, mainModule, mp->entry) == -1) {
159     dlclose(mp);
160     errvalid++;
161     strcpy(errbuf, "loadbind: ");
162     strcat(errbuf, strerror(errno));
163     return (VOID *) NULL;
164   }
165   /*
166    * If the user wants global binding, loadbind against all other
167    * loaded modules.
168    */
169   if (mode & RTLD_GLOBAL) {
170     register ModulePtr mp1;
171     for (mp1 = mp->next; mp1; mp1 = mp1->next)
172       if (loadbind(0, mp1->entry, mp->entry) == -1) {
173         dlclose(mp);
174         errvalid++;
175         strcpy(errbuf, "loadbind: ");
176         strcat(errbuf, strerror(errno));
177         return (VOID *) NULL;
178       }
179   }
180   if (readExports(mp) == -1) {
181     dlclose(mp);
182     return (VOID *) NULL;
183   }
184   /*
185    * If there is a dl_info structure, call the init function.
186    */
187   if (mp->info = (struct dl_info *)dlsym(mp, "dl_info")) {
188     if (mp->info->init)
189       (*mp->info->init)();
190   } else
191     errvalid = 0;
192   /*
193    * If the shared object was compiled using xlC we will need
194    * to call static constructors (and later on dlclose destructors).
195    */
196   if (mp->cdtors = (CdtorPtr)dlsym(mp, "__cdtors")) {
197     while (mp->cdtors->init) {
198       (*mp->cdtors->init)();
199       mp->cdtors++;
200     }
201   } else
202     errvalid = 0;
203   return (VOID *) mp;
204 }
VOID* dlsym (void * handle, const char * symbol)

Definition at line 245 of file tclLoadAix.c.
References Export::addr, errvalid, Module::exports, Export::name, Module::nExports, and NULL.
Referenced by TclpFindSymbol().246 {
247   register ModulePtr mp = (ModulePtr)handle;
248   register ExportPtr ep;
249   register int i;
250 
251   /*
252    * Could speed up the search, but I assume that one assigns
253    * the result to function pointers anyways.
254    */
255   for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
256     if (strcmp(ep->name, symbol) == 0)
257       return ep->addr;
258   errvalid++;
259   strcpy(errbuf, "dlsym: undefined symbol ");
260   strcat(errbuf, symbol);
261   return NULL;
262 }
static void * findMain (void) [static]

Definition at line 508 of file tclLoadAix.c.
References ENOMEM, errno, errvalid, and NULL.
Referenced by dlopen().509 {
510   struct ld_info *lp;
511   char *buf;
512   int size = 4*1024;
513   int i;
514   void *ret;
515 
516   if ((buf = malloc(size)) == NULL) {
517     errvalid++;
518     strcpy(errbuf, "findMain: ");
519     strcat(errbuf, strerror(errno));
520     return NULL;
521   }
522   while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
523     free(buf);
524     size += 4*1024;
525     if ((buf = malloc(size)) == NULL) {
526       errvalid++;
527       strcpy(errbuf, "findMain: ");
528       strcat(errbuf, strerror(errno));
529       return NULL;
530     }
531   }
532   if (i == -1) {
533     errvalid++;
534     strcpy(errbuf, "findMain: ");
535     strcat(errbuf, strerror(errno));
536     free(buf);
537     return NULL;
538   }
539   /*
540    * The first entry is the main module. The entry point
541    * returned by load() does actually point to the data
542    * segment origin.
543    */
544   lp = (struct ld_info *)buf;
545   ret = lp->ldinfo_dataorg;
546   free(buf);
547   return ret;
548 }
static int readExports (ModulePtr) [static]

Definition at line 324 of file tclLoadAix.c.
References Export::addr, ENOENT, ENOMEM, Module::entry, errno, errvalid, Module::exports, Export::name, Module::name, Module::nExports, and NULL.325 {
326   LDFILE *ldp = NULL;
327   SCNHDR sh, shdata;
328   LDHDR *lhp;
329   char *ldbuf;
330   LDSYM *ls;
331   int i;
332   ExportPtr ep;
333 
334   if ((ldp = ldopen(mp->name, ldp)) == NULL) {
335     struct ld_info *lp;
336     char *buf;
337     int size = 4*1024;
338     if (errno != ENOENT) {
339       errvalid++;
340       strcpy(errbuf, "readExports: ");
341       strcat(errbuf, strerror(errno));
342       return -1;
343     }
344     /*
345      * The module might be loaded due to the LIBPATH
346      * environment variable. Search for the loaded
347      * module using L_GETINFO.
348      */
349     if ((buf = malloc(size)) == NULL) {
350       errvalid++;
351       strcpy(errbuf, "readExports: ");
352       strcat(errbuf, strerror(errno));
353       return -1;
354     }
355     while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
356       free(buf);
357       size += 4*1024;
358       if ((buf = malloc(size)) == NULL) {
359         errvalid++;
360         strcpy(errbuf, "readExports: ");
361         strcat(errbuf, strerror(errno));
362         return -1;
363       }
364     }
365     if (i == -1) {
366       errvalid++;
367       strcpy(errbuf, "readExports: ");
368       strcat(errbuf, strerror(errno));
369       free(buf);
370       return -1;
371     }
372     /*
373      * Traverse the list of loaded modules. The entry point
374      * returned by load() does actually point to the data
375      * segment origin.
376      */
377     lp = (struct ld_info *)buf;
378     while (lp) {
379       if (lp->ldinfo_dataorg == mp->entry) {
380         ldp = ldopen(lp->ldinfo_filename, ldp);
381         break;
382       }
383       if (lp->ldinfo_next == 0)
384         lp = NULL;
385       else
386         lp = (struct ld_info *)((char *)lp + lp->ldinfo_next);
387     }
388     free(buf);
389     if (!ldp) {
390       errvalid++;
391       strcpy(errbuf, "readExports: ");
392       strcat(errbuf, strerror(errno));
393       return -1;
394     }
395   }
396   if (TYPE(ldp) != U802TOCMAGIC) {
397     errvalid++;
398     strcpy(errbuf, "readExports: bad magic");
399     while(ldclose(ldp) == FAILURE)
400       ;
401     return -1;
402   }
403   /*
404    * Get the padding for the data section. This is needed for
405    * AIX 4.1 compilers. This is used when building the final
406    * function pointer to the exported symbol.
407    */
408   if (ldnshread(ldp, _DATA, &shdata) != SUCCESS) {
409     errvalid++;
410     strcpy(errbuf, "readExports: cannot read data section header");
411     while(ldclose(ldp) == FAILURE)
412       ;
413     return -1;
414   }
415   if (ldnshread(ldp, _LOADER, &sh) != SUCCESS) {
416     errvalid++;
417     strcpy(errbuf, "readExports: cannot read loader section header");
418     while(ldclose(ldp) == FAILURE)
419       ;
420     return -1;
421   }
422   /*
423    * We read the complete loader section in one chunk, this makes
424    * finding long symbol names residing in the string table easier.
425    */
426   if ((ldbuf = (char *)malloc(sh.s_size)) == NULL) {
427     errvalid++;
428     strcpy(errbuf, "readExports: ");
429     strcat(errbuf, strerror(errno));
430     while(ldclose(ldp) == FAILURE)
431       ;
432     return -1;
433   }
434   if (FSEEK(ldp, sh.s_scnptr, BEGINNING) != OKFSEEK) {
435     errvalid++;
436     strcpy(errbuf, "readExports: cannot seek to loader section");
437     free(ldbuf);
438     while(ldclose(ldp) == FAILURE)
439       ;
440     return -1;
441   }
442   if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) {
443     errvalid++;
444     strcpy(errbuf, "readExports: cannot read loader section");
445     free(ldbuf);
446     while(ldclose(ldp) == FAILURE)
447       ;
448     return -1;
449   }
450   lhp = (LDHDR *)ldbuf;
451   ls = (LDSYM *)(ldbuf+LDHDRSZ);
452   /*
453    * Count the number of exports to include in our export table.
454    */
455   for (i = lhp->l_nsyms; i; i--, ls++) {
456     if (!LDR_EXPORT(*ls))
457       continue;
458     mp->nExports++;
459   }
460   if ((mp->exports = (ExportPtr)calloc(mp->nExports, sizeof(*mp->exports))) == NULL) {
461     errvalid++;
462     strcpy(errbuf, "readExports: ");
463     strcat(errbuf, strerror(errno));
464     free(ldbuf);
465     while(ldclose(ldp) == FAILURE)
466       ;
467     return -1;
468   }
469   /*
470    * Fill in the export table. All entries are relative to
471    * the entry point we got from load.
472    */
473   ep = mp->exports;
474   ls = (LDSYM *)(ldbuf+LDHDRSZ);
475   for (i = lhp->l_nsyms; i; i--, ls++) {
476     char *symname;
477     char tmpsym[SYMNMLEN+1];
478     if (!LDR_EXPORT(*ls))
479       continue;
480     if (ls->l_zeroes == 0)
481       symname = ls->l_offset+lhp->l_stoff+ldbuf;
482     else {
483       /*
484        * The l_name member is not zero terminated, we
485        * must copy the first SYMNMLEN chars and make
486        * sure we have a zero byte at the end.
487        */
488       strncpy(tmpsym, ls->l_name, SYMNMLEN);
489       tmpsym[SYMNMLEN] = '\0';
490       symname = tmpsym;
491     }
492     ep->name = malloc((unsigned) (strlen(symname) + 1));
493     strcpy(ep->name, symname);
494     ep->addr = (void *)((unsigned long)mp->entry +
495           ls->l_value - shdata.s_vaddr);
496     ep++;
497   }
498   free(ldbuf);
499   while(ldclose(ldp) == FAILURE)
500     ;
501   return 0;
502 }
static void terminate (void) [static]

Definition at line 315 of file tclLoadAix.c.
References dlclose(), and modList.
Referenced by dlopen().316 {
317   while (modList)
318     dlclose(modList);
319 }

Variable Documentation
char errbuf[BUFSIZ] [static]

Definition at line 87 of file tclLoadAix.c.
Referenced by Tcl_ResourceObjCmd().int errvalid [static]

Definition at line 88 of file tclLoadAix.c.
Referenced by dlclose(), dlerror(), dlsym(), findMain(), and readExports().ModulePtr modList [static]

Definition at line 81 of file tclLoadAix.c.
Referenced by dlclose(), dlopen(), and terminate().

unix/tclLoadAout.c File Reference
#include "tclInt.h"
#include <fcntl.h>
#include "../compat/unistd.h"
Defines
#define TCL_LOADSHIM  0x4000L
#define TCL_LOADALIGN  0x4000L
#define TCL_LOADMAX  2000000L
Typedefs
typedef Tcl_PackageInitProc *DictFn _ANSI_ARGS_ ((CONST char *symbol))
Functions
char *brk _ANSI_ARGS_ ((char *))
char *sbrk _ANSI_ARGS_ ((size_t))
static int FindLibraries _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_DString *buf))
static void UnlinkSymbolTable _ANSI_ARGS_ ((void))
int TclpDlopen (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr)
Tcl_PackageInitProc * TclpFindSymbol (Tcl_Interp *interp, Tcl_LoadHandle loadHandle, CONST char *symbol)
static int FindLibraries (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_DString *buf)
static void UnlinkSymbolTable ()
void TclpUnloadFile (Tcl_LoadHandle loadHandle)
int TclGuessPackageName (CONST char *fileName, Tcl_DString *bufPtr)
Variables
static char * SymbolTableFile = NULL

Define Documentation
#define TCL_LOADALIGN  0x4000L

Definition at line 61 of file tclLoadAout.c.
Referenced by TclpDlopen().#define TCL_LOADMAX  2000000L

Definition at line 70 of file tclLoadAout.c.
Referenced by TclpDlopen().#define TCL_LOADSHIM  0x4000L

Definition at line 52 of file tclLoadAout.c.
Referenced by TclpDlopen().
Typedef Documentation
typedef Tcl_PackageInitProc* DictFn _ANSI_ARGS_((CONST char *symbol))

Definition at line 92 of file tclLoadAout.c.
Function Documentation
static void UnlinkSymbolTable _ANSI_ARGS_ ((void)) [static]
static int FindLibraries _ANSI_ARGS_ ((Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_DString *buf)) [static]
char* sbrk _ANSI_ARGS_ ((size_t))
char* brk _ANSI_ARGS_ ((char *))
static int FindLibraries (Tcl_Interp * interp, Tcl_Obj * pathPtr, Tcl_DString * buf) [static]

Definition at line 357 of file tclLoadAout.c.
References CONST, fopen, NULL, Tcl_DStringAppend(), TCL_ERROR, Tcl_FSGetNativePath(), Tcl_GetString(), TCL_OK, Tcl_PosixError(), and void().
Referenced by TclpDlopen().361 {
362     FILE * f;     /* The load module */
363     int c = 0;      /* Byte from the load module */
364     char * p;
365     CONST char *native;
366 
367     char *fileName = Tcl_GetString(pathPtr);
368   
369     /* Open the load module */
370     
371     native = Tcl_FSGetNativePath(pathPtr);
372     f = fopen(native, "rb");        /* INTL: Native. */
373     
374     if (f == NULL) {
375   Tcl_AppendResult (interp, "couldn't open \"", fileName, "\": ",
376         Tcl_PosixError (interp), (char *) NULL);
377   return TCL_ERROR;
378     }
379     
380     /* Search for the library list in the load module */
381     
382     p = "@LIBS: ";
383     while (*p != '\0' && (c = getc (f)) != EOF) {
384   if (c == *p) {
385       ++p;
386   }
387   else {
388       p = "@LIBS: ";
389       if (c == *p) {
390     ++p;
391       }
392   }
393     }
394     
395     /* No library list -- this must be an ill-formed module */
396     
397     if (c == EOF) {
398   Tcl_AppendResult (interp, "File \"", fileName,
399         "\" is not a Tcl load module.", (char *) NULL);
400   (void) fclose (f);
401   return TCL_ERROR;
402     }
403     
404     /* Accumulate the library list */
405     
406     while ((c = getc (f)) != '\0' && c != EOF) {
407   char cc = c;
408   Tcl_DStringAppend (buf, &cc, 1);
409     }
410     (void) fclose (f);
411     
412     if (c == EOF) {
413   Tcl_AppendResult (interp, "Library directory in \"", fileName,
414         "\" ends prematurely.", (char *) NULL);
415   return TCL_ERROR;
416     }
417 
418     return TCL_OK;
419 }
int TclGuessPackageName (CONST char * fileName, Tcl_DString * bufPtr)

Definition at line 495 of file tclLoadAout.c.
References CONST, Tcl_DStringAppend(), Tcl_DStringSetLength(), Tcl_DStringValue, and Tcl_UtfToTitle().500 {
501     CONST char *p, *q;
502     char *r;
503 
504     if ((q = strrchr(fileName,'/'))) {
505   q++;
506     } else {
507   q = fileName;
508     }
509     if (!strncmp(q,"lib",3)) {
510   q+=3;
511     }
512     p = q;
513     while ((*p) && (*p != '.') && ((*p<'0') || (*p>'9'))) {
514   p++;
515     }
516     if ((p>q+2) && !strncmp(p-2,"_G0.",4)) {
517   p-=2;
518     }
519     if (p<q) {
520   return 0;
521     }
522 
523     Tcl_DStringAppend(bufPtr,q, p-q);
524 
525     r = Tcl_DStringValue(bufPtr);
526     r += strlen(r) - (p-q);
527 
528     /*
529      * Capitalize the string and then recompute the length.
530      */
531 
532     Tcl_UtfToTitle(r);
533     Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr)));
534 
535     return 1;
536 }
int TclpDlopen (Tcl_Interp * interp, Tcl_Obj * pathPtr, Tcl_LoadHandle * loadHandle, Tcl_FSUnloadFileProc ** unloadProcPtr)

Definition at line 141 of file tclLoadAout.c.
References ckalloc, exec, FindLibraries(), L_tmpnam, NULL, SEEK_SET, status, strstr(), Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, TCL_ERROR, Tcl_Eval(), Tcl_GetString(), TCL_LOADALIGN, TCL_LOADMAX, TCL_LOADSHIM, TCL_OK, Tcl_PosixError(), Tcl_SetResult(), TCL_STATIC, tclExecutableName, TclGuessPackageName(), tmpnam(), UnlinkSymbolTable(), and void().152 {
153     char * inputSymbolTable;  /* Name of the file containing the 
154          * symbol table from the last link. */
155     Tcl_DString linkCommandBuf; /* Command to do the run-time relocation
156          * of the module.*/
157     char * linkCommand;
158     char relocatedFileName [L_tmpnam];
159         /* Name of the file holding the relocated */
160         /* text of the module */
161     int relocatedFd;    /* File descriptor of the file holding
162          * relocated text */
163     struct exec relocatedHead;  /* Header of the relocated text */
164     unsigned long relocatedSize;/* Size of the relocated text */
165     char * startAddress;  /* Starting address of the module */
166     int status;     /* Status return from Tcl_ calls */
167     char * p;
168 
169     /* Find the file that contains the symbols for the run-time link. */
170     
171     if (SymbolTableFile != NULL) {
172   inputSymbolTable = SymbolTableFile;
173     } else if (tclExecutableName == NULL) {
174   Tcl_SetResult (interp, "can't find the tclsh executable", TCL_STATIC);
175   return TCL_ERROR;
176     } else {
177   inputSymbolTable = tclExecutableName;
178     }
179     
180     /* Construct the `ld' command that builds the relocated module */
181     
182     tmpnam (relocatedFileName);
183     Tcl_DStringInit (&linkCommandBuf);
184     Tcl_DStringAppend (&linkCommandBuf, "exec ld -o ", -1);
185     Tcl_DStringAppend (&linkCommandBuf, relocatedFileName, -1);
186 #if defined(__mips) || defined(mips)
187     Tcl_DStringAppend (&linkCommandBuf, " -G 0 ", -1);
188 #endif
189     Tcl_DStringAppend (&linkCommandBuf, " -u TclLoadDictionary_", -1);
190     TclGuessPackageName(Tcl_GetString(pathPtr), &linkCommandBuf);
191     Tcl_DStringAppend (&linkCommandBuf, " -A ", -1);
192     Tcl_DStringAppend (&linkCommandBuf, inputSymbolTable, -1);
193     Tcl_DStringAppend (&linkCommandBuf, " -N -T XXXXXXXX ", -1);
194     Tcl_DStringAppend (&linkCommandBuf, Tcl_GetString(pathPtr), -1);
195     Tcl_DStringAppend (&linkCommandBuf, " ", -1);
196     
197     if (FindLibraries (interp, pathPtr, &linkCommandBuf) != TCL_OK) {
198   Tcl_DStringFree (&linkCommandBuf);
199   return TCL_ERROR;
200     }
201     
202     linkCommand = Tcl_DStringValue (&linkCommandBuf);
203     
204     /* Determine the starting address, and plug it into the command */
205     
206     startAddress = (char *) (((unsigned long) sbrk (0)
207             + TCL_LOADSHIM + TCL_LOADALIGN - 1)
208            & (- TCL_LOADALIGN));
209     p = strstr (linkCommand, "-T") + 3;
210     sprintf (p, "%08lx", (long) startAddress);
211     p [8] = ' ';
212     
213     /* Run the linker */
214     
215     status = Tcl_Eval (interp, linkCommand);
216     Tcl_DStringFree (&linkCommandBuf);
217     if (status != 0) {
218   return TCL_ERROR;
219     }
220     
221     /* Open the linker's result file and read the header */
222     
223     relocatedFd = open (relocatedFileName, O_RDONLY);
224     if (relocatedFd < 0) {
225   goto ioError;
226     }
227     status= read (relocatedFd, (char *) & relocatedHead, sizeof relocatedHead);
228     if (status < sizeof relocatedHead) {
229   goto ioError;
230     }
231     
232     /* Check the magic number */
233     
234     if (relocatedHead.a_magic != OMAGIC) {
235   Tcl_AppendResult (interp, "bad magic number in intermediate file \"",
236         relocatedFileName, "\"", (char *) NULL);
237   goto failure;
238     }
239     
240     /* Make sure that memory allocation is still consistent */
241     
242     if ((unsigned long) sbrk (0) > (unsigned long) startAddress) {
243   Tcl_SetResult (interp, "can't load, memory allocation is inconsistent.",
244            TCL_STATIC);
245   goto failure;
246     }
247     
248     /* Make sure that the relocated module's size is reasonable */
249     
250     relocatedSize = relocatedHead.a_text + relocatedHead.a_data
251       + relocatedHead.a_bss;
252     if (relocatedSize > TCL_LOADMAX) {
253   Tcl_SetResult (interp, "module too big to load", TCL_STATIC);
254   goto failure;
255     }
256     
257     /* Advance the break to protect the loaded module */
258     
259     (void) brk (startAddress + relocatedSize);
260     
261     /*
262      * Seek to the start of the module's text.
263      *
264      * Note that this does not really work with large files (i.e. where
265      * lseek64 exists and is different to lseek), but anyone trying to
266      * dynamically load a binary that is larger than what can fit in
267      * addressable memory is in trouble anyway...
268      */
269     
270 #if defined(__mips) || defined(mips)
271     status = lseek (relocatedFd,
272         (off_t) N_TXTOFF (relocatedHead.ex_f, relocatedHead.ex_o),
273         SEEK_SET);
274 #else
275     status = lseek (relocatedFd, (off_t) N_TXTOFF (relocatedHead), SEEK_SET);
276 #endif
277     if (status < 0) {
278   goto ioError;
279     }
280     
281     /* Read in the module's text and data */
282     
283     relocatedSize = relocatedHead.a_text + relocatedHead.a_data;
284     if (read (relocatedFd, startAddress, relocatedSize) < relocatedSize) {
285   brk (startAddress);
286       ioError:
287   Tcl_AppendResult (interp, "error on intermediate file \"",
288         relocatedFileName, "\": ", Tcl_PosixError (interp),
289         (char *) NULL);
290       failure:
291   (void) unlink (relocatedFileName);
292   return TCL_ERROR;
293     }
294     
295     /* Close the intermediate file. */
296     
297     (void) close (relocatedFd);
298     
299     /* Arrange things so that intermediate symbol tables eventually get
300     * deleted. */
301     
302     if (SymbolTableFile != NULL) {
303   UnlinkSymbolTable ();
304     } else {
305   atexit (UnlinkSymbolTable);
306     }
307     SymbolTableFile = ckalloc (strlen (relocatedFileName) + 1);
308     strcpy (SymbolTableFile, relocatedFileName);
309     
310     *loadHandle = startAddress;
311     return TCL_OK;
312 }
Tcl_PackageInitProc* TclpFindSymbol (Tcl_Interp * interp, Tcl_LoadHandle loadHandle, CONST char * symbol)

Definition at line 330 of file tclLoadAout.c.334 {
335     /* Look up the entry point in the load module's dictionary. */
336     DictFn dictionary = (DictFn) loadHandle;
337     return (Tcl_PackageInitProc*) dictionary(sym1);
338 }
void TclpUnloadFile (Tcl_LoadHandle loadHandle)

Definition at line 466 of file tclLoadAout.c.471 {
472 }
static void UnlinkSymbolTable () [static]

Definition at line 440 of file tclLoadAout.c.
References ckfree, NULL, and void().
Referenced by TclpDlopen().441 {
442     (void) unlink (SymbolTableFile);
443     ckfree (SymbolTableFile);
444     SymbolTableFile = NULL;
445 }

Variable Documentation
char* SymbolTableFile = NULL [static]

Definition at line 86 of file tclLoadAout.c.

unix/tclLoadDl.c File Reference
#include "tclInt.h"
#include <dlfcn.h>
Defines
#define RTLD_NOW  1
#define RTLD_GLOBAL  0
Functions
int TclpDlopen (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr)
Tcl_PackageInitProc * TclpFindSymbol (Tcl_Interp *interp, Tcl_LoadHandle loadHandle, CONST char *symbol)
void TclpUnloadFile (Tcl_LoadHandle loadHandle)
int TclGuessPackageName (CONST char *fileName, Tcl_DString *bufPtr)

Define Documentation
#define RTLD_GLOBAL  0

Definition at line 35 of file tclLoadDl.c.#define RTLD_NOW  1

Definition at line 31 of file tclLoadDl.c.
Function Documentation
int TclGuessPackageName (CONST char * fileName, Tcl_DString * bufPtr)

Definition at line 209 of file tclLoadDl.c.214 {
215     return 0;
216 }
int TclpDlopen (Tcl_Interp * interp, Tcl_Obj * pathPtr, Tcl_LoadHandle * loadHandle, Tcl_FSUnloadFileProc ** unloadProcPtr)

Definition at line 57 of file tclLoadDl.c.
References CONST, dlerror(), dlopen(), NULL, RTLD_GLOBAL, RTLD_NOW, Tcl_DStringFree(), TCL_ERROR, Tcl_FSGetNativePath(), Tcl_GetString(), TCL_OK, Tcl_UtfToExternalDString(), TclpUnloadFile(), and VOID.68 {
69     VOID *handle;
70     CONST char *native;
71 
72     /* 
73      * First try the full path the user gave us.  This is particularly
74      * important if the cwd is inside a vfs, and we are trying to load
75      * using a relative path.
76      */
77     native = Tcl_FSGetNativePath(pathPtr);
78     handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL);
79     if (handle == NULL) {
80   /* 
81    * Let the OS loader examine the binary search path for
82    * whatever string the user gave us which hopefully refers
83    * to a file on the binary path
84    */
85   Tcl_DString ds;
86   char *fileName = Tcl_GetString(pathPtr);
87   native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
88   handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL);
89   Tcl_DStringFree(&ds);
90     }
91     
92     if (handle == NULL) {
93   /*
94    * Write the string to a variable first to work around a compiler bug
95    * in the Sun Forte 6 compiler. [Bug 1503729]
96    */
97 
98   CONST char *errorStr = dlerror();
99 
100   Tcl_AppendResult(interp, "couldn't load file \"", 
101     Tcl_GetString(pathPtr), "\": ", errorStr, (char *) NULL);
102   return TCL_ERROR;
103     }
104 
105     *unloadProcPtr = &TclpUnloadFile;
106     *loadHandle = (Tcl_LoadHandle)handle;
107     return TCL_OK;
108 }
Tcl_PackageInitProc* TclpFindSymbol (Tcl_Interp * interp, Tcl_LoadHandle loadHandle, CONST char * symbol)

Definition at line 126 of file tclLoadDl.c.
References CONST, dlsym(), NULL, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_UtfToExternalDString(), and VOID.130 {
131     CONST char *native;
132     Tcl_DString newName, ds;
133     VOID *handle = (VOID*)loadHandle;
134     Tcl_PackageInitProc *proc;
135     /* 
136      * Some platforms still add an underscore to the beginning of symbol
137      * names.  If we can't find a name without an underscore, try again
138      * with the underscore.
139      */
140 
141     native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
142     proc = (Tcl_PackageInitProc *) dlsym(handle,  /* INTL: Native. */
143       native);  
144     if (proc == NULL) {
145   Tcl_DStringInit(&newName);
146   Tcl_DStringAppend(&newName, "_", 1);
147   native = Tcl_DStringAppend(&newName, native, -1);
148   proc = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */
149     native);
150   Tcl_DStringFree(&newName);
151     }
152     Tcl_DStringFree(&ds);
153 
154     return proc;
155 }
void TclpUnloadFile (Tcl_LoadHandle loadHandle)

Definition at line 176 of file tclLoadDl.c.
References dlclose(), and VOID.181 {
182     VOID *handle;
183 
184     handle = (VOID *) loadHandle;
185     dlclose(handle);
186 }

unix/tclLoadDld.c File Reference
#include "tclInt.h"
#include "dld.h"
Defines
#define RTLD_NOW  1
Functions
int TclpDlopen (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr)
Tcl_PackageInitProc * TclpFindSymbol (Tcl_Interp *interp, Tcl_LoadHandle loadHandle, CONST char *symbol)
void TclpUnloadFile (Tcl_LoadHandle loadHandle)
int TclGuessPackageName (CONST char *fileName, Tcl_DString *bufPtr)

Define Documentation
#define RTLD_NOW  1

Definition at line 27 of file tclLoadDld.c.
Function Documentation
int TclGuessPackageName (CONST char * fileName, Tcl_DString * bufPtr)

Definition at line 194 of file tclLoadDld.c.199 {
200     return 0;
201 }
int TclpDlopen (Tcl_Interp * interp, Tcl_Obj * pathPtr, Tcl_LoadHandle * loadHandle, Tcl_FSUnloadFileProc ** unloadProcPtr)

Definition at line 49 of file tclLoadDld.c.
References ckalloc, CONST, NULL, Tcl_DStringFree(), TCL_ERROR, Tcl_FSGetNativePath(), Tcl_GetString(), TCL_OK, Tcl_SetResult(), TCL_STATIC, Tcl_UtfToExternalDString(), tclExecutableName, and TclpUnloadFile().60 {
61     static int firstTime = 1;
62     int returnCode;
63     char *fileName;
64     CONST char *native;
65     
66     /*
67      *  The dld package needs to know the pathname to the tcl binary.
68      *  If that's not known, return an error.
69      */
70 
71     if (firstTime) {
72   if (tclExecutableName == NULL) {
73       Tcl_SetResult(interp,
74         "don't know name of application binary file, so can't initialize dynamic loader",
75         TCL_STATIC);
76       return TCL_ERROR;
77   }
78   returnCode = dld_init(tclExecutableName);
79   if (returnCode != 0) {
80       Tcl_AppendResult(interp,
81         "initialization failed for dynamic loader: ",
82         dld_strerror(returnCode), (char *) NULL);
83       return TCL_ERROR;
84   }
85   firstTime = 0;
86     }
87 
88     fileName = Tcl_GetString(pathPtr);
89 
90     /* 
91      * First try the full path the user gave us.  This is particularly
92      * important if the cwd is inside a vfs, and we are trying to load
93      * using a relative path.
94      */
95     native = Tcl_FSGetNativePath(pathPtr);
96     returnCode = dld_link(native);
97     
98     if (returnCode != 0) {
99   Tcl_DString ds;
100   native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
101   returnCode = dld_link(native);
102   Tcl_DStringFree(&ds);
103     }
104 
105     if (returnCode != 0) {
106   Tcl_AppendResult(interp, "couldn't load file \"", 
107        fileName, "\": ", 
108        dld_strerror(returnCode), (char *) NULL);
109   return TCL_ERROR;
110     }
111     *loadHandle = (Tcl_LoadHandle) strcpy(
112       (char *) ckalloc((unsigned) (strlen(fileName) + 1)), fileName);
113     *unloadProcPtr = &TclpUnloadFile;
114     return TCL_OK;
115 }
Tcl_PackageInitProc* TclpFindSymbol (Tcl_Interp * interp, Tcl_LoadHandle loadHandle, CONST char * symbol)

Definition at line 133 of file tclLoadDld.c.137 {
138     return (Tcl_PackageInitProc *) dld_get_func(symbol);
139 }
void TclpUnloadFile (Tcl_LoadHandle loadHandle)

Definition at line 160 of file tclLoadDld.c.
References ckfree.165 {
166     char *fileName;
167 
168     handle = (char *) loadHandle;
169     dld_unlink_by_file(handle, 0);
170     ckfree(handle);
171 }

unix/tclLoadDyld.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include <mach-o/dyld.h>
#include <mach-o/fat.h>
#include <mach-o/swap.h>
#include <mach-o/arch.h>
#include <libkern/OSByteOrder.h>
#include <mach/mach.h>
Classes
struct Tcl_DyldModuleHandle
struct Tcl_DyldLoadHandle
Functions
static CONST char * DyldOFIErrorMsg (int err)
int TclpDlopen (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr)
Tcl_PackageInitProc * TclpFindSymbol (Tcl_Interp *interp, Tcl_LoadHandle loadHandle, CONST char *symbol)
void TclpUnloadFile (Tcl_LoadHandle loadHandle)
int TclGuessPackageName (CONST char *fileName, Tcl_DString *bufPtr)

Function Documentation
static CONST char* DyldOFIErrorMsg (int err) [static]

Definition at line 60 of file tclLoadDyld.c.
References NULL.
Referenced by TclpDlopen().60                          {
61     switch(err) {
62     case NSObjectFileImageSuccess:
63   return NULL;
64     case NSObjectFileImageFailure:
65   return "object file setup failure";
66     case NSObjectFileImageInappropriateFile:
67   return "not a Mach-O MH_BUNDLE file";
68     case NSObjectFileImageArch:
69   return "no object for this architecture";
70     case NSObjectFileImageFormat:
71   return "bad object file format";
72     case NSObjectFileImageAccess:
73   return "can't read object file";
74     default:
75   return "unknown error";
76     }
77 }
int TclGuessPackageName (CONST char * fileName, Tcl_DString * bufPtr)

Definition at line 359 of file tclLoadDyld.c.364 {
365     return 0;
366 }
int TclpDlopen (Tcl_Interp * interp, Tcl_Obj * pathPtr, Tcl_LoadHandle * loadHandle, Tcl_FSUnloadFileProc ** unloadProcPtr)

Definition at line 98 of file tclLoadDyld.c.
References ckalloc, CONST, Tcl_DyldLoadHandle::dyldLibHeader, DyldOFIErrorMsg(), Tcl_DyldModuleHandle::module, Tcl_DyldLoadHandle::modulePtr, Tcl_DyldModuleHandle::nextPtr, NULL, Tcl_DStringFree(), TCL_ERROR, Tcl_FSGetNativePath(), Tcl_GetString(), TCL_OK, Tcl_UtfToExternalDString(), and TclpUnloadFile().109 {
110     Tcl_DyldLoadHandle *dyldLoadHandle;
111     CONST struct mach_header *dyldLibHeader;
112     NSObjectFileImage dyldObjFileImage = NULL;
113     Tcl_DyldModuleHandle *modulePtr = NULL;
114     CONST char *native;
115 
116     /*
117      * First try the full path the user gave us. This is particularly
118      * important if the cwd is inside a vfs, and we are trying to load using a
119      * relative path.
120      */
121 
122     native = Tcl_FSGetNativePath(pathPtr);
123     dyldLibHeader = NSAddImage(native, NSADDIMAGE_OPTION_RETURN_ON_ERROR);
124 
125     if (!dyldLibHeader) {
126   NSLinkEditErrors editError;
127   int errorNumber;
128   CONST char *name, *msg, *objFileImageErrMsg = NULL;
129 
130   NSLinkEditError(&editError, &errorNumber, &name, &msg);
131 
132   if (editError == NSLinkEditFileAccessError) {
133       /*
134        * The requested file was not found. Let the OS loader examine the
135        * binary search path for whatever string the user gave us which
136        * hopefully refers to a file on the binary path.
137        */
138 
139       Tcl_DString ds;
140       char *fileName = Tcl_GetString(pathPtr);
141       CONST char *native =
142         Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
143 
144       dyldLibHeader = NSAddImage(native, NSADDIMAGE_OPTION_WITH_SEARCHING
145         | NSADDIMAGE_OPTION_RETURN_ON_ERROR);
146       Tcl_DStringFree(&ds);
147       if (!dyldLibHeader) {
148     NSLinkEditError(&editError, &errorNumber, &name, &msg);
149       }
150   } else if ((editError == NSLinkEditFileFormatError
151     && errorNumber == EBADMACHO)
152     || editError == NSLinkEditOtherError){
153       /*
154        * The requested file was found but was not of type MH_DYLIB,
155        * attempt to load it as a MH_BUNDLE.
156        */
157 
158       NSObjectFileImageReturnCode err =
159         NSCreateObjectFileImageFromFile(native, &dyldObjFileImage);
160       objFileImageErrMsg = DyldOFIErrorMsg(err);
161   }
162 
163   if (!dyldLibHeader && !dyldObjFileImage) {
164       Tcl_AppendResult(interp, msg, (char *) NULL);
165       if (msg && *msg) {
166     Tcl_AppendResult(interp, "\n", (char *) NULL);
167       }
168       if (objFileImageErrMsg) {
169     Tcl_AppendResult(interp,
170       "NSCreateObjectFileImageFromFile() error: ",
171       objFileImageErrMsg, (char *) NULL);
172       }
173       return TCL_ERROR;
174   }
175     }
176 
177     if (dyldObjFileImage) {
178   NSModule module;
179 
180   module = NSLinkModule(dyldObjFileImage, native,
181     NSLINKMODULE_OPTION_BINDNOW
182     | NSLINKMODULE_OPTION_RETURN_ON_ERROR);
183   NSDestroyObjectFileImage(dyldObjFileImage);
184 
185   if (!module) {
186       NSLinkEditErrors editError;
187       int errorNumber;
188       CONST char *name, *msg;
189 
190       NSLinkEditError(&editError, &errorNumber, &name, &msg);
191       Tcl_AppendResult(interp, msg, (char *) NULL);
192       return TCL_ERROR;
193   }
194 
195   modulePtr = (Tcl_DyldModuleHandle *)
196     ckalloc(sizeof(Tcl_DyldModuleHandle));
197   modulePtr->module = module;
198   modulePtr->nextPtr = NULL;
199     }
200 
201     dyldLoadHandle = (Tcl_DyldLoadHandle *)
202       ckalloc(sizeof(Tcl_DyldLoadHandle));
203     dyldLoadHandle->dyldLibHeader = dyldLibHeader;
204     dyldLoadHandle->modulePtr = modulePtr;
205     *loadHandle = (Tcl_LoadHandle) dyldLoadHandle;
206     *unloadProcPtr = &TclpUnloadFile;
207     return TCL_OK;
208 }
Tcl_PackageInitProc* TclpFindSymbol (Tcl_Interp * interp, Tcl_LoadHandle loadHandle, CONST char * symbol)

Definition at line 227 of file tclLoadDyld.c.
References ckalloc, CONST, Tcl_DyldLoadHandle::dyldLibHeader, Tcl_DyldModuleHandle::module, Tcl_DyldLoadHandle::modulePtr, Tcl_DyldModuleHandle::nextPtr, NULL, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), and Tcl_UtfToExternalDString().231 {
232     NSSymbol nsSymbol;
233     CONST char *native;
234     Tcl_DString newName, ds;
235     Tcl_PackageInitProc *proc = NULL;
236     Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *) loadHandle;
237 
238     /*
239      * dyld adds an underscore to the beginning of symbol names.
240      */
241 
242     native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
243     Tcl_DStringInit(&newName);
244     Tcl_DStringAppend(&newName, "_", 1);
245     native = Tcl_DStringAppend(&newName, native, -1);
246 
247     if (dyldLoadHandle->dyldLibHeader) {
248   nsSymbol = NSLookupSymbolInImage(dyldLoadHandle->dyldLibHeader, native,
249     NSLOOKUPSYMBOLINIMAGE_OPTION_BIND_NOW |
250     NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR);
251   if (nsSymbol) {
252       /*
253        * Until dyld supports unloading of MY_DYLIB binaries, the
254        * following is not needed.
255        */
256 
257 #ifdef DYLD_SUPPORTS_DYLIB_UNLOADING
258       NSModule module = NSModuleForSymbol(nsSymbol);
259       Tcl_DyldModuleHandle *modulePtr = dyldLoadHandle->modulePtr;
260 
261       while (modulePtr != NULL) {
262     if (module == modulePtr->module) {
263         break;
264     }
265     modulePtr = modulePtr->nextPtr;
266       }
267       if (modulePtr == NULL) {
268     modulePtr = (Tcl_DyldModuleHandle *)
269       ckalloc(sizeof(Tcl_DyldModuleHandle));
270     modulePtr->module = module;
271     modulePtr->nextPtr = dyldLoadHandle->modulePtr;
272     dyldLoadHandle->modulePtr = modulePtr;
273       }
274 #endif /* DYLD_SUPPORTS_DYLIB_UNLOADING */
275 
276   } else {
277       NSLinkEditErrors editError;
278       int errorNumber;
279       CONST char *name, *msg;
280 
281       NSLinkEditError(&editError, &errorNumber, &name, &msg);
282       Tcl_AppendResult(interp, msg, (char *) NULL);
283   }
284     } else {
285   nsSymbol = NSLookupSymbolInModule(dyldLoadHandle->modulePtr->module,
286     native);
287     }
288     if (nsSymbol) {
289   proc = NSAddressOfSymbol(nsSymbol);
290     }
291     Tcl_DStringFree(&newName);
292     Tcl_DStringFree(&ds);
293 
294     return proc;
295 }
void TclpUnloadFile (Tcl_LoadHandle loadHandle)

Definition at line 318 of file tclLoadDyld.c.
References ckfree, Tcl_DyldModuleHandle::module, Tcl_DyldLoadHandle::modulePtr, Tcl_DyldModuleHandle::nextPtr, and NULL.322 {
323     Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *) loadHandle;
324     Tcl_DyldModuleHandle *modulePtr = dyldLoadHandle->modulePtr;
325 
326     while (modulePtr != NULL) {
327   void *ptr;
328 
329   NSUnLinkModule(modulePtr->module,
330     NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES);
331   ptr = modulePtr;
332   modulePtr = modulePtr->nextPtr;
333   ckfree(ptr);
334     }
335     ckfree((char*) dyldLoadHandle);
336 }

unix/tclLoadNext.c File Reference
#include "tclInt.h"
#include <mach-o/rld.h>
#include <streams/streams.h>
Functions
int TclpDlopen (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr)
Tcl_PackageInitProc * TclpFindSymbol (Tcl_Interp *interp, Tcl_LoadHandle loadHandle, CONST char *symbol)
void TclpUnloadFile (Tcl_LoadHandle loadHandle)
int TclGuessPackageName (CONST char *fileName, Tcl_DString *bufPtr)

Function Documentation
int TclGuessPackageName (CONST char * fileName, Tcl_DString * bufPtr)

Definition at line 179 of file tclLoadNext.c.184 {
185     return 0;
186 }
int TclpDlopen (Tcl_Interp * interp, Tcl_Obj * pathPtr, Tcl_LoadHandle * loadHandle, Tcl_FSUnloadFileProc ** unloadProcPtr)

Definition at line 39 of file tclLoadNext.c.
References CONST, NULL, Tcl_DStringFree(), TCL_ERROR, Tcl_FSGetNativePath(), Tcl_GetString(), TCL_OK, Tcl_UtfToExternalDString(), and TclpUnloadFile().50 {
51     struct mach_header *header;
52     char *fileName;
53     char *files[2];
54     CONST char *native;
55     int result = 1;
56     
57     NXStream *errorStream = NXOpenMemory(0,0,NX_READWRITE);
58     
59     fileName = Tcl_GetString(pathPtr);
60 
61     /* 
62      * First try the full path the user gave us.  This is particularly
63      * important if the cwd is inside a vfs, and we are trying to load
64      * using a relative path.
65      */
66     native = Tcl_FSGetNativePath(pathPtr);
67     files = {native,NULL};
68 
69     result = rld_load(errorStream, &header, files, NULL);
70     
71     if (!result) {
72   /* 
73    * Let the OS loader examine the binary search path for
74    * whatever string the user gave us which hopefully refers
75    * to a file on the binary path
76    */
77   Tcl_DString ds;
78   native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
79   files = {native,NULL};
80   result = rld_load(errorStream, &header, files, NULL);
81   Tcl_DStringFree(&ds);
82     }
83     
84     if (!result) {
85   char *data;
86   int len, maxlen;
87   NXGetMemoryBuffer(errorStream,&data,&len,&maxlen);
88   Tcl_AppendResult(interp, "couldn't load file \"",
89        fileName, "\": ", data, NULL);
90   NXCloseMemory(errorStream, NX_FREEBUFFER);
91   return TCL_ERROR;
92     }
93     NXCloseMemory(errorStream, NX_FREEBUFFER);
94     
95     *loadHandle = (Tcl_LoadHandle)1; /* A dummy non-NULL value */
96     *unloadProcPtr = &TclpUnloadFile;
97     
98     return TCL_OK;
99 }
Tcl_PackageInitProc* TclpFindSymbol (Tcl_Interp * interp, Tcl_LoadHandle loadHandle, CONST char * symbol)

Definition at line 117 of file tclLoadNext.c.
References NULL.121 {
122     Tcl_PackageInitProc *proc=NULL;
123     if(symbol) {
124   char sym[strlen(symbol)+2];
125   sym[0]='_'; sym[1]=0; strcat(sym,symbol);
126   rld_lookup(NULL,sym,(unsigned long *)&proc);
127     }
128     return proc;
129 }
void TclpUnloadFile (Tcl_LoadHandle loadHandle)

Definition at line 150 of file tclLoadNext.c.155 {
156 }

unix/tclLoadOSF.c File Reference
#include "tclInt.h"
#include <sys/types.h>
#include <loader.h>
Functions
int TclpDlopen (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr)
Tcl_PackageInitProc * TclpFindSymbol (Tcl_Interp *interp, Tcl_LoadHandle loadHandle, CONST char *symbol)
void TclpUnloadFile (Tcl_LoadHandle loadHandle)
int TclGuessPackageName (CONST char *fileName, Tcl_DString *bufPtr)

Function Documentation
int TclGuessPackageName (CONST char * fileName, Tcl_DString * bufPtr)

Definition at line 195 of file tclLoadOSF.c.200 {
201     return 0;
202 }
int TclpDlopen (Tcl_Interp * interp, Tcl_Obj * pathPtr, Tcl_LoadHandle * loadHandle, Tcl_FSUnloadFileProc ** unloadProcPtr)

Definition at line 60 of file tclLoadOSF.c.
References CONST, NULL, Tcl_DStringFree(), TCL_ERROR, Tcl_FSGetNativePath(), Tcl_GetString(), TCL_OK, Tcl_PosixError(), Tcl_UtfToExternalDString(), and TclpUnloadFile().71 {
72     ldr_module_t lm;
73     char *pkg;
74     char *fileName = Tcl_GetString(pathPtr);
75     CONST char *native;
76 
77     /* 
78      * First try the full path the user gave us.  This is particularly
79      * important if the cwd is inside a vfs, and we are trying to load
80      * using a relative path.
81      */
82     native = Tcl_FSGetNativePath(pathPtr);
83     lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS);
84 
85     if (lm == LDR_NULL_MODULE) {
86   /* 
87    * Let the OS loader examine the binary search path for
88    * whatever string the user gave us which hopefully refers
89    * to a file on the binary path
90    */
91   Tcl_DString ds;
92   native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
93   lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS);
94   Tcl_DStringFree(&ds);
95     }
96     
97     if (lm == LDR_NULL_MODULE) {
98   Tcl_AppendResult(interp, "couldn't load file \"", fileName,
99       "\": ", Tcl_PosixError (interp), (char *) NULL);
100   return TCL_ERROR;
101     }
102 
103     *clientDataPtr = NULL;
104     
105     /*
106      * My convention is to use a [OSF loader] package name the same as shlib,
107      * since the idiots never implemented ldr_lookup() and it is otherwise
108      * impossible to get a package name given a module.
109      *
110      * I build loadable modules with a makefile rule like 
111      *    ld ... -export $@: -o $@ $(OBJS)
112      */
113     if ((pkg = strrchr(fileName, '/')) == NULL) {
114         pkg = fileName;
115     } else {
116   pkg++;
117     }
118     *loadHandle = pkg;
119     *unloadProcPtr = &TclpUnloadFile;
120     return TCL_OK;
121 }
Tcl_PackageInitProc* TclpFindSymbol (Tcl_Interp * interp, Tcl_LoadHandle loadHandle, CONST char * symbol)

Definition at line 139 of file tclLoadOSF.c.143 {
144     return ldr_lookup_package((char *)loadHandle, symbol);
145 }
void TclpUnloadFile (Tcl_LoadHandle loadHandle)

Definition at line 166 of file tclLoadOSF.c.171 {
172 }

unix/tclLoadShl.c File Reference
#include <dl.h>
#include "tclInt.h"
Functions
int TclpDlopen (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr)
Tcl_PackageInitProc * TclpFindSymbol (Tcl_Interp *interp, Tcl_LoadHandle loadHandle, CONST char *symbol)
void TclpUnloadFile (Tcl_LoadHandle loadHandle)
int TclGuessPackageName (CONST char *fileName, Tcl_DString *bufPtr)

Function Documentation
int TclGuessPackageName (CONST char * fileName, Tcl_DString * bufPtr)

Definition at line 201 of file tclLoadShl.c.206 {
207     return 0;
208 }
int TclpDlopen (Tcl_Interp * interp, Tcl_Obj * pathPtr, Tcl_LoadHandle * loadHandle, Tcl_FSUnloadFileProc ** unloadProcPtr)

Definition at line 47 of file tclLoadShl.c.
References CONST, NULL, Tcl_DStringFree(), TCL_ERROR, Tcl_FSGetNativePath(), Tcl_GetString(), TCL_OK, Tcl_PosixError(), Tcl_UtfToExternalDString(), and TclpUnloadFile().58 {
59     shl_t handle;
60     CONST char *native;
61     char *fileName = Tcl_GetString(pathPtr);
62 
63     /*
64      * The flags below used to be BIND_IMMEDIATE; they were changed at
65      * the suggestion of Wolfgang Kechel (wolfgang@prs.de): "This
66      * enables verbosity for missing symbols when loading a shared lib
67      * and allows to load libtk8.0.sl into tclsh8.0 without problems.
68      * In general, this delays resolving symbols until they are actually
69      * needed.  Shared libs do no longer need all libraries linked in
70      * when they are build."
71      */
72 
73 
74     /*
75      * First try the full path the user gave us.  This is particularly
76      * important if the cwd is inside a vfs, and we are trying to load
77      * using a relative path.
78      */
79     native = Tcl_FSGetNativePath(pathPtr);
80     handle = shl_load(native, BIND_DEFERRED|BIND_VERBOSE, 0L);
81 
82     if (handle == NULL) {
83   /*
84    * Let the OS loader examine the binary search path for
85    * whatever string the user gave us which hopefully refers
86    * to a file on the binary path
87    */
88   Tcl_DString ds;
89   native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
90   handle = shl_load(native,
91         BIND_DEFERRED|BIND_VERBOSE|DYNAMIC_PATH, 0L);
92   Tcl_DStringFree(&ds);
93     }
94 
95     if (handle == NULL) {
96   Tcl_AppendResult(interp, "couldn't load file \"", fileName,
97     "\": ", Tcl_PosixError(interp), (char *) NULL);
98   return TCL_ERROR;
99     }
100     *loadHandle = (Tcl_LoadHandle) handle;
101     *unloadProcPtr = &TclpUnloadFile;
102     return TCL_OK;
103 }
Tcl_PackageInitProc* TclpFindSymbol (Tcl_Interp * interp, Tcl_LoadHandle loadHandle, CONST char * symbol)

Definition at line 121 of file tclLoadShl.c.
References NULL, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), and Tcl_DStringValue.125 {
126     Tcl_DString newName;
127     Tcl_PackageInitProc *proc=NULL;
128     shl_t handle = (shl_t)loadHandle;
129     /*
130      * Some versions of the HP system software still use "_" at the
131      * beginning of exported symbols while others don't;  try both
132      * forms of each name.
133      */
134 
135     if (shl_findsym(&handle, symbol, (short) TYPE_PROCEDURE, (void *) &proc)
136       != 0) {
137   Tcl_DStringInit(&newName);
138   Tcl_DStringAppend(&newName, "_", 1);
139   Tcl_DStringAppend(&newName, symbol, -1);
140   if (shl_findsym(&handle, Tcl_DStringValue(&newName),
141     (short) TYPE_PROCEDURE, (void *) &proc) != 0) {
142       proc = NULL;
143   }
144   Tcl_DStringFree(&newName);
145     }
146     return proc;
147 }
void TclpUnloadFile (Tcl_LoadHandle loadHandle)

Definition at line 168 of file tclLoadShl.c.173 {
174     shl_t handle;
175 
176     handle = (shl_t) loadHandle;
177     shl_unload(handle);
178 }

unix/tclUnixChan.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include "tclIO.h"
Classes
struct FileState
struct TcpState
Defines
#define SUPPORTS_TTY
#define UNSUPPORTED_OPTION(detail)
#define TCP_ASYNC_SOCKET  (1<<0)
#define TCP_ASYNC_CONNECT  (1<<1)
#define SOMAXCONN  100
#define SOCKET_BUFSIZE  4096
#define ZERO_OFFSET  ((Tcl_SeekOffset) 0)
#define ERROR_OFFSET  ((Tcl_SeekOffset) -1)
Functions
static TcpState *CreateSocket _ANSI_ARGS_ ((Tcl_Interp *interp, int port, CONST char *host, int server, CONST char *myaddr, int myport, int async))
static int CreateSocketAddress _ANSI_ARGS_ ((struct sockaddr_in *sockaddrPtr, CONST char *host, int port))
static int FileBlockModeProc _ANSI_ARGS_ ((ClientData instanceData, int mode))
static int FileCloseProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp))
static int FileGetHandleProc _ANSI_ARGS_ ((ClientData instanceData, int direction, ClientData *handlePtr))
static int FileInputProc _ANSI_ARGS_ ((ClientData instanceData, char *buf, int toRead, int *errorCode))
static int FileOutputProc _ANSI_ARGS_ ((ClientData instanceData, CONST char *buf, int toWrite, int *errorCode))
static int FileSeekProc _ANSI_ARGS_ ((ClientData instanceData, long offset, int mode, int *errorCode))
static Tcl_WideInt FileWideSeekProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCode))
static void TcpAccept _ANSI_ARGS_ ((ClientData data, int mask))
static int TcpGetOptionProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, Tcl_DString *dsPtr))
static int WaitForConnect _ANSI_ARGS_ ((TcpState *statePtr, int *errorCodePtr))
static Tcl_Channel MakeTcpClientChannelMode _ANSI_ARGS_ ((ClientData tcpSocket, int mode))
static int FileBlockModeProc (ClientData instanceData, int mode)
static int FileInputProc (ClientData instanceData, char *buf, int toRead, int *errorCodePtr)
static int FileOutputProc (ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr)
static int FileCloseProc (ClientData instanceData, Tcl_Interp *interp)
static int FileSeekProc (ClientData instanceData, long offset, int mode, int *errorCodePtr)
static Tcl_WideInt FileWideSeekProc (ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCodePtr)
static void FileWatchProc (ClientData instanceData, int mask)
static int FileGetHandleProc (ClientData instanceData, int direction, ClientData *handlePtr)
Tcl_Channel TclpOpenFileChannel (Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions)
Tcl_Channel Tcl_MakeFileChannel (ClientData handle, int mode)
static int TcpBlockModeProc (ClientData instanceData, int mode)
static int WaitForConnect (TcpState *statePtr, int *errorCodePtr)
static int TcpInputProc (ClientData instanceData, char *buf, int bufSize, int *errorCodePtr)
static int TcpOutputProc (ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr)
static int TcpCloseProc (ClientData instanceData, Tcl_Interp *interp)
static int TcpGetOptionProc (ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, Tcl_DString *dsPtr)
static void TcpWatchProc (ClientData instanceData, int mask)
static int TcpGetHandleProc (ClientData instanceData, int direction, ClientData *handlePtr)
static TcpState * CreateSocket (Tcl_Interp *interp, int port, CONST char *host, int server, CONST char *myaddr, int myport, int async)
static int CreateSocketAddress (struct sockaddr_in *sockaddrPtr, CONST char *host, int port)
Tcl_Channel Tcl_OpenTcpClient (Tcl_Interp *interp, int port, CONST char *host, CONST char *myaddr, int myport, int async)
Tcl_Channel Tcl_MakeTcpClientChannel (ClientData sock)
static Tcl_Channel MakeTcpClientChannelMode (ClientData sock, int mode)
Tcl_Channel Tcl_OpenTcpServer (Tcl_Interp *interp, int port, CONST char *myHost, Tcl_TcpAcceptProc *acceptProc, ClientData acceptProcData)
static void TcpAccept (ClientData data, int mask)
Tcl_Channel TclpGetDefaultStdChannel (int type)
int Tcl_GetOpenFile (Tcl_Interp *interp, CONST char *string, int forWriting, int checkUsage, ClientData *filePtr)
int TclUnixWaitForFile (int fd, int mask, int timeout)
Variables
static Tcl_ChannelType fileChannelType
static Tcl_ChannelType tcpChannelType

Define Documentation
#define ERROR_OFFSET  ((Tcl_SeekOffset) -1)

Referenced by TclpGetDefaultStdChannel().#define SOCKET_BUFSIZE  4096

Definition at line 228 of file tclUnixChan.c.
Referenced by CreateSocket().#define SOMAXCONN  100

Definition at line 215 of file tclUnixChan.c.
Referenced by CreateSocket().#define SUPPORTS_TTY

Definition at line 45 of file tclUnixChan.c.
Referenced by Tcl_GetOpenFile().#define TCP_ASYNC_CONNECT  (1<<1)

Definition at line 205 of file tclUnixChan.c.#define TCP_ASYNC_SOCKET  (1<<0)

Definition at line 204 of file tclUnixChan.c.#define UNSUPPORTED_OPTION(detail)
Value:if (interp) {             \
      Tcl_AppendResult(interp, (detail),        \
        " not supported for this platform", (char *) NULL); \
  }
Definition at line 166 of file tclUnixChan.c.#define ZERO_OFFSET  ((Tcl_SeekOffset) 0)

Referenced by TclpGetDefaultStdChannel().
Function Documentation
static Tcl_Channel MakeTcpClientChannelMode _ANSI_ARGS_ ((ClientData tcpSocket, int mode)) [static]
static int WaitForConnect _ANSI_ARGS_ ((TcpState *statePtr, int *errorCodePtr)) [static]
static int TcpGetOptionProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, Tcl_DString *dsPtr)) [static]
static void TcpAccept _ANSI_ARGS_ ((ClientData data, int mask)) [static]
static Tcl_WideInt FileWideSeekProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCode)) [static]
static int FileSeekProc _ANSI_ARGS_ ((ClientData instanceData, long offset, int mode, int *errorCode)) [static]
static int FileOutputProc _ANSI_ARGS_ ((ClientData instanceData, CONST char *buf, int toWrite, int *errorCode)) [static]
static int FileInputProc _ANSI_ARGS_ ((ClientData instanceData, char *buf, int toRead, int *errorCode)) [static]
static int FileGetHandleProc _ANSI_ARGS_ ((ClientData instanceData, int direction, ClientData *handlePtr)) [static]
static int FileCloseProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp)) [static]
static int FileBlockModeProc _ANSI_ARGS_ ((ClientData instanceData, int mode)) [static]
static int CreateSocketAddress _ANSI_ARGS_ ((struct sockaddr_in *sockaddrPtr, CONST char *host, int port)) [static]
static TcpState* CreateSocket _ANSI_ARGS_ ((Tcl_Interp *interp, int port, CONST char *host, int server, CONST char *myaddr, int myport, int async)) [static]
static TcpState* CreateSocket (Tcl_Interp * interp, int port, CONST char * host, int server, CONST char * myaddr, int myport, int async) [static]

Definition at line 2484 of file tclUnixChan.c.
References ckalloc, CreateSocketAddress(), EINPROGRESS, errno, FD_CLOEXEC, NULL, O_NONBLOCK, setsockopt, SOCKET_BUFSIZE, SOMAXCONN, Tcl_PosixError(), TclSockMinimumBuffers(), TCP_ASYNC_CONNECT, and void().2496 {
2497     int status, sock, asyncConnect, curState, origState;
2498     struct sockaddr_in sockaddr;  /* socket address */
2499     struct sockaddr_in mysockaddr;  /* Socket address for client */
2500     TcpState *statePtr;
2501 
2502     sock = -1;
2503     origState = 0;
2504     if (! CreateSocketAddress(&sockaddr, host, port)) {
2505   goto addressError;
2506     }
2507     if ((myaddr != NULL || myport != 0) &&
2508       ! CreateSocketAddress(&mysockaddr, myaddr, myport)) {
2509   goto addressError;
2510     }
2511 
2512     sock = socket(AF_INET, SOCK_STREAM, 0);
2513     if (sock < 0) {
2514   goto addressError;
2515     }
2516 
2517     /*
2518      * Set the close-on-exec flag so that the socket will not get
2519      * inherited by child processes.
2520      */
2521 
2522     fcntl(sock, F_SETFD, FD_CLOEXEC);
2523 
2524     /*
2525      * Set kernel space buffering
2526      */
2527 
2528     TclSockMinimumBuffers(sock, SOCKET_BUFSIZE);
2529 
2530     asyncConnect = 0;
2531     status = 0;
2532     if (server) {
2533   /*
2534    * Set up to reuse server addresses automatically and bind to the
2535    * specified port.
2536    */
2537 
2538   status = 1;
2539   (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &status,
2540     sizeof(status));
2541   status = bind(sock, (struct sockaddr *) &sockaddr,
2542     sizeof(struct sockaddr));
2543   if (status != -1) {
2544       status = listen(sock, SOMAXCONN);
2545   } 
2546     } else {
2547   if (myaddr != NULL || myport != 0) { 
2548       curState = 1;
2549       (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
2550         (char *) &curState, sizeof(curState));
2551       status = bind(sock, (struct sockaddr *) &mysockaddr,
2552         sizeof(struct sockaddr));
2553       if (status < 0) {
2554     goto bindError;
2555       }
2556   }
2557 
2558   /*
2559    * Attempt to connect. The connect may fail at present with an
2560    * EINPROGRESS but at a later time it will complete. The caller
2561    * will set up a file handler on the socket if she is interested in
2562    * being informed when the connect completes.
2563    */
2564 
2565   if (async) {
2566 #ifndef USE_FIONBIO
2567       origState = fcntl(sock, F_GETFL);
2568       curState = origState | O_NONBLOCK;
2569       status = fcntl(sock, F_SETFL, curState);
2570 #else /* USE_FIONBIO */
2571       curState = 1;
2572       status = ioctl(sock, FIONBIO, &curState);
2573 #endif /* !USE_FIONBIO */
2574   } else {
2575       status = 0;
2576   }
2577   if (status > -1) {
2578       status = connect(sock, (struct sockaddr *) &sockaddr,
2579         sizeof(sockaddr));
2580       if (status < 0) {
2581     if (errno == EINPROGRESS) {
2582         asyncConnect = 1;
2583         status = 0;
2584     }
2585       } else {
2586     /*
2587      * Here we are if the connect succeeds. In case of an
2588      * asynchronous connect we have to reset the channel to
2589      * blocking mode.  This appears to happen not very often,
2590      * but e.g. on a HP 9000/800 under HP-UX B.11.00 we enter
2591      * this stage. [Bug: 4388]
2592      */
2593     if (async) {
2594 #ifndef USE_FIONBIO
2595         origState = fcntl(sock, F_GETFL);
2596         curState = origState & ~(O_NONBLOCK);
2597         status = fcntl(sock, F_SETFL, curState);
2598 #else /* USE_FIONBIO */
2599         curState = 0;
2600         status = ioctl(sock, FIONBIO, &curState);
2601 #endif /* !USE_FIONBIO */
2602     }
2603       }
2604   }
2605     }
2606 
2607 bindError:
2608     if (status < 0) {
2609   if (interp != NULL) {
2610       Tcl_AppendResult(interp, "couldn't open socket: ",
2611         Tcl_PosixError(interp), (char *) NULL);
2612   }
2613   if (sock != -1) {
2614       close(sock);
2615   }
2616   return NULL;
2617     }
2618 
2619     /*
2620      * Allocate a new TcpState for this socket.
2621      */
2622 
2623     statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
2624     statePtr->flags = 0;
2625     if (asyncConnect) {
2626   statePtr->flags = TCP_ASYNC_CONNECT;
2627     }
2628     statePtr->fd = sock;
2629 
2630     return statePtr;
2631 
2632 addressError:
2633     if (sock != -1) {
2634   close(sock);
2635     }
2636     if (interp != NULL) {
2637   Tcl_AppendResult(interp, "couldn't open socket: ",
2638     Tcl_PosixError(interp), (char *) NULL);
2639     }
2640     return NULL;
2641 }
static int CreateSocketAddress (struct sockaddr_in * sockaddrPtr, CONST char * host, int port) [static]

Definition at line 2661 of file tclUnixChan.c.
References CONST, EHOSTUNREACH, ENXIO, errno, NULL, size_t(), Tcl_DStringFree(), Tcl_UtfToExternalDString(), TclpGetHostByName(), VOID, and void().
Referenced by CreateSocket().2665 {
2666     struct hostent *hostent;    /* Host database entry */
2667     struct in_addr addr;    /* For 64/32 bit madness */
2668 
2669     (void) memset((VOID *) sockaddrPtr, '\0', sizeof(struct sockaddr_in));
2670     sockaddrPtr->sin_family = AF_INET;
2671     sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF));
2672     if (host == NULL) {
2673   addr.s_addr = INADDR_ANY;
2674     } else {
2675   Tcl_DString ds;
2676   CONST char *native;
2677 
2678   if (host == NULL) {
2679       native = NULL;
2680   } else {
2681       native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
2682   }
2683   addr.s_addr = inet_addr(native);    /* INTL: Native. */
2684   /*
2685    * This is 0xFFFFFFFF to ensure that it compares as a 32bit -1
2686    * on either 32 or 64 bits systems.
2687    */
2688   if (addr.s_addr == 0xFFFFFFFF) {
2689       hostent = TclpGetHostByName(native);    /* INTL: Native. */
2690       if (hostent != (struct hostent *) NULL) {
2691     memcpy((VOID *) &addr,
2692       (VOID *) hostent->h_addr_list[0],
2693       (size_t) hostent->h_length);
2694       } else {
2695 #ifdef  EHOSTUNREACH
2696     errno = EHOSTUNREACH;
2697 #else /* !EHOSTUNREACH */
2698 #ifdef ENXIO
2699     errno = ENXIO;
2700 #endif /* ENXIO */
2701 #endif /* EHOSTUNREACH */
2702     if (native != NULL) {
2703         Tcl_DStringFree(&ds);
2704     }
2705     return 0; /* error */
2706       }
2707   }
2708   if (native != NULL) {
2709       Tcl_DStringFree(&ds);
2710   }
2711     }
2712 
2713     /*
2714      * NOTE: On 64 bit machines the assignment below is rumored to not
2715      * do the right thing. Please report errors related to this if you
2716      * observe incorrect behavior on 64 bit machines such as DEC Alphas.
2717      * Should we modify this code to do an explicit memcpy?
2718      */
2719 
2720     sockaddrPtr->sin_addr.s_addr = addr.s_addr;
2721     return 1; /* Success. */
2722 }
static int FileBlockModeProc (ClientData instanceData, int mode) [static]

Definition at line 407 of file tclUnixChan.c.
References errno, FileState::fd, O_NONBLOCK, and TCL_MODE_BLOCKING.412 {
413     FileState *fsPtr = (FileState *) instanceData;
414     int curStatus;
415 
416 #ifndef USE_FIONBIO
417     curStatus = fcntl(fsPtr->fd, F_GETFL);
418     if (mode == TCL_MODE_BLOCKING) {
419   curStatus &= (~(O_NONBLOCK));
420     } else {
421   curStatus |= O_NONBLOCK;
422     }
423     if (fcntl(fsPtr->fd, F_SETFL, curStatus) < 0) {
424   return errno;
425     }
426     curStatus = fcntl(fsPtr->fd, F_GETFL);
427 #else /* USE_FIONBIO */
428     if (mode == TCL_MODE_BLOCKING) {
429   curStatus = 0;
430     } else {
431   curStatus = 1;
432     }
433     if (ioctl(fsPtr->fd, (int) FIONBIO, &curStatus) < 0) {
434   return errno;
435     }
436 #endif /* !USE_FIONBIO */
437     return 0;
438 }
static int FileCloseProc (ClientData instanceData, Tcl_Interp * interp) [static]

Definition at line 554 of file tclUnixChan.c.
References ckfree, dataKey, errno, FileState::fd, Tcl_DeleteFileHandler(), TCL_TSD_INIT, and TclInThreadExit().557 {
558     FileState *fsPtr = (FileState *) instanceData;
559     int errorCode = 0;
560 #ifdef DEPRECATED
561     FileState **nextPtrPtr;
562     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
563 #endif /* DEPRECATED */
564     Tcl_DeleteFileHandler(fsPtr->fd);
565 
566     /*
567      * Do not close standard channels while in thread-exit.
568      */
569 
570     if (!TclInThreadExit()
571       || ((fsPtr->fd != 0) && (fsPtr->fd != 1) && (fsPtr->fd != 2))) {
572   if (close(fsPtr->fd) < 0) {
573       errorCode = errno;
574   }
575     }
576     ckfree((char *) fsPtr);
577     return errorCode;
578 }
static int FileGetHandleProc (ClientData instanceData, int direction, ClientData * handlePtr) [static]

Definition at line 737 of file tclUnixChan.c.
References FileState::fd, TCL_ERROR, TCL_OK, and FileState::validMask.741 {
742     FileState *fsPtr = (FileState *) instanceData;
743 
744     if (direction & fsPtr->validMask) {
745   *handlePtr = (ClientData) fsPtr->fd;
746   return TCL_OK;
747     } else {
748   return TCL_ERROR;
749     }
750 }
static int FileInputProc (ClientData instanceData, char * buf, int toRead, int * errorCodePtr) [static]

Definition at line 459 of file tclUnixChan.c.
References errno, FileState::fd, and size_t().465 {
466     FileState *fsPtr = (FileState *) instanceData;
467     int bytesRead;      /* How many bytes were actually
468            * read from the input device? */
469 
470     *errorCodePtr = 0;
471 
472     /*
473      * Assume there is always enough input available. This will block
474      * appropriately, and read will unblock as soon as a short read is
475      * possible, if the channel is in blocking mode. If the channel is
476      * nonblocking, the read will never block.
477      */
478 
479     bytesRead = read(fsPtr->fd, buf, (size_t) toRead);
480     if (bytesRead > -1) {
481   return bytesRead;
482     }
483     *errorCodePtr = errno;
484     return -1;
485 }
static int FileOutputProc (ClientData instanceData, CONST char * buf, int toWrite, int * errorCodePtr) [static]

Definition at line 507 of file tclUnixChan.c.
References errno, FileState::fd, and size_t().512 {
513     FileState *fsPtr = (FileState *) instanceData;
514     int written;
515 
516     *errorCodePtr = 0;
517 
518     if (toWrite == 0) {
519   /*
520    * SF Tcl Bug 465765.
521    * Do not try to write nothing into a file. STREAM based
522    * implementations will considers this as EOF (if there is a
523    * pipe behind the file).
524    */
525 
526   return 0;
527     }
528     written = write(fsPtr->fd, buf, (size_t) toWrite);
529     if (written > -1) {
530   return written;
531     }
532     *errorCodePtr = errno;
533     return -1;
534 }
static int FileSeekProc (ClientData instanceData, long offset, int mode, int * errorCodePtr) [static]

Definition at line 601 of file tclUnixChan.c.
References EOVERFLOW, errno, FileState::fd, INT_MAX, SEEK_CUR, SEEK_SET, Tcl_LongAsWide, Tcl_WideAsLong, and TclOSseek.607 {
608     FileState *fsPtr = (FileState *) instanceData;
609     Tcl_WideInt oldLoc, newLoc;
610 
611     /*
612      * Save our current place in case we need to roll-back the seek.
613      */
614     oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR);
615     if (oldLoc == Tcl_LongAsWide(-1)) {
616   /*
617    * Bad things are happening.  Error out...
618    */
619   *errorCodePtr = errno;
620   return -1;
621     }
622  
623     newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);
624  
625     /*
626      * Check for expressability in our return type, and roll-back otherwise.
627      */
628     if (newLoc > Tcl_LongAsWide(INT_MAX)) {
629   *errorCodePtr = EOVERFLOW;
630   TclOSseek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET);
631   return -1;
632     } else {
633   *errorCodePtr = (newLoc == Tcl_LongAsWide(-1)) ? errno : 0;
634     }
635     return (int) Tcl_WideAsLong(newLoc);
636 }
static void FileWatchProc (ClientData instanceData, int mask) [static]

Definition at line 694 of file tclUnixChan.c.
References FileState::channel, FileState::fd, Tcl_CreateFileHandler(), Tcl_DeleteFileHandler(), Tcl_NotifyChannel(), and FileState::validMask.
Referenced by FileCloseProc().699 {
700     FileState *fsPtr = (FileState *) instanceData;
701 
702     /*
703      * Make sure we only register for events that are valid on this file.
704      * Note that we are passing Tcl_NotifyChannel directly to
705      * Tcl_CreateFileHandler with the channel pointer as the client data.
706      */
707 
708     mask &= fsPtr->validMask;
709     if (mask) {
710   Tcl_CreateFileHandler(fsPtr->fd, mask,
711     (Tcl_FileProc *) Tcl_NotifyChannel,
712     (ClientData) fsPtr->channel);
713     } else {
714   Tcl_DeleteFileHandler(fsPtr->fd);
715     }
716 }
static Tcl_WideInt FileWideSeekProc (ClientData instanceData, Tcl_WideInt offset, int mode, int * errorCodePtr) [static]

Definition at line 660 of file tclUnixChan.c.
References errno, FileState::fd, and TclOSseek.666 {
667     FileState *fsPtr = (FileState *) instanceData;
668     Tcl_WideInt newLoc;
669 
670     newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);
671 
672     *errorCodePtr = (newLoc == -1) ? errno : 0;
673     return newLoc;
674 }
static Tcl_Channel MakeTcpClientChannelMode (ClientData sock, int mode) [static]

Definition at line 2820 of file tclUnixChan.c.
References ckalloc, NULL, Tcl_Close(), Tcl_CreateChannel(), TCL_ERROR, TCL_INTEGER_SPACE, Tcl_SetChannelOption(), and tcpChannelType.
Referenced by Tcl_MakeFileChannel(), and Tcl_MakeTcpClientChannel().2824 {
2825     TcpState *statePtr;
2826     char channelName[16 + TCL_INTEGER_SPACE];
2827 
2828     statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
2829     statePtr->fd = (int) sock;
2830     statePtr->flags = 0;
2831     statePtr->acceptProc = NULL;
2832     statePtr->acceptProcData = (ClientData) NULL;
2833 
2834     sprintf(channelName, "sock%d", statePtr->fd);
2835 
2836     statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
2837       (ClientData) statePtr, mode);
2838     if (Tcl_SetChannelOption((Tcl_Interp *) NULL, statePtr->channel,
2839       "-translation", "auto crlf") == TCL_ERROR) {
2840   Tcl_Close((Tcl_Interp *) NULL, statePtr->channel);
2841   return NULL;
2842     }
2843     return statePtr->channel;
2844 }
int Tcl_GetOpenFile (Tcl_Interp * interp, CONST char * string, int forWriting, int checkUsage, ClientData * filePtr)

Definition at line 3077 of file tclUnixChan.c.
References fileChannelType, NULL, SUPPORTS_TTY, TCL_ERROR, Tcl_GetChannel(), Tcl_GetChannelHandle(), Tcl_GetChannelType(), TCL_OK, TCL_READABLE, TCL_WRITABLE, tcpChannelType, and Tcl_ChannelType::typeName.
Referenced by TestgetopenfileCmd().3088 {
3089     Tcl_Channel chan;
3090     int chanMode;
3091     Tcl_ChannelType *chanTypePtr;
3092     ClientData data;
3093     int fd;
3094     FILE *f;
3095 
3096     chan = Tcl_GetChannel(interp, string, &chanMode);
3097     if (chan == (Tcl_Channel) NULL) {
3098   return TCL_ERROR;
3099     }
3100     if ((forWriting) && ((chanMode & TCL_WRITABLE) == 0)) {
3101   Tcl_AppendResult(interp,
3102     "\"", string, "\" wasn't opened for writing", (char *) NULL);
3103   return TCL_ERROR;
3104     } else if ((!(forWriting)) && ((chanMode & TCL_READABLE) == 0)) {
3105   Tcl_AppendResult(interp,
3106     "\"", string, "\" wasn't opened for reading", (char *) NULL);
3107   return TCL_ERROR;
3108     }
3109 
3110     /*
3111      * We allow creating a FILE * out of file based, pipe based and socket
3112      * based channels. We currently do not allow any other channel types,
3113      * because it is likely that stdio will not know what to do with them.
3114      */
3115 
3116     chanTypePtr = Tcl_GetChannelType(chan);
3117     if ((chanTypePtr == &fileChannelType)
3118 #ifdef SUPPORTS_TTY
3119       || (chanTypePtr == &ttyChannelType)
3120 #endif /* SUPPORTS_TTY */
3121       || (chanTypePtr == &tcpChannelType)
3122       || (strcmp(chanTypePtr->typeName, "pipe") == 0)) {
3123   if (Tcl_GetChannelHandle(chan,
3124     (forWriting ? TCL_WRITABLE : TCL_READABLE),
3125     (ClientData*) &data) == TCL_OK) {
3126       fd = (int) data;
3127 
3128       /*
3129        * The call to fdopen below is probably dangerous, since it will
3130        * truncate an existing file if the file is being opened
3131        * for writing....
3132        */
3133 
3134       f = fdopen(fd, (forWriting ? "w" : "r"));
3135       if (f == NULL) {
3136     Tcl_AppendResult(interp, "cannot get a FILE * for \"", string,
3137       "\"", (char *) NULL);
3138     return TCL_ERROR;
3139       }
3140       *filePtr = (ClientData) f;
3141       return TCL_OK;
3142   }
3143     }
3144 
3145     Tcl_AppendResult(interp, "\"", string,
3146       "\" cannot be used to get a FILE *", (char *) NULL);
3147     return TCL_ERROR;      
3148 }
Tcl_Channel Tcl_MakeFileChannel (ClientData handle, int mode)

Definition at line 1905 of file tclUnixChan.c.
References FileState::channel, ckalloc, dataKey, FileState::fd, fileChannelType, ThreadSpecificData::firstFilePtr, MakeTcpClientChannelMode(), FileState::nextPtr, NULL, socklen_t, Tcl_CreateChannel(), TCL_EXCEPTION, TCL_INTEGER_SPACE, TCL_TSD_INIT, and FileState::validMask.1909 {
1910     FileState *fsPtr;
1911     char channelName[16 + TCL_INTEGER_SPACE];
1912     int fd = (int) handle;
1913     Tcl_ChannelType *channelTypePtr;
1914 #ifdef DEPRECATED
1915     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1916 #endif /* DEPRECATED */
1917     struct sockaddr sockaddr;
1918     socklen_t sockaddrLen = sizeof(sockaddr);
1919 
1920     if (mode == 0) {
1921   return NULL;
1922     }
1923 
1924 
1925     /*
1926      * Look to see if a channel with this fd and the same mode already exists.
1927      * If the fd is used, but the mode doesn't match, return NULL.
1928      */
1929 
1930 #ifdef DEPRECATED
1931     for (fsPtr = tsdPtr->firstFilePtr; fsPtr != NULL; fsPtr = fsPtr->nextPtr) {
1932   if (fsPtr->fd == fd) {
1933       return ((mode|TCL_EXCEPTION) == fsPtr->validMask) ?
1934         fsPtr->channel : NULL;
1935   }
1936     }
1937 #endif /* DEPRECATED */
1938 
1939     sockaddr.sa_family = AF_UNSPEC;
1940 
1941 #ifdef SUPPORTS_TTY
1942     if (isatty(fd)) {
1943   fsPtr = TtyInit(fd, 0);
1944   channelTypePtr = &ttyChannelType;
1945   sprintf(channelName, "serial%d", fd);
1946     } else
1947 #endif /* SUPPORTS_TTY */
1948     if (getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0
1949             && sockaddrLen > 0
1950             && sockaddr.sa_family == AF_INET) {
1951         return MakeTcpClientChannelMode((ClientData) fd, mode);
1952     } else {
1953         channelTypePtr = &fileChannelType;
1954         fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
1955         sprintf(channelName, "file%d", fd);
1956     }
1957 
1958 #ifdef DEPRECATED
1959     if (channelTypePtr == &fileChannelType) {
1960         fsPtr->nextPtr = tsdPtr->firstFilePtr;
1961         tsdPtr->firstFilePtr = fsPtr;
1962     }
1963 #endif /* DEPRECATED */
1964     fsPtr->fd = fd;
1965     fsPtr->validMask = mode | TCL_EXCEPTION;
1966     fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
1967       (ClientData) fsPtr, mode);
1968 
1969     return fsPtr->channel;
1970 }
Tcl_Channel Tcl_MakeTcpClientChannel (ClientData sock)

Definition at line 2796 of file tclUnixChan.c.
References MakeTcpClientChannelMode(), TCL_READABLE, and TCL_WRITABLE.2798 {
2799     return MakeTcpClientChannelMode(sock, (TCL_READABLE | TCL_WRITABLE));
2800 }
Tcl_Channel Tcl_OpenTcpClient (Tcl_Interp * interp, int port, CONST char * host, CONST char * myaddr, int myport, int async)

Definition at line 2742 of file tclUnixChan.c.
References CreateSocket(), NULL, Tcl_Close(), Tcl_CreateChannel(), TCL_ERROR, TCL_INTEGER_SPACE, TCL_READABLE, Tcl_SetChannelOption(), TCL_WRITABLE, and tcpChannelType.2751 {
2752     TcpState *statePtr;
2753     char channelName[16 + TCL_INTEGER_SPACE];
2754 
2755     /*
2756      * Create a new client socket and wrap it in a channel.
2757      */
2758 
2759     statePtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
2760     if (statePtr == NULL) {
2761   return NULL;
2762     }
2763 
2764     statePtr->acceptProc = NULL;
2765     statePtr->acceptProcData = (ClientData) NULL;
2766 
2767     sprintf(channelName, "sock%d", statePtr->fd);
2768 
2769     statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
2770       (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
2771     if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation",
2772       "auto crlf") == TCL_ERROR) {
2773   Tcl_Close((Tcl_Interp *) NULL, statePtr->channel);
2774   return NULL;
2775     }
2776     return statePtr->channel;
2777 }
Tcl_Channel Tcl_OpenTcpServer (Tcl_Interp * interp, int port, CONST char * myHost, Tcl_TcpAcceptProc * acceptProc, ClientData acceptProcData)

Definition at line 2865 of file tclUnixChan.c.
References CreateSocket(), NULL, Tcl_CreateChannel(), Tcl_CreateFileHandler(), TCL_INTEGER_SPACE, TCL_READABLE, TcpAccept(), and tcpChannelType.2873 {
2874     TcpState *statePtr;
2875     char channelName[16 + TCL_INTEGER_SPACE];
2876 
2877     /*
2878      * Create a new client socket and wrap it in a channel.
2879      */
2880 
2881     statePtr = CreateSocket(interp, port, myHost, 1, NULL, 0, 0);
2882     if (statePtr == NULL) {
2883   return NULL;
2884     }
2885 
2886     statePtr->acceptProc = acceptProc;
2887     statePtr->acceptProcData = acceptProcData;
2888 
2889     /*
2890      * Set up the callback mechanism for accepting connections
2891      * from new clients.
2892      */
2893 
2894     Tcl_CreateFileHandler(statePtr->fd, TCL_READABLE, TcpAccept,
2895       (ClientData) statePtr);
2896     sprintf(channelName, "sock%d", statePtr->fd);
2897     statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
2898       (ClientData) statePtr, 0);
2899     return statePtr->channel;
2900 }
Tcl_Channel TclpGetDefaultStdChannel (int type)

Definition at line 2986 of file tclUnixChan.c.
References EBADF, errno, ERROR_OFFSET, fileChannelType, NULL, panic, SEEK_CUR, Tcl_GetChannelType(), Tcl_MakeFileChannel(), TCL_READABLE, Tcl_SetChannelOption(), TCL_STDERR, TCL_STDIN, TCL_STDOUT, TCL_WRITABLE, TclOSseek, and ZERO_OFFSET.2988 {
2989     Tcl_Channel channel = NULL;
2990     int fd = 0;     /* Initializations needed to prevent */
2991     int mode = 0;   /* compiler warning (used before set). */
2992     char *bufMode = NULL;
2993 
2994     /*
2995      * Some #def's to make the code a little clearer!
2996      */
2997 #define ZERO_OFFSET ((Tcl_SeekOffset) 0)
2998 #define ERROR_OFFSET  ((Tcl_SeekOffset) -1)
2999 
3000     switch (type) {
3001   case TCL_STDIN:
3002       if ((TclOSseek(0, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
3003         && (errno == EBADF)) {
3004     return (Tcl_Channel) NULL;
3005       }
3006       fd = 0;
3007       mode = TCL_READABLE;
3008       bufMode = "line";
3009       break;
3010   case TCL_STDOUT:
3011       if ((TclOSseek(1, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
3012         && (errno == EBADF)) {
3013     return (Tcl_Channel) NULL;
3014       }
3015       fd = 1;
3016       mode = TCL_WRITABLE;
3017       bufMode = "line";
3018       break;
3019   case TCL_STDERR:
3020       if ((TclOSseek(2, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
3021         && (errno == EBADF)) {
3022     return (Tcl_Channel) NULL;
3023       }
3024       fd = 2;
3025       mode = TCL_WRITABLE;
3026       bufMode = "none";
3027       break;
3028   default:
3029       panic("TclGetDefaultStdChannel: Unexpected channel type");
3030       break;
3031     }
3032 
3033 #undef ZERO_OFFSET
3034 #undef ERROR_OFFSET
3035 
3036     channel = Tcl_MakeFileChannel((ClientData) fd, mode);
3037     if (channel == NULL) {
3038   return NULL;
3039     }
3040 
3041     /*
3042      * Set up the normal channel options for stdio handles.
3043      */
3044 
3045     if (Tcl_GetChannelType(channel) == &fileChannelType) {
3046   Tcl_SetChannelOption(NULL, channel, "-translation", "auto");
3047     } else {
3048   Tcl_SetChannelOption(NULL, channel, "-translation", "auto crlf");
3049     }
3050     Tcl_SetChannelOption(NULL, channel, "-buffering", bufMode);
3051     return channel;
3052 }
Tcl_Channel TclpOpenFileChannel (Tcl_Interp * interp, Tcl_Obj * pathPtr, int mode, int permissions)

Definition at line 1767 of file tclUnixChan.c.
References FileState::channel, ckalloc, CONST, dataKey, FileState::fd, FD_CLOEXEC, fileChannelType, FileState::nextPtr, NULL, panic, Tcl_Close(), Tcl_CreateChannel(), TCL_EXCEPTION, Tcl_FSGetNativePath(), Tcl_GetString(), TCL_INTEGER_SPACE, TCL_OK, Tcl_PosixError(), TCL_READABLE, Tcl_SetChannelOption(), TCL_TSD_INIT, TCL_WRITABLE, TclOSopen, and FileState::validMask.1775 {
1776     int fd, channelPermissions;
1777     FileState *fsPtr;
1778     CONST char *native, *translation;
1779     char channelName[16 + TCL_INTEGER_SPACE];
1780     Tcl_ChannelType *channelTypePtr;
1781 #ifdef SUPPORTS_TTY
1782     int ctl_tty;
1783 #endif /* SUPPORTS_TTY */
1784 #ifdef DEPRECATED
1785     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1786 #endif /* DEPRECATED */
1787 
1788     switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
1789   case O_RDONLY:
1790       channelPermissions = TCL_READABLE;
1791       break;
1792   case O_WRONLY:
1793       channelPermissions = TCL_WRITABLE;
1794       break;
1795   case O_RDWR:
1796       channelPermissions = (TCL_READABLE | TCL_WRITABLE);
1797       break;
1798   default:
1799       /*
1800        * This may occurr if modeString was "", for example.
1801        */
1802       panic("TclpOpenFileChannel: invalid mode value");
1803       return NULL;
1804     }
1805 
1806     native = Tcl_FSGetNativePath(pathPtr);
1807     if (native == NULL) {
1808   return NULL;
1809     }
1810     fd = TclOSopen(native, mode, permissions);
1811 #ifdef SUPPORTS_TTY
1812     ctl_tty = (strcmp (native, "/dev/tty") == 0);
1813 #endif /* SUPPORTS_TTY */
1814 
1815     if (fd < 0) {
1816   if (interp != (Tcl_Interp *) NULL) {
1817       Tcl_AppendResult(interp, "couldn't open \"", 
1818         Tcl_GetString(pathPtr), "\": ",
1819         Tcl_PosixError(interp), (char *) NULL);
1820   }
1821   return NULL;
1822     }
1823 
1824     /*
1825      * Set close-on-exec flag on the fd so that child processes will not
1826      * inherit this fd.
1827      */
1828 
1829     fcntl(fd, F_SETFD, FD_CLOEXEC);
1830 
1831     sprintf(channelName, "file%d", fd);
1832 
1833 #ifdef SUPPORTS_TTY
1834     if (!ctl_tty && isatty(fd)) {
1835   /*
1836    * Initialize the serial port to a set of sane parameters.
1837    * Especially important if the remote device is set to echo and
1838    * the serial port driver was also set to echo -- as soon as a char
1839    * were sent to the serial port, the remote device would echo it,
1840    * then the serial driver would echo it back to the device, etc.
1841    */
1842 
1843   translation = "auto crlf";
1844   channelTypePtr = &ttyChannelType;
1845   fsPtr = TtyInit(fd, 1);
1846     } else 
1847 #endif  /* SUPPORTS_TTY */
1848     {
1849   translation = NULL;
1850   channelTypePtr = &fileChannelType;
1851   fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
1852     }
1853 
1854 #ifdef DEPRECATED
1855     if (channelTypePtr == &fileChannelType) {
1856         /* TIP #218. Removed the code inserting the new structure
1857    * into the global list. This is now handled in the thread
1858    * action callbacks, and only there.
1859    */
1860         fsPtr->nextPtr = NULL;
1861     }
1862 #endif /* DEPRECATED */
1863     fsPtr->validMask = channelPermissions | TCL_EXCEPTION;
1864     fsPtr->fd = fd;
1865 
1866     fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
1867       (ClientData) fsPtr, channelPermissions);
1868 
1869     if (translation != NULL) {
1870   /*
1871    * Gotcha.  Most modems need a "\r" at the end of the command
1872    * sequence.  If you just send "at\n", the modem will not respond
1873    * with "OK" because it never got a "\r" to actually invoke the
1874    * command.  So, by default, newlines are translated to "\r\n" on
1875    * output to avoid "bug" reports that the serial port isn't working.
1876    */
1877 
1878   if (Tcl_SetChannelOption(interp, fsPtr->channel, "-translation",
1879     translation) != TCL_OK) {
1880       Tcl_Close(NULL, fsPtr->channel);
1881       return NULL;
1882   }
1883     }
1884 
1885     return fsPtr->channel;
1886 }
int TclUnixWaitForFile (int fd, int mask, int timeout)

Definition at line 3175 of file tclUnixChan.c.
References FD_SETSIZE, MASK_SIZE, NBBY, NULL, panic, Tcl_Time::sec, SELECT_MASK, TCL_EXCEPTION, Tcl_GetTime(), TCL_READABLE, TCL_WRITABLE, Tcl_Time::usec, and VOID.
Referenced by TestfilehandlerCmd(), TestfilewaitCmd(), and WaitForConnect().3177                                      : OR'ed combination of
3178          * TCL_READABLE, TCL_WRITABLE, and
3179          * TCL_EXCEPTION. */
3180     int timeout;    /* Maximum amount of time to wait for one
3181          * of the conditions in mask to occur, in
3182          * milliseconds.  A value of 0 means don't
3183          * wait at all, and a value of -1 means
3184          * wait forever. */
3185 {
3186     Tcl_Time abortTime = {0, 0}, now; /* silence gcc 4 warning */
3187     struct timeval blockTime, *timeoutPtr;
3188     int index, bit, numFound, result = 0;
3189     fd_mask readyMasks[3*MASK_SIZE];
3190         /* This array reflects the readable/writable
3191          * conditions that were found to exist by the
3192          * last call to select. */
3193 
3194     /*
3195      * If there is a non-zero finite timeout, compute the time when
3196      * we give up.
3197      */
3198 
3199     if (timeout > 0) {
3200   Tcl_GetTime(&now);
3201   abortTime.sec = now.sec + timeout/1000;
3202   abortTime.usec = now.usec + (timeout%1000)*1000;
3203   if (abortTime.usec >= 1000000) {
3204       abortTime.usec -= 1000000;
3205       abortTime.sec += 1;
3206   }
3207   timeoutPtr = &blockTime;
3208     } else if (timeout == 0) {
3209   timeoutPtr = &blockTime;
3210   blockTime.tv_sec = 0;
3211   blockTime.tv_usec = 0;
3212     } else {
3213   timeoutPtr = NULL;
3214     }
3215 
3216     /*
3217      * Initialize the ready masks and compute the mask offsets.
3218      */
3219 
3220     if (fd >= FD_SETSIZE) {
3221   panic("TclWaitForFile can't handle file id %d", fd);
3222     }
3223     memset((VOID *) readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask));
3224     index = fd/(NBBY*sizeof(fd_mask));
3225     bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
3226 
3227     /*
3228      * Loop in a mini-event loop of our own, waiting for either the
3229      * file to become ready or a timeout to occur.
3230      */
3231 
3232     while (1) {
3233   if (timeout > 0) {
3234       blockTime.tv_sec = abortTime.sec - now.sec;
3235       blockTime.tv_usec = abortTime.usec - now.usec;
3236       if (blockTime.tv_usec < 0) {
3237     blockTime.tv_sec -= 1;
3238     blockTime.tv_usec += 1000000;
3239       }
3240       if (blockTime.tv_sec < 0) {
3241     blockTime.tv_sec = 0;
3242     blockTime.tv_usec = 0;
3243       }
3244   }
3245 
3246   /*
3247    * Set the appropriate bit in the ready masks for the fd.
3248    */
3249 
3250   if (mask & TCL_READABLE) {
3251       readyMasks[index] |= bit;
3252   }
3253   if (mask & TCL_WRITABLE) {
3254       (readyMasks+MASK_SIZE)[index] |= bit;
3255   }
3256   if (mask & TCL_EXCEPTION) {
3257       (readyMasks+2*(MASK_SIZE))[index] |= bit;
3258   }
3259 
3260   /*
3261    * Wait for the event or a timeout.
3262    */
3263 
3264   numFound = select(fd+1, (SELECT_MASK *) &readyMasks[0],
3265     (SELECT_MASK *) &readyMasks[MASK_SIZE],
3266     (SELECT_MASK *) &readyMasks[2*MASK_SIZE], timeoutPtr);
3267   if (numFound == 1) {
3268       if (readyMasks[index] & bit) {
3269     result |= TCL_READABLE;
3270       }
3271       if ((readyMasks+MASK_SIZE)[index] & bit) {
3272     result |= TCL_WRITABLE;
3273       }
3274       if ((readyMasks+2*(MASK_SIZE))[index] & bit) {
3275     result |= TCL_EXCEPTION;
3276       }
3277       result &= mask;
3278       if (result) {
3279     break;
3280       }
3281   }
3282   if (timeout == 0) {
3283       break;
3284   }
3285   if (timeout < 0) {
3286       continue;
3287   }
3288 
3289   /*
3290    * The select returned early, so we need to recompute the timeout.
3291    */
3292 
3293   Tcl_GetTime(&now);
3294   if ((abortTime.sec < now.sec)
3295     || ((abortTime.sec == now.sec)
3296     && (abortTime.usec <= now.usec))) {
3297       break;
3298   }
3299     }
3300     return result;
3301 }
static void TcpAccept (ClientData data, int mask) [static]

Definition at line 2920 of file tclUnixChan.c.
References TcpState::acceptProc, TcpState::acceptProcData, TcpState::channel, ckalloc, TcpState::fd, FD_CLOEXEC, TcpState::flags, ntohs, NULL, socklen_t, Tcl_CreateChannel(), TCL_INTEGER_SPACE, TCL_READABLE, Tcl_SetChannelOption(), TCL_WRITABLE, tcpChannelType, and void().2923 {
2924     TcpState *sockState;    /* Client data of server socket. */
2925     int newsock;      /* The new client socket */
2926     TcpState *newSockState;   /* State for new socket. */
2927     struct sockaddr_in addr;    /* The remote address */
2928     socklen_t len;        /* For accept interface */
2929     char channelName[16 + TCL_INTEGER_SPACE];
2930 
2931     sockState = (TcpState *) data;
2932 
2933     len = sizeof(struct sockaddr_in);
2934     newsock = accept(sockState->fd, (struct sockaddr *) &addr, &len);
2935     if (newsock < 0) {
2936   return;
2937     }
2938 
2939     /*
2940      * Set close-on-exec flag to prevent the newly accepted socket from
2941      * being inherited by child processes.
2942      */
2943 
2944     (void) fcntl(newsock, F_SETFD, FD_CLOEXEC);
2945 
2946     newSockState = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
2947 
2948     newSockState->flags = 0;
2949     newSockState->fd = newsock;
2950     newSockState->acceptProc = NULL;
2951     newSockState->acceptProcData = NULL;
2952 
2953     sprintf(channelName, "sock%d", newsock);
2954     newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
2955       (ClientData) newSockState, (TCL_READABLE | TCL_WRITABLE));
2956 
2957     Tcl_SetChannelOption(NULL, newSockState->channel, "-translation",
2958       "auto crlf");
2959 
2960     if (sockState->acceptProc != NULL) {
2961   (*sockState->acceptProc)(sockState->acceptProcData,
2962     newSockState->channel, inet_ntoa(addr.sin_addr),
2963     ntohs(addr.sin_port));
2964     }
2965 }
static int TcpBlockModeProc (ClientData instanceData, int mode) [static]

Definition at line 1991 of file tclUnixChan.c.
References errno, O_NONBLOCK, TCL_MODE_BLOCKING, and TCP_ASYNC_SOCKET.1996 {
1997     TcpState *statePtr = (TcpState *) instanceData;
1998     int setting;
1999 
2000 #ifndef USE_FIONBIO
2001     setting = fcntl(statePtr->fd, F_GETFL);
2002     if (mode == TCL_MODE_BLOCKING) {
2003   statePtr->flags &= (~(TCP_ASYNC_SOCKET));
2004   setting &= (~(O_NONBLOCK));
2005     } else {
2006   statePtr->flags |= TCP_ASYNC_SOCKET;
2007   setting |= O_NONBLOCK;
2008     }
2009     if (fcntl(statePtr->fd, F_SETFL, setting) < 0) {
2010   return errno;
2011     }
2012 #else /* USE_FIONBIO */
2013     if (mode == TCL_MODE_BLOCKING) {
2014   statePtr->flags &= (~(TCP_ASYNC_SOCKET));
2015   setting = 0;
2016   if (ioctl(statePtr->fd, (int) FIONBIO, &setting) == -1) {
2017       return errno;
2018   }
2019     } else {
2020   statePtr->flags |= TCP_ASYNC_SOCKET;
2021   setting = 1;
2022   if (ioctl(statePtr->fd, (int) FIONBIO, &setting) == -1) {
2023       return errno;
2024   }
2025     }
2026 #endif /* !USE_FIONBIO */
2027 
2028     return 0;
2029 }
static int TcpCloseProc (ClientData instanceData, Tcl_Interp * interp) [static]

Definition at line 2213 of file tclUnixChan.c.
References ckfree, errno, and Tcl_DeleteFileHandler().2216 {
2217     TcpState *statePtr = (TcpState *) instanceData;
2218     int errorCode = 0;
2219 
2220     /*
2221      * Delete a file handler that may be active for this socket if this
2222      * is a server socket - the file handler was created automatically
2223      * by Tcl as part of the mechanism to accept new client connections.
2224      * Channel handlers are already deleted in the generic IO channel
2225      * closing code that called this function, so we do not have to
2226      * delete them here.
2227      */
2228 
2229     Tcl_DeleteFileHandler(statePtr->fd);
2230 
2231     if (close(statePtr->fd) < 0) {
2232   errorCode = errno;
2233     }
2234     ckfree((char *) statePtr);
2235 
2236     return errorCode;
2237 }
static int TcpGetHandleProc (ClientData instanceData, int direction, ClientData * handlePtr) [static]

Definition at line 2454 of file tclUnixChan.c.
References TCL_OK.2458 {
2459     TcpState *statePtr = (TcpState *) instanceData;
2460 
2461     *handlePtr = (ClientData)statePtr->fd;
2462     return TCL_OK;
2463 }
static int TcpGetOptionProc (ClientData instanceData, Tcl_Interp * interp, CONST char * optionName, Tcl_DString * dsPtr) [static]

Definition at line 2261 of file tclUnixChan.c.
References errno, getsockopt, ntohs, NULL, size_t(), socklen_t, Tcl_BadChannelOption(), Tcl_DStringAppend(), Tcl_DStringAppendElement(), Tcl_DStringEndSublist(), Tcl_DStringFree(), Tcl_DStringStartSublist(), Tcl_DStringValue, Tcl_ErrnoMsg(), TCL_ERROR, Tcl_ExternalToUtfDString(), TCL_INTEGER_SPACE, TCL_OK, Tcl_PosixError(), TclFormatInt(), and TclpGetHostByAddr().2270 {
2271     TcpState *statePtr = (TcpState *) instanceData;
2272     struct sockaddr_in sockname;
2273     struct sockaddr_in peername;
2274     struct hostent *hostEntPtr;
2275     socklen_t size = sizeof(struct sockaddr_in);
2276     size_t len = 0;
2277     char buf[TCL_INTEGER_SPACE];
2278 
2279     if (optionName != (char *) NULL) {
2280   len = strlen(optionName);
2281     }
2282 
2283     if ((len > 1) && (optionName[1] == 'e') &&
2284       (strncmp(optionName, "-error", len) == 0)) {
2285   socklen_t optlen = sizeof(int);
2286   int err, ret;
2287 
2288   ret = getsockopt(statePtr->fd, SOL_SOCKET, SO_ERROR,
2289     (char *)&err, &optlen);
2290   if (ret < 0) {
2291       err = errno;
2292   }
2293   if (err != 0) {
2294       Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(err), -1);
2295   }
2296   return TCL_OK;
2297     }
2298 
2299     if ((len == 0) ||
2300       ((len > 1) && (optionName[1] == 'p') &&
2301         (strncmp(optionName, "-peername", len) == 0))) {
2302   if (getpeername(statePtr->fd, (struct sockaddr *) &peername,
2303     &size) >= 0) {
2304       if (len == 0) {
2305     Tcl_DStringAppendElement(dsPtr, "-peername");
2306     Tcl_DStringStartSublist(dsPtr);
2307       }
2308       Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
2309       hostEntPtr = TclpGetHostByAddr(     /* INTL: Native. */
2310         (char *) &peername.sin_addr,
2311         sizeof(peername.sin_addr), AF_INET);
2312       if (hostEntPtr != (struct hostent *) NULL) {
2313     Tcl_DString ds;
2314 
2315     Tcl_ExternalToUtfDString(NULL, hostEntPtr->h_name, -1, &ds);
2316     Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
2317     Tcl_DStringFree(&ds);
2318       } else {
2319     Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
2320       }
2321       TclFormatInt(buf, ntohs(peername.sin_port));
2322       Tcl_DStringAppendElement(dsPtr, buf);
2323       if (len == 0) {
2324     Tcl_DStringEndSublist(dsPtr);
2325       } else {
2326     return TCL_OK;
2327       }
2328   } else {
2329       /*
2330        * getpeername failed - but if we were asked for all the options
2331        * (len==0), don't flag an error at that point because it could
2332        * be an fconfigure request on a server socket. (which have
2333        * no peer). same must be done on win&mac.
2334        */
2335 
2336       if (len) {
2337     if (interp) {
2338         Tcl_AppendResult(interp, "can't get peername: ",
2339           Tcl_PosixError(interp), (char *) NULL);
2340     }
2341     return TCL_ERROR;
2342       }
2343   }
2344     }
2345 
2346     if ((len == 0) ||
2347       ((len > 1) && (optionName[1] == 's') &&
2348       (strncmp(optionName, "-sockname", len) == 0))) {
2349   if (getsockname(statePtr->fd, (struct sockaddr *) &sockname,
2350     &size) >= 0) {
2351       if (len == 0) {
2352     Tcl_DStringAppendElement(dsPtr, "-sockname");
2353     Tcl_DStringStartSublist(dsPtr);
2354       }
2355       Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
2356       hostEntPtr = TclpGetHostByAddr(     /* INTL: Native. */
2357         (char *) &sockname.sin_addr,
2358         sizeof(sockname.sin_addr), AF_INET);
2359       if (hostEntPtr != (struct hostent *) NULL) {
2360     Tcl_DString ds;
2361 
2362     Tcl_ExternalToUtfDString(NULL, hostEntPtr->h_name, -1, &ds);
2363     Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
2364     Tcl_DStringFree(&ds);
2365       } else {
2366     Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
2367       }
2368       TclFormatInt(buf, ntohs(sockname.sin_port));
2369       Tcl_DStringAppendElement(dsPtr, buf);
2370       if (len == 0) {
2371     Tcl_DStringEndSublist(dsPtr);
2372       } else {
2373     return TCL_OK;
2374       }
2375   } else {
2376       if (interp) {
2377     Tcl_AppendResult(interp, "can't get sockname: ",
2378       Tcl_PosixError(interp), (char *) NULL);
2379       }
2380       return TCL_ERROR;
2381   }
2382     }
2383 
2384     if (len > 0) {
2385   return Tcl_BadChannelOption(interp, optionName, "peername sockname");
2386     }
2387 
2388     return TCL_OK;
2389 }
static int TcpInputProc (ClientData instanceData, char * buf, int bufSize, int * errorCodePtr) [static]

Definition at line 2118 of file tclUnixChan.c.
References ECONNRESET, errno, size_t(), and WaitForConnect().2124 {
2125     TcpState *statePtr = (TcpState *) instanceData;
2126     int bytesRead, state;
2127 
2128     *errorCodePtr = 0;
2129     state = WaitForConnect(statePtr, errorCodePtr);
2130     if (state != 0) {
2131   return -1;
2132     }
2133     bytesRead = recv(statePtr->fd, buf, (size_t) bufSize, 0);
2134     if (bytesRead > -1) {
2135   return bytesRead;
2136     }
2137     if (errno == ECONNRESET) {
2138   /*
2139    * Turn ECONNRESET into a soft EOF condition.
2140    */
2141 
2142   return 0;
2143     }
2144     *errorCodePtr = errno;
2145     return -1;
2146 }
static int TcpOutputProc (ClientData instanceData, CONST char * buf, int toWrite, int * errorCodePtr) [static]

Definition at line 2170 of file tclUnixChan.c.
References errno, size_t(), and WaitForConnect().2175 {
2176     TcpState *statePtr = (TcpState *) instanceData;
2177     int written;
2178     int state;        /* Of waiting for connection. */
2179 
2180     *errorCodePtr = 0;
2181     state = WaitForConnect(statePtr, errorCodePtr);
2182     if (state != 0) {
2183   return -1;
2184     }
2185     written = send(statePtr->fd, buf, (size_t) toWrite, 0);
2186     if (written > -1) {
2187   return written;
2188     }
2189     *errorCodePtr = errno;
2190     return -1;
2191 }
static void TcpWatchProc (ClientData instanceData, int mask) [static]

Definition at line 2409 of file tclUnixChan.c.
References Tcl_CreateFileHandler(), Tcl_DeleteFileHandler(), and Tcl_NotifyChannel().2414 {
2415     TcpState *statePtr = (TcpState *) instanceData;
2416 
2417     /*
2418      * Make sure we don't mess with server sockets since they will never
2419      * be readable or writable at the Tcl level.  This keeps Tcl scripts
2420      * from interfering with the -accept behavior.
2421      */
2422 
2423     if (!statePtr->acceptProc) {
2424   if (mask) {
2425       Tcl_CreateFileHandler(statePtr->fd, mask,
2426         (Tcl_FileProc *) Tcl_NotifyChannel,
2427         (ClientData) statePtr->channel);
2428   } else {
2429       Tcl_DeleteFileHandler(statePtr->fd);
2430   }
2431     }
2432 }
static int WaitForConnect (TcpState * statePtr, int * errorCodePtr) [static]

Definition at line 2049 of file tclUnixChan.c.
References errno, EWOULDBLOCK, O_NONBLOCK, TCL_EXCEPTION, TCL_WRITABLE, TclUnixWaitForFile(), TCP_ASYNC_CONNECT, TCP_ASYNC_SOCKET, and void().
Referenced by TcpInputProc(), and TcpOutputProc().2052 {
2053     int timeOut;    /* How long to wait. */
2054     int state;      /* Of calling TclWaitForFile. */
2055     int flags;      /* fcntl flags for the socket. */
2056 
2057     /*
2058      * If an asynchronous connect is in progress, attempt to wait for it
2059      * to complete before reading.
2060      */
2061 
2062     if (statePtr->flags & TCP_ASYNC_CONNECT) {
2063   if (statePtr->flags & TCP_ASYNC_SOCKET) {
2064       timeOut = 0;
2065   } else {
2066       timeOut = -1;
2067   }
2068   errno = 0;
2069   state = TclUnixWaitForFile(statePtr->fd,
2070     TCL_WRITABLE | TCL_EXCEPTION, timeOut);
2071   if (!(statePtr->flags & TCP_ASYNC_SOCKET)) {
2072 #ifndef USE_FIONBIO
2073       flags = fcntl(statePtr->fd, F_GETFL);
2074       flags &= (~(O_NONBLOCK));
2075       (void) fcntl(statePtr->fd, F_SETFL, flags);
2076 #else /* USE_FIONBIO */
2077       flags = 0;
2078       (void) ioctl(statePtr->fd, FIONBIO, &flags);
2079 #endif /* !USE_FIONBIO */
2080   }
2081   if (state & TCL_EXCEPTION) {
2082       return -1;
2083   }
2084   if (state & TCL_WRITABLE) {
2085       statePtr->flags &= (~(TCP_ASYNC_CONNECT));
2086   } else if (timeOut == 0) {
2087       *errorCodePtr = errno = EWOULDBLOCK;
2088       return -1;
2089   }
2090     }
2091     return 0;
2092 }

Variable Documentation
Tcl_ChannelType fileChannelType [static]
Initial value: {
    "file",     
    TCL_CHANNEL_VERSION_4,  
    FileCloseProc,    
    FileInputProc,    
    FileOutputProc,   
    FileSeekProc,   
    NULL,     
    NULL,     
    FileWatchProc,    
    FileGetHandleProc,    
    NULL,     
    FileBlockModeProc,    
    NULL,     
    NULL,     
    FileWideSeekProc,   

    NULL,

}
Definition at line 310 of file tclUnixChan.c.Tcl_ChannelType tcpChannelType [static]
Initial value: {
    "tcp",      
    TCL_CHANNEL_VERSION_4,  
    TcpCloseProc,   
    TcpInputProc,   
    TcpOutputProc,    
    NULL,     
    NULL,     
    TcpGetOptionProc,   
    TcpWatchProc,   
    TcpGetHandleProc,   
    NULL,     
    TcpBlockModeProc,   
    NULL,     
    NULL,     
    NULL,     
    NULL,     
}
Definition at line 368 of file tclUnixChan.c.

unix/tclUnixCompat.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include <pwd.h>
#include <grp.h>
#include <errno.h>
#include <string.h>
Defines
#define PadBuffer(buffer, length, size)
Functions
passwd * TclpGetPwNam (const char *name)
passwd * TclpGetPwUid (uid_t uid)
group * TclpGetGrNam (const char *name)
group * TclpGetGrGid (gid_t gid)
hostent * TclpGetHostByName (const char *name)
hostent * TclpGetHostByAddr (const char *addr, int length, int type)

Define Documentation
#define PadBuffer(buffer, length, size)
Value:if (((length) % (size))) {                      \
  (buffer) += ((size) - ((length) % (size))); \
  (length) += ((size) - ((length) % (size))); \
    }
Definition at line 30 of file tclUnixCompat.c.
Function Documentation
struct group* TclpGetGrGid (gid_t gid)

Definition at line 522 of file tclUnixCompat.c.
References dataKey, NULL, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by GetGroupAttribute().523 {
524 #if !defined(TCL_THREADS)
525     return getgrgid(gid);
526 #else
527     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
528 
529 #if defined(HAVE_GETGRGID_R_5)
530     struct group *grPtr = NULL;
531     return (getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf),
532            &grPtr) == 0 && grPtr != NULL) ? &tsdPtr->grp : NULL;
533 
534 #elif defined(HAVE_GETGRGID_R_4)
535     return getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf));
536 
537 #else
538     struct group *grPtr;
539     Tcl_MutexLock(&compatLock);
540     grPtr = getgrgid(gid);
541     if (grPtr != NULL) {
542   tsdPtr->grp = *grPtr;
543   grPtr = &tsdPtr->grp;
544   if (CopyGrp(&tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)) == -1) {
545       grPtr = NULL;
546   }
547     }
548     Tcl_MutexUnlock(&compatLock);
549     return grPtr;
550 #endif
551     return NULL; /* Not reached */
552 #endif /* TCL_THREADS */
553 }
struct group* TclpGetGrNam (const char * name)

Definition at line 470 of file tclUnixCompat.c.
References dataKey, NULL, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by SetGroupAttribute().471 {
472 #if !defined(TCL_THREADS)
473     return getgrnam(name);
474 #else
475     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
476 
477 #if defined(HAVE_GETGRNAM_R_5)
478     struct group *grPtr = NULL;
479     return (getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf),
480            &grPtr) == 0 && grPtr != NULL) ? &tsdPtr->grp : NULL;
481 
482 #elif defined(HAVE_GETGRNAM_R_4)
483     return getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf));
484 
485 #else
486     struct group *grPtr;
487     Tcl_MutexLock(&compatLock);
488     grPtr = getgrnam(name);
489     if (grPtr != NULL) {
490   tsdPtr->grp = *grPtr;
491   grPtr = &tsdPtr->grp;
492   if (CopyGrp(&tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)) == -1) {
493       grPtr = NULL;
494   }
495     }
496     Tcl_MutexUnlock(&compatLock);
497     return grPtr;
498 #endif
499     return NULL; /* Not reached */
500 #endif /* TCL_THREADS */
501 }
struct hostent* TclpGetHostByAddr (const char * addr, int length, int type)

Definition at line 635 of file tclUnixCompat.c.
References dataKey, NULL, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by TcpGetOptionProc().636 {
637 #if !defined(TCL_THREADS) || defined(HAVE_MTSAFE_GETHOSTBYADDR)
638     return gethostbyaddr(addr, length, type);
639 #else
640     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
641 
642 #if defined(HAVE_GETHOSTBYADDR_R_7)
643     int h_errno;
644     return gethostbyaddr_r(addr, length, type, &tsdPtr->hent, tsdPtr->hbuf,
645          sizeof(tsdPtr->hbuf), &h_errno);
646 
647 #elif defined(HAVE_GETHOSTBYADDR_R_8)
648     struct hostent *hePtr;
649     int h_errno;
650     return (gethostbyaddr_r(addr, length, type, &tsdPtr->hent, tsdPtr->hbuf,
651           sizeof(tsdPtr->hbuf), &hePtr, &h_errno) == 0) ?
652   &tsdPtr->hent : NULL;
653 #else
654     struct hostent *hePtr;
655     Tcl_MutexLock(&compatLock);
656     hePtr = gethostbyaddr(addr, length, type);
657     if (hePtr != NULL) {
658   tsdPtr->hent = *hePtr;
659   hePtr = &tsdPtr->hent;
660   if (CopyHostent(&tsdPtr->hent, tsdPtr->hbuf,
661       sizeof(tsdPtr->hbuf)) == -1) {
662       hePtr = NULL;
663   }
664     }
665     Tcl_MutexUnlock(&compatLock);
666     return hePtr;
667 #endif
668     return NULL; /* Not reached */
669 #endif /* TCL_THREADS */
670 }
struct hostent* TclpGetHostByName (const char * name)

Definition at line 574 of file tclUnixCompat.c.
References dataKey, NULL, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by CreateSocketAddress(), and TCL_DECLARE_MUTEX().575 {
576 #if !defined(TCL_THREADS) || defined(HAVE_MTSAFE_GETHOSTBYNAME)
577     return gethostbyname(name);
578 #else
579     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
580 
581 #if defined(HAVE_GETHOSTBYNAME_R_5)
582     int h_errno;
583     return gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf,
584          sizeof(tsdPtr->hbuf), &h_errno);
585 
586 #elif defined(HAVE_GETHOSTBYNAME_R_6)
587     struct hostent *hePtr;
588     int h_errno;
589     return (gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf,
590           sizeof(tsdPtr->hbuf), &hePtr, &h_errno) == 0) ?
591   &tsdPtr->hent : NULL;
592 
593 #elif defined(HAVE_GETHOSTBYNAME_R_3)
594     struct hostent_data data;
595     return (gethostbyname_r(name, &tsdPtr->hent, &data) == 0) ?
596   &tsdPtr->hent : NULL;
597 #else
598     struct hostent *hePtr;
599     Tcl_MutexLock(&compatLock);
600     hePtr = gethostbyname(name);
601     if (hePtr != NULL) {
602   tsdPtr->hent = *hePtr;
603   hePtr = &tsdPtr->hent;
604   if (CopyHostent(&tsdPtr->hent, tsdPtr->hbuf,
605       sizeof(tsdPtr->hbuf)) == -1) {
606       hePtr = NULL;
607   }
608     }
609     Tcl_MutexUnlock(&compatLock);
610     return hePtr;
611 #endif
612     return NULL; /* Not reached */
613 #endif /* TCL_THREADS */
614 }
struct passwd* TclpGetPwNam (const char * name)

Definition at line 366 of file tclUnixCompat.c.
References dataKey, NULL, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by SetOwnerAttribute().367 {
368 #if !defined(TCL_THREADS)
369     return getpwnam(name);
370 #else
371     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
372 
373 #if defined(HAVE_GETPWNAM_R_5)
374     struct passwd *pwPtr = NULL;
375     return (getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf),
376            &pwPtr) == 0 && pwPtr != NULL) ? &tsdPtr->pwd : NULL;
377 
378 #elif defined(HAVE_GETPWNAM_R_4)
379     return getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf));
380 
381 #else
382     struct passwd *pwPtr;
383     Tcl_MutexLock(&compatLock);
384     pwPtr = getpwnam(name);
385     if (pwPtr != NULL) {
386   tsdPtr->pwd = *pwPtr;
387   pwPtr = &tsdPtr->pwd;
388   if (CopyPwd(&tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)) == -1) {
389       pwPtr = NULL;
390   }
391     }
392     Tcl_MutexUnlock(&compatLock);
393     return pwPtr;
394 #endif
395     return NULL; /* Not reached */
396 #endif /* TCL_THREADS */
397 }
struct passwd* TclpGetPwUid (uid_t uid)

Definition at line 418 of file tclUnixCompat.c.
References dataKey, NULL, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by GetOwnerAttribute().419 {
420 #if !defined(TCL_THREADS)
421     return getpwuid(uid);
422 #else
423     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
424 
425 #if defined(HAVE_GETPWUID_R_5)
426     struct passwd *pwPtr = NULL;
427     return (getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf),
428            &pwPtr) == 0 && pwPtr != NULL) ? &tsdPtr->pwd : NULL;
429 
430 #elif defined(HAVE_GETPWUID_R_4)
431     return getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf));
432 
433 #else
434     struct passwd *pwPtr;
435     Tcl_MutexLock(&compatLock);
436     pwPtr = getpwuid(uid);
437     if (pwPtr != NULL) {
438   tsdPtr->pwd = *pwPtr;
439   pwPtr = &tsdPtr->pwd;
440   if (CopyPwd(&tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)) == -1) {
441       pwPtr = NULL;
442   }
443     }
444     Tcl_MutexUnlock(&compatLock);
445     return pwPtr;
446 #endif
447     return NULL; /* Not reached */
448 #endif /* TCL_THREADS */
449 }

unix/tclUnixEvent.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Functions
void Tcl_Sleep (int ms)

Function Documentation
void Tcl_Sleep (int ms)

Definition at line 34 of file tclUnixEvent.c.
References before(), SELECT_MASK, Tcl_GetTime(), and void().36 {
37     struct timeval delay;
38     Tcl_Time before, after;
39 
40     /*
41      * The only trick here is that select appears to return early
42      * under some conditions, so we have to check to make sure that
43      * the right amount of time really has elapsed.  If it's too
44      * early, go back to sleep again.
45      */
46 
47     Tcl_GetTime(&before);
48     after = before;
49     after.sec += ms/1000;
50     after.usec += (ms%1000)*1000;
51     if (after.usec > 1000000) {
52   after.usec -= 1000000;
53   after.sec += 1;
54     }
55     while (1) {
56   delay.tv_sec = after.sec - before.sec;
57   delay.tv_usec = after.usec - before.usec;
58   if (delay.tv_usec < 0) {
59       delay.tv_usec += 1000000;
60       delay.tv_sec -= 1;
61   }
62 
63   /*
64    * Special note:  must convert delay.tv_sec to int before comparing
65    * to zero, since delay.tv_usec is unsigned on some platforms.
66    */
67 
68   if ((((int) delay.tv_sec) < 0)
69     || ((delay.tv_usec == 0) && (delay.tv_sec == 0))) {
70       break;
71   }
72   (void) select(0, (SELECT_MASK *) 0, (SELECT_MASK *) 0,
73     (SELECT_MASK *) 0, &delay);
74   Tcl_GetTime(&before);
75     }
76 }

unix/tclUnixFCmd.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include <utime.h>
#include <grp.h>
#include <sys/statfs.h>
Defines
#define DOTREE_PRED  1
#define DOTREE_POSTD  2
#define DOTREE_F  3
#define MAX_READDIR_UNLINK_THRESHOLD  130
#define Realpath  realpath
#define haveRealpath  1
Functions
static int GetGroupAttribute _ANSI_ARGS_ ((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr))
static int SetGroupAttribute _ANSI_ARGS_ ((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr))
static int GetModeFromPermString _ANSI_ARGS_ ((Tcl_Interp *interp, char *modeStringPtr, mode_t *modePtr))
typedef int (TraversalProc)
static int CopyFile _ANSI_ARGS_ ((CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr))
static int DoCopyFile _ANSI_ARGS_ ((CONST char *srcPtr, CONST char *dstPtr, CONST Tcl_StatBuf *statBufPtr))
static int DoCreateDirectory _ANSI_ARGS_ ((CONST char *pathPtr))
static int DoRemoveDirectory _ANSI_ARGS_ ((Tcl_DString *pathPtr, int recursive, Tcl_DString *errorPtr))
static int DoRenameFile _ANSI_ARGS_ ((CONST char *src, CONST char *dst))
static int TraversalCopy _ANSI_ARGS_ ((Tcl_DString *srcPtr, Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr))
static int TraverseUnixTree _ANSI_ARGS_ ((TraversalProc *traversalProc, Tcl_DString *sourcePtr, Tcl_DString *destPtr, Tcl_DString *errorPtr, int doRewind))
int TclpObjRenameFile (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
static int DoRenameFile (CONST char *src, CONST char *dst)
int TclpObjCopyFile (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
static int DoCopyFile (CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr)
static int CopyFile (CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr)
int TclpObjDeleteFile (Tcl_Obj *pathPtr)
int TclpDeleteFile (CONST char *path)
int TclpObjCreateDirectory (Tcl_Obj *pathPtr)
static int DoCreateDirectory (CONST char *path)
int TclpObjCopyDirectory (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr)
int TclpObjRemoveDirectory (Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr)
static int DoRemoveDirectory (Tcl_DString *pathPtr, int recursive, Tcl_DString *errorPtr)
static int TraverseUnixTree (TraversalProc *traverseProc, Tcl_DString *sourcePtr, Tcl_DString *targetPtr, Tcl_DString *errorPtr, int doRewind)
static int TraversalCopy (Tcl_DString *srcPtr, Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr)
static int TraversalDelete (Tcl_DString *srcPtr, Tcl_DString *ignore, CONST Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr)
static int CopyFileAtts (CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr)
static int GetGroupAttribute (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)
static int GetOwnerAttribute (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)
static int GetPermissionsAttribute (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)
static int SetGroupAttribute (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr)
static int SetOwnerAttribute (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr)
static int SetPermissionsAttribute (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr)
Tcl_Obj * TclpObjListVolumes (void)
static int GetModeFromPermString (Tcl_Interp *interp, char *modeStringPtr, mode_t *modePtr)
int TclpObjNormalizePath (Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint)
Variables
CONST char * tclpFileAttrStrings []
CONST TclFileAttrProcs tclpFileAttrProcs []

Define Documentation
#define DOTREE_F  3

Definition at line 70 of file tclUnixFCmd.c.
Referenced by TraversalCopy(), TraversalDelete(), TraverseUnixTree(), and TraverseWinTree().#define DOTREE_POSTD  2

Definition at line 69 of file tclUnixFCmd.c.
Referenced by TraversalCopy(), TraversalDelete(), TraverseUnixTree(), and TraverseWinTree().#define DOTREE_PRED  1

Definition at line 68 of file tclUnixFCmd.c.
Referenced by TraversalCopy(), TraversalDelete(), TraverseUnixTree(), and TraverseWinTree().#define haveRealpath  1

Definition at line 204 of file tclUnixFCmd.c.
Referenced by DoRenameFile(), and TclpObjNormalizePath().#define MAX_READDIR_UNLINK_THRESHOLD  130

Definition at line 142 of file tclUnixFCmd.c.
Referenced by TraverseUnixTree().#define Realpath  realpath

Definition at line 189 of file tclUnixFCmd.c.
Referenced by DoRenameFile(), and TclpObjNormalizePath().
Function Documentation
static int TraverseUnixTree _ANSI_ARGS_ ((TraversalProc *traversalProc, Tcl_DString *sourcePtr, Tcl_DString *destPtr, Tcl_DString *errorPtr, int doRewind)) [static]
static int TraversalCopy _ANSI_ARGS_ ((Tcl_DString *srcPtr, Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr)) [static]
static int DoRenameFile _ANSI_ARGS_ ((CONST char *src, CONST char *dst)) [static]
static int DoRemoveDirectory _ANSI_ARGS_ ((Tcl_DString *pathPtr, int recursive, Tcl_DString *errorPtr)) [static]
static int DoCreateDirectory _ANSI_ARGS_ ((CONST char *pathPtr)) [static]
static int DoCopyFile _ANSI_ARGS_ ((CONST char *srcPtr, CONST char *dstPtr, CONST Tcl_StatBuf *statBufPtr)) [static]
static int CopyFile _ANSI_ARGS_ ((CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr)) [static]
static int GetModeFromPermString _ANSI_ARGS_ ((Tcl_Interp *interp, char *modeStringPtr, mode_t *modePtr)) [static]
static int SetGroupAttribute _ANSI_ARGS_ ((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr)) [static]
static int GetGroupAttribute _ANSI_ARGS_ ((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)) [static]
static int CopyFile (CONST char * src, CONST char * dst, CONST Tcl_StatBuf * statBufPtr) [static]

Definition at line 468 of file tclUnixFCmd.c.
References ckalloc, ckfree, CopyFileAtts(), size_t(), TCL_ERROR, TCL_OK, and TclOSopen.
Referenced by DoCopyFile().474 {
475     int srcFd;
476     int dstFd;
477     unsigned blockSize;   /* Optimal I/O blocksize for filesystem */
478     char *buffer;   /* Data buffer for copy */
479     size_t nread;
480 
481     if ((srcFd = TclOSopen(src, O_RDONLY, 0)) < 0) {  /* INTL: Native. */
482   return TCL_ERROR;
483     }
484 
485     dstFd = TclOSopen(dst, O_CREAT|O_TRUNC|O_WRONLY,  /* INTL: Native. */
486       statBufPtr->st_mode);
487     if (dstFd < 0) {
488   close(srcFd); 
489   return TCL_ERROR;
490     }
491 
492 #ifdef HAVE_ST_BLKSIZE
493     blockSize = statBufPtr->st_blksize;
494 #else
495 #ifndef NO_FSTATFS
496     {
497   struct statfs fs;
498   if (fstatfs(srcFd, &fs, sizeof(fs), 0) == 0) {
499       blockSize = fs.f_bsize;
500   } else {
501       blockSize = 4096;
502   }
503     }
504 #else 
505     blockSize = 4096;
506 #endif
507 #endif
508 
509     buffer = ckalloc(blockSize);
510     while (1) {
511   nread = read(srcFd, buffer, blockSize);
512   if ((nread == -1) || (nread == 0)) {
513       break;
514   }
515   if (write(dstFd, buffer, nread) != nread) {
516       nread = (size_t) -1;
517       break;
518   }
519     }
520 
521     ckfree(buffer);
522     close(srcFd);
523     if ((close(dstFd) != 0) || (nread == -1)) {
524   unlink(dst);          /* INTL: Native. */
525   return TCL_ERROR;
526     }
527     if (CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) {
528   /*
529    * The copy succeeded, but setting the permissions failed, so be in
530    * a consistent state, we remove the file that was created by the
531    * copy.
532    */
533 
534   unlink(dst);          /* INTL: Native. */
535   return TCL_ERROR;
536     }
537     return TCL_OK;
538 }
static int CopyFileAtts (CONST char * src, CONST char * dst, CONST Tcl_StatBuf * statBufPtr) [static]

Definition at line 1193 of file tclUnixFCmd.c.
References NULL, TCL_ERROR, and TCL_OK.
Referenced by CopyFile(), DoCopyFile(), and TraversalCopy().1198 {
1199     struct utimbuf tval;
1200     mode_t newMode;
1201     
1202     newMode = statBufPtr->st_mode
1203       & (S_ISUID | S_ISGID | S_IRWXU | S_IRWXG | S_IRWXO);
1204   
1205     /* 
1206      * Note that if you copy a setuid file that is owned by someone
1207      * else, and you are not root, then the copy will be setuid to you.
1208      * The most correct implementation would probably be to have the
1209      * copy not setuid to anyone if the original file was owned by 
1210      * someone else, but this corner case isn't currently handled.
1211      * It would require another lstat(), or getuid().
1212      */
1213     
1214     if (chmod(dst, newMode)) {        /* INTL: Native. */
1215   newMode &= ~(S_ISUID | S_ISGID);
1216   if (chmod(dst, newMode)) {      /* INTL: Native. */
1217       return TCL_ERROR;
1218   }
1219     }
1220 
1221     tval.actime = statBufPtr->st_atime; 
1222     tval.modtime = statBufPtr->st_mtime; 
1223 
1224     if (utime(dst, &tval)) {        /* INTL: Native. */
1225   return TCL_ERROR;
1226     }
1227 #ifdef HAVE_COPYFILE
1228 #ifdef WEAK_IMPORT_COPYFILE
1229     if (copyfile != NULL)
1230 #endif
1231     copyfile(src, dst, NULL, COPYFILE_XATTR|COPYFILE_ACL);
1232 #endif
1233     return TCL_OK;
1234 }
static int DoCopyFile (CONST char * src, CONST char * dst, CONST Tcl_StatBuf * statBufPtr) [static]

Definition at line 376 of file tclUnixFCmd.c.
References CopyFile(), CopyFileAtts(), EISDIR, ENOENT, errno, MAXPATHLEN, NULL, readlink, S_IFLNK, S_ISDIR, TCL_ERROR, TCL_OK, and TclOSlstat.381 {
382     Tcl_StatBuf dstStatBuf;
383 
384     if (S_ISDIR(statBufPtr->st_mode)) {
385   errno = EISDIR;
386   return TCL_ERROR;
387     }
388 
389     /*
390      * symlink, and some of the other calls will fail if the target 
391      * exists, so we remove it first
392      */
393     
394     if (TclOSlstat(dst, &dstStatBuf) == 0) {    /* INTL: Native. */
395   if (S_ISDIR(dstStatBuf.st_mode)) {
396       errno = EISDIR;
397       return TCL_ERROR;
398   }
399     }
400     if (unlink(dst) != 0) {       /* INTL: Native. */
401   if (errno != ENOENT) {
402       return TCL_ERROR;
403   } 
404     }
405 
406     switch ((int) (statBufPtr->st_mode & S_IFMT)) {
407 #ifndef DJGPP
408         case S_IFLNK: {
409       char link[MAXPATHLEN];
410       int length;
411 
412       length = readlink(src, link, sizeof(link)); /* INTL: Native. */
413       if (length == -1) {
414     return TCL_ERROR;
415       }
416       link[length] = '\0';
417       if (symlink(link, dst) < 0) {   /* INTL: Native. */
418     return TCL_ERROR;
419       }
420 #ifdef HAVE_COPYFILE
421 #ifdef WEAK_IMPORT_COPYFILE
422       if (copyfile != NULL)
423 #endif
424       copyfile(src, dst, NULL, COPYFILE_XATTR|COPYFILE_NOFOLLOW_SRC);
425 #endif
426       break;
427   }
428 #endif
429         case S_IFBLK:
430         case S_IFCHR: {
431       if (mknod(dst, statBufPtr->st_mode,   /* INTL: Native. */
432         statBufPtr->st_rdev) < 0) {
433     return TCL_ERROR;
434       }
435       return CopyFileAtts(src, dst, statBufPtr);
436   }
437         case S_IFIFO: {
438       if (mkfifo(dst, statBufPtr->st_mode) < 0) { /* INTL: Native. */
439     return TCL_ERROR;
440       }
441       return CopyFileAtts(src, dst, statBufPtr);
442   }
443         default: {
444       return CopyFile(src, dst, statBufPtr);
445   }
446     }
447     return TCL_OK;
448 }
static int DoCreateDirectory (CONST char * path) [static]

Definition at line 613 of file tclUnixFCmd.c.
References TCL_ERROR, and TCL_OK.615 {
616     mode_t mode;
617 
618     mode = umask(0);
619     umask(mode);
620 
621     /*
622      * umask return value is actually the inverse of the permissions.
623      */
624 
625     mode = (0777 & ~mode) | S_IRUSR | S_IWUSR | S_IXUSR;
626 
627     if (mkdir(path, mode) != 0) {     /* INTL: Native. */
628   return TCL_ERROR;
629     }
630     return TCL_OK;
631 }
static int DoRemoveDirectory (Tcl_DString * pathPtr, int recursive, Tcl_DString * errorPtr) [static]

Definition at line 754 of file tclUnixFCmd.c.
References CONST, EEXIST, ENOTEMPTY, errno, NULL, Tcl_DStringValue, TCL_ERROR, Tcl_ExternalToUtfDString(), TCL_OK, TclOSstat, TraversalDelete(), and TraverseUnixTree().763 {
764     CONST char *path;
765     mode_t oldPerm = 0;
766     int result;
767     
768     path = Tcl_DStringValue(pathPtr);
769     
770     if (recursive != 0) {
771   /* We should try to change permissions so this can be deleted */
772   Tcl_StatBuf statBuf;
773   int newPerm;
774 
775   if (TclOSstat(path, &statBuf) == 0) {
776       oldPerm = (mode_t) (statBuf.st_mode & 0x00007FFF);
777   }
778   
779   newPerm = oldPerm | (64+128+256);
780   chmod(path, (mode_t) newPerm);
781     }
782     
783     if (rmdir(path) == 0) {       /* INTL: Native. */
784   return TCL_OK;
785     }
786     if (errno == ENOTEMPTY) {
787   errno = EEXIST;
788     }
789 
790     result = TCL_OK;
791     if ((errno != EEXIST) || (recursive == 0)) {
792   if (errorPtr != NULL) {
793       Tcl_ExternalToUtfDString(NULL, path, -1, errorPtr);
794   }
795   result = TCL_ERROR;
796     }
797     
798     /*
799      * The directory is nonempty, but the recursive flag has been
800      * specified, so we recursively remove all the files in the directory.
801      */
802 
803     if (result == TCL_OK) {
804   result = TraverseUnixTree(TraversalDelete, pathPtr, NULL, errorPtr, 1);
805     }
806     
807     if ((result != TCL_OK) && (recursive != 0)) {
808         /* Try to restore permissions */
809         chmod(path, oldPerm);
810     }
811     return result;
812 }
static int DoRenameFile (CONST char * src, CONST char * dst) [static]

Definition at line 254 of file tclUnixFCmd.c.
References closedir(), dirent::d_name, EEXIST, EINVAL, EIO, ENOTEMPTY, errno, haveRealpath, MAXPATHLEN, NULL, opendir(), Realpath, TCL_ERROR, TCL_OK, and TclOSreaddir.259 {
260     if (rename(src, dst) == 0) {      /* INTL: Native. */
261   return TCL_OK;
262     }
263     if (errno == ENOTEMPTY) {
264   errno = EEXIST;
265     }
266 
267     /*
268      * IRIX returns EIO when you attept to move a directory into
269      * itself.  We just map EIO to EINVAL get the right message on SGI.
270      * Most platforms don't return EIO except in really strange cases.
271      */
272     
273     if (errno == EIO) {
274   errno = EINVAL;
275     }
276     
277 #ifndef NO_REALPATH
278     /*
279      * SunOS 4.1.4 reports overwriting a non-empty directory with a
280      * directory as EINVAL instead of EEXIST (first rule out the correct
281      * EINVAL result code for moving a directory into itself).  Must be
282      * conditionally compiled because realpath() not defined on all systems.
283      */
284 
285     if (errno == EINVAL && haveRealpath) {
286   char srcPath[MAXPATHLEN], dstPath[MAXPATHLEN];
287   DIR *dirPtr;
288   Tcl_DirEntry *dirEntPtr;
289 
290   if ((Realpath((char *) src, srcPath) != NULL) /* INTL: Native. */
291     && (Realpath((char *) dst, dstPath) != NULL) /* INTL: Native. */
292     && (strncmp(srcPath, dstPath, strlen(srcPath)) != 0)) {
293       dirPtr = opendir(dst);      /* INTL: Native. */
294       if (dirPtr != NULL) {
295     while (1) {
296         dirEntPtr = TclOSreaddir(dirPtr); /* INTL: Native. */
297         if (dirEntPtr == NULL) {
298       break;
299         }
300         if ((strcmp(dirEntPtr->d_name, ".") != 0) &&
301           (strcmp(dirEntPtr->d_name, "..") != 0)) {
302       errno = EEXIST;
303       closedir(dirPtr);
304       return TCL_ERROR;
305         }
306     }
307     closedir(dirPtr);
308       }
309   }
310   errno = EINVAL;
311     }
312 #endif  /* !NO_REALPATH */
313 
314     if (strcmp(src, "/") == 0) {
315   /*
316    * Alpha reports renaming / as EBUSY and Linux reports it as EACCES,
317    * instead of EINVAL.
318    */
319    
320   errno = EINVAL;
321     }
322 
323     /*
324      * DEC Alpha OSF1 V3.0 returns EACCES when attempting to move a
325      * file across filesystems and the parent directory of that file is
326      * not writable.  Most other systems return EXDEV.  Does nothing to
327      * correct this behavior.
328      */
329 
330     return TCL_ERROR;
331 }
static int GetGroupAttribute (Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj ** attributePtrPtr) [static]

Definition at line 1255 of file tclUnixFCmd.c.
References CONST, NULL, Tcl_DStringFree(), TCL_ERROR, Tcl_ExternalToUtfDString(), Tcl_GetString(), Tcl_NewIntObj(), Tcl_NewStringObj(), TCL_OK, Tcl_PosixError(), TclpGetGrGid(), and TclpObjStat().1260 {
1261     Tcl_StatBuf statBuf;
1262     struct group *groupPtr;
1263     int result;
1264 
1265     result = TclpObjStat(fileName, &statBuf);
1266     
1267     if (result != 0) {
1268   Tcl_AppendResult(interp, "could not read \"", 
1269     Tcl_GetString(fileName), "\": ",
1270     Tcl_PosixError(interp), (char *) NULL);
1271   return TCL_ERROR;
1272     }
1273 
1274     groupPtr = TclpGetGrGid(statBuf.st_gid);
1275 
1276     if (result == -1 || groupPtr == NULL) {
1277   *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_gid);
1278     } else {
1279   Tcl_DString ds;
1280   CONST char *utf;
1281 
1282   utf = Tcl_ExternalToUtfDString(NULL, groupPtr->gr_name, -1, &ds); 
1283   *attributePtrPtr = Tcl_NewStringObj(utf, -1);
1284   Tcl_DStringFree(&ds);
1285     }
1286     endgrent();
1287     return TCL_OK;
1288 }
static int GetModeFromPermString (Tcl_Interp * interp, char * modeStringPtr, mode_t * modePtr) [static]

Definition at line 1627 of file tclUnixFCmd.c.
References TCL_ERROR, and TCL_OK.
Referenced by SetPermissionsAttribute().1631 {
1632     mode_t newMode;
1633     mode_t oldMode;   /* Storage for the value of the old mode
1634          * (that is passed in), to allow for the
1635          * chmod style manipulation */
1636     int i,n, who, op, what, op_found, who_found;
1637 
1638     /*
1639      * We start off checking for an "rwxrwxrwx" style permissions string
1640      */
1641     if (strlen(modeStringPtr) != 9) {
1642         goto chmodStyleCheck;
1643     }
1644 
1645     newMode = 0;
1646     for (i = 0; i < 9; i++) {
1647   switch (*(modeStringPtr+i)) {
1648       case 'r':
1649     if ((i%3) != 0) {
1650         goto chmodStyleCheck;
1651     }
1652     newMode |= (1<<(8-i));
1653     break;
1654       case 'w':
1655     if ((i%3) != 1) {
1656         goto chmodStyleCheck;
1657     }
1658     newMode |= (1<<(8-i));
1659     break;
1660       case 'x':
1661     if ((i%3) != 2) {
1662         goto chmodStyleCheck;
1663     }
1664     newMode |= (1<<(8-i));
1665     break;
1666       case 's':
1667     if (((i%3) != 2) || (i > 5)) {
1668         goto chmodStyleCheck;
1669     }
1670     newMode |= (1<<(8-i));
1671     newMode |= (1<<(11-(i/3)));
1672     break;
1673       case 'S':
1674     if (((i%3) != 2) || (i > 5)) {
1675         goto chmodStyleCheck;
1676     }
1677     newMode |= (1<<(11-(i/3)));
1678     break;
1679       case 't':
1680     if (i != 8) {
1681         goto chmodStyleCheck;
1682     }
1683     newMode |= (1<<(8-i));
1684     newMode |= (1<<9);
1685     break;
1686       case 'T':
1687     if (i != 8) {
1688         goto chmodStyleCheck;
1689     }
1690     newMode |= (1<<9);
1691     break;
1692       case '-':
1693     break;
1694       default:
1695     /*
1696      * Oops, not what we thought it was, so go on
1697      */
1698     goto chmodStyleCheck;
1699   }
1700     }
1701     *modePtr = newMode;
1702     return TCL_OK;
1703 
1704     chmodStyleCheck:
1705     /*
1706      * We now check for an "ugoa+-=rwxst" style permissions string
1707      */
1708 
1709     for (n = 0 ; *(modeStringPtr+n) != '\0' ; n = n + i) {
1710   oldMode = *modePtr;
1711   who = op = what = op_found = who_found = 0;
1712   for (i = 0 ; *(modeStringPtr+n+i) != '\0' ; i++ ) {
1713       if (!who_found) {
1714     /* who */
1715     switch (*(modeStringPtr+n+i)) {
1716         case 'u' :
1717       who |= 0x9c0;
1718       continue;
1719         case 'g' :
1720       who |= 0x438;
1721       continue;
1722         case 'o' :
1723       who |= 0x207;
1724       continue;
1725         case 'a' :
1726       who |= 0xfff;
1727       continue;
1728     }
1729       }
1730       who_found = 1;
1731       if (who == 0) {
1732     who = 0xfff;
1733       }
1734       if (!op_found) {
1735     /* op */
1736     switch (*(modeStringPtr+n+i)) {
1737         case '+' :
1738       op = 1;
1739       op_found = 1;
1740       continue;
1741         case '-' :
1742       op = 2;
1743       op_found = 1;
1744       continue;
1745         case '=' :
1746       op = 3;
1747       op_found = 1;
1748       continue;
1749         default  :
1750       return TCL_ERROR;
1751     }
1752       }
1753       /* what */
1754       switch (*(modeStringPtr+n+i)) {
1755     case 'r' :
1756         what |= 0x124;
1757         continue;
1758     case 'w' :
1759         what |= 0x92;
1760         continue;
1761     case 'x' :
1762         what |= 0x49;
1763         continue;
1764     case 's' :
1765         what |= 0xc00;
1766         continue;
1767     case 't' :
1768         what |= 0x200;
1769         continue;
1770     case ',' :
1771         break;
1772     default  :
1773         return TCL_ERROR;
1774       }
1775       if (*(modeStringPtr+n+i) == ',') {
1776     i++;
1777     break;
1778       }
1779   }
1780   switch (op) {
1781       case 1 :
1782     *modePtr = oldMode | (who & what);
1783     continue;
1784       case 2 :
1785     *modePtr = oldMode & ~(who & what);
1786     continue;
1787       case 3 :
1788     *modePtr = (oldMode & ~who) | (who & what);
1789     continue;
1790   }
1791     }
1792     return TCL_OK;
1793 }
static int GetOwnerAttribute (Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj ** attributePtrPtr) [static]

Definition at line 1308 of file tclUnixFCmd.c.
References CONST, NULL, Tcl_DStringFree(), Tcl_DStringLength, TCL_ERROR, Tcl_ExternalToUtfDString(), Tcl_GetString(), Tcl_NewIntObj(), Tcl_NewStringObj(), TCL_OK, Tcl_PosixError(), TclpGetPwUid(), and TclpObjStat().1313 {
1314     Tcl_StatBuf statBuf;
1315     struct passwd *pwPtr;
1316     int result;
1317 
1318     result = TclpObjStat(fileName, &statBuf);
1319     
1320     if (result != 0) {
1321   Tcl_AppendResult(interp, "could not read \"", 
1322     Tcl_GetString(fileName), "\": ",
1323     Tcl_PosixError(interp), (char *) NULL);
1324   return TCL_ERROR;
1325     }
1326 
1327     pwPtr = TclpGetPwUid(statBuf.st_uid);
1328 
1329     if (result == -1 || pwPtr == NULL) {
1330   *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_uid);
1331     } else {
1332   Tcl_DString ds;
1333   CONST char *utf;
1334 
1335   utf = Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds); 
1336   *attributePtrPtr = Tcl_NewStringObj(utf, Tcl_DStringLength(&ds));
1337   Tcl_DStringFree(&ds);
1338     }
1339     endpwent();
1340     return TCL_OK;
1341 }
static int GetPermissionsAttribute (Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj ** attributePtrPtr) [static]

Definition at line 1361 of file tclUnixFCmd.c.
References NULL, TCL_ERROR, Tcl_GetString(), Tcl_NewStringObj(), TCL_OK, Tcl_PosixError(), and TclpObjStat().1366 {
1367     Tcl_StatBuf statBuf;
1368     char returnString[7];
1369     int result;
1370 
1371     result = TclpObjStat(fileName, &statBuf);
1372     
1373     if (result != 0) {
1374   Tcl_AppendResult(interp, "could not read \"", 
1375     Tcl_GetString(fileName), "\": ",
1376     Tcl_PosixError(interp), (char *) NULL);
1377   return TCL_ERROR;
1378     }
1379 
1380     sprintf(returnString, "%0#5lo", (long) (statBuf.st_mode & 0x00007FFF));
1381 
1382     *attributePtrPtr = Tcl_NewStringObj(returnString, -1);
1383     
1384     return TCL_OK;
1385 }
typedef int (TraversalProc)

Definition at line 102 of file tclUnixFCmd.c.110      {
111     UNIX_GROUP_ATTRIBUTE,
112     UNIX_OWNER_ATTRIBUTE,
113     UNIX_PERMISSIONS_ATTRIBUTE
114 };
static int SetGroupAttribute (Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj * attributePtr) [static]

Definition at line 1404 of file tclUnixFCmd.c.
References CONST, NULL, Tcl_DStringFree(), TCL_ERROR, Tcl_FSGetNativePath(), Tcl_GetLongFromObj(), Tcl_GetString(), Tcl_GetStringFromObj(), TCL_OK, Tcl_PosixError(), Tcl_UtfToExternalDString(), TclpGetGrNam(), and uid_t.1409 {
1410     long gid;
1411     int result;
1412     CONST char *native;
1413 
1414     if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) {
1415   Tcl_DString ds;
1416   struct group *groupPtr;
1417   CONST char *string;
1418   int length;
1419 
1420   string = Tcl_GetStringFromObj(attributePtr, &length);
1421   native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
1422   groupPtr = TclpGetGrNam(native); /* INTL: Native. */
1423   Tcl_DStringFree(&ds);
1424 
1425   if (groupPtr == NULL) {
1426       endgrent();
1427       Tcl_AppendResult(interp, "could not set group for file \"",
1428         Tcl_GetString(fileName), "\": group \"", 
1429         string, "\" does not exist",
1430         (char *) NULL);
1431       return TCL_ERROR;
1432   }
1433   gid = groupPtr->gr_gid;
1434     }
1435 
1436     native = Tcl_FSGetNativePath(fileName);
1437     result = chown(native, (uid_t) -1, (gid_t) gid);  /* INTL: Native. */
1438 
1439     endgrent();
1440     if (result != 0) {
1441   Tcl_AppendResult(interp, "could not set group for file \"",
1442       Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), 
1443       (char *) NULL);
1444   return TCL_ERROR;
1445     }    
1446     return TCL_OK;
1447 }
static int SetOwnerAttribute (Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj * attributePtr) [static]

Definition at line 1466 of file tclUnixFCmd.c.
References CONST, NULL, Tcl_DStringFree(), TCL_ERROR, Tcl_FSGetNativePath(), Tcl_GetLongFromObj(), Tcl_GetString(), Tcl_GetStringFromObj(), TCL_OK, Tcl_PosixError(), Tcl_UtfToExternalDString(), TclpGetPwNam(), and uid_t.1471 {
1472     long uid;
1473     int result;
1474     CONST char *native;
1475 
1476     if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) {
1477   Tcl_DString ds;
1478   struct passwd *pwPtr;
1479   CONST char *string;
1480   int length;
1481 
1482   string = Tcl_GetStringFromObj(attributePtr, &length);
1483   native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
1484   pwPtr = TclpGetPwNam(native); /* INTL: Native. */
1485   Tcl_DStringFree(&ds);
1486 
1487   if (pwPtr == NULL) {
1488       endpwent();
1489       Tcl_AppendResult(interp, "could not set owner for file \"",
1490            Tcl_GetString(fileName), "\": user \"", 
1491            string, "\" does not exist",
1492         (char *) NULL);
1493       return TCL_ERROR;
1494   }
1495   uid = pwPtr->pw_uid;
1496     }
1497 
1498     native = Tcl_FSGetNativePath(fileName);
1499     result = chown(native, (uid_t) uid, (gid_t) -1);   /* INTL: Native. */
1500     
1501     endpwent();
1502     if (result != 0) {
1503   Tcl_AppendResult(interp, "could not set owner for file \"", 
1504        Tcl_GetString(fileName), "\": ", 
1505        Tcl_PosixError(interp), (char *) NULL);
1506   return TCL_ERROR;
1507     }
1508     return TCL_OK;
1509 }
static int SetPermissionsAttribute (Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj * attributePtr) [static]

Definition at line 1528 of file tclUnixFCmd.c.
References CONST, GetModeFromPermString(), NULL, TCL_ERROR, Tcl_FSGetNativePath(), Tcl_GetLongFromObj(), Tcl_GetObjResult(), Tcl_GetString(), TCL_OK, Tcl_PosixError(), and TclpObjStat().1533 {
1534     long mode;
1535     mode_t newMode;
1536     int result;
1537     CONST char *native;
1538 
1539     /*
1540      * First try if the string is a number
1541      */
1542     if (Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) {
1543         newMode = (mode_t) (mode & 0x00007FFF);
1544     } else {
1545   Tcl_StatBuf buf;
1546   char *modeStringPtr = Tcl_GetString(attributePtr);
1547 
1548   /*
1549    * Try the forms "rwxrwxrwx" and "ugo=rwx"
1550    *
1551    * We get the current mode of the file, in order to allow for
1552    * ug+-=rwx style chmod strings.
1553    */
1554   result = TclpObjStat(fileName, &buf);
1555   if (result != 0) {
1556       Tcl_AppendResult(interp, "could not read \"", 
1557         Tcl_GetString(fileName), "\": ",
1558         Tcl_PosixError(interp), (char *) NULL);
1559       return TCL_ERROR;
1560   }
1561   newMode = (mode_t) (buf.st_mode & 0x00007FFF);
1562 
1563   if (GetModeFromPermString(NULL, modeStringPtr, &newMode) != TCL_OK) {
1564       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1565         "unknown permission string format \"",
1566         modeStringPtr, "\"", (char *) NULL);
1567       return TCL_ERROR;
1568   }
1569     }
1570 
1571     native = Tcl_FSGetNativePath(fileName);
1572     result = chmod(native, newMode);    /* INTL: Native. */
1573     if (result != 0) {
1574   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1575     "could not set permissions for file \"", 
1576     Tcl_GetString(fileName), "\": ",
1577     Tcl_PosixError(interp), (char *) NULL);
1578   return TCL_ERROR;
1579     }
1580     return TCL_OK;
1581 }
int TclpDeleteFile (CONST char * path)

Definition at line 570 of file tclUnixFCmd.c.
References TCL_ERROR, and TCL_OK.572 {
573     if (unlink(path) != 0) {        /* INTL: Native. */
574   return TCL_ERROR;
575     }
576     return TCL_OK;
577 }
int TclpObjCopyDirectory (Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr, Tcl_Obj ** errorPtr)

Definition at line 660 of file tclUnixFCmd.c.
References NULL, Tcl_DecrRefCount, Tcl_DStringFree(), Tcl_DStringValue, Tcl_FSGetTranslatedPath(), Tcl_GetString(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_OK, Tcl_UtfToExternalDString(), TraversalCopy(), and TraverseUnixTree().664 {
665     Tcl_DString ds;
666     Tcl_DString srcString, dstString;
667     int ret;
668     Tcl_Obj *transPtr;
669     
670     transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr);
671     Tcl_UtfToExternalDString(NULL, 
672            (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), 
673            -1, &srcString);
674     if (transPtr != NULL) {
675   Tcl_DecrRefCount(transPtr);
676     }
677     transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr);
678     Tcl_UtfToExternalDString(NULL, 
679            (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), 
680            -1, &dstString);
681     if (transPtr != NULL) {
682   Tcl_DecrRefCount(transPtr);
683     }
684 
685     ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds, 0);
686 
687     Tcl_DStringFree(&srcString);
688     Tcl_DStringFree(&dstString);
689 
690     if (ret != TCL_OK) {
691   *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
692   Tcl_DStringFree(&ds);
693   Tcl_IncrRefCount(*errorPtr);
694     }
695     return ret;
696 }
int TclpObjCopyFile (Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)

Definition at line 361 of file tclUnixFCmd.c.
References CONST, DoCopyFile(), TCL_ERROR, Tcl_FSGetNativePath(), and TclOSlstat.364 {
365     CONST char *src = Tcl_FSGetNativePath(srcPathPtr);
366     Tcl_StatBuf srcStatBuf;
367 
368     if (TclOSlstat(src, &srcStatBuf) != 0) {    /* INTL: Native. */
369   return TCL_ERROR;
370     }
371 
372     return DoCopyFile(src, Tcl_FSGetNativePath(destPathPtr), &srcStatBuf);
373 }
int TclpObjCreateDirectory (Tcl_Obj * pathPtr)

Definition at line 606 of file tclUnixFCmd.c.
References DoCreateDirectory(), and Tcl_FSGetNativePath().608 {
609     return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
610 }
int TclpObjDeleteFile (Tcl_Obj * pathPtr)

Definition at line 563 of file tclUnixFCmd.c.
References Tcl_FSGetNativePath(), and TclpDeleteFile().565 {
566     return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr));
567 }
Tcl_Obj* TclpObjListVolumes (void)

Definition at line 1600 of file tclUnixFCmd.c.
References Tcl_IncrRefCount, and Tcl_NewStringObj().1601 {
1602     Tcl_Obj *resultPtr = Tcl_NewStringObj("/",1);
1603 
1604     Tcl_IncrRefCount(resultPtr);
1605     return resultPtr;
1606 }
int TclpObjNormalizePath (Tcl_Interp * interp, Tcl_Obj * pathPtr, int nextCheckpoint)

Definition at line 1816 of file tclUnixFCmd.c.
References CONST, F_OK, haveRealpath, MAXPATHLEN, NULL, Realpath, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, Tcl_ExternalToUtfDString(), Tcl_GetStringFromObj(), Tcl_SetStringObj(), and Tcl_UtfToExternalDString().1820 {
1821     char *currentPathEndPosition;
1822     int pathLen;
1823     char cur;
1824     char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
1825 #ifndef NO_REALPATH
1826     char normPath[MAXPATHLEN];
1827     Tcl_DString ds;
1828     CONST char *nativePath; 
1829 #endif
1830     /* 
1831      * We add '1' here because if nextCheckpoint is zero we know
1832      * that '/' exists, and if it isn't zero, it must point at
1833      * a directory separator which we also know exists.
1834      */
1835     currentPathEndPosition = path + nextCheckpoint;
1836     if (*currentPathEndPosition == '/') {
1837   currentPathEndPosition++;
1838     }
1839 
1840 #ifndef NO_REALPATH
1841     /* For speed, try to get the entire path in one go */
1842     if (nextCheckpoint == 0 && haveRealpath) {
1843         char *lastDir = strrchr(currentPathEndPosition, '/');
1844   if (lastDir != NULL) {
1845       nativePath = Tcl_UtfToExternalDString(NULL, path, 
1846               lastDir - path, &ds);
1847       if (Realpath(nativePath, normPath) != NULL) {
1848     if (*nativePath != '/' && *normPath == '/') {
1849         /*
1850          * realpath has transformed a relative path into an
1851          * absolute path, we do not know how to handle this.
1852          */
1853     } else {
1854         nextCheckpoint = lastDir - path;
1855         goto wholeStringOk;
1856     }
1857       }
1858       Tcl_DStringFree(&ds);
1859   }
1860     }
1861     /* Else do it the slow way */
1862 #endif
1863     
1864     while (1) {
1865   cur = *currentPathEndPosition;
1866   if ((cur == '/') && (path != currentPathEndPosition)) {
1867       /* Reached directory separator */
1868       Tcl_DString ds;
1869       CONST char *nativePath;
1870       int accessOk;
1871 
1872       nativePath = Tcl_UtfToExternalDString(NULL, path, 
1873         currentPathEndPosition - path, &ds);
1874       accessOk = access(nativePath, F_OK);
1875       Tcl_DStringFree(&ds);
1876       if (accessOk != 0) {
1877     /* File doesn't exist */
1878     break;
1879       }
1880       /* Update the acceptable point */
1881       nextCheckpoint = currentPathEndPosition - path;
1882   } else if (cur == 0) {
1883       /* Reached end of string */
1884       break;
1885   }
1886   currentPathEndPosition++;
1887     }
1888     /* 
1889      * We should really now convert this to a canonical path.  We do
1890      * that with 'realpath' if we have it available.  Otherwise we could
1891      * step through every single path component, checking whether it is a 
1892      * symlink, but that would be a lot of work, and most modern OSes 
1893      * have 'realpath'.
1894      */
1895 #ifndef NO_REALPATH
1896     if (haveRealpath) {
1897   /* 
1898    * If we only had '/foo' or '/' then we never increment nextCheckpoint
1899    * and we don't need or want to go through 'Realpath'.  Also, on some
1900    * platforms, passing an empty string to 'Realpath' will give us the
1901    * normalized pwd, which is not what we want at all!
1902    */
1903   if (nextCheckpoint == 0) return 0;
1904   
1905   nativePath = Tcl_UtfToExternalDString(NULL, path, nextCheckpoint, &ds);
1906   if (Realpath(nativePath, normPath) != NULL) {
1907       int newNormLen;
1908       wholeStringOk:
1909       newNormLen = strlen(normPath);
1910       if ((newNormLen == Tcl_DStringLength(&ds))
1911         && (strcmp(normPath, nativePath) == 0)) {
1912     /* String is unchanged */
1913     Tcl_DStringFree(&ds);
1914     if (path[nextCheckpoint] != '\0') {
1915         nextCheckpoint++;
1916     }
1917     return nextCheckpoint;
1918       }
1919       
1920       /* 
1921        * Free up the native path and put in its place the
1922        * converted, normalized path.
1923        */
1924       Tcl_DStringFree(&ds);
1925       Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds);
1926     
1927       if (path[nextCheckpoint] != '\0') {
1928     /* not at end, append remaining path */
1929     int normLen = Tcl_DStringLength(&ds);
1930     Tcl_DStringAppend(&ds, path + nextCheckpoint,
1931       pathLen - nextCheckpoint);
1932     /* 
1933      * We recognise up to and including the directory
1934      * separator.
1935      */ 
1936     nextCheckpoint = normLen + 1;
1937       } else {
1938     /* We recognise the whole string */ 
1939     nextCheckpoint = Tcl_DStringLength(&ds);
1940       }
1941       /* 
1942        * Overwrite with the normalized path.
1943        */
1944       Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds),
1945         Tcl_DStringLength(&ds));
1946   }
1947   Tcl_DStringFree(&ds);
1948     }
1949 #endif  /* !NO_REALPATH */
1950 
1951     return nextCheckpoint;
1952 }
int TclpObjRemoveDirectory (Tcl_Obj * pathPtr, int recursive, Tcl_Obj ** errorPtr)

Definition at line 726 of file tclUnixFCmd.c.
References DoRemoveDirectory(), NULL, Tcl_DecrRefCount, Tcl_DStringFree(), Tcl_DStringValue, Tcl_FSGetTranslatedPath(), Tcl_GetString(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_OK, and Tcl_UtfToExternalDString().730 {
731     Tcl_DString ds;
732     Tcl_DString pathString;
733     int ret;
734     Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
735 
736     Tcl_UtfToExternalDString(NULL, 
737            (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), 
738            -1, &pathString);
739     if (transPtr != NULL) {
740   Tcl_DecrRefCount(transPtr);
741     }
742     ret = DoRemoveDirectory(&pathString, recursive, &ds);
743     Tcl_DStringFree(&pathString);
744 
745     if (ret != TCL_OK) {
746   *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
747   Tcl_DStringFree(&ds);
748   Tcl_IncrRefCount(*errorPtr);
749     }
750     return ret;
751 }
int TclpObjRenameFile (Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)

Definition at line 245 of file tclUnixFCmd.c.
References DoRenameFile(), and Tcl_FSGetNativePath().248 {
249     return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), 
250       Tcl_FSGetNativePath(destPathPtr));
251 }
static int TraversalCopy (Tcl_DString * srcPtr, Tcl_DString * dstPtr, CONST Tcl_StatBuf * statBufPtr, int type, Tcl_DString * errorPtr) [static]

Definition at line 1074 of file tclUnixFCmd.c.
References CopyFileAtts(), DoCopyFile(), DoCreateDirectory(), DOTREE_F, DOTREE_POSTD, DOTREE_PRED, NULL, Tcl_DStringLength, Tcl_DStringValue, TCL_ERROR, Tcl_ExternalToUtfDString(), and TCL_OK.
Referenced by TclpObjCopyDirectory().1083 {
1084     switch (type) {
1085   case DOTREE_F:
1086       if (DoCopyFile(Tcl_DStringValue(srcPtr), Tcl_DStringValue(dstPtr),
1087         statBufPtr) == TCL_OK) {
1088     return TCL_OK;
1089       }
1090       break;
1091 
1092   case DOTREE_PRED:
1093       if (DoCreateDirectory(Tcl_DStringValue(dstPtr)) == TCL_OK) {
1094     return TCL_OK;
1095       }
1096       break;
1097 
1098   case DOTREE_POSTD:
1099       if (CopyFileAtts(Tcl_DStringValue(srcPtr),
1100         Tcl_DStringValue(dstPtr), statBufPtr) == TCL_OK) {
1101     return TCL_OK;
1102       }
1103       break;
1104 
1105     }
1106 
1107     /*
1108      * There shouldn't be a problem with src, because we already checked it
1109      * to get here.
1110      */
1111 
1112     if (errorPtr != NULL) {
1113   Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(dstPtr),
1114     Tcl_DStringLength(dstPtr), errorPtr);
1115     }
1116     return TCL_ERROR;
1117 }
static int TraversalDelete (Tcl_DString * srcPtr, Tcl_DString * ignore, CONST Tcl_StatBuf * statBufPtr, int type, Tcl_DString * errorPtr) [static]

Definition at line 1139 of file tclUnixFCmd.c.
References DoRemoveDirectory(), DOTREE_F, DOTREE_POSTD, DOTREE_PRED, NULL, Tcl_DStringLength, Tcl_DStringValue, TCL_ERROR, Tcl_ExternalToUtfDString(), TCL_OK, and TclpDeleteFile().
Referenced by DoRemoveDirectory().1148 {
1149     switch (type) {
1150         case DOTREE_F: {
1151       if (TclpDeleteFile(Tcl_DStringValue(srcPtr)) == 0) {
1152     return TCL_OK;
1153       }
1154       break;
1155   }
1156         case DOTREE_PRED: {
1157       return TCL_OK;
1158   }
1159         case DOTREE_POSTD: {
1160       if (DoRemoveDirectory(srcPtr, 0, NULL) == 0) {
1161     return TCL_OK;
1162       }
1163       break;
1164   }     
1165     }
1166     if (errorPtr != NULL) {
1167   Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(srcPtr),
1168     Tcl_DStringLength(srcPtr), errorPtr);
1169     }
1170     return TCL_ERROR;
1171 }
static int TraverseUnixTree (TraversalProc * traverseProc, Tcl_DString * sourcePtr, Tcl_DString * targetPtr, Tcl_DString * errorPtr, int doRewind) [static]

Definition at line 837 of file tclUnixFCmd.c.
References closedir(), CONST, dirent::d_name, DOTREE_F, DOTREE_POSTD, DOTREE_PRED, MAX_READDIR_UNLINK_THRESHOLD, NULL, opendir(), S_ISDIR, Tcl_DStringAppend(), Tcl_DStringLength, Tcl_DStringSetLength(), Tcl_DStringValue, TCL_ERROR, Tcl_ExternalToUtfDString(), TCL_OK, TclOSlstat, and TclOSreaddir.
Referenced by DoRemoveDirectory(), and TclpObjCopyDirectory().853 {
854     Tcl_StatBuf statBuf;
855     CONST char *source, *errfile;
856     int result, sourceLen;
857     int targetLen;
858 #ifndef HAVE_FTS
859     int numProcessed = 0;
860     Tcl_DirEntry *dirEntPtr;
861     DIR *dirPtr;
862 #else
863     CONST char *paths[2] = {NULL, NULL};
864     FTS *fts = NULL;
865     FTSENT *ent;
866 #endif
867 
868     errfile = NULL;
869     result = TCL_OK;
870     targetLen = 0;    /* lint. */
871 
872     source = Tcl_DStringValue(sourcePtr);
873     if (TclOSlstat(source, &statBuf) != 0) {    /* INTL: Native. */
874   errfile = source;
875   goto end;
876     }
877     if (!S_ISDIR(statBuf.st_mode)) {
878   /*
879    * Process the regular file
880    */
881 
882   return (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_F,
883     errorPtr);
884     }
885 #ifndef HAVE_FTS
886     dirPtr = opendir(source);       /* INTL: Native. */
887     if (dirPtr == NULL) {
888   /* 
889    * Can't read directory
890    */
891 
892   errfile = source;
893   goto end;
894     }
895     result = (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_PRED,
896       errorPtr);
897     if (result != TCL_OK) {
898   closedir(dirPtr);
899   return result;
900     }
901 
902     Tcl_DStringAppend(sourcePtr, "/", 1);
903     sourceLen = Tcl_DStringLength(sourcePtr);
904 
905     if (targetPtr != NULL) {
906   Tcl_DStringAppend(targetPtr, "/", 1);
907   targetLen = Tcl_DStringLength(targetPtr);
908     }
909 
910     while ((dirEntPtr = TclOSreaddir(dirPtr)) != NULL) { /* INTL: Native. */
911   if ((dirEntPtr->d_name[0] == '.')
912     && ((dirEntPtr->d_name[1] == '\0')
913       || (strcmp(dirEntPtr->d_name, "..") == 0))) {
914       continue;
915   }
916 
917   /*
918    * Append name after slash, and recurse on the file.
919    */
920 
921   Tcl_DStringAppend(sourcePtr, dirEntPtr->d_name, -1);
922   if (targetPtr != NULL) {
923       Tcl_DStringAppend(targetPtr, dirEntPtr->d_name, -1);
924   }
925   result = TraverseUnixTree(traverseProc, sourcePtr, targetPtr,
926     errorPtr, doRewind);
927   if (result != TCL_OK) {
928       break;
929   } else {
930       numProcessed++;
931   }
932 
933   /*
934    * Remove name after slash.
935    */
936 
937   Tcl_DStringSetLength(sourcePtr, sourceLen);
938   if (targetPtr != NULL) {
939       Tcl_DStringSetLength(targetPtr, targetLen);
940   }
941   if (doRewind && (numProcessed > MAX_READDIR_UNLINK_THRESHOLD)) {
942       /*
943        * Call rewinddir if we've called unlink or rmdir so many times
944        * (since the opendir or the previous rewinddir), to avoid
945        * a NULL-return that may a symptom of a buggy readdir.
946        */
947       rewinddir(dirPtr);
948       numProcessed = 0;
949   }
950     }
951     closedir(dirPtr);
952 
953     /*
954      * Strip off the trailing slash we added
955      */
956 
957     Tcl_DStringSetLength(sourcePtr, sourceLen - 1);
958     if (targetPtr != NULL) {
959   Tcl_DStringSetLength(targetPtr, targetLen - 1);
960     }
961 
962     if (result == TCL_OK) {
963   /*
964    * Call traverseProc() on a directory after visiting all the
965    * files in that directory.
966    */
967 
968   result = (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_POSTD,
969     errorPtr);
970     }
971 #else /* HAVE_FTS */
972     paths[0] = source;
973     fts = fts_open((char**)paths, FTS_PHYSICAL|FTS_NOCHDIR|
974 #ifdef HAVE_STRUCT_STAT64
975       FTS_NOSTAT,       /* fts doesn't do stat64 */
976 #else
977       (doRewind ? FTS_NOSTAT : 0),  /* no need to stat for delete */
978 #endif
979       NULL);
980     if (fts == NULL) {
981   errfile = source;
982   goto end;
983     }
984 
985     sourceLen = Tcl_DStringLength(sourcePtr);
986     if (targetPtr != NULL) {
987   targetLen = Tcl_DStringLength(targetPtr);
988     }
989 
990     while ((ent = fts_read(fts)) != NULL) {
991   unsigned short info = ent->fts_info;
992   char * path = ent->fts_path + sourceLen;
993   unsigned short pathlen = ent->fts_pathlen - sourceLen;
994   int type;
995   Tcl_StatBuf *statBufPtr = NULL;
996   
997   if (info == FTS_DNR || info == FTS_ERR || info == FTS_NS) {
998       errfile = ent->fts_path;
999       break;
1000   }
1001   Tcl_DStringAppend(sourcePtr, path, pathlen);
1002   if (targetPtr != NULL) {
1003       Tcl_DStringAppend(targetPtr, path, pathlen);
1004   }
1005   switch (info) {
1006       case FTS_D:
1007     type = DOTREE_PRED;
1008     break;
1009       case FTS_DP:
1010     type = DOTREE_POSTD;
1011     break;
1012       default:
1013     type = DOTREE_F;
1014     break;
1015   }
1016   if (!doRewind) { /* no need to stat for delete */
1017 #ifdef HAVE_STRUCT_STAT64
1018       statBufPtr = &statBuf;
1019       if (TclOSlstat(ent->fts_path, statBufPtr) != 0) {
1020     errfile = ent->fts_path;
1021     break;
1022       }
1023 #else
1024       statBufPtr = ent->fts_statp;
1025 #endif
1026   }
1027   result = (*traverseProc)(sourcePtr, targetPtr, statBufPtr, type,
1028     errorPtr);
1029   if (result != TCL_OK) {
1030       break;
1031   }
1032   Tcl_DStringSetLength(sourcePtr, sourceLen);
1033   if (targetPtr != NULL) {
1034       Tcl_DStringSetLength(targetPtr, targetLen);
1035   }
1036     }
1037 #endif /* HAVE_FTS */
1038 
1039     end:
1040     if (errfile != NULL) {
1041   if (errorPtr != NULL) {
1042       Tcl_ExternalToUtfDString(NULL, errfile, -1, errorPtr);
1043   }
1044   result = TCL_ERROR;
1045     }
1046 #ifdef HAVE_FTS
1047     if (fts != NULL) {
1048   fts_close(fts);
1049     }
1050 #endif /* HAVE_FTS */
1051 
1052     return result;
1053 }

Variable Documentation
CONST TclFileAttrProcs tclpFileAttrProcs[]
Initial value: {
    {GetGroupAttribute,   SetGroupAttribute},
    {GetOwnerAttribute,   SetOwnerAttribute},
    {GetPermissionsAttribute, SetPermissionsAttribute}
}
Definition at line 123 of file tclUnixFCmd.c.CONST char* tclpFileAttrStrings[]
Initial value: {
    "-group",
    "-owner",
    "-permissions",
    (char *) NULL
}
Definition at line 116 of file tclUnixFCmd.c.

unix/tclUnixFile.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Functions
static int NativeMatchType (CONST char *nativeName, Tcl_GlobTypeData *types)
char * TclpFindExecutable (CONST char *argv0)
int TclpMatchInDirectory (Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types)
char * TclpGetUserHome (CONST char *name, Tcl_DString *bufferPtr)
int TclpObjAccess (Tcl_Obj *pathPtr, int mode)
int TclpObjChdir (Tcl_Obj *pathPtr)
int TclpObjLstat (Tcl_Obj *pathPtr, Tcl_StatBuf *bufPtr)
Tcl_Obj * TclpObjGetCwd (Tcl_Interp *interp)
CONST char * TclpGetCwd (Tcl_Interp *interp, Tcl_DString *bufferPtr)
char * TclpReadlink (CONST char *path, Tcl_DString *linkPtr)
int TclpObjStat (Tcl_Obj *pathPtr, Tcl_StatBuf *bufPtr)
Tcl_Obj * TclpFilesystemPathType (Tcl_Obj *pathObjPtr)
int TclpUtime (Tcl_Obj *pathPtr, struct utimbuf *tval)

Function Documentation
static int NativeMatchType (CONST char * nativeName, Tcl_GlobTypeData * types) [static]

Definition at line 339 of file tclUnixFile.c.
References NULL, R_OK, S_ISBLK, S_ISCHR, S_ISDIR, S_ISFIFO, S_ISLNK, S_ISREG, S_ISSOCK, TCL_GLOB_PERM_R, TCL_GLOB_PERM_RONLY, TCL_GLOB_PERM_W, TCL_GLOB_PERM_X, TCL_GLOB_TYPE_BLOCK, TCL_GLOB_TYPE_CHAR, TCL_GLOB_TYPE_DIR, TCL_GLOB_TYPE_FILE, TCL_GLOB_TYPE_LINK, TCL_GLOB_TYPE_PIPE, TCL_GLOB_TYPE_SOCK, TclOSlstat, TclOSstat, W_OK, and X_OK.342 {
343     Tcl_StatBuf buf;
344     if (types == NULL) {
345   /* 
346    * Simply check for the file's existence, but do it
347    * with lstat, in case it is a link to a file which
348    * doesn't exist (since that case would not show up
349    * if we used 'access' or 'stat')
350    */
351   if (TclOSlstat(nativeEntry, &buf) != 0) {
352       return 0;
353   }
354     } else {
355   if (types->perm != 0) {
356       if (TclOSstat(nativeEntry, &buf) != 0) {
357     /* 
358      * Either the file has disappeared between the
359      * 'readdir' call and the 'stat' call, or
360      * the file is a link to a file which doesn't
361      * exist (which we could ascertain with
362      * lstat), or there is some other strange
363      * problem.  In all these cases, we define this
364      * to mean the file does not match any defined
365      * permission, and therefore it is not 
366      * added to the list of files to return.
367      */
368     return 0;
369       }
370       
371       /* 
372        * readonly means that there are NO write permissions
373        * (even for user), but execute is OK for anybody
374        */
375       if (((types->perm & TCL_GLOB_PERM_RONLY) &&
376       (buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
377     ((types->perm & TCL_GLOB_PERM_R) &&
378       (access(nativeEntry, R_OK) != 0)) ||
379     ((types->perm & TCL_GLOB_PERM_W) &&
380       (access(nativeEntry, W_OK) != 0)) ||
381     ((types->perm & TCL_GLOB_PERM_X) &&
382       (access(nativeEntry, X_OK) != 0))
383     ) {
384     return 0;
385       }
386   }
387   if (types->type != 0) {
388       if (types->perm == 0) {
389     /* We haven't yet done a stat on the file */
390     if (TclOSstat(nativeEntry, &buf) != 0) {
391         /* 
392          * Posix error occurred.  The only ok
393          * case is if this is a link to a nonexistent
394          * file, and the user did 'glob -l'. So
395          * we check that here:
396          */
397         if (types->type & TCL_GLOB_TYPE_LINK) {
398       if (TclOSlstat(nativeEntry, &buf) == 0) {
399           if (S_ISLNK(buf.st_mode)) {
400         return 1;
401           }
402       }
403         }
404         return 0;
405     }
406       }
407       /*
408        * In order bcdpfls as in 'find -t'
409        */
410       if (
411     ((types->type & TCL_GLOB_TYPE_BLOCK) &&
412       S_ISBLK(buf.st_mode)) ||
413     ((types->type & TCL_GLOB_TYPE_CHAR) &&
414       S_ISCHR(buf.st_mode)) ||
415     ((types->type & TCL_GLOB_TYPE_DIR) &&
416       S_ISDIR(buf.st_mode)) ||
417     ((types->type & TCL_GLOB_TYPE_PIPE) &&
418       S_ISFIFO(buf.st_mode)) ||
419     ((types->type & TCL_GLOB_TYPE_FILE) &&
420       S_ISREG(buf.st_mode))
421 #ifdef S_ISSOCK
422     || ((types->type & TCL_GLOB_TYPE_SOCK) &&
423       S_ISSOCK(buf.st_mode))
424 #endif /* S_ISSOCK */
425     ) {
426     /* Do nothing -- this file is ok */
427       } else {
428 #ifdef S_ISLNK
429     if (types->type & TCL_GLOB_TYPE_LINK) {
430         if (TclOSlstat(nativeEntry, &buf) == 0) {
431       if (S_ISLNK(buf.st_mode)) {
432           return 1;
433       }
434         }
435     }
436 #endif /* S_ISLNK */
437     return 0;
438       }
439   }
440     }
441     return 1;
442 }
Tcl_Obj* TclpFilesystemPathType (Tcl_Obj* pathObjPtr)

Definition at line 796 of file tclUnixFile.c.
References NULL.798 {
799     /* All native paths are of the same type */
800     return NULL;
801 }
char* TclpFindExecutable (CONST char * argv0)

Definition at line 46 of file tclUnixFile.c.
References ckalloc, CONST, NULL, S_ISREG, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringSetLength(), Tcl_DStringValue, Tcl_ExternalToUtfDString(), tclNativeExecutableName, TclOSstat, TclpGetCwd(), UCHAR, and X_OK.49 {
50     CONST char *name, *p;
51     Tcl_StatBuf statBuf;
52     int length;
53     Tcl_DString buffer, nameString;
54 
55     if (argv0 == NULL) {
56   return NULL;
57     }
58     if (tclNativeExecutableName != NULL) {
59   return tclNativeExecutableName;
60     }
61 
62     Tcl_DStringInit(&buffer);
63 
64     name = argv0;
65     for (p = name; *p != '\0'; p++) {
66   if (*p == '/') {
67       /*
68        * The name contains a slash, so use the name directly
69        * without doing a path search.
70        */
71 
72       goto gotName;
73   }
74     }
75 
76     p = getenv("PATH");         /* INTL: Native. */
77     if (p == NULL) {
78   /*
79    * There's no PATH environment variable; use the default that
80    * is used by sh.
81    */
82 
83   p = ":/bin:/usr/bin";
84     } else if (*p == '\0') {
85   /*
86    * An empty path is equivalent to ".".
87    */
88 
89   p = "./";
90     }
91 
92     /*
93      * Search through all the directories named in the PATH variable
94      * to see if argv[0] is in one of them.  If so, use that file
95      * name.
96      */
97 
98     while (1) {
99   while (isspace(UCHAR(*p))) {    /* INTL: BUG */
100       p++;
101   }
102   name = p;
103   while ((*p != ':') && (*p != 0)) {
104       p++;
105   }
106   Tcl_DStringSetLength(&buffer, 0);
107   if (p != name) {
108       Tcl_DStringAppend(&buffer, name, p - name);
109       if (p[-1] != '/') {
110     Tcl_DStringAppend(&buffer, "/", 1);
111       }
112   }
113   name = Tcl_DStringAppend(&buffer, argv0, -1);
114 
115   /*
116    * INTL: The following calls to access() and stat() should not be
117    * converted to Tclp routines because they need to operate on native
118    * strings directly.
119    */
120 
121   if ((access(name, X_OK) == 0)     /* INTL: Native. */
122     && (TclOSstat(name, &statBuf) == 0) /* INTL: Native. */
123     && S_ISREG(statBuf.st_mode)) {
124       goto gotName;
125   }
126   if (*p == '\0') {
127       break;
128   } else if (*(p+1) == 0) {
129       p = "./";
130   } else {
131       p++;
132   }
133     }
134     goto done;
135 
136     /*
137      * If the name starts with "/" then just copy it to tclExecutableName.
138      */
139 
140 gotName:
141 #ifdef DJGPP
142     if (name[1] == ':')  {
143 #else
144     if (name[0] == '/')  {
145 #endif
146   Tcl_ExternalToUtfDString(NULL, name, -1, &nameString);
147   tclNativeExecutableName = (char *)
148     ckalloc((unsigned) (Tcl_DStringLength(&nameString) + 1));
149   strcpy(tclNativeExecutableName, Tcl_DStringValue(&nameString));
150   Tcl_DStringFree(&nameString);
151   goto done;
152     }
153 
154     /*
155      * The name is relative to the current working directory.  First
156      * strip off a leading "./", if any, then add the full path name of
157      * the current working directory.
158      */
159 
160     if ((name[0] == '.') && (name[1] == '/')) {
161   name += 2;
162     }
163 
164     Tcl_ExternalToUtfDString(NULL, name, -1, &nameString);
165 
166     Tcl_DStringFree(&buffer);
167     TclpGetCwd(NULL, &buffer);
168 
169     length = Tcl_DStringLength(&buffer) + Tcl_DStringLength(&nameString) + 2;
170     tclNativeExecutableName = (char *) ckalloc((unsigned) length);
171     strcpy(tclNativeExecutableName, Tcl_DStringValue(&buffer));
172     tclNativeExecutableName[Tcl_DStringLength(&buffer)] = '/';
173     strcpy(tclNativeExecutableName + Tcl_DStringLength(&buffer) + 1,
174       Tcl_DStringValue(&nameString));
175     Tcl_DStringFree(&nameString);
176     
177 done:
178     Tcl_DStringFree(&buffer);
179     return tclNativeExecutableName;
180 }
CONST char* TclpGetCwd (Tcl_Interp * interp, Tcl_DString * bufferPtr)

Definition at line 607 of file tclUnixFile.c.
References MAXPATHLEN, NULL, Tcl_ExternalToUtfDString(), and Tcl_PosixError().611 {
612     char buffer[MAXPATHLEN+1];
613 
614 #ifdef USEGETWD
615     if (getwd(buffer) == NULL) {      /* INTL: Native. */
616 #else
617     if (getcwd(buffer, MAXPATHLEN + 1) == NULL) { /* INTL: Native. */
618 #endif
619   if (interp != NULL) {
620       Tcl_AppendResult(interp,
621         "error getting working directory name: ",
622         Tcl_PosixError(interp), (char *) NULL);
623   }
624   return NULL;
625     }
626     return Tcl_ExternalToUtfDString(NULL, buffer, -1, bufferPtr);
627 }
char* TclpGetUserHome (CONST char * name, Tcl_DString * bufferPtr)

Definition at line 466 of file tclUnixFile.c.
References CONST, NULL, Tcl_DStringFree(), Tcl_DStringValue, Tcl_ExternalToUtfDString(), and Tcl_UtfToExternalDString().470 {
471     struct passwd *pwPtr;
472     Tcl_DString ds;
473     CONST char *native;
474 
475     native = Tcl_UtfToExternalDString(NULL, name, -1, &ds);
476     pwPtr = getpwnam(native);       /* INTL: Native. */
477     Tcl_DStringFree(&ds);
478     
479     if (pwPtr == NULL) {
480   endpwent();
481   return NULL;
482     }
483     Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, -1, bufferPtr);
484     endpwent();
485     return Tcl_DStringValue(bufferPtr);
486 }
int TclpMatchInDirectory (Tcl_Interp * interp, Tcl_Obj * resultPtr, Tcl_Obj * pathPtr, CONST char * pattern, Tcl_GlobTypeData * types)

Definition at line 201 of file tclUnixFile.c.
References closedir(), CONST, dirent::d_name, NativeMatchType(), NULL, opendir(), S_ISDIR, Tcl_DecrRefCount, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringSetLength(), Tcl_DStringValue, TCL_ERROR, Tcl_ExternalToUtfDString(), Tcl_FSGetNativePath(), Tcl_FSGetTranslatedPath(), Tcl_GetStringFromObj(), TCL_GLOB_PERM_HIDDEN, Tcl_ListObjAppendElement(), TCL_OK, Tcl_PosixError(), Tcl_ResetResult(), Tcl_StringCaseMatch(), Tcl_UtfToExternalDString(), TclNewFSPathObj(), TclOSreaddir, and TclOSstat.209 {
210     CONST char *native;
211     Tcl_Obj *fileNamePtr;
212 
213     fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
214     if (fileNamePtr == NULL) {
215   return TCL_ERROR;
216     }
217     
218     if (pattern == NULL || (*pattern == '\0')) {
219   /* Match a file directly */
220   native = (CONST char*) Tcl_FSGetNativePath(pathPtr);
221   if (NativeMatchType(native, types)) {
222       Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
223   }
224   Tcl_DecrRefCount(fileNamePtr);
225   return TCL_OK;
226     } else {
227   DIR *d;
228   Tcl_DirEntry *entryPtr;
229   CONST char *dirName;
230   int dirLength;
231   int matchHidden;
232   int nativeDirLen;
233   Tcl_StatBuf statBuf;
234   Tcl_DString ds;      /* native encoding of dir */
235   Tcl_DString dsOrig;  /* utf-8 encoding of dir */
236 
237   Tcl_DStringInit(&dsOrig);
238   dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
239   Tcl_DStringAppend(&dsOrig, dirName, dirLength);
240   
241   /*
242    * Make sure that the directory part of the name really is a
243    * directory.  If the directory name is "", use the name "."
244    * instead, because some UNIX systems don't treat "" like "."
245    * automatically.  Keep the "" for use in generating file names,
246    * otherwise "glob foo.c" would return "./foo.c".
247    */
248 
249   if (dirLength == 0) {
250       dirName = ".";
251   } else {
252       dirName = Tcl_DStringValue(&dsOrig);
253       /* Make sure we have a trailing directory delimiter */
254       if (dirName[dirLength-1] != '/') {
255     dirName = Tcl_DStringAppend(&dsOrig, "/", 1);
256     dirLength++;
257       }
258   }
259   Tcl_DecrRefCount(fileNamePtr);
260   
261   /*
262    * Now open the directory for reading and iterate over the contents.
263    */
264 
265   native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
266 
267   if ((TclOSstat(native, &statBuf) != 0)    /* INTL: Native. */
268     || !S_ISDIR(statBuf.st_mode)) {
269       Tcl_DStringFree(&dsOrig);
270       Tcl_DStringFree(&ds);
271       return TCL_OK;
272   }
273 
274   d = opendir(native);        /* INTL: Native. */
275   if (d == NULL) {
276       Tcl_DStringFree(&ds);
277       Tcl_ResetResult(interp);
278       Tcl_AppendResult(interp, "couldn't read directory \"",
279         Tcl_DStringValue(&dsOrig), "\": ",
280         Tcl_PosixError(interp), (char *) NULL);
281       Tcl_DStringFree(&dsOrig);
282       return TCL_ERROR;
283   }
284 
285   nativeDirLen = Tcl_DStringLength(&ds);
286 
287   /*
288    * Check to see if -type or the pattern requests hidden files.
289    */
290   matchHidden = ((types && (types->perm & TCL_GLOB_PERM_HIDDEN)) ||
291     ((pattern[0] == '.')
292       || ((pattern[0] == '\\') && (pattern[1] == '.'))));
293 
294   while ((entryPtr = TclOSreaddir(d)) != NULL) { /* INTL: Native. */
295       Tcl_DString utfDs;
296       CONST char *utfname;
297 
298       /* 
299        * Skip this file if it doesn't agree with the hidden
300        * parameters requested by the user (via -type or pattern).
301        */
302       if (*entryPtr->d_name == '.') {
303     if (!matchHidden) continue;
304       } else {
305     if (matchHidden) continue;
306       }
307 
308       /*
309        * Now check to see if the file matches, according to both type
310        * and pattern.  If so, add the file to the result.
311        */
312 
313       utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name,
314         -1, &utfDs);
315       if (Tcl_StringCaseMatch(utfname, pattern, 0)) {
316     int typeOk = 1;
317 
318     if (types != NULL) {
319         Tcl_DStringSetLength(&ds, nativeDirLen);
320         native = Tcl_DStringAppend(&ds, entryPtr->d_name, -1);
321         typeOk = NativeMatchType(native, types);
322     }
323     if (typeOk) {
324         Tcl_ListObjAppendElement(interp, resultPtr, 
325           TclNewFSPathObj(pathPtr, utfname,
326             Tcl_DStringLength(&utfDs)));
327     }
328       }
329       Tcl_DStringFree(&utfDs);
330   }
331 
332   closedir(d);
333   Tcl_DStringFree(&ds);
334   Tcl_DStringFree(&dsOrig);
335   return TCL_OK;
336     }
337 }
int TclpObjAccess (Tcl_Obj * pathPtr, int mode)

Definition at line 505 of file tclUnixFile.c.
References CONST, NULL, and Tcl_FSGetNativePath().508 {
509     CONST char *path = Tcl_FSGetNativePath(pathPtr);
510     if (path == NULL) {
511   return -1;
512     } else {
513   return access(path, mode);
514     }
515 }
int TclpObjChdir (Tcl_Obj * pathPtr)

Definition at line 534 of file tclUnixFile.c.
References CONST, NULL, and Tcl_FSGetNativePath().536 {
537     CONST char *path = Tcl_FSGetNativePath(pathPtr);
538     if (path == NULL) {
539   return -1;
540     } else {
541   return chdir(path);
542     }
543 }
Tcl_Obj* TclpObjGetCwd (Tcl_Interp * interp)

Definition at line 591 of file tclUnixFile.c.
References NULL, Tcl_DStringFree(), Tcl_DStringValue, Tcl_IncrRefCount, Tcl_NewStringObj(), and TclpGetCwd().593 {
594     Tcl_DString ds;
595     if (TclpGetCwd(interp, &ds) != NULL) {
596   Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
597   Tcl_IncrRefCount(cwdPtr);
598   Tcl_DStringFree(&ds);
599   return cwdPtr;
600     } else {
601   return NULL;
602     }
603 }
int TclpObjLstat (Tcl_Obj * pathPtr, Tcl_StatBuf * bufPtr)

Definition at line 562 of file tclUnixFile.c.
References Tcl_FSGetNativePath(), and TclOSlstat.565 {
566     return TclOSlstat(Tcl_FSGetNativePath(pathPtr), bufPtr);
567 }
int TclpObjStat (Tcl_Obj * pathPtr, Tcl_StatBuf * bufPtr)

Definition at line 693 of file tclUnixFile.c.
References CONST, NULL, Tcl_FSGetNativePath(), and TclOSstat.696 {
697     CONST char *path = Tcl_FSGetNativePath(pathPtr);
698     if (path == NULL) {
699   return -1;
700     } else {
701   return TclOSstat(path, bufPtr);
702     }
703 }
char* TclpReadlink (CONST char * path, Tcl_DString * linkPtr)

Definition at line 650 of file tclUnixFile.c.
References CONST, MAXPATHLEN, NULL, readlink, Tcl_DStringFree(), Tcl_DStringValue, Tcl_ExternalToUtfDString(), and Tcl_UtfToExternalDString().654 {
655 #ifndef DJGPP
656     char link[MAXPATHLEN];
657     int length;
658     CONST char *native;
659     Tcl_DString ds;
660 
661     native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
662     length = readlink(native, link, sizeof(link));  /* INTL: Native. */
663     Tcl_DStringFree(&ds);
664     
665     if (length < 0) {
666   return NULL;
667     }
668 
669     Tcl_ExternalToUtfDString(NULL, link, length, linkPtr);
670     return Tcl_DStringValue(linkPtr);
671 #else
672     return NULL;
673 #endif
674 }
int TclpUtime (Tcl_Obj * pathPtr, struct utimbuf * tval)

Definition at line 819 of file tclUnixFile.c.
References Tcl_FSGetNativePath().822 {
823     return utime(Tcl_FSGetNativePath(pathPtr),tval);
824 }

unix/tclUnixInit.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include <locale.h>
#include "tclInitScript.h"
Classes
struct LocaleTable
Defines
#define TCL_DEFAULT_ENCODING  "iso8859-1"
#define LIBRARY_SIZE  32
Functions
void TclpInitPlatform ()
int TclpInitLibraryPath (CONST char *path)
void TclpSetInitialEncodings ()
void TclpSetVariables (Tcl_Interp *interp)
int TclpFindVariable (CONST char *name, int *lengthPtr)
int Tcl_Init (Tcl_Interp *interp)
void Tcl_SourceRCFile (Tcl_Interp *interp)
int TclpCheckStackSpace ()
Variables
static Tcl_Encoding binaryEncoding = NULL
static int libraryPathEncodingFixed = 0
static char defaultLibraryDir [sizeof(TCL_LIBRARY)+200] = TCL_LIBRARY
static char pkgPath [sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH
static CONST LocaleTable localeTable []

Define Documentation
#define LIBRARY_SIZE  32

Referenced by AppendDllPath(), and TclpInitLibraryPath().#define TCL_DEFAULT_ENCODING  "iso8859-1"

Definition at line 57 of file tclUnixInit.c.
Referenced by TclpSetInitialEncodings().
Function Documentation
int Tcl_Init (Tcl_Interp * interp)

Definition at line 1013 of file tclUnixInit.c.
References initScript, Tcl_DecrRefCount, TCL_ERROR, Tcl_Eval(), TCL_GLOBAL_ONLY, Tcl_IncrRefCount, Tcl_NewObj(), Tcl_SetVar2Ex(), TclGetLibraryPath(), and tclPreInitScript.1015 {
1016     Tcl_Obj *pathPtr;
1017 
1018     if (tclPreInitScript != NULL) {
1019   if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
1020       return (TCL_ERROR);
1021   };
1022     }
1023     
1024     pathPtr = TclGetLibraryPath();
1025     if (pathPtr == NULL) {
1026   pathPtr = Tcl_NewObj();
1027     }
1028     Tcl_IncrRefCount(pathPtr);
1029     Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
1030     Tcl_DecrRefCount(pathPtr);
1031     return Tcl_Eval(interp, initScript);
1032 }
void Tcl_SourceRCFile (Tcl_Interp * interp)

Definition at line 1053 of file tclUnixInit.c.
References CONST, Tcl_Close(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_EvalFile(), Tcl_GetObjResult(), Tcl_GetStdChannel(), Tcl_GetVar(), TCL_GLOBAL_ONLY, TCL_OK, Tcl_OpenFileChannel(), TCL_STDERR, Tcl_TranslateFileName(), Tcl_WriteChars(), and Tcl_WriteObj().1055 {
1056     Tcl_DString temp;
1057     CONST char *fileName;
1058     Tcl_Channel errChannel;
1059 
1060     fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
1061 
1062     if (fileName != NULL) {
1063         Tcl_Channel c;
1064   CONST char *fullName;
1065 
1066         Tcl_DStringInit(&temp);
1067   fullName = Tcl_TranslateFileName(interp, fileName, &temp);
1068   if (fullName == NULL) {
1069       /*
1070        * Couldn't translate the file name (e.g. it referred to a
1071        * bogus user or there was no HOME environment variable).
1072        * Just do nothing.
1073        */
1074   } else {
1075 
1076       /*
1077        * Test for the existence of the rc file before trying to read it.
1078        */
1079 
1080             c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
1081             if (c != (Tcl_Channel) NULL) {
1082                 Tcl_Close(NULL, c);
1083     if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
1084         errChannel = Tcl_GetStdChannel(TCL_STDERR);
1085         if (errChannel) {
1086       Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
1087       Tcl_WriteChars(errChannel, "\n", 1);
1088         }
1089     }
1090       }
1091   }
1092         Tcl_DStringFree(&temp);
1093     }
1094 }
int TclpCheckStackSpace ()

Definition at line 1114 of file tclUnixInit.c.1115 {
1116     /*
1117      * This function is unimplemented on Unix platforms.
1118      */
1119 
1120     return 1;
1121 }
int TclpFindVariable (CONST char * name, int * lengthPtr)

Definition at line 957 of file tclUnixInit.c.
References CONST, environ, Tcl_DStringFree(), Tcl_DStringInit(), and Tcl_ExternalToUtfDString().964 {
965     int i, result = -1;
966     register CONST char *env, *p1, *p2;
967     Tcl_DString envString;
968 
969     Tcl_DStringInit(&envString);
970     for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
971   p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
972   p2 = name;
973 
974   for (; *p2 == *p1; p1++, p2++) {
975       /* NULL loop body. */
976   }
977   if ((*p1 == '=') && (*p2 == '\0')) {
978       *lengthPtr = p2 - name;
979       result = i;
980       goto done;
981   }
982   
983   Tcl_DStringFree(&envString);
984     }
985     
986     *lengthPtr = i;
987 
988     done:
989     Tcl_DStringFree(&envString);
990     return result;
991 }
int TclpInitLibraryPath (CONST char * path)

Definition at line 296 of file tclUnixInit.c.
References ckalloc, ckfree, CONST, defaultLibraryDir, LIBRARY_SIZE, MAXPATHLEN, strcasecmp(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringValue, Tcl_ExternalToUtfDString(), Tcl_GetDefaultEncodingDir(), Tcl_JoinPath(), Tcl_ListObjAppendElement(), Tcl_NewObj(), Tcl_NewStringObj(), TCL_OK, TCL_PATCH_LEVEL, Tcl_SplitPath(), TCL_VERSION, and TclSetLibraryPath().299 {
300 #define LIBRARY_SIZE      32
301     Tcl_Obj *pathPtr, *objPtr;
302     CONST char *str;
303     Tcl_DString buffer, ds;
304     int pathc;
305     CONST char **pathv;
306     char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE];
307 
308     Tcl_DStringInit(&ds);
309     pathPtr = Tcl_NewObj();
310 
311     /*
312      * Initialize the substrings used when locating an executable.  The
313      * installLib variable computes the path as though the executable
314      * is installed.  The developLib computes the path as though the
315      * executable is run from a develpment directory.
316      */
317      
318     sprintf(installLib, "lib/tcl%s", TCL_VERSION);
319     sprintf(developLib, "tcl%s/library", TCL_PATCH_LEVEL);
320 
321     /*
322      * Look for the library relative to default encoding dir.
323      */
324 
325     str = Tcl_GetDefaultEncodingDir();
326     if ((str != NULL) && (str[0] != '\0')) {
327   objPtr = Tcl_NewStringObj(str, -1);
328   Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
329     }
330 
331     /*
332      * Look for the library relative to the TCL_LIBRARY env variable.
333      * If the last dirname in the TCL_LIBRARY path does not match the
334      * last dirname in the installLib variable, use the last dir name
335      * of installLib in addition to the orginal TCL_LIBRARY path.
336      */
337 
338     str = getenv("TCL_LIBRARY");      /* INTL: Native. */
339     Tcl_ExternalToUtfDString(NULL, str, -1, &buffer);
340     str = Tcl_DStringValue(&buffer);
341 
342     if ((str != NULL) && (str[0] != '\0')) {
343   /*
344    * If TCL_LIBRARY is set, search there.
345    */
346    
347   objPtr = Tcl_NewStringObj(str, -1);
348   Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
349 
350   Tcl_SplitPath(str, &pathc, &pathv);
351   if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) {
352       /*
353        * If TCL_LIBRARY is set but refers to a different tcl
354        * installation than the current version, try fiddling with the
355        * specified directory to make it refer to this installation by
356        * removing the old "tclX.Y" and substituting the current
357        * version string.
358        */
359       
360       pathv[pathc - 1] = installLib + 4;
361       str = Tcl_JoinPath(pathc, pathv, &ds);
362       objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
363       Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
364       Tcl_DStringFree(&ds);
365   }
366   ckfree((char *) pathv);
367     }
368 
369     /*
370      * Look for the library relative to the executable.  This algorithm
371      * should be the same as the one in the tcl_findLibrary procedure.
372      *
373      * This code looks in the following directories:
374      *
375      *  <bindir>/../<installLib>
376      *    (e.g. /usr/local/bin/../lib/tcl8.4)
377      *  <bindir>/../../<installLib>
378      *    (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.4)
379      *  <bindir>/../library
380      *    (e.g. /usr/src/tcl8.4.0/unix/../library)
381      *  <bindir>/../../library
382      *    (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../library)
383      *  <bindir>/../../<developLib>
384      *    (e.g. /usr/src/tcl8.4.0/unix/../../tcl8.4.0/library)
385      *  <bindir>/../../../<developLib>
386      *    (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../../tcl8.4.0/library)
387      */
388      
389 
390      /*
391       * The variable path holds an absolute path.  Take care not to
392       * overwrite pathv[0] since that might produce a relative path.
393       */
394 
395     if (path != NULL) {
396   int i, origc;
397   CONST char **origv;
398 
399   Tcl_SplitPath(path, &origc, &origv);
400   pathc = 0;
401   pathv = (CONST char **) ckalloc((unsigned int)(origc * sizeof(char *)));
402   for (i=0; i< origc; i++) {
403       if (origv[i][0] == '.') {
404     if (strcmp(origv[i], ".") == 0) {
405         /* do nothing */
406     } else if (strcmp(origv[i], "..") == 0) {
407         pathc--;
408     } else {
409         pathv[pathc++] = origv[i];
410     }
411       } else {
412     pathv[pathc++] = origv[i];
413       }
414   }
415   if (pathc > 2) {
416       str = pathv[pathc - 2];
417       pathv[pathc - 2] = installLib;
418       path = Tcl_JoinPath(pathc - 1, pathv, &ds);
419       pathv[pathc - 2] = str;
420       objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
421       Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
422       Tcl_DStringFree(&ds);
423   }
424   if (pathc > 3) {
425       str = pathv[pathc - 3];
426       pathv[pathc - 3] = installLib;
427       path = Tcl_JoinPath(pathc - 2, pathv, &ds);
428       pathv[pathc - 3] = str;
429       objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
430       Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
431       Tcl_DStringFree(&ds);
432   }
433   if (pathc > 2) {
434       str = pathv[pathc - 2];
435       pathv[pathc - 2] = "library";
436       path = Tcl_JoinPath(pathc - 1, pathv, &ds);
437       pathv[pathc - 2] = str;
438       objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
439       Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
440       Tcl_DStringFree(&ds);
441   }
442   if (pathc > 3) {
443       str = pathv[pathc - 3];
444       pathv[pathc - 3] = "library";
445       path = Tcl_JoinPath(pathc - 2, pathv, &ds);
446       pathv[pathc - 3] = str;
447       objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
448       Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
449       Tcl_DStringFree(&ds);
450   }
451   if (pathc > 3) {
452       str = pathv[pathc - 3];
453       pathv[pathc - 3] = developLib;
454       path = Tcl_JoinPath(pathc - 2, pathv, &ds);
455       pathv[pathc - 3] = str;
456       objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
457       Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
458       Tcl_DStringFree(&ds);
459   }
460   if (pathc > 4) {
461       str = pathv[pathc - 4];
462       pathv[pathc - 4] = developLib;
463       path = Tcl_JoinPath(pathc - 3, pathv, &ds);
464       pathv[pathc - 4] = str;
465       objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
466       Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
467       Tcl_DStringFree(&ds);
468   }
469   ckfree((char *) origv);
470   ckfree((char *) pathv);
471     }
472 
473     /*
474      * Finally, look for the library relative to the compiled-in path.
475      * This is needed when users install Tcl with an exec-prefix that
476      * is different from the prtefix.
477      */
478 
479     {
480 #ifdef HAVE_COREFOUNDATION
481     char tclLibPath[MAXPATHLEN + 1];
482 
483     if (MacOSXGetLibraryPath(NULL, MAXPATHLEN, tclLibPath) == TCL_OK) {
484         str = tclLibPath;
485     } else
486 #endif /* HAVE_COREFOUNDATION */
487     {
488         str = defaultLibraryDir;
489     }
490     if (str[0] != '\0') {
491         objPtr = Tcl_NewStringObj(str, -1);
492         Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
493     }
494     }
495 
496     TclSetLibraryPath(pathPtr);    
497     Tcl_DStringFree(&buffer);
498 
499     return 1; /* 1 indicates that pathPtr may be dirty utf (needs cleaning) */
500 }
void TclpInitPlatform ()

Definition at line 193 of file tclUnixInit.c.
References dlopen(), EBADF, errno, RTLD_NOW, SEEK_CUR, SIGPIPE, strtol(), TCL_PLATFORM_UNIX, TclOSseek, tclPlatform, and void().194 {
195     tclPlatform = TCL_PLATFORM_UNIX;
196 
197     /*
198      * Make sure, that the standard FDs exist. [Bug 772288]
199      */
200     if (TclOSseek(0, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) {
201   open("/dev/null", O_RDONLY);
202     }
203     if (TclOSseek(1, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) {
204   open("/dev/null", O_WRONLY);
205     }
206     if (TclOSseek(2, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) {
207   open("/dev/null", O_WRONLY);
208     }
209 
210     /*
211      * The code below causes SIGPIPE (broken pipe) errors to
212      * be ignored.  This is needed so that Tcl processes don't
213      * die if they create child processes (e.g. using "exec" or
214      * "open") that terminate prematurely.  The signal handler
215      * is only set up when the first interpreter is created;
216      * after this the application can override the handler with
217      * a different one of its own, if it wants.
218      */
219 
220 #ifdef SIGPIPE
221     (void) signal(SIGPIPE, SIG_IGN);
222 #endif /* SIGPIPE */
223 
224 #if defined(__FreeBSD__) && defined(__GNUC__)
225     /*
226      * Adjust the rounding mode to be more conventional. Note that FreeBSD
227      * only provides the __fpsetreg() used by the following two for the GNU
228      * Compiler. When using, say, Intel's icc they break. (Partially based on
229      * patch in BSD ports system from root@celsius.bychok.com)
230      */
231 
232     fpsetround(FP_RN);
233     fpsetmask(0L);
234 #endif
235 
236 #if defined(__bsdi__) && (_BSDI_VERSION > 199501)
237     /*
238      * Find local symbols. Don't report an error if we fail.
239      */
240     (void) dlopen (NULL, RTLD_NOW);     /* INTL: Native. */
241 #endif
242 
243 #ifdef GET_DARWIN_RELEASE
244     {
245   struct utsname name;
246   if (!uname(&name)) {
247       tclMacOSXDarwinRelease = strtol(name.release, NULL, 10);
248   }
249     }
250 #endif
251 }
void TclpSetInitialEncodings ()

Definition at line 527 of file tclUnixInit.c.
References CONST, TCL_DEFAULT_ENCODING, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringValue, TCL_ERROR, Tcl_ExternalToUtfDString(), Tcl_GetEncoding(), Tcl_GetEncodingName(), Tcl_GetStringFromObj(), Tcl_ListObjGetElements(), TCL_OK, Tcl_SetStringObj(), Tcl_SetSystemEncoding(), Tcl_UtfToLower(), and TclGetLibraryPath().528 {
529   CONST char *encoding = NULL;
530   int i, setSysEncCode = TCL_ERROR;
531   Tcl_Obj *pathPtr;
532 
533   /*
534    * Determine the current encoding from the LC_* or LANG environment
535    * variables.  We previously used setlocale() to determine the locale,
536    * but this does not work on some systems (e.g. Linux/i386 RH 5.0).
537    */
538 #ifdef HAVE_LANGINFO
539   if (
540 #ifdef WEAK_IMPORT_NL_LANGINFO
541     nl_langinfo != NULL &&
542 #endif
543     setlocale(LC_CTYPE, "") != NULL) {
544       Tcl_DString ds;
545 
546       /*
547        * Use a DString so we can overwrite it in name compatability
548        * checks below.
549        */
550 
551       Tcl_DStringInit(&ds);
552       encoding = Tcl_DStringAppend(&ds, nl_langinfo(CODESET), -1);
553 
554       Tcl_UtfToLower(Tcl_DStringValue(&ds));
555 #ifdef HAVE_LANGINFO_DEBUG
556       fprintf(stderr, "encoding '%s'", encoding);
557 #endif
558       if (encoding[0] == 'i' && encoding[1] == 's' && encoding[2] == 'o'
559         && encoding[3] == '-') {
560     char *p, *q;
561     /* need to strip '-' from iso-* encoding */
562     for(p = Tcl_DStringValue(&ds)+3, q = Tcl_DStringValue(&ds)+4;
563         *p; *p++ = *q++);
564       } else if (encoding[0] == 'i' && encoding[1] == 'b'
565         && encoding[2] == 'm' && encoding[3] >= '0'
566         && encoding[3] <= '9') {
567     char *p, *q;
568     /* if langinfo reports "ibm*" we should use "cp*" */
569     p = Tcl_DStringValue(&ds);
570     *p++ = 'c'; *p++ = 'p';
571     for(q = p+1; *p ; *p++ = *q++);
572       } else if ((*encoding == '\0')
573         || !strcmp(encoding, "ansi_x3.4-1968")) {
574     /* Use iso8859-1 for empty or 'ansi_x3.4-1968' encoding */
575     encoding = "iso8859-1";
576       }
577 #ifdef HAVE_LANGINFO_DEBUG
578       fprintf(stderr, " ?%s?", encoding);
579 #endif
580       setSysEncCode = Tcl_SetSystemEncoding(NULL, encoding);
581       if (setSysEncCode != TCL_OK) {
582     /*
583      * If this doesn't return TCL_OK, the encoding returned by
584      * nl_langinfo or as we translated it wasn't accepted.  Do
585      * this fallback check.  If this fails, we will enter the
586      * old fallback below.
587      */
588 
589     for (i = 0; localeTable[i].lang != NULL; i++) {
590         if (strcmp(localeTable[i].lang, encoding) == 0) {
591       setSysEncCode = Tcl_SetSystemEncoding(NULL,
592         localeTable[i].encoding);
593       break;
594         }
595     }
596       }
597 #ifdef HAVE_LANGINFO_DEBUG
598       fprintf(stderr, " => '%s'\n", encoding);
599 #endif
600       Tcl_DStringFree(&ds);
601   }
602 #ifdef HAVE_LANGINFO_DEBUG
603   else {
604       fprintf(stderr, "setlocale returned NULL\n");
605   }
606 #endif
607 #endif /* HAVE_LANGINFO */
608 
609   if (setSysEncCode != TCL_OK) {
610       /*
611        * Classic fallback check.  This tries a homebrew algorithm to
612        * determine what encoding should be used based on env vars.
613        */
614       char *langEnv = getenv("LC_ALL");
615       encoding = NULL;
616 
617       if (langEnv == NULL || langEnv[0] == '\0') {
618     langEnv = getenv("LC_CTYPE");
619       }
620       if (langEnv == NULL || langEnv[0] == '\0') {
621     langEnv = getenv("LANG");
622       }
623       if (langEnv == NULL || langEnv[0] == '\0') {
624     langEnv = NULL;
625       }
626 
627       if (langEnv != NULL) {
628     for (i = 0; localeTable[i].lang != NULL; i++) {
629         if (strcmp(localeTable[i].lang, langEnv) == 0) {
630       encoding = localeTable[i].encoding;
631       break;
632         }
633     }
634     /*
635      * There was no mapping in the locale table.  If there is an
636      * encoding subfield, we can try to guess from that.
637      */
638 
639     if (encoding == NULL) {
640         char *p;
641         for (p = langEnv; *p != '\0'; p++) {
642       if (*p == '.') {
643           p++;
644           break;
645       }
646         }
647         if (*p != '\0') {
648       Tcl_DString ds;
649       Tcl_DStringInit(&ds);
650       encoding = Tcl_DStringAppend(&ds, p, -1);
651 
652       Tcl_UtfToLower(Tcl_DStringValue(&ds));
653       setSysEncCode = Tcl_SetSystemEncoding(NULL, encoding);
654       if (setSysEncCode != TCL_OK) {
655           encoding = NULL;
656       }
657       Tcl_DStringFree(&ds);
658         }
659     }
660 #ifdef HAVE_LANGINFO_DEBUG
661     fprintf(stderr, "encoding fallback check '%s' => '%s'\n",
662       langEnv, encoding);
663 #endif
664       }
665       if (setSysEncCode != TCL_OK) {
666     if (encoding == NULL) {
667         encoding = TCL_DEFAULT_ENCODING;
668     }
669 
670     Tcl_SetSystemEncoding(NULL, encoding);
671       }
672 
673       /*
674        * Initialize the C library's locale subsystem.  This is required
675        * for input methods to work properly on X11.  We only do this for
676        * LC_CTYPE because that's the necessary one, and we don't want to
677        * affect LC_TIME here.  The side effect of setting the default
678        * locale should be to load any locale specific modules that are
679        * needed by X.  [BUG: 5422 3345 4236 2522 2521].
680        * In HAVE_LANGINFO, this call is already done above.
681        */
682 #ifndef HAVE_LANGINFO
683       setlocale(LC_CTYPE, "");
684 #endif
685   }
686 
687   /*
688    * In case the initial locale is not "C", ensure that the numeric
689    * processing is done in "C" locale regardless.  This is needed because
690    * Tcl relies on routines like strtod, but should not have locale
691    * dependent behavior.
692    */
693 
694   setlocale(LC_NUMERIC, "C");
695 
696     if ((libraryPathEncodingFixed == 0) && strcmp("identity",
697       Tcl_GetEncodingName(Tcl_GetEncoding(NULL, NULL))) ) {
698   /*
699    * Until the system encoding was actually set, the library path was
700    * actually in the native multi-byte encoding, and not really UTF-8
701    * as advertised.  We cheated as follows:
702    *
703    * 1. It was safe to allow the Tcl_SetSystemEncoding() call to 
704    * append the ASCII chars that make up the encoding's filename to 
705    * the names (in the native encoding) of directories in the library 
706    * path, since all Unix multi-byte encodings have ASCII in the
707    * beginning.
708    *
709    * 2. To open the encoding file, the native bytes in the file name
710    * were passed to the OS, without translating from UTF-8 to native,
711    * because the name was already in the native encoding.
712    *
713    * Now that the system encoding was actually successfully set,
714    * translate all the names in the library path to UTF-8.  That way,
715    * next time we search the library path, we'll translate the names 
716    * from UTF-8 to the system encoding which will be the native 
717    * encoding.
718    */
719 
720   pathPtr = TclGetLibraryPath();
721   if (pathPtr != NULL) {
722       int objc;
723       Tcl_Obj **objv;
724       
725       objc = 0;
726       Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
727       for (i = 0; i < objc; i++) {
728     int length;
729     char *string;
730     Tcl_DString ds;
731 
732     string = Tcl_GetStringFromObj(objv[i], &length);
733     Tcl_ExternalToUtfDString(NULL, string, length, &ds);
734     Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds), 
735       Tcl_DStringLength(&ds));
736     Tcl_DStringFree(&ds);
737       }
738   }
739 
740   libraryPathEncodingFixed = 1;
741     }
742     
743     /* This is only ever called from the startup thread */
744     if (binaryEncoding == NULL) {
745   /*
746    * Keep the iso8859-1 encoding preloaded.  The IO package uses
747    * it for gets on a binary channel.
748    */
749   binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
750     }
751 }
void TclpSetVariables (Tcl_Interp * interp)

Definition at line 773 of file tclUnixInit.c.
References CONST, defaultLibraryDir, MAXPATHLEN, pkgPath, S_ISDIR, TCL_APPEND_VALUE, Tcl_CreateNamespace(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, Tcl_ExternalToUtfDString(), TCL_GLOBAL_ONLY, TCL_OK, Tcl_ResetResult(), Tcl_SetVar(), Tcl_SetVar2(), TclGetEnv(), TclOSstat, TRUE, and UCHAR.775 {
776 #ifndef NO_UNAME
777     struct utsname name;
778 #endif
779     int unameOK;
780     CONST char *user;
781     Tcl_DString ds;
782 
783 #ifdef HAVE_COREFOUNDATION
784     char tclLibPath[MAXPATHLEN + 1];
785 
786 #if MAC_OS_X_VERSION_MAX_ALLOWED > 1020
787     /*
788      * Set msgcat fallback locale to current CFLocale identifier.
789      */
790     CFLocaleRef localeRef;
791     
792     if (CFLocaleCopyCurrent != NULL && CFLocaleGetIdentifier != NULL &&
793       (localeRef = CFLocaleCopyCurrent())) {
794   CFStringRef locale = CFLocaleGetIdentifier(localeRef);
795 
796   if (locale) {
797       char loc[256];
798 
799       if (CFStringGetCString(locale, loc, 256, kCFStringEncodingUTF8)) {
800     if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) {
801         Tcl_ResetResult(interp);
802     }
803     Tcl_SetVar(interp, "::tcl::mac::locale", loc, TCL_GLOBAL_ONLY);
804       }
805   }
806   CFRelease(localeRef);
807     }
808 #endif
809 
810     if (MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) {
811         CONST char *str;
812         Tcl_DString ds;
813         CFBundleRef bundleRef;
814 
815         Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, 
816                 TCL_GLOBAL_ONLY);
817         Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
818                 TCL_GLOBAL_ONLY);
819         Tcl_SetVar(interp, "tcl_pkgPath", " ",
820                 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
821         str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds);
822         if ((str != NULL) && (str[0] != '\0')) {
823             char *p = Tcl_DStringValue(&ds);
824             /* convert DYLD_FRAMEWORK_PATH from colon to space separated */
825             do {
826                 if(*p == ':') *p = ' ';
827             } while (*p++);
828             Tcl_SetVar(interp, "tcl_pkgPath", Tcl_DStringValue(&ds),
829                     TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
830             Tcl_SetVar(interp, "tcl_pkgPath", " ",
831                     TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
832             Tcl_DStringFree(&ds);
833         }
834         if ((bundleRef = CFBundleGetMainBundle())) {
835             CFURLRef frameworksURL;
836             Tcl_StatBuf statBuf;
837             if((frameworksURL = CFBundleCopyPrivateFrameworksURL(bundleRef))) {
838                 if(CFURLGetFileSystemRepresentation(frameworksURL, TRUE,
839                             (unsigned char*) tclLibPath, MAXPATHLEN) &&
840                         ! TclOSstat(tclLibPath, &statBuf) &&
841                         S_ISDIR(statBuf.st_mode)) {
842                     Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
843                             TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
844                     Tcl_SetVar(interp, "tcl_pkgPath", " ",
845                             TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
846                 }
847                 CFRelease(frameworksURL);
848             }
849             if((frameworksURL = CFBundleCopySharedFrameworksURL(bundleRef))) {
850                 if(CFURLGetFileSystemRepresentation(frameworksURL, TRUE,
851                             (unsigned char*) tclLibPath, MAXPATHLEN) &&
852                         ! TclOSstat(tclLibPath, &statBuf) &&
853                         S_ISDIR(statBuf.st_mode)) {
854                     Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
855                             TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
856                     Tcl_SetVar(interp, "tcl_pkgPath", " ",
857                             TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
858                 }
859                 CFRelease(frameworksURL);
860             }
861         }
862         Tcl_SetVar(interp, "tcl_pkgPath", pkgPath,
863                 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
864     } else
865 #endif /* HAVE_COREFOUNDATION */
866     {
867         Tcl_SetVar(interp, "tclDefaultLibrary", defaultLibraryDir, 
868                 TCL_GLOBAL_ONLY);
869         Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
870     }
871 
872 #ifdef DJGPP
873     Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY);
874 #else
875     Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY);
876 #endif
877     unameOK = 0;
878 #ifndef NO_UNAME
879     if (uname(&name) >= 0) {
880   CONST char *native;
881   
882   unameOK = 1;
883 
884   native = Tcl_ExternalToUtfDString(NULL, name.sysname, -1, &ds);
885   Tcl_SetVar2(interp, "tcl_platform", "os", native, TCL_GLOBAL_ONLY);
886   Tcl_DStringFree(&ds);
887   
888   /*
889    * The following code is a special hack to handle differences in
890    * the way version information is returned by uname.  On most
891    * systems the full version number is available in name.release.
892    * However, under AIX the major version number is in
893    * name.version and the minor version number is in name.release.
894    */
895 
896   if ((strchr(name.release, '.') != NULL)
897     || !isdigit(UCHAR(name.version[0]))) {  /* INTL: digit */
898       Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
899         TCL_GLOBAL_ONLY);
900   } else {
901       Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version,
902         TCL_GLOBAL_ONLY);
903       Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".",
904         TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
905       Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
906         TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
907   }
908   Tcl_SetVar2(interp, "tcl_platform", "machine", name.machine,
909     TCL_GLOBAL_ONLY);
910     }
911 #endif
912     if (!unameOK) {
913   Tcl_SetVar2(interp, "tcl_platform", "os", "", TCL_GLOBAL_ONLY);
914   Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY);
915   Tcl_SetVar2(interp, "tcl_platform", "machine", "", TCL_GLOBAL_ONLY);
916     }
917 
918     /*
919      * Copy USER or LOGNAME environment variable into tcl_platform(user)
920      */
921 
922     Tcl_DStringInit(&ds);
923     user = TclGetEnv("USER", &ds);
924     if (user == NULL) {
925   user = TclGetEnv("LOGNAME", &ds);
926   if (user == NULL) {
927       user = "";
928   }
929     }
930     Tcl_SetVar2(interp, "tcl_platform", "user", user, TCL_GLOBAL_ONLY);
931     Tcl_DStringFree(&ds);
932 
933 }

Variable Documentation
Tcl_Encoding binaryEncoding = NULL [static]

Definition at line 46 of file tclUnixInit.c.char defaultLibraryDir[sizeof(TCL_LIBRARY)+200] = TCL_LIBRARY [static]

Definition at line 65 of file tclUnixInit.c.
Referenced by TclpInitLibraryPath(), and TclpSetVariables().int libraryPathEncodingFixed = 0 [static]

Definition at line 48 of file tclUnixInit.c.CONST LocaleTable localeTable[] [static]

Definition at line 88 of file tclUnixInit.c.char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH [static]

Definition at line 73 of file tclUnixInit.c.
Referenced by TclpSetVariables().

unix/tclUnixNotfy.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include <signal.h>
Classes
struct FileHandler
struct FileHandlerEvent
struct SelectMasks
struct ThreadSpecificData
Functions
static int FileHandlerEventProc _ANSI_ARGS_ ((Tcl_Event *evPtr, int flags))
ClientData Tcl_InitNotifier ()
void Tcl_FinalizeNotifier (ClientData clientData)
void Tcl_AlertNotifier (ClientData clientData)
void Tcl_SetTimer (Tcl_Time *timePtr)
void Tcl_ServiceModeHook (int mode)
void Tcl_CreateFileHandler (int fd, int mask, Tcl_FileProc *proc, ClientData clientData)
void Tcl_DeleteFileHandler (int fd)
static int FileHandlerEventProc (Tcl_Event *evPtr, int flags)
int Tcl_WaitForEvent (Tcl_Time *timePtr)
Variables
TclStubs tclStubs
Tcl_NotifierProcs tclOriginalNotifier
static Tcl_ThreadDataKey dataKey

Function Documentation
static int FileHandlerEventProc _ANSI_ARGS_ ((Tcl_Event *evPtr, int flags)) [static]
static int FileHandlerEventProc (Tcl_Event * evPtr, int flags) [static]

Definition at line 590 of file tclUnixNotfy.c.
References FileHandler::clientData, dataKey, FileHandlerEvent::fd, FileHandler::fd, ThreadSpecificData::firstFileHandlerPtr, FileHandler::mask, FileHandler::nextPtr, NULL, FileHandler::proc, FileHandler::readyMask, TCL_FILE_EVENTS, and TCL_TSD_INIT.
Referenced by FileProc(), and Tcl_WaitForEvent().594 {
595     int mask;
596     FileHandler *filePtr;
597     FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) evPtr;
598     ThreadSpecificData *tsdPtr;
599 
600     if (!(flags & TCL_FILE_EVENTS)) {
601   return 0;
602     }
603 
604     /*
605      * Search through the file handlers to find the one whose handle matches
606      * the event.  We do this rather than keeping a pointer to the file
607      * handler directly in the event, so that the handler can be deleted
608      * while the event is queued without leaving a dangling pointer.
609      */
610 
611     tsdPtr = TCL_TSD_INIT(&dataKey);
612     for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
613    filePtr = filePtr->nextPtr) {
614   if (filePtr->fd != fileEvPtr->fd) {
615       continue;
616   }
617 
618   /*
619    * The code is tricky for two reasons:
620    * 1. The file handler's desired events could have changed
621    *    since the time when the event was queued, so AND the
622    *    ready mask with the desired mask.
623    * 2. The file could have been closed and re-opened since
624    *    the time when the event was queued.  This is why the
625    *    ready mask is stored in the file handler rather than
626    *    the queued event:  it will be zeroed when a new
627    *    file handler is created for the newly opened file.
628    */
629 
630   mask = filePtr->readyMask & filePtr->mask;
631   filePtr->readyMask = 0;
632   if (mask != 0) {
633       (*filePtr->proc)(filePtr->clientData, mask);
634   }
635   break;
636     }
637     return 1;
638 }
void Tcl_AlertNotifier (ClientData clientData)

Definition at line 337 of file tclUnixNotfy.c.
References Tcl_ConditionNotify, Tcl_MutexLock, and Tcl_MutexUnlock.339 {
340 #ifdef TCL_THREADS
341     ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
342     Tcl_MutexLock(&notifierMutex);
343     tsdPtr->eventReady = 1;
344     Tcl_ConditionNotify(&tsdPtr->waitCV);
345     Tcl_MutexUnlock(&notifierMutex);
346 #endif
347 }
void Tcl_CreateFileHandler (int fd, int mask, Tcl_FileProc * proc, ClientData clientData)

Definition at line 422 of file tclUnixNotfy.c.
References ThreadSpecificData::checkMasks, ckalloc, FileHandler::clientData, Tcl_NotifierProcs::createFileHandlerProc, dataKey, SelectMasks::exceptional, FileHandler::fd, ThreadSpecificData::firstFileHandlerPtr, FileHandler::mask, FileHandler::nextPtr, NULL, ThreadSpecificData::numFdBits, FileHandler::proc, SelectMasks::readable, FileHandler::readyMask, TCL_EXCEPTION, TCL_READABLE, TCL_TSD_INIT, TCL_WRITABLE, tclOriginalNotifier, tclStubs, and SelectMasks::writable.
Referenced by FileWatchProc(), PipeWatchProc(), Tcl_OpenTcpServer(), TcpWatchProc(), and TestfilehandlerCmd().425                                           :
426          * indicates conditions under which
427          * proc should be called. */
428     Tcl_FileProc *proc;   /* Procedure to call for each
429          * selected event. */
430     ClientData clientData;  /* Arbitrary data to pass to proc. */
431 {
432     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
433     FileHandler *filePtr;
434 
435     if (tclStubs.tcl_CreateFileHandler != tclOriginalNotifier.createFileHandlerProc) {
436   tclStubs.tcl_CreateFileHandler(fd, mask, proc, clientData);
437   return;
438     }
439 
440     for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
441    filePtr = filePtr->nextPtr) {
442   if (filePtr->fd == fd) {
443       break;
444   }
445     }
446     if (filePtr == NULL) {
447   filePtr = (FileHandler*) ckalloc(sizeof(FileHandler));
448   filePtr->fd = fd;
449   filePtr->readyMask = 0;
450   filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
451   tsdPtr->firstFileHandlerPtr = filePtr;
452     }
453     filePtr->proc = proc;
454     filePtr->clientData = clientData;
455     filePtr->mask = mask;
456 
457     /*
458      * Update the check masks for this file.
459      */
460 
461     if ( mask & TCL_READABLE ) {
462   FD_SET( fd, &(tsdPtr->checkMasks.readable) );
463     } else {
464   FD_CLR( fd, &(tsdPtr->checkMasks.readable) );
465     }
466     if ( mask & TCL_WRITABLE ) {
467   FD_SET( fd, &(tsdPtr->checkMasks.writable) );
468     } else {
469   FD_CLR( fd, &(tsdPtr->checkMasks.writable) );
470     }
471     if ( mask & TCL_EXCEPTION ) {
472   FD_SET( fd, &(tsdPtr->checkMasks.exceptional) );
473     } else {
474   FD_CLR( fd, &(tsdPtr->checkMasks.exceptional) );
475     }
476     if (tsdPtr->numFdBits <= fd) {
477   tsdPtr->numFdBits = fd+1;
478     }
479 }

void Tcl_DeleteFileHandler (int fd)

Definition at line 499 of file tclUnixNotfy.c.
References ThreadSpecificData::checkMasks, dataKey, Tcl_NotifierProcs::deleteFileHandlerProc, SelectMasks::exceptional, FileHandler::fd, ThreadSpecificData::firstFileHandlerPtr, FileHandler::mask, FileHandler::nextPtr, NULL, ThreadSpecificData::numFdBits, SelectMasks::readable, TCL_EXCEPTION, TCL_READABLE, TCL_TSD_INIT, TCL_WRITABLE, tclOriginalNotifier, tclStubs, and SelectMasks::writable.
Referenced by FileCloseProc(), FileWatchProc(), NotifierExitHandler(), PipeWatchProc(), TclpCloseFile(), TcpCloseProc(), TcpWatchProc(), and TestfilehandlerCmd().501 {
502     FileHandler *filePtr, *prevPtr;
503     int i;
504     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
505 
506     if (tclStubs.tcl_DeleteFileHandler != tclOriginalNotifier.deleteFileHandlerProc) {
507   tclStubs.tcl_DeleteFileHandler(fd);
508   return;
509     }
510 
511     /*
512      * Find the entry for the given file (and return if there isn't one).
513      */
514 
515     for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
516    prevPtr = filePtr, filePtr = filePtr->nextPtr) {
517   if (filePtr == NULL) {
518       return;
519   }
520   if (filePtr->fd == fd) {
521       break;
522   }
523     }
524 
525     /*
526      * Update the check masks for this file.
527      */
528 
529     if (filePtr->mask & TCL_READABLE) {
530   FD_CLR( fd, &(tsdPtr->checkMasks.readable) );
531     }
532     if (filePtr->mask & TCL_WRITABLE) {
533   FD_CLR( fd, &(tsdPtr->checkMasks.writable) );
534     }
535     if (filePtr->mask & TCL_EXCEPTION) {
536   FD_CLR( fd, &(tsdPtr->checkMasks.exceptional) );
537     }
538 
539     /*
540      * Find current max fd.
541      */
542 
543     if (fd+1 == tsdPtr->numFdBits) {
544   tsdPtr->numFdBits = 0;
545   for (i = fd-1; i >= 0; i--) {
546       if ( FD_ISSET( i, &(tsdPtr->checkMasks.readable) )
547      || FD_ISSET( i, &(tsdPtr->checkMasks.writable) )
548      || FD_ISSET( i, &(tsdPtr->checkMasks.exceptional ) ) ) {
549     tsdPtr->numFdBits = i+1;
550     break;
551       }
552   }
553     }
554 
555     /*
556      * Clean up information in the callback record.
557      */
558 
559     if (prevPtr == NULL) {
560   tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
561     } else {
562   prevPtr->nextPtr = filePtr->nextPtr;
563     }
564     ckfree((char *) filePtr);
565 }
void Tcl_FinalizeNotifier (ClientData clientData)

Definition at line 263 of file tclUnixNotfy.c.
References dataKey, notifierCount, NULL, panic, Tcl_ConditionFinalize, Tcl_ConditionWait, Tcl_JoinThread(), Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.265 {
266 #ifdef TCL_THREADS
267     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
268 
269     Tcl_MutexLock(&notifierMutex);
270     notifierCount--;
271 
272     /*
273      * If this is the last thread to use the notifier, close the notifier
274      * pipe and wait for the background thread to terminate.
275      */
276 
277     if (notifierCount == 0) {
278   int result;
279   if (triggerPipe < 0) {
280       panic("Tcl_FinalizeNotifier: notifier pipe not initialized");
281   }
282 
283   /*
284    * Send "q" message to the notifier thread so that it will
285    * terminate.  The notifier will return from its call to select()
286    * and notice that a "q" message has arrived, it will then close
287    * its side of the pipe and terminate its thread.  Note the we can
288    * not just close the pipe and check for EOF in the notifier
289    * thread because if a background child process was created with
290    * exec, select() would not register the EOF on the pipe until the
291    * child processes had terminated. [Bug: 4139] [Bug: 1222872]
292    */
293 
294   write(triggerPipe, "q", 1);
295   close(triggerPipe);
296   while(triggerPipe >= 0) {
297       Tcl_ConditionWait(&notifierCV, &notifierMutex, NULL);
298   }
299   result = Tcl_JoinThread(notifierThread, NULL);
300   if (result) {
301       Tcl_Panic("Tcl_FinalizeNotifier: unable to join notifier thread");
302   }
303     }
304 
305     /*
306      * Clean up any synchronization objects in the thread local storage.
307      */
308 
309     Tcl_ConditionFinalize(&(tsdPtr->waitCV));
310 
311     Tcl_MutexUnlock(&notifierMutex);
312 #endif
313 }
ClientData Tcl_InitNotifier ()

Definition at line 211 of file tclUnixNotfy.c.
References dataKey, notifierCount, NULL, panic, Tcl_ConditionWait, Tcl_MutexLock, Tcl_MutexUnlock, TCL_OK, TCL_THREAD_JOINABLE, TCL_THREAD_STACK_DEFAULT, TCL_TSD_INIT, and TclpThreadCreate().212 {
213     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
214 
215 #ifdef TCL_THREADS
216     tsdPtr->eventReady = 0;
217 
218     /*
219      * Start the Notifier thread if necessary.
220      */
221 
222     Tcl_MutexLock(&notifierMutex);
223     if (notifierCount == 0) {
224   if (TclpThreadCreate(&notifierThread, NotifierThreadProc, NULL,
225          TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) {
226       panic("Tcl_InitNotifier: unable to start notifier thread");
227   }
228     }
229     notifierCount++;
230 
231     /*
232      * Wait for the notifier pipe to be created.
233      */
234 
235     while (triggerPipe < 0) {
236   Tcl_ConditionWait(&notifierCV, &notifierMutex, NULL);
237     }
238 
239     Tcl_MutexUnlock(&notifierMutex);
240 #endif
241     return (ClientData) tsdPtr;
242 }
void Tcl_ServiceModeHook (int mode)

Definition at line 399 of file tclUnixNotfy.c.402 {
403 }
void Tcl_SetTimer (Tcl_Time * timePtr)

Definition at line 368 of file tclUnixNotfy.c.
References Tcl_NotifierProcs::setTimerProc, tclOriginalNotifier, and tclStubs.370 {
371     /*
372      * The interval timer doesn't do anything in this implementation,
373      * because the only event loop is via Tcl_DoOneEvent, which passes
374      * timeout values to Tcl_WaitForEvent.
375      */
376 
377     if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) {
378   tclStubs.tcl_SetTimer(timePtr);
379     }
380 }
int Tcl_WaitForEvent (Tcl_Time * timePtr)

Definition at line 660 of file tclUnixNotfy.c.
References ThreadSpecificData::checkMasks, ckalloc, dataKey, SelectMasks::exceptional, FileHandlerEvent::fd, FileHandler::fd, FileHandlerEventProc(), ThreadSpecificData::firstFileHandlerPtr, FileHandlerEvent::header, FileHandler::nextPtr, ThreadSpecificData::nextPtr, NULL, ThreadSpecificData::numFdBits, Tcl_Event::proc, SelectMasks::readable, FileHandler::readyMask, ThreadSpecificData::readyMasks, Tcl_ConditionWait, TCL_EXCEPTION, Tcl_MutexLock, Tcl_MutexUnlock, TCL_QUEUE_TAIL, Tcl_QueueEvent(), TCL_READABLE, TCL_TSD_INIT, TCL_WRITABLE, tclOriginalNotifier, tclStubs, Tcl_NotifierProcs::waitForEventProc, and SelectMasks::writable.662 {
663     FileHandler *filePtr;
664     FileHandlerEvent *fileEvPtr;
665     int mask;
666 #ifdef TCL_THREADS
667     int waitForFiles;
668 #else
669     /* Impl. notes: timeout & timeoutPtr are used if, and only if
670      * threads are not enabled. They are the arguments for the regular
671      * select() used when the core is not thread-enabled. */
672 
673     struct timeval timeout, *timeoutPtr;
674     int numFound;
675 #endif
676     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
677 
678     if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) {
679   return tclStubs.tcl_WaitForEvent(timePtr);
680     }
681 
682 #ifndef TCL_THREADS
683     /*
684      * Set up the timeout structure.  Note that if there are no events to
685      * check for, we return with a negative result rather than blocking
686      * forever.
687      */
688 
689     if (timePtr) {
690   timeout.tv_sec = timePtr->sec;
691   timeout.tv_usec = timePtr->usec;
692   timeoutPtr = &timeout;
693     } else if (tsdPtr->numFdBits == 0) {
694   /*
695    * If there are no threads, no timeout, and no fds registered,
696    * then there are no events possible and we must avoid deadlock.
697    * Note that this is not entirely correct because there might
698    * be a signal that could interrupt the select call, but we
699    * don't handle that case if we aren't using threads.
700    */
701 
702   return -1;
703     } else {
704   timeoutPtr = NULL;
705     }
706 #endif
707 
708 #ifdef TCL_THREADS
709     /*
710      * Place this thread on the list of interested threads, signal the
711      * notifier thread, and wait for a response or a timeout.
712      */
713 
714     Tcl_MutexLock(&notifierMutex);
715 
716     waitForFiles = (tsdPtr->numFdBits > 0);
717     if (timePtr != NULL && timePtr->sec == 0 && (timePtr->usec == 0
718 #if defined(__APPLE__) && defined(__LP64__)
719       /*
720        * On 64-bit Darwin, pthread_cond_timedwait() appears to have a bug
721        * that causes it to wait forever when passed an absolute time which
722        * has already been exceeded by the system time; as a workaround,
723        * when given a very brief timeout, just do a poll. [Bug 1457797]
724        */
725       || timePtr->usec < 10
726 #endif
727       )) {
728   /*
729    * Cannot emulate a polling select with a polling condition variable.
730    * Instead, pretend to wait for files and tell the notifier
731    * thread what we are doing.  The notifier thread makes sure
732    * it goes through select with its select mask in the same state
733    * as ours currently is.  We block until that happens.
734    */
735 
736   waitForFiles = 1;
737   tsdPtr->pollState = POLL_WANT;
738   timePtr = NULL;
739     } else {
740   tsdPtr->pollState = 0;
741     }
742 
743     if (waitForFiles) {
744         /*
745          * Add the ThreadSpecificData structure of this thread to the list
746          * of ThreadSpecificData structures of all threads that are waiting
747          * on file events.
748          */
749 
750 
751         tsdPtr->nextPtr = waitingListPtr;
752         if (waitingListPtr) {
753             waitingListPtr->prevPtr = tsdPtr;
754         }
755         tsdPtr->prevPtr = 0;
756         waitingListPtr = tsdPtr;
757   tsdPtr->onList = 1;
758   
759   write(triggerPipe, "", 1);
760     }
761 
762     FD_ZERO( &(tsdPtr->readyMasks.readable) );
763     FD_ZERO( &(tsdPtr->readyMasks.writable) );
764     FD_ZERO( &(tsdPtr->readyMasks.exceptional) );
765 
766     if (!tsdPtr->eventReady) {
767         Tcl_ConditionWait(&tsdPtr->waitCV, &notifierMutex, timePtr);
768     }
769     tsdPtr->eventReady = 0;
770 
771     if (waitForFiles && tsdPtr->onList) {
772   /*
773    * Remove the ThreadSpecificData structure of this thread from the
774    * waiting list.  Alert the notifier thread to recompute its select
775    * masks - skipping this caused a hang when trying to close a pipe
776    * which the notifier thread was still doing a select on.
777    */
778 
779         if (tsdPtr->prevPtr) {
780             tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
781         } else {
782             waitingListPtr = tsdPtr->nextPtr;
783         }
784         if (tsdPtr->nextPtr) {
785             tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
786         }
787         tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
788   tsdPtr->onList = 0;
789   write(triggerPipe, "", 1);
790     }
791 
792     
793 #else
794     tsdPtr->readyMasks = tsdPtr->checkMasks;
795     numFound = select( tsdPtr->numFdBits,
796            &(tsdPtr->readyMasks.readable),
797            &(tsdPtr->readyMasks.writable),
798            &(tsdPtr->readyMasks.exceptional),
799            timeoutPtr );
800 
801     /*
802      * Some systems don't clear the masks after an error, so
803      * we have to do it here.
804      */
805 
806     if (numFound == -1) {
807   FD_ZERO( &(tsdPtr->readyMasks.readable ) );
808   FD_ZERO( &(tsdPtr->readyMasks.writable ) );
809   FD_ZERO( &(tsdPtr->readyMasks.exceptional ) );
810     }
811 #endif
812 
813     /*
814      * Queue all detected file events before returning.
815      */
816 
817     for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL);
818    filePtr = filePtr->nextPtr) {
819 
820   mask = 0;
821   if ( FD_ISSET( filePtr->fd, &(tsdPtr->readyMasks.readable) ) ) {
822       mask |= TCL_READABLE;
823   }
824   if ( FD_ISSET( filePtr->fd, &(tsdPtr->readyMasks.writable) ) ) {
825       mask |= TCL_WRITABLE;
826   }
827   if ( FD_ISSET( filePtr->fd, &(tsdPtr->readyMasks.exceptional) ) ) {
828       mask |= TCL_EXCEPTION;
829   }
830 
831   if (!mask) {
832       continue;
833   }
834 
835   /*
836    * Don't bother to queue an event if the mask was previously
837    * non-zero since an event must still be on the queue.
838    */
839 
840   if (filePtr->readyMask == 0) {
841       fileEvPtr = (FileHandlerEvent *) ckalloc(
842     sizeof(FileHandlerEvent));
843       fileEvPtr->header.proc = FileHandlerEventProc;
844       fileEvPtr->fd = filePtr->fd;
845       Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
846   }
847   filePtr->readyMask = mask;
848     }
849 #ifdef TCL_THREADS
850     Tcl_MutexUnlock(&notifierMutex);
851 #endif
852     return 0;
853 }

Variable Documentation
Tcl_ThreadDataKey dataKey [static]

Definition at line 112 of file tclUnixNotfy.c.Tcl_NotifierProcs tclOriginalNotifier

Definition at line 46 of file tclStubInit.c.TclStubs tclStubs

Definition at line 411 of file tclStubInit.c.

unix/tclUnixPipe.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Classes
struct PipeState
Defines
#define MakeFile(fd)  ((TclFile)(((int)fd)+1))
#define GetFd(file)  (((int)file)-1)
Functions
static int PipeBlockModeProc _ANSI_ARGS_ ((ClientData instanceData, int mode))
static int PipeCloseProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp))
static int PipeGetHandleProc _ANSI_ARGS_ ((ClientData instanceData, int direction, ClientData *handlePtr))
static int PipeInputProc _ANSI_ARGS_ ((ClientData instanceData, char *buf, int toRead, int *errorCode))
static int PipeOutputProc _ANSI_ARGS_ ((ClientData instanceData, CONST char *buf, int toWrite, int *errorCode))
static void RestoreSignals _ANSI_ARGS_ ((void))
static int SetupStdFile _ANSI_ARGS_ ((TclFile file, int type))
TclFile TclpMakeFile (Tcl_Channel channel, int direction)
TclFile TclpOpenFile (CONST char *fname, int mode)
TclFile TclpCreateTempFile (CONST char *contents)
Tcl_Obj * TclpTempFileName ()
int TclpCreatePipe (TclFile *readPipe, TclFile *writePipe)
int TclpCloseFile (TclFile file)
int TclpCreateProcess (Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr)
static void RestoreSignals ()
static int SetupStdFile (TclFile file, int type)
Tcl_Channel TclpCreateCommandChannel (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)
void TclGetAndDetachPids (Tcl_Interp *interp, Tcl_Channel chan)
static int PipeBlockModeProc (ClientData instanceData, int mode)
static int PipeCloseProc (ClientData instanceData, Tcl_Interp *interp)
static int PipeInputProc (ClientData instanceData, char *buf, int toRead, int *errorCodePtr)
static int PipeOutputProc (ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr)
static void PipeWatchProc (ClientData instanceData, int mask)
static int PipeGetHandleProc (ClientData instanceData, int direction, ClientData *handlePtr)
Tcl_Pid Tcl_WaitPid (Tcl_Pid pid, int *statPtr, int options)
int Tcl_PidObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST *objv)
void TclpFinalizePipes ()
Variables
static Tcl_ChannelType pipeChannelType

Define Documentation
#define GetFd(file)  (((int)file)-1)

Definition at line 30 of file tclUnixPipe.c.
Referenced by PipeBlockModeProc(), PipeCloseProc(), PipeGetHandleProc(), PipeInputProc(), PipeOutputProc(), PipeWatchProc(), SetupStdFile(), TclpCloseFile(), TclpCreateCommandChannel(), TclpCreateProcess(), and TestfilehandlerCmd().#define MakeFile(fd)  ((TclFile)(((int)fd)+1))

Definition at line 29 of file tclUnixPipe.c.
Referenced by TclpCreatePipe(), TclpCreateTempFile(), TclpMakeFile(), and TclpOpenFile().
Function Documentation
static int SetupStdFile _ANSI_ARGS_ ((TclFile file, int type)) [static]
static void RestoreSignals _ANSI_ARGS_ ((void)) [static]
static int PipeOutputProc _ANSI_ARGS_ ((ClientData instanceData, CONST char *buf, int toWrite, int *errorCode)) [static]
static int PipeInputProc _ANSI_ARGS_ ((ClientData instanceData, char *buf, int toRead, int *errorCode)) [static]
static int PipeGetHandleProc _ANSI_ARGS_ ((ClientData instanceData, int direction, ClientData *handlePtr)) [static]
static int PipeCloseProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp)) [static]
static int PipeBlockModeProc _ANSI_ARGS_ ((ClientData instanceData, int mode)) [static]
static int PipeBlockModeProc (ClientData instanceData, int mode) [static]

Definition at line 842 of file tclUnixPipe.c.
References errno, GetFd, PipeState::inFile, PipeState::isNonBlocking, NULL, O_NONBLOCK, PipeState::outFile, TCL_MODE_BLOCKING, and TCL_MODE_NONBLOCKING.847 {
848     PipeState *psPtr = (PipeState *) instanceData;
849     int curStatus;
850     int fd;
851 
852 #ifndef USE_FIONBIO    
853     if (psPtr->inFile) {
854         fd = GetFd(psPtr->inFile);
855         curStatus = fcntl(fd, F_GETFL);
856         if (mode == TCL_MODE_BLOCKING) {
857             curStatus &= (~(O_NONBLOCK));
858         } else {
859             curStatus |= O_NONBLOCK;
860         }
861         if (fcntl(fd, F_SETFL, curStatus) < 0) {
862             return errno;
863         }
864     }
865     if (psPtr->outFile) {
866         fd = GetFd(psPtr->outFile);
867         curStatus = fcntl(fd, F_GETFL);
868         if (mode == TCL_MODE_BLOCKING) {
869             curStatus &= (~(O_NONBLOCK));
870         } else {
871             curStatus |= O_NONBLOCK;
872         }
873         if (fcntl(fd, F_SETFL, curStatus) < 0) {
874             return errno;
875         }
876     }
877 #endif  /* !FIONBIO */
878 
879 #ifdef  USE_FIONBIO
880     if (psPtr->inFile) {
881         fd = GetFd(psPtr->inFile);
882         if (mode == TCL_MODE_BLOCKING) {
883             curStatus = 0;
884         } else {
885             curStatus = 1;
886         }
887         if (ioctl(fd, (int) FIONBIO, &curStatus) < 0) {
888             return errno;
889         }
890     }
891     if (psPtr->outFile != NULL) {
892         fd = GetFd(psPtr->outFile);
893         if (mode == TCL_MODE_BLOCKING) {
894             curStatus = 0;
895         } else {
896             curStatus = 1;
897         }
898         if (ioctl(fd, (int) FIONBIO,  &curStatus) < 0) {
899             return errno;
900         }
901     }
902 #endif  /* USE_FIONBIO */
903 
904     psPtr->isNonBlocking = (mode == TCL_MODE_NONBLOCKING);
905 
906     return 0;
907 }
static int PipeCloseProc (ClientData instanceData, Tcl_Interp * interp) [static]

Definition at line 929 of file tclUnixPipe.c.
References ckfree, errno, PipeState::errorFile, GetFd, PipeState::inFile, PipeState::isNonBlocking, NULL, PipeState::numPids, PipeState::outFile, PipeState::pidPtr, Tcl_DetachPids(), Tcl_MakeFileChannel(), TCL_READABLE, Tcl_ReapDetachedProcs(), TclCleanupChildren(), TclInExit(), and TclpCloseFile().932 {
933     PipeState *pipePtr;
934     Tcl_Channel errChan;
935     int errorCode, result;
936 
937     errorCode = 0;
938     result = 0;
939     pipePtr = (PipeState *) instanceData;
940     if (pipePtr->inFile) {
941   if (TclpCloseFile(pipePtr->inFile) < 0) {
942       errorCode = errno;
943   }
944     }
945     if (pipePtr->outFile) {
946   if ((TclpCloseFile(pipePtr->outFile) < 0) && (errorCode == 0)) {
947       errorCode = errno;
948   }
949     }
950 
951     if (pipePtr->isNonBlocking || TclInExit()) {
952     
953   /*
954          * If the channel is non-blocking or Tcl is being cleaned up, just
955          * detach the children PIDs, reap them (important if we are in a
956          * dynamic load module), and discard the errorFile.
957          */
958         
959         Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr);
960         Tcl_ReapDetachedProcs();
961 
962         if (pipePtr->errorFile) {
963       TclpCloseFile(pipePtr->errorFile);
964         }
965     } else {
966         
967   /*
968          * Wrap the error file into a channel and give it to the cleanup
969          * routine.
970          */
971 
972         if (pipePtr->errorFile) {
973       errChan = Tcl_MakeFileChannel(
974     (ClientData) GetFd(pipePtr->errorFile), TCL_READABLE);
975         } else {
976             errChan = NULL;
977         }
978         result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
979                 errChan);
980     }
981 
982     if (pipePtr->numPids != 0) {
983         ckfree((char *) pipePtr->pidPtr);
984     }
985     ckfree((char *) pipePtr);
986     if (errorCode == 0) {
987         return result;
988     }
989     return errorCode;
990 }
static int PipeGetHandleProc (ClientData instanceData, int direction, ClientData * handlePtr) [static]

Definition at line 1161 of file tclUnixPipe.c.
References GetFd, PipeState::inFile, PipeState::outFile, TCL_ERROR, TCL_OK, TCL_READABLE, and TCL_WRITABLE.1165 {
1166     PipeState *psPtr = (PipeState *) instanceData;
1167 
1168     if (direction == TCL_READABLE && psPtr->inFile) {
1169   *handlePtr = (ClientData) GetFd(psPtr->inFile);
1170   return TCL_OK;
1171     }
1172     if (direction == TCL_WRITABLE && psPtr->outFile) {
1173   *handlePtr = (ClientData) GetFd(psPtr->outFile);
1174   return TCL_OK;
1175     }
1176     return TCL_ERROR;
1177 }
static int PipeInputProc (ClientData instanceData, char * buf, int toRead, int * errorCodePtr) [static]

Definition at line 1011 of file tclUnixPipe.c.
References EINTR, errno, GetFd, PipeState::inFile, and size_t().1017 {
1018     PipeState *psPtr = (PipeState *) instanceData;
1019     int bytesRead;      /* How many bytes were actually
1020                                          * read from the input device? */
1021 
1022     *errorCodePtr = 0;
1023     
1024     /*
1025      * Assume there is always enough input available. This will block
1026      * appropriately, and read will unblock as soon as a short read is
1027      * possible, if the channel is in blocking mode. If the channel is
1028      * nonblocking, the read will never block.
1029      * Some OSes can throw an interrupt error, for which we should
1030      * immediately retry. [Bug #415131]
1031      */
1032 
1033     do {
1034   bytesRead = read (GetFd(psPtr->inFile), buf, (size_t) toRead);
1035     } while ((bytesRead < 0) && (errno == EINTR));
1036 
1037     if (bytesRead < 0) {
1038   *errorCodePtr = errno;
1039   return -1;
1040     } else {
1041   return bytesRead;
1042     }
1043 }
static int PipeOutputProc (ClientData instanceData, CONST char * buf, int toWrite, int * errorCodePtr) [static]

Definition at line 1065 of file tclUnixPipe.c.
References EINTR, errno, GetFd, PipeState::outFile, and size_t().1070 {
1071     PipeState *psPtr = (PipeState *) instanceData;
1072     int written;
1073 
1074     *errorCodePtr = 0;
1075 
1076     /*
1077      * Some OSes can throw an interrupt error, for which we should
1078      * immediately retry. [Bug #415131]
1079      */
1080 
1081     do {
1082   written = write(GetFd(psPtr->outFile), buf, (size_t) toWrite);
1083     } while ((written < 0) && (errno == EINTR));
1084 
1085     if (written < 0) {
1086   *errorCodePtr = errno;
1087   return -1;
1088     } else {
1089   return written;
1090     }
1091 }
static void PipeWatchProc (ClientData instanceData, int mask) [static]

Definition at line 1111 of file tclUnixPipe.c.
References PipeState::channel, GetFd, PipeState::inFile, PipeState::outFile, Tcl_CreateFileHandler(), Tcl_DeleteFileHandler(), TCL_EXCEPTION, Tcl_NotifyChannel(), TCL_READABLE, and TCL_WRITABLE.1116 {
1117     PipeState *psPtr = (PipeState *) instanceData;
1118     int newmask;
1119 
1120     if (psPtr->inFile) {
1121   newmask = mask & (TCL_READABLE | TCL_EXCEPTION);
1122   if (newmask) {
1123       Tcl_CreateFileHandler(GetFd(psPtr->inFile), mask,
1124         (Tcl_FileProc *) Tcl_NotifyChannel,
1125         (ClientData) psPtr->channel);
1126   } else {
1127       Tcl_DeleteFileHandler(GetFd(psPtr->inFile));
1128   }
1129     }
1130     if (psPtr->outFile) {
1131   newmask = mask & (TCL_WRITABLE | TCL_EXCEPTION);
1132   if (newmask) {
1133       Tcl_CreateFileHandler(GetFd(psPtr->outFile), mask,
1134         (Tcl_FileProc *) Tcl_NotifyChannel,
1135         (ClientData) psPtr->channel);
1136   } else {
1137       Tcl_DeleteFileHandler(GetFd(psPtr->outFile));
1138   }
1139     }
1140 }
static void RestoreSignals () [static]

Definition at line 562 of file tclUnixPipe.c.
References SIGHUP, SIGPIPE, and SIGQUIT.
Referenced by TclpCreateProcess().563 {
564 #ifdef SIGABRT
565     signal(SIGABRT, SIG_DFL);
566 #endif
567 #ifdef SIGALRM
568     signal(SIGALRM, SIG_DFL);
569 #endif
570 #ifdef SIGFPE
571     signal(SIGFPE, SIG_DFL);
572 #endif
573 #ifdef SIGHUP
574     signal(SIGHUP, SIG_DFL);
575 #endif
576 #ifdef SIGILL
577     signal(SIGILL, SIG_DFL);
578 #endif
579 #ifdef SIGINT
580     signal(SIGINT, SIG_DFL);
581 #endif
582 #ifdef SIGPIPE
583     signal(SIGPIPE, SIG_DFL);
584 #endif
585 #ifdef SIGQUIT
586     signal(SIGQUIT, SIG_DFL);
587 #endif
588 #ifdef SIGSEGV
589     signal(SIGSEGV, SIG_DFL);
590 #endif
591 #ifdef SIGTERM
592     signal(SIGTERM, SIG_DFL);
593 #endif
594 #ifdef SIGUSR1
595     signal(SIGUSR1, SIG_DFL);
596 #endif
597 #ifdef SIGUSR2
598     signal(SIGUSR2, SIG_DFL);
599 #endif
600 #ifdef SIGCHLD
601     signal(SIGCHLD, SIG_DFL);
602 #endif
603 #ifdef SIGCONT
604     signal(SIGCONT, SIG_DFL);
605 #endif
606 #ifdef SIGTSTP
607     signal(SIGTSTP, SIG_DFL);
608 #endif
609 #ifdef SIGTTIN
610     signal(SIGTTIN, SIG_DFL);
611 #endif
612 #ifdef SIGTTOU
613     signal(SIGTTOU, SIG_DFL);
614 #endif
615 }
static int SetupStdFile (TclFile file, int type) [static]

Definition at line 637 of file tclUnixPipe.c.
References GetFd, Tcl_GetStdChannel(), TCL_READABLE, TCL_STDERR, TCL_STDIN, TCL_STDOUT, TCL_WRITABLE, and TclpMakeFile().
Referenced by TclpCreateProcess().640 {
641     Tcl_Channel channel;
642     int fd;
643     int targetFd = 0;   /* Initializations here needed only to */
644     int direction = 0;    /* prevent warnings about using uninitialized
645          * variables. */
646 
647     switch (type) {
648   case TCL_STDIN:
649       targetFd = 0;
650       direction = TCL_READABLE;
651       break;
652   case TCL_STDOUT:
653       targetFd = 1;
654       direction = TCL_WRITABLE;
655       break;
656   case TCL_STDERR:
657       targetFd = 2;
658       direction = TCL_WRITABLE;
659       break;
660     }
661 
662     if (!file) {
663   channel = Tcl_GetStdChannel(type);
664   if (channel) {
665       file = TclpMakeFile(channel, direction);
666   }
667     }
668     if (file) {
669   fd = GetFd(file);
670   if (fd != targetFd) {
671       if (dup2(fd, targetFd) == -1) {
672     return 0;
673       }
674 
675             /*
676              * Must clear the close-on-exec flag for the target FD, since
677              * some systems (e.g. Ultrix) do not clear the CLOEXEC flag on
678              * the target FD.
679              */
680             
681             fcntl(targetFd, F_SETFD, 0);
682   } else {
683       /*
684        * Since we aren't dup'ing the file, we need to explicitly clear
685        * the close-on-exec flag.
686        */
687 
688      fcntl(fd, F_SETFD, 0);
689   }
690     } else {
691   close(targetFd);
692     }
693     return 1;
694 }
int Tcl_PidObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, Tcl_Obj *CONST * objv)

Definition at line 1232 of file tclUnixPipe.c.
References getpid, NULL, PipeState::numPids, PipeState::pidPtr, pipeChannelType, TCL_ERROR, Tcl_GetChannel(), Tcl_GetChannelInstanceData(), Tcl_GetChannelType(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_ListObjAppendElement(), Tcl_NewLongObj(), TCL_OK, Tcl_SetLongObj(), Tcl_WrongNumArgs(), and TclpGetPid.1237 {
1238     Tcl_Channel chan;
1239     Tcl_ChannelType *chanTypePtr;
1240     PipeState *pipePtr;
1241     int i;
1242     Tcl_Obj *resultPtr, *longObjPtr;
1243 
1244     if (objc > 2) {
1245   Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
1246   return TCL_ERROR;
1247     }
1248     if (objc == 1) {
1249   Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) getpid());
1250     } else {
1251         chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
1252         if (chan == (Tcl_Channel) NULL) {
1253       return TCL_ERROR;
1254   }
1255   chanTypePtr = Tcl_GetChannelType(chan);
1256   if (chanTypePtr != &pipeChannelType) {
1257       return TCL_OK;
1258   }
1259         pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
1260   resultPtr = Tcl_GetObjResult(interp);
1261         for (i = 0; i < pipePtr->numPids; i++) {
1262       longObjPtr = Tcl_NewLongObj((long) TclpGetPid(pipePtr->pidPtr[i]));
1263       Tcl_ListObjAppendElement(NULL, resultPtr, longObjPtr);
1264   }
1265     }
1266     return TCL_OK;
1267 }
Tcl_Pid Tcl_WaitPid (Tcl_Pid pid, int * statPtr, int options)

Definition at line 1196 of file tclUnixPipe.c.
References EINTR, errno, pid_t, and waitpid().1200 {
1201     int result;
1202     pid_t real_pid;
1203 
1204     real_pid = (pid_t) pid;
1205     while (1) {
1206   result = (int) waitpid(real_pid, statPtr, options);
1207   if ((result != -1) || (errno != EINTR)) {
1208       return (Tcl_Pid) result;
1209   }
1210     }
1211 }
void TclGetAndDetachPids (Tcl_Interp * interp, Tcl_Channel chan)

Definition at line 793 of file tclUnixPipe.c.
References ckfree, PipeState::numPids, PipeState::pidPtr, pipeChannelType, Tcl_AppendElement(), Tcl_DetachPids(), Tcl_GetChannelInstanceData(), Tcl_GetChannelType(), TCL_INTEGER_SPACE, TclFormatInt(), and TclpGetPid.
Referenced by Tcl_ExecObjCmd().796 {
797     PipeState *pipePtr;
798     Tcl_ChannelType *chanTypePtr;
799     int i;
800     char buf[TCL_INTEGER_SPACE];
801 
802     /*
803      * Punt if the channel is not a command channel.
804      */
805 
806     chanTypePtr = Tcl_GetChannelType(chan);
807     if (chanTypePtr != &pipeChannelType) {
808         return;
809     }
810 
811     pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
812     for (i = 0; i < pipePtr->numPids; i++) {
813         TclFormatInt(buf, (long) TclpGetPid(pipePtr->pidPtr[i]));
814         Tcl_AppendElement(interp, buf);
815         Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
816     }
817     if (pipePtr->numPids > 0) {
818         ckfree((char *) pipePtr->pidPtr);
819         pipePtr->numPids = 0;
820     }
821 }
int TclpCloseFile (TclFile file)

Definition at line 327 of file tclUnixPipe.c.
References GetFd, and Tcl_DeleteFileHandler().
Referenced by PipeClose2Proc(), PipeCloseProc(), Tcl_OpenCommandChannel(), TclCreatePipeline(), TclpCreateProcess(), and TestfilehandlerCmd().329 {
330     int fd = GetFd(file);
331 
332     /*
333      * Refuse to close the fds for stdin, stdout and stderr.
334      */
335     
336     if ((fd == 0) || (fd == 1) || (fd == 2)) {
337         return 0;
338     }
339     
340     Tcl_DeleteFileHandler(fd);
341     return close(fd);
342 }
Tcl_Channel TclpCreateCommandChannel (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid * pidPtr)

Definition at line 715 of file tclUnixPipe.c.
References ckalloc, GetFd, pipeChannelType, Tcl_CreateChannel(), TCL_INTEGER_SPACE, TCL_READABLE, and TCL_WRITABLE.
Referenced by Tcl_MakeFileChannel(), Tcl_OpenCommandChannel(), and TclpOpenFileChannel().725 {
726     char channelName[16 + TCL_INTEGER_SPACE];
727     int channelId;
728     PipeState *statePtr = (PipeState *) ckalloc((unsigned) sizeof(PipeState));
729     int mode;
730 
731     statePtr->inFile = readFile;
732     statePtr->outFile = writeFile;
733     statePtr->errorFile = errorFile;
734     statePtr->numPids = numPids;
735     statePtr->pidPtr = pidPtr;
736     statePtr->isNonBlocking = 0;
737 
738     mode = 0;
739     if (readFile) {
740         mode |= TCL_READABLE;
741     }
742     if (writeFile) {
743         mode |= TCL_WRITABLE;
744     }
745     
746     /*
747      * Use one of the fds associated with the channel as the
748      * channel id.
749      */
750 
751     if (readFile) {
752   channelId = GetFd(readFile);
753     } else if (writeFile) {
754   channelId = GetFd(writeFile);
755     } else if (errorFile) {
756   channelId = GetFd(errorFile);
757     } else {
758   channelId = 0;
759     }
760 
761     /*
762      * For backward compatibility with previous versions of Tcl, we
763      * use "file%d" as the base name for pipes even though it would
764      * be more natural to use "pipe%d".
765      */
766 
767     sprintf(channelName, "file%d", channelId);
768     statePtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
769             (ClientData) statePtr, mode);
770     return statePtr->channel;
771 }
int TclpCreatePipe (TclFile * readPipe, TclFile * writePipe)

Definition at line 290 of file tclUnixPipe.c.
References FD_CLOEXEC, and MakeFile.
Referenced by TclCreatePipeline(), TclpCreateProcess(), and TestfilehandlerCmd().295 {
296     int pipeIds[2];
297 
298     if (pipe(pipeIds) != 0) {
299   return 0;
300     }
301 
302     fcntl(pipeIds[0], F_SETFD, FD_CLOEXEC);
303     fcntl(pipeIds[1], F_SETFD, FD_CLOEXEC);
304 
305     *readPipe = MakeFile(pipeIds[0]);
306     *writePipe = MakeFile(pipeIds[1]);
307     return 1;
308 }
int TclpCreateProcess (Tcl_Interp * interp, int argc, CONST char ** argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid * pidPtr)

Definition at line 370 of file tclUnixPipe.c.
References ckalloc, ckfree, errno, GetFd, NULL, RestoreSignals(), SetupStdFile(), size_t(), status, strtol(), Tcl_DStringFree(), TCL_ERROR, Tcl_GetStdChannel(), TCL_INTEGER_SPACE, TCL_OK, Tcl_PosixError(), TCL_STDERR, TCL_STDIN, TCL_STDOUT, Tcl_UtfToExternalDString(), Tcl_WaitPid(), TclpCloseFile(), and TclpCreatePipe().
Referenced by TclCreatePipeline().399 {
400     TclFile errPipeIn, errPipeOut;
401     int count, status, fd;
402     char errSpace[200 + TCL_INTEGER_SPACE];
403     Tcl_DString *dsArray;
404     char **newArgv;
405     int pid, i;
406     
407     errPipeIn = NULL;
408     errPipeOut = NULL;
409     pid = -1;
410 
411     /*
412      * Create a pipe that the child can use to return error
413      * information if anything goes wrong.
414      */
415 
416     if (TclpCreatePipe(&errPipeIn, &errPipeOut) == 0) {
417   Tcl_AppendResult(interp, "couldn't create pipe: ",
418     Tcl_PosixError(interp), (char *) NULL);
419   goto error;
420     }
421 
422     /*
423      * We need to allocate and convert this before the fork
424      * so it is properly deallocated later
425      */
426     dsArray = (Tcl_DString *) ckalloc(argc * sizeof(Tcl_DString));
427     newArgv = (char **) ckalloc((argc+1) * sizeof(char *));
428     newArgv[argc] = NULL;
429     for (i = 0; i < argc; i++) {
430   newArgv[i] = Tcl_UtfToExternalDString(NULL, argv[i], -1, &dsArray[i]);
431     }
432 
433 #ifdef USE_VFORK
434     /*
435      * After vfork(), do not call code in the child that changes global state,
436      * because it is using the parent's memory space at that point and writes
437      * might corrupt the parent: so ensure standard channels are initialized in
438      * the parent, otherwise SetupStdFile() might initialize them in the child.
439      */
440     if (!inputFile) {
441   Tcl_GetStdChannel(TCL_STDIN);
442     }
443     if (!outputFile) {
444         Tcl_GetStdChannel(TCL_STDOUT);
445     }
446     if (!errorFile) {
447         Tcl_GetStdChannel(TCL_STDERR);
448     }
449 #endif
450     pid = fork();
451     if (pid == 0) {
452   int joinThisError = errorFile && (errorFile == outputFile);
453 
454   fd = GetFd(errPipeOut);
455 
456   /*
457    * Set up stdio file handles for the child process.
458    */
459 
460   if (!SetupStdFile(inputFile, TCL_STDIN)
461     || !SetupStdFile(outputFile, TCL_STDOUT)
462     || (!joinThisError && !SetupStdFile(errorFile, TCL_STDERR))
463     || (joinThisError &&
464       ((dup2(1,2) == -1) ||
465        (fcntl(2, F_SETFD, 0) != 0)))) {
466       sprintf(errSpace,
467         "%dforked process couldn't set up input/output: ", errno);
468       write(fd, errSpace, (size_t) strlen(errSpace));
469       _exit(1);
470   }
471 
472   /*
473    * Close the input side of the error pipe.
474    */
475 
476   RestoreSignals();
477   execvp(newArgv[0], newArgv);      /* INTL: Native. */
478   sprintf(errSpace, "%dcouldn't execute \"%.150s\": ", errno, argv[0]);
479   write(fd, errSpace, (size_t) strlen(errSpace));
480   _exit(1);
481     }
482     
483     /*
484      * Free the mem we used for the fork
485      */
486     for (i = 0; i < argc; i++) {
487   Tcl_DStringFree(&dsArray[i]);
488     }
489     ckfree((char *) dsArray);
490     ckfree((char *) newArgv);
491 
492     if (pid == -1) {
493   Tcl_AppendResult(interp, "couldn't fork child process: ",
494     Tcl_PosixError(interp), (char *) NULL);
495   goto error;
496     }
497 
498     /*
499      * Read back from the error pipe to see if the child started
500      * up OK.  The info in the pipe (if any) consists of a decimal
501      * errno value followed by an error message.
502      */
503 
504     TclpCloseFile(errPipeOut);
505     errPipeOut = NULL;
506 
507     fd = GetFd(errPipeIn);
508     count = read(fd, errSpace, (size_t) (sizeof(errSpace) - 1));
509     if (count > 0) {
510   char *end;
511   errSpace[count] = 0;
512   errno = strtol(errSpace, &end, 10);
513   Tcl_AppendResult(interp, end, Tcl_PosixError(interp),
514     (char *) NULL);
515   goto error;
516     }
517     
518     TclpCloseFile(errPipeIn);
519     *pidPtr = (Tcl_Pid) pid;
520     return TCL_OK;
521 
522     error:
523     if (pid != -1) {
524   /*
525    * Reap the child process now if an error occurred during its
526    * startup.  We don't call this with WNOHANG because that can lead to
527    * defunct processes on an MP system.   We shouldn't have to worry
528    * about hanging here, since this is the error case.  [Bug: 6148]
529    */
530 
531   Tcl_WaitPid((Tcl_Pid) pid, &status, 0);
532     }
533     
534     if (errPipeIn) {
535   TclpCloseFile(errPipeIn);
536     }
537     if (errPipeOut) {
538   TclpCloseFile(errPipeOut);
539     }
540     return TCL_ERROR;
541 }
TclFile TclpCreateTempFile (CONST char * contents)

Definition at line 192 of file tclUnixPipe.c.
References CONST, dstring, FD_CLOEXEC, L_tmpnam, MakeFile, NULL, P_tmpdir, SEEK_SET, Tcl_DStringFree(), Tcl_UtfToExternalDString(), and TclOSseek.
Referenced by TclCreatePipeline().194 {
195     char fileName[L_tmpnam + 9];
196     CONST char *native;
197     Tcl_DString dstring;
198     int fd;
199 
200     /*
201      * We should also check against making more then TMP_MAX of these.
202      */
203 
204     strcpy(fileName, P_tmpdir);       /* INTL: Native. */
205     if (fileName[strlen(fileName) - 1] != '/') {
206   strcat(fileName, "/");        /* INTL: Native. */
207     }
208     strcat(fileName, "tclXXXXXX");
209     fd = mkstemp(fileName);       /* INTL: Native. */
210     if (fd == -1) {
211   return NULL;
212     }
213     fcntl(fd, F_SETFD, FD_CLOEXEC);
214     unlink(fileName);         /* INTL: Native. */
215 
216     if (contents != NULL) {
217   native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring);
218   if (write(fd, native, strlen(native)) == -1) {
219       close(fd);
220       Tcl_DStringFree(&dstring);
221       return NULL;
222   }
223   Tcl_DStringFree(&dstring);
224   TclOSseek(fd, (Tcl_SeekOffset) 0, SEEK_SET);
225     }
226     return MakeFile(fd);
227 }
void TclpFinalizePipes ()

Definition at line 1285 of file tclUnixPipe.c.
Referenced by TclFinalizeIOSubsystem().1286 {
1287 }
TclFile TclpMakeFile (Tcl_Channel channel, int direction)

Definition at line 109 of file tclUnixPipe.c.
References MakeFile, NULL, Tcl_GetChannelHandle(), and TCL_OK.
Referenced by SetupStdFile(), TCL_DECLARE_MUTEX(), and TclCreatePipeline().112 {
113     ClientData data;
114 
115     if (Tcl_GetChannelHandle(channel, direction, (ClientData *) &data)
116       == TCL_OK) {
117   return MakeFile((int)data);
118     } else {
119   return (TclFile) NULL;
120     }
121 }
TclFile TclpOpenFile (CONST char * fname, int mode)

Definition at line 140 of file tclUnixPipe.c.
References CONST, FD_CLOEXEC, MakeFile, NULL, SEEK_END, Tcl_DStringFree(), Tcl_UtfToExternalDString(), TclOSopen, and TclOSseek.
Referenced by TCL_DECLARE_MUTEX().143 {
144     int fd;
145     CONST char *native;
146     Tcl_DString ds;
147 
148     native = Tcl_UtfToExternalDString(NULL, fname, -1, &ds);
149     fd = TclOSopen(native, mode, 0666);     /* INTL: Native. */
150     Tcl_DStringFree(&ds);
151     if (fd != -1) {
152         fcntl(fd, F_SETFD, FD_CLOEXEC);
153 
154   /*
155    * If the file is being opened for writing, seek to the end
156    * so we can append to any data already in the file.
157    */
158 
159   if ((mode & O_WRONLY) && !(mode & O_APPEND)) {
160       TclOSseek(fd, (Tcl_SeekOffset) 0, SEEK_END);
161   }
162 
163   /*
164    * Increment the fd so it can't be 0, which would conflict with
165    * the NULL return for errors.
166    */
167 
168   return MakeFile(fd);
169     }
170     return NULL;
171 }
Tcl_Obj* TclpTempFileName ()

Definition at line 246 of file tclUnixPipe.c.
References FD_CLOEXEC, L_tmpnam, NULL, P_tmpdir, and TclpNativeToNormalized().247 {
248     char fileName[L_tmpnam + 9];
249     Tcl_Obj *result = NULL;
250     int fd;
251 
252     /*
253      * We should also check against making more then TMP_MAX of these.
254      */
255 
256     strcpy(fileName, P_tmpdir);   /* INTL: Native. */
257     if (fileName[strlen(fileName) - 1] != '/') {
258   strcat(fileName, "/");    /* INTL: Native. */
259     }
260     strcat(fileName, "tclXXXXXX");
261     fd = mkstemp(fileName);   /* INTL: Native. */
262     if (fd == -1) {
263   return NULL;
264     }
265     fcntl(fd, F_SETFD, FD_CLOEXEC);
266     unlink(fileName);     /* INTL: Native. */
267 
268     result = TclpNativeToNormalized((ClientData) fileName);
269     close (fd);
270     return result;
271 }

Variable Documentation
Tcl_ChannelType pipeChannelType [static]
Initial value: {
    "pipe",     
    TCL_CHANNEL_VERSION_4,  
    PipeCloseProc,    
    PipeInputProc,    
    PipeOutputProc,   
    NULL,     
    NULL,     
    NULL,     
    PipeWatchProc,    
    PipeGetHandleProc,    
    NULL,     
    PipeBlockModeProc,    
    NULL,     
    NULL,     
    NULL,                       
    NULL,                       
}
Definition at line 73 of file tclUnixPipe.c.
Referenced by Tcl_PidObjCmd(), TclGetAndDetachPids(), and TclpCreateCommandChannel().

unix/tclUnixPort.h File Reference
#include <errno.h>
#include <fcntl.h>
#include <pwd.h>
#include <signal.h>
#include <sys/types.h>
#include <dirent.h>
#include <sys/file.h>
#include <sys/stat.h>
#include <time.h>
#include <sys/wait.h>
#include "../compat/unistd.h"
#include <utime.h>
#include <sys/socket.h>
#include <sys/utsname.h>
#include <netinet/in.h>
#include <arpa/inet.h>
#include <netdb.h>
#include <float.h>
#include <grp.h>
#include "tclPlatDecls.h"
#include "tclIntPlatDecls.h"
#include "tclInt.h"
Defines
#define TclOSreaddir  readdir
#define TclOSseek  lseek
#define TclOSopen  open
#define TclOSstat  stat
#define TclOSlstat  lstat
#define FLT_MAX  3.402823466E+38F
#define FLT_MIN  1.175494351E-38F
#define O_NONBLOCK  0x80
#define NBIO_FLAG  O_NDELAY
#define WAIT_STATUS_TYPE  union wait
#define WIFEXITED(stat)  (((*((int *) &(stat))) & 0xff) == 0)
#define WEXITSTATUS(stat)  (((*((int *) &(stat))) >> 8) & 0xff)
#define WIFSIGNALED(stat)  (((*((int *) &(stat)))) && ((*((int *) &(stat))) == ((*((int *) &(stat))) & 0x00ff)))
#define WTERMSIG(stat)  ((*((int *) &(stat))) & 0x7f)
#define WIFSTOPPED(stat)  (((*((int *) &(stat))) & 0xff) == 0177)
#define WSTOPSIG(stat)  (((*((int *) &(stat))) >> 8) & 0xff)
#define WNOHANG  1
#define WUNTRACED  2
#define SEEK_SET  0
#define SEEK_CUR  1
#define SEEK_END  2
#define F_OK  00
#define X_OK  01
#define W_OK  02
#define R_OK  04
#define FD_CLOEXEC  1
#define lstat  stat
#define lstat64  stat64
#define TclOSlstat  TclOSstat
#define S_ISREG(m)  0
#define S_ISDIR(m)  0
#define S_ISCHR(m)  0
#define S_ISBLK(m)  0
#define S_ISFIFO(m)  0
#define S_ISLNK(m)  0
#define S_ISSOCK(m)  0
#define MAXPATHLEN  2048
#define MAXNAMLEN  255
#define L_tmpnam  100
#define SELECT_MASK  fd_set
#define NBBY  8
#define FD_SETSIZE  256
#define howmany(x, y)  (((x)+((y)-1))/(y))
#define NFDBITS  NBBY*sizeof(fd_mask)
#define MASK_SIZE  howmany(FD_SETSIZE, NFDBITS)
#define EOVERFLOW  EINVAL
#define TclpPanic  ((Tcl_PanicProc *) NULL)
#define TCL_PLATFORM_TRANSLATION  TCL_TRANSLATE_LF
#define TclpGetPid(pid)  ((unsigned long) (pid))
#define TclpReleaseFile(file)
#define TclpExit  exit
#define TclpMutexInit(a)
#define TclpMutexLock(a)
#define TclpMutexUnlock(a)
Typedefs
typedef dirent Tcl_DirEntry
typedef off_t Tcl_SeekOffset
typedef int TclpMutex
Functions
double strtod ()
EXTERN struct passwd * TclpGetPwNam (const char *name)
EXTERN struct group * TclpGetGrNam (const char *name)
EXTERN struct passwd * TclpGetPwUid (uid_t uid)
EXTERN struct group * TclpGetGrGid (gid_t gid)
EXTERN struct hostent * TclpGetHostByName (const char *name)
EXTERN struct hostent * TclpGetHostByAddr (const char *addr, int length, int type)
Variables
char ** environ

Define Documentation
#define EOVERFLOW  EINVAL

Definition at line 478 of file tclUnixPort.h.#define F_OK  00

Definition at line 298 of file tclUnixPort.h.
Referenced by NativeAccess(), Tcl_FileObjCmd(), TclpCreateProcess(), and TclpObjNormalizePath().#define FD_CLOEXEC  1

Definition at line 316 of file tclUnixPort.h.
Referenced by CreateSocket(), TclpCreatePipe(), TclpCreateTempFile(), TclpOpenFile(), TclpOpenFileChannel(), TclpTempFileName(), and TcpAccept().#define FD_SETSIZE  256

Definition at line 448 of file tclUnixPort.h.
Referenced by TclUnixWaitForFile().#define FLT_MAX  3.402823466E+38F

Definition at line 163 of file tclUnixPort.h.
Referenced by FormatNumber().#define FLT_MIN  1.175494351E-38F

Definition at line 170 of file tclUnixPort.h.#define howmany(x, y)  (((x)+((y)-1))/(y))

Definition at line 452 of file tclUnixPort.h.#define L_tmpnam  100

Definition at line 411 of file tclUnixPort.h.
Referenced by TclpCreateTempFile(), TclpDlopen(), and TclpTempFileName().#define lstat  stat

Definition at line 326 of file tclUnixPort.h.#define lstat64  stat64

Definition at line 327 of file tclUnixPort.h.#define MASK_SIZE  howmany(FD_SETSIZE, NFDBITS)

Definition at line 457 of file tclUnixPort.h.
Referenced by TclUnixWaitForFile().#define MAXNAMLEN  255

Definition at line 402 of file tclUnixPort.h.#define MAXPATHLEN  2048

Definition at line 394 of file tclUnixPort.h.#define NBBY  8

Definition at line 437 of file tclUnixPort.h.#define NBIO_FLAG  O_NDELAY

Definition at line 191 of file tclUnixPort.h.#define NFDBITS  NBBY*sizeof(fd_mask)

Definition at line 455 of file tclUnixPort.h.#define O_NONBLOCK  0x80

Definition at line 179 of file tclUnixPort.h.
Referenced by CreateSocket(), FileBlockModeProc(), PipeBlockModeProc(), TclGetOpenMode(), TcpBlockModeProc(), TestfilehandlerCmd(), and WaitForConnect().#define R_OK  04

Definition at line 307 of file tclUnixPort.h.
Referenced by NativeAccess(), NativeMatchType(), Tcl_FileObjCmd(), Tcl_FSChdir(), and Tcl_FSLoadFile().#define S_ISBLK(m)  0

Definition at line 361 of file tclUnixPort.h.
Referenced by GetTypeFromMode(), and NativeMatchType().#define S_ISCHR(m)  0

Definition at line 354 of file tclUnixPort.h.
Referenced by GetTypeFromMode(), and NativeMatchType().#define S_ISDIR(m)  0

Definition at line 347 of file tclUnixPort.h.
Referenced by CopyRenameOneFile(), DoCopyFile(), FileCopyRename(), GetTypeFromMode(), NativeMatchType(), Tcl_FileObjCmd(), Tcl_FSChdir(), TclFileDeleteCmd(), TclFileMakeDirsCmd(), TclpMatchInDirectory(), TclpSetVariables(), and TraverseUnixTree().#define S_ISFIFO(m)  0

Definition at line 368 of file tclUnixPort.h.
Referenced by GetTypeFromMode(), and NativeMatchType().#define S_ISLNK(m)  0

Definition at line 375 of file tclUnixPort.h.
Referenced by CopyRenameOneFile(), GetTypeFromMode(), and NativeMatchType().#define S_ISREG(m)  0

Definition at line 340 of file tclUnixPort.h.
Referenced by GetTypeFromMode(), NativeMatchType(), Tcl_FileObjCmd(), and TclpFindExecutable().#define S_ISSOCK(m)  0

Definition at line 382 of file tclUnixPort.h.
Referenced by GetTypeFromMode(), and NativeMatchType().#define SEEK_CUR  1

Definition at line 259 of file tclUnixPort.h.
Referenced by FileSeek(), FileSeekProc(), FileWideSeekProc(), Tcl_Seek(), Tcl_SeekObjCmd(), Tcl_Tell(), TclpGetDefaultStdChannel(), TclpInitPlatform(), TransformSeekProc(), and TransformWideSeekProc().#define SEEK_END  2

Definition at line 262 of file tclUnixPort.h.
Referenced by FileOutput(), FileSeek(), OpenFileChannel(), PretendTclpOpenFileChannel(), Tcl_FSOpenFileChannel(), Tcl_SeekObjCmd(), and TclpOpenFile().#define SEEK_SET  0

Definition at line 256 of file tclUnixPort.h.
Referenced by FileSeek(), FileSeekProc(), FileWideSeekProc(), main(), Tcl_SeekObjCmd(), TclCleanupChildren(), TclpCreateTempFile(), and TclpDlopen().#define SELECT_MASK  fd_set

Definition at line 420 of file tclUnixPort.h.
Referenced by Tcl_Sleep(), and TclUnixWaitForFile().#define TCL_PLATFORM_TRANSLATION  TCL_TRANSLATE_LF

Definition at line 630 of file tclUnixPort.h.#define TclOSlstat  TclOSstat

Definition at line 328 of file tclUnixPort.h.#define TclOSlstat  lstat

Definition at line 328 of file tclUnixPort.h.
Referenced by DoCopyFile(), NativeMatchType(), TclpObjCopyFile(), TclpObjLstat(), and TraverseUnixTree().#define TclOSopen  open

Definition at line 75 of file tclUnixPort.h.
Referenced by CopyFile(), TclpOpenFile(), and TclpOpenFileChannel().#define TclOSreaddir  readdir

Definition at line 65 of file tclUnixPort.h.
Referenced by DoRenameFile(), TclpMatchInDirectory(), TclpReaddir(), and TraverseUnixTree().#define TclOSseek  lseek

Definition at line 74 of file tclUnixPort.h.
Referenced by FileSeekProc(), FileWideSeekProc(), TclpCreateTempFile(), TclpGetDefaultStdChannel(), TclpInitPlatform(), and TclpOpenFile().#define TclOSstat  stat

Definition at line 82 of file tclUnixPort.h.
Referenced by DoRemoveDirectory(), NativeMatchType(), TclpFindExecutable(), TclpMatchInDirectory(), TclpObjStat(), and TclpSetVariables().#define TclpExit  exit

Definition at line 657 of file tclUnixPort.h.
Referenced by Tcl_Exit().#define TclpGetPid(pid)  ((unsigned long) (pid))

Definition at line 638 of file tclUnixPort.h.#define TclpMutexInit(a)

Definition at line 683 of file tclUnixPort.h.#define TclpMutexLock(a)

Definition at line 684 of file tclUnixPort.h.#define TclpMutexUnlock(a)

Definition at line 685 of file tclUnixPort.h.#define TclpPanic  ((Tcl_PanicProc *) NULL)

Definition at line 505 of file tclUnixPort.h.#define TclpReleaseFile(file)

Definition at line 639 of file tclUnixPort.h.
Referenced by TclCreatePipeline().#define W_OK  02

Definition at line 304 of file tclUnixPort.h.
Referenced by NativeAccess(), NativeMatchType(), Tcl_FileObjCmd(), and TclpObjAccess().#define WAIT_STATUS_TYPE  union wait

Definition at line 203 of file tclUnixPort.h.#define WEXITSTATUS(stat)  (((*((int *) &(stat))) >> 8) & 0xff)

Definition at line 219 of file tclUnixPort.h.#define WIFEXITED(stat)  (((*((int *) &(stat))) & 0xff) == 0)

Definition at line 215 of file tclUnixPort.h.#define WIFSIGNALED(stat)  (((*((int *) &(stat)))) && ((*((int *) &(stat))) == ((*((int *) &(stat))) & 0x00ff)))

Definition at line 223 of file tclUnixPort.h.#define WIFSTOPPED(stat)  (((*((int *) &(stat))) & 0xff) == 0177)

Definition at line 231 of file tclUnixPort.h.#define WNOHANG  1

Definition at line 244 of file tclUnixPort.h.#define WSTOPSIG(stat)  (((*((int *) &(stat))) >> 8) & 0xff)

Definition at line 235 of file tclUnixPort.h.#define WTERMSIG(stat)  ((*((int *) &(stat))) & 0x7f)

Definition at line 227 of file tclUnixPort.h.#define WUNTRACED  2

Definition at line 247 of file tclUnixPort.h.
Referenced by waitpid().#define X_OK  01

Definition at line 301 of file tclUnixPort.h.
Referenced by NativeAccess(), NativeMatchType(), Tcl_FileObjCmd(), TclpFindExecutable(), and TclpObjAccess().
Typedef Documentation
typedef struct dirent Tcl_DirEntry

Definition at line 64 of file tclUnixPort.h.typedef off_t Tcl_SeekOffset

Definition at line 73 of file tclUnixPort.h.typedef int TclpMutex

Definition at line 682 of file tclUnixPort.h.
Function Documentation
double strtod ()
EXTERN struct group* TclpGetGrGid (gid_t gid)

Definition at line 522 of file tclUnixCompat.c.
References dataKey, NULL, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by GetGroupAttribute().523 {
524 #if !defined(TCL_THREADS)
525     return getgrgid(gid);
526 #else
527     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
528 
529 #if defined(HAVE_GETGRGID_R_5)
530     struct group *grPtr = NULL;
531     return (getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf),
532            &grPtr) == 0 && grPtr != NULL) ? &tsdPtr->grp : NULL;
533 
534 #elif defined(HAVE_GETGRGID_R_4)
535     return getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf));
536 
537 #else
538     struct group *grPtr;
539     Tcl_MutexLock(&compatLock);
540     grPtr = getgrgid(gid);
541     if (grPtr != NULL) {
542   tsdPtr->grp = *grPtr;
543   grPtr = &tsdPtr->grp;
544   if (CopyGrp(&tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)) == -1) {
545       grPtr = NULL;
546   }
547     }
548     Tcl_MutexUnlock(&compatLock);
549     return grPtr;
550 #endif
551     return NULL; /* Not reached */
552 #endif /* TCL_THREADS */
553 }
EXTERN struct group* TclpGetGrNam (const char * name)

Definition at line 470 of file tclUnixCompat.c.
References dataKey, NULL, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by SetGroupAttribute().471 {
472 #if !defined(TCL_THREADS)
473     return getgrnam(name);
474 #else
475     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
476 
477 #if defined(HAVE_GETGRNAM_R_5)
478     struct group *grPtr = NULL;
479     return (getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf),
480            &grPtr) == 0 && grPtr != NULL) ? &tsdPtr->grp : NULL;
481 
482 #elif defined(HAVE_GETGRNAM_R_4)
483     return getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf));
484 
485 #else
486     struct group *grPtr;
487     Tcl_MutexLock(&compatLock);
488     grPtr = getgrnam(name);
489     if (grPtr != NULL) {
490   tsdPtr->grp = *grPtr;
491   grPtr = &tsdPtr->grp;
492   if (CopyGrp(&tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)) == -1) {
493       grPtr = NULL;
494   }
495     }
496     Tcl_MutexUnlock(&compatLock);
497     return grPtr;
498 #endif
499     return NULL; /* Not reached */
500 #endif /* TCL_THREADS */
501 }
EXTERN struct hostent* TclpGetHostByAddr (const char * addr, int length, int type)

Definition at line 635 of file tclUnixCompat.c.
References dataKey, NULL, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by TcpGetOptionProc().636 {
637 #if !defined(TCL_THREADS) || defined(HAVE_MTSAFE_GETHOSTBYADDR)
638     return gethostbyaddr(addr, length, type);
639 #else
640     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
641 
642 #if defined(HAVE_GETHOSTBYADDR_R_7)
643     int h_errno;
644     return gethostbyaddr_r(addr, length, type, &tsdPtr->hent, tsdPtr->hbuf,
645          sizeof(tsdPtr->hbuf), &h_errno);
646 
647 #elif defined(HAVE_GETHOSTBYADDR_R_8)
648     struct hostent *hePtr;
649     int h_errno;
650     return (gethostbyaddr_r(addr, length, type, &tsdPtr->hent, tsdPtr->hbuf,
651           sizeof(tsdPtr->hbuf), &hePtr, &h_errno) == 0) ?
652   &tsdPtr->hent : NULL;
653 #else
654     struct hostent *hePtr;
655     Tcl_MutexLock(&compatLock);
656     hePtr = gethostbyaddr(addr, length, type);
657     if (hePtr != NULL) {
658   tsdPtr->hent = *hePtr;
659   hePtr = &tsdPtr->hent;
660   if (CopyHostent(&tsdPtr->hent, tsdPtr->hbuf,
661       sizeof(tsdPtr->hbuf)) == -1) {
662       hePtr = NULL;
663   }
664     }
665     Tcl_MutexUnlock(&compatLock);
666     return hePtr;
667 #endif
668     return NULL; /* Not reached */
669 #endif /* TCL_THREADS */
670 }
EXTERN struct hostent* TclpGetHostByName (const char * name)

Definition at line 574 of file tclUnixCompat.c.
References dataKey, NULL, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by CreateSocketAddress(), and TCL_DECLARE_MUTEX().575 {
576 #if !defined(TCL_THREADS) || defined(HAVE_MTSAFE_GETHOSTBYNAME)
577     return gethostbyname(name);
578 #else
579     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
580 
581 #if defined(HAVE_GETHOSTBYNAME_R_5)
582     int h_errno;
583     return gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf,
584          sizeof(tsdPtr->hbuf), &h_errno);
585 
586 #elif defined(HAVE_GETHOSTBYNAME_R_6)
587     struct hostent *hePtr;
588     int h_errno;
589     return (gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf,
590           sizeof(tsdPtr->hbuf), &hePtr, &h_errno) == 0) ?
591   &tsdPtr->hent : NULL;
592 
593 #elif defined(HAVE_GETHOSTBYNAME_R_3)
594     struct hostent_data data;
595     return (gethostbyname_r(name, &tsdPtr->hent, &data) == 0) ?
596   &tsdPtr->hent : NULL;
597 #else
598     struct hostent *hePtr;
599     Tcl_MutexLock(&compatLock);
600     hePtr = gethostbyname(name);
601     if (hePtr != NULL) {
602   tsdPtr->hent = *hePtr;
603   hePtr = &tsdPtr->hent;
604   if (CopyHostent(&tsdPtr->hent, tsdPtr->hbuf,
605       sizeof(tsdPtr->hbuf)) == -1) {
606       hePtr = NULL;
607   }
608     }
609     Tcl_MutexUnlock(&compatLock);
610     return hePtr;
611 #endif
612     return NULL; /* Not reached */
613 #endif /* TCL_THREADS */
614 }
EXTERN struct passwd* TclpGetPwNam (const char * name)

Definition at line 366 of file tclUnixCompat.c.
References dataKey, NULL, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by SetOwnerAttribute().367 {
368 #if !defined(TCL_THREADS)
369     return getpwnam(name);
370 #else
371     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
372 
373 #if defined(HAVE_GETPWNAM_R_5)
374     struct passwd *pwPtr = NULL;
375     return (getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf),
376            &pwPtr) == 0 && pwPtr != NULL) ? &tsdPtr->pwd : NULL;
377 
378 #elif defined(HAVE_GETPWNAM_R_4)
379     return getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf));
380 
381 #else
382     struct passwd *pwPtr;
383     Tcl_MutexLock(&compatLock);
384     pwPtr = getpwnam(name);
385     if (pwPtr != NULL) {
386   tsdPtr->pwd = *pwPtr;
387   pwPtr = &tsdPtr->pwd;
388   if (CopyPwd(&tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)) == -1) {
389       pwPtr = NULL;
390   }
391     }
392     Tcl_MutexUnlock(&compatLock);
393     return pwPtr;
394 #endif
395     return NULL; /* Not reached */
396 #endif /* TCL_THREADS */
397 }
EXTERN struct passwd* TclpGetPwUid (uid_t uid)

Definition at line 418 of file tclUnixCompat.c.
References dataKey, NULL, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by GetOwnerAttribute().419 {
420 #if !defined(TCL_THREADS)
421     return getpwuid(uid);
422 #else
423     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
424 
425 #if defined(HAVE_GETPWUID_R_5)
426     struct passwd *pwPtr = NULL;
427     return (getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf),
428            &pwPtr) == 0 && pwPtr != NULL) ? &tsdPtr->pwd : NULL;
429 
430 #elif defined(HAVE_GETPWUID_R_4)
431     return getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf));
432 
433 #else
434     struct passwd *pwPtr;
435     Tcl_MutexLock(&compatLock);
436     pwPtr = getpwuid(uid);
437     if (pwPtr != NULL) {
438   tsdPtr->pwd = *pwPtr;
439   pwPtr = &tsdPtr->pwd;
440   if (CopyPwd(&tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)) == -1) {
441       pwPtr = NULL;
442   }
443     }
444     Tcl_MutexUnlock(&compatLock);
445     return pwPtr;
446 #endif
447     return NULL; /* Not reached */
448 #endif /* TCL_THREADS */
449 }

Variable Documentation
char** environ

Definition at line 47 of file tclMacEnv.c.
Referenced by TclMacCreateEnv(), and TclpFindVariable().

unix/tclUnixSock.c File Reference
#include "tcl.h"
#include "tclPort.h"
Defines
#define TCL_HOSTNAME_LEN  256
Functions
TCL_DECLARE_MUTEX (hostMutex)
int TclpHasSockets (Tcl_Interp *interp)
void TclpFinalizeSockets ()
Variables
static char hostname [TCL_HOSTNAME_LEN+1]
static int hostnameInited = 0

Define Documentation
#define TCL_HOSTNAME_LEN  256

Definition at line 34 of file tclUnixSock.c.
Function Documentation
TCL_DECLARE_MUTEX (hostMutex)

Definition at line 44 of file tclUnixSock.c.
References ckalloc, ckfree, CONST, hostname, hostnameInited, NULL, size_t(), Tcl_ExternalToUtf(), Tcl_MutexLock, Tcl_MutexUnlock, TclpGetHostByName(), and VOID.54           :
55  *  A string containing the network name for this machine, or
56  *  an empty string if we can't figure out the name.  The caller 
57  *  must not modify or free this string.
58  *
59  * Side effects:
60  *  None.
61  *
62  *----------------------------------------------------------------------
63  */
64 
65 CONST char *
66 Tcl_GetHostName()
67 {
68 #ifndef NO_UNAME
69     struct utsname u;
70     struct hostent *hp;
71 #else
72     char buffer[sizeof(hostname)];
73 #endif
74     CONST char *native;
75 
76     Tcl_MutexLock(&hostMutex);
77     if (hostnameInited) {
78   Tcl_MutexUnlock(&hostMutex);
79         return hostname;
80     }
81 
82     native = NULL;
83 #ifndef NO_UNAME
84     (VOID *) memset((VOID *) &u, (int) 0, sizeof(struct utsname));
85     if (uname(&u) > -1) {       /* INTL: Native. */
86         hp = TclpGetHostByName(u.nodename);     /* INTL: Native. */
87   if (hp == NULL) {
88       /*
89        * Sometimes the nodename is fully qualified, but gets truncated
90        * as it exceeds SYS_NMLN.  See if we can just get the immediate
91        * nodename and get a proper answer that way.
92        */
93       char *dot = strchr(u.nodename, '.');
94       if (dot != NULL) {
95     char *node = ckalloc((unsigned) (dot - u.nodename + 1));
96     memcpy(node, u.nodename, (size_t) (dot - u.nodename));
97     node[dot - u.nodename] = '\0';
98     hp = TclpGetHostByName(node);
99     ckfree(node);
100       }
101   }
102         if (hp != NULL) {
103       native = hp->h_name;
104         } else {
105       native = u.nodename;
106         }
107     }
108 #else
109     /*
110      * Uname doesn't exist; try gethostname instead.
111      */
112 
113     if (gethostname(buffer, sizeof(buffer)) > -1) { /* INTL: Native. */
114   native = buffer;
115     }
116 #endif
117 
118     if (native == NULL) {
119   hostname[0] = 0;
120     } else {
121   Tcl_ExternalToUtf(NULL, NULL, native, -1, 0, NULL, hostname,
122     sizeof(hostname), NULL, NULL, NULL);
123     }
124     hostnameInited = 1;
125     Tcl_MutexUnlock(&hostMutex);
126     return hostname;
127 }

void TclpFinalizeSockets ()

Definition at line 169 of file tclUnixSock.c.170 {
171     return;
172 }
int TclpHasSockets (Tcl_Interp * interp)

Definition at line 146 of file tclUnixSock.c.
References TCL_OK.148 {
149     return TCL_OK;
150 }

Variable Documentation
char hostname[TCL_HOSTNAME_LEN+1] [static]

Definition at line 42 of file tclUnixSock.c.
Referenced by TCL_DECLARE_MUTEX(), and Tcl_GetHostName().int hostnameInited = 0 [static]

Definition at line 43 of file tclUnixSock.c.
Referenced by TCL_DECLARE_MUTEX(), and Tcl_GetHostName().

unix/tclUnixTest.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include <signal.h>
#include <sys/resource.h>
Classes
struct Pipe
Defines
#define MakeFile(fd)  ((TclFile)((fd)+1))
#define GetFd(file)  (((int)file)-1)
#define MAX_PIPES  10
Functions
static void TestFileHandlerProc _ANSI_ARGS_ ((ClientData clientData, int mask))
static int TestfilehandlerCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv))
int TclplatformtestInit _ANSI_ARGS_ ((Tcl_Interp *interp))
static void AlarmHandler _ANSI_ARGS_ (())
int TclplatformtestInit (Tcl_Interp *interp)
static int TestfilehandlerCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static void TestFileHandlerProc (ClientData clientData, int mask)
static int TestfilewaitCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestfindexecutableCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestgetopenfileCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestsetdefencdirCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestgetdefencdirCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestalarmCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static void AlarmHandler ()
static int TestgotsigCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)
static int TestchmodCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)
Variables
static Pipe testPipes [MAX_PIPES]
static char * gotsig = "0"

Define Documentation
#define GetFd(file)  (((int)file)-1)

Definition at line 33 of file tclUnixTest.c.#define MakeFile(fd)  ((TclFile)((fd)+1))

Definition at line 32 of file tclUnixTest.c.#define MAX_PIPES  10

Definition at line 53 of file tclUnixTest.c.
Referenced by TestfilehandlerCmd().
Function Documentation
static void AlarmHandler _ANSI_ARGS_ (()) [static]
int TclplatformtestInit _ANSI_ARGS_ ((Tcl_Interp *interp))
static int TestfilehandlerCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)) [static]
static void TestFileHandlerProc _ANSI_ARGS_ ((ClientData clientData, int mask)) [static]
static void AlarmHandler () [static]

Definition at line 679 of file tclUnixTest.c.
References gotsig.
Referenced by TestalarmCmd().680 {
681     gotsig = "1";
682 }
int TclplatformtestInit (Tcl_Interp * interp)

Definition at line 107 of file tclUnixTest.c.
References NULL, Tcl_CreateCommand(), TCL_OK, TestalarmCmd(), TestchmodCmd(), TestfilehandlerCmd(), TestfilewaitCmd(), TestfindexecutableCmd(), TestgetdefencdirCmd(), TestgetopenfileCmd(), TestgotsigCmd(), and TestsetdefencdirCmd().109 {
110     Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
111       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
112     Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd,
113             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
114     Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
115             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
116     Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
117             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
118     Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
119             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
120     Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
121             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
122     Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd,
123             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
124     Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
125             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
126     Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd,
127             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
128     return TCL_OK;
129 }
static int TestalarmCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 626 of file tclUnixTest.c.
References AlarmHandler(), NULL, TCL_ERROR, Tcl_GetInt(), TCL_OK, Tcl_PosixError(), and void().
Referenced by TclplatformtestInit().631 {
632 #ifdef SA_RESTART
633     unsigned int sec;
634     struct sigaction action;
635 
636     if (argc > 1) {
637   Tcl_GetInt(interp, argv[1], (int *)&sec);
638     } else {
639   sec = 1;
640     }
641 
642     /*
643      * Setup the signal handling that automatically retries
644      * any interupted I/O system calls.
645      */
646     action.sa_handler = AlarmHandler;
647     memset((void *)&action.sa_mask, 0, sizeof(sigset_t));
648     action.sa_flags = SA_RESTART;
649 
650     if (sigaction(SIGALRM, &action, NULL) < 0) {
651   Tcl_AppendResult(interp, "sigaction: ", Tcl_PosixError(interp), NULL);
652   return TCL_ERROR;
653     }
654     (void)alarm(sec);
655     return TCL_OK;
656 #else
657     Tcl_AppendResult(interp, "warning: sigaction SA_RESTART not support on this platform", NULL);
658     return TCL_ERROR;
659 #endif
660 }
static int TestchmodCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 731 of file tclUnixTest.c.
References CONST, NULL, strtol(), Tcl_DStringFree(), TCL_ERROR, TCL_OK, Tcl_PosixError(), and Tcl_TranslateFileName().
Referenced by TclplatformtestInit().736 {
737     int i, mode;
738     char *rest;
739 
740     if (argc < 2) {
741   usage:
742   Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
743     " mode file ?file ...?", NULL);
744   return TCL_ERROR;
745     }
746 
747     mode = (int) strtol(argv[1], &rest, 8);
748     if ((rest == argv[1]) || (*rest != '\0')) {
749   goto usage;
750     }
751 
752     for (i = 2; i < argc; i++) {
753   Tcl_DString buffer;
754   CONST char *translated;
755 
756   translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
757   if (translated == NULL) {
758       return TCL_ERROR;
759   }
760   if (chmod(translated, (unsigned) mode) != 0) {
761       Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
762         NULL);
763       return TCL_ERROR;
764   }
765   Tcl_DStringFree(&buffer);
766     }
767     return TCL_OK;
768 }
static int TestfilehandlerCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 150 of file tclUnixTest.c.
References GetFd, initialized, MAX_PIPES, NULL, O_NONBLOCK, Pipe::readCount, Pipe::readFile, Tcl_AppendElement(), Tcl_CreateFileHandler(), Tcl_DeleteFileHandler(), TCL_DONT_WAIT, Tcl_DoOneEvent(), TCL_ERROR, TCL_FILE_EVENTS, Tcl_GetInt(), TCL_INTEGER_SPACE, TCL_OK, Tcl_PosixError(), TCL_READABLE, Tcl_SetResult(), TCL_STATIC, TCL_VOLATILE, TCL_WINDOW_EVENTS, TCL_WRITABLE, TclFormatInt(), TclpCloseFile(), TclpCreatePipe(), TclUnixWaitForFile(), TestFileHandlerProc(), testPipes, VOID, Pipe::writeCount, and Pipe::writeFile.
Referenced by TclplatformtestInit().155 {
156     Pipe *pipePtr;
157     int i, mask, timeout;
158     static int initialized = 0;
159     char buffer[4000];
160     TclFile file;
161 
162     /*
163      * NOTE: When we make this code work on Windows also, the following
164      * variable needs to be made Unix-only.
165      */
166     
167     if (!initialized) {
168   for (i = 0; i < MAX_PIPES; i++) {
169       testPipes[i].readFile = NULL;
170   }
171   initialized = 1;
172     }
173 
174     if (argc < 2) {
175   Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
176                 " option ... \"", (char *) NULL);
177         return TCL_ERROR;
178     }
179     pipePtr = NULL;
180     if (argc >= 3) {
181   if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK) {
182       return TCL_ERROR;
183   }
184   if (i >= MAX_PIPES) {
185       Tcl_AppendResult(interp, "bad index ", argv[2], (char *) NULL);
186       return TCL_ERROR;
187   }
188   pipePtr = &testPipes[i];
189     }
190 
191     if (strcmp(argv[1], "close") == 0) {
192   for (i = 0; i < MAX_PIPES; i++) {
193       if (testPipes[i].readFile != NULL) {
194     TclpCloseFile(testPipes[i].readFile);
195     testPipes[i].readFile = NULL;
196     TclpCloseFile(testPipes[i].writeFile);
197     testPipes[i].writeFile = NULL;
198       }
199   }
200     } else if (strcmp(argv[1], "clear") == 0) {
201   if (argc != 3) {
202       Tcl_AppendResult(interp, "wrong # arguments: should be \"",
203                     argv[0], " clear index\"", (char *) NULL);
204       return TCL_ERROR;
205   }
206   pipePtr->readCount = pipePtr->writeCount = 0;
207     } else if (strcmp(argv[1], "counts") == 0) {
208   char buf[TCL_INTEGER_SPACE * 2];
209   
210   if (argc != 3) {
211       Tcl_AppendResult(interp, "wrong # arguments: should be \"",
212                     argv[0], " counts index\"", (char *) NULL);
213       return TCL_ERROR;
214   }
215   sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount);
216   Tcl_SetResult(interp, buf, TCL_VOLATILE);
217     } else if (strcmp(argv[1], "create") == 0) {
218   if (argc != 5) {
219       Tcl_AppendResult(interp, "wrong # arguments: should be \"",
220                     argv[0], " create index readMode writeMode\"",
221                     (char *) NULL);
222       return TCL_ERROR;
223   }
224   if (pipePtr->readFile == NULL) {
225       if (!TclpCreatePipe(&pipePtr->readFile, &pipePtr->writeFile)) {
226     Tcl_AppendResult(interp, "couldn't open pipe: ",
227       Tcl_PosixError(interp), (char *) NULL);
228     return TCL_ERROR;
229       }
230 #ifdef O_NONBLOCK
231       fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK);
232       fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK);
233 #else
234       Tcl_SetResult(interp, "can't make pipes non-blocking",
235         TCL_STATIC);
236       return TCL_ERROR;
237 #endif
238   }
239   pipePtr->readCount = 0;
240   pipePtr->writeCount = 0;
241 
242   if (strcmp(argv[3], "readable") == 0) {
243       Tcl_CreateFileHandler(GetFd(pipePtr->readFile), TCL_READABLE,
244         TestFileHandlerProc, (ClientData) pipePtr);
245   } else if (strcmp(argv[3], "off") == 0) {
246       Tcl_DeleteFileHandler(GetFd(pipePtr->readFile));
247   } else if (strcmp(argv[3], "disabled") == 0) {
248       Tcl_CreateFileHandler(GetFd(pipePtr->readFile), 0,
249         TestFileHandlerProc, (ClientData) pipePtr);
250   } else {
251       Tcl_AppendResult(interp, "bad read mode \"", argv[3], "\"",
252         (char *) NULL);
253       return TCL_ERROR;
254   }
255   if (strcmp(argv[4], "writable") == 0) {
256       Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), TCL_WRITABLE,
257         TestFileHandlerProc, (ClientData) pipePtr);
258   } else if (strcmp(argv[4], "off") == 0) {
259       Tcl_DeleteFileHandler(GetFd(pipePtr->writeFile));
260   } else if (strcmp(argv[4], "disabled") == 0) {
261       Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), 0,
262         TestFileHandlerProc, (ClientData) pipePtr);
263   } else {
264       Tcl_AppendResult(interp, "bad read mode \"", argv[4], "\"",
265         (char *) NULL);
266       return TCL_ERROR;
267   }
268     } else if (strcmp(argv[1], "empty") == 0) {
269   if (argc != 3) {
270       Tcl_AppendResult(interp, "wrong # arguments: should be \"",
271                     argv[0], " empty index\"", (char *) NULL);
272       return TCL_ERROR;
273   }
274 
275         while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) {
276             /* Empty loop body. */
277         }
278     } else if (strcmp(argv[1], "fill") == 0) {
279   if (argc != 3) {
280       Tcl_AppendResult(interp, "wrong # arguments: should be \"",
281                     argv[0], " fill index\"", (char *) NULL);
282       return TCL_ERROR;
283   }
284 
285   memset((VOID *) buffer, 'a', 4000);
286         while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) {
287             /* Empty loop body. */
288         }
289     } else if (strcmp(argv[1], "fillpartial") == 0) {
290   char buf[TCL_INTEGER_SPACE];
291   
292   if (argc != 3) {
293       Tcl_AppendResult(interp, "wrong # arguments: should be \"",
294                     argv[0], " fillpartial index\"", (char *) NULL);
295       return TCL_ERROR;
296   }
297 
298   memset((VOID *) buffer, 'b', 10);
299   TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10));
300   Tcl_SetResult(interp, buf, TCL_VOLATILE);
301     } else if (strcmp(argv[1], "oneevent") == 0) {
302   Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT);
303     } else if (strcmp(argv[1], "wait") == 0) {
304   if (argc != 5) {
305       Tcl_AppendResult(interp, "wrong # arguments: should be \"",
306                     argv[0], " wait index readable|writable timeout\"",
307                     (char *) NULL);
308       return TCL_ERROR;
309   }
310   if (pipePtr->readFile == NULL) {
311       Tcl_AppendResult(interp, "pipe ", argv[2], " doesn't exist",
312         (char *) NULL);
313       return TCL_ERROR;
314   }
315   if (strcmp(argv[3], "readable") == 0) {
316       mask = TCL_READABLE;
317       file = pipePtr->readFile;
318   } else {
319       mask = TCL_WRITABLE;
320       file = pipePtr->writeFile;
321   }
322   if (Tcl_GetInt(interp, argv[4], &timeout) != TCL_OK) {
323       return TCL_ERROR;
324   }
325   i = TclUnixWaitForFile(GetFd(file), mask, timeout);
326   if (i & TCL_READABLE) {
327       Tcl_AppendElement(interp, "readable");
328   }
329   if (i & TCL_WRITABLE) {
330       Tcl_AppendElement(interp, "writable");
331   }
332     } else if (strcmp(argv[1], "windowevent") == 0) {
333   Tcl_DoOneEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT);
334     } else {
335   Tcl_AppendResult(interp, "bad option \"", argv[1],
336     "\": must be close, clear, counts, create, empty, fill, ",
337     "fillpartial, oneevent, wait, or windowevent",
338     (char *) NULL);
339   return TCL_ERROR;
340     }
341     return TCL_OK;
342 }
static void TestFileHandlerProc (ClientData clientData, int mask) [static]

Definition at line 344 of file tclUnixTest.c.
References Pipe::readCount, TCL_READABLE, TCL_WRITABLE, and Pipe::writeCount.
Referenced by TestfilehandlerCmd().346                                                     :
347          * TCL_READABLE or TCL_WRITABLE. */
348 {
349     Pipe *pipePtr = (Pipe *) clientData;
350 
351     if (mask & TCL_READABLE) {
352   pipePtr->readCount++;
353     }
354     if (mask & TCL_WRITABLE) {
355   pipePtr->writeCount++;
356     }
357 }

static int TestfilewaitCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 377 of file tclUnixTest.c.
References NULL, Tcl_AppendElement(), TCL_ERROR, Tcl_GetChannel(), Tcl_GetChannelHandle(), Tcl_GetInt(), TCL_OK, TCL_READABLE, Tcl_SetResult(), TCL_STATIC, TCL_WRITABLE, and TclUnixWaitForFile().
Referenced by TclplatformtestInit().382 {
383     int mask, result, timeout;
384     Tcl_Channel channel;
385     int fd;
386     ClientData data;
387 
388     if (argc != 4) {
389   Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
390     " file readable|writable|both timeout\"", (char *) NULL);
391   return TCL_ERROR;
392     }
393     channel = Tcl_GetChannel(interp, argv[1], NULL);
394     if (channel == NULL) {
395   return TCL_ERROR;
396     }
397     if (strcmp(argv[2], "readable") == 0) {
398   mask = TCL_READABLE;
399     } else if (strcmp(argv[2], "writable") == 0){
400   mask = TCL_WRITABLE;
401     } else if (strcmp(argv[2], "both") == 0){
402   mask = TCL_WRITABLE|TCL_READABLE;
403     } else {
404   Tcl_AppendResult(interp, "bad argument \"", argv[2],
405     "\": must be readable, writable, or both", (char *) NULL);
406   return TCL_ERROR;
407     }
408     if (Tcl_GetChannelHandle(channel, 
409       (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE,
410       (ClientData*) &data) != TCL_OK) {
411   Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC);
412   return TCL_ERROR;
413     }
414     fd = (int) data;
415     if (Tcl_GetInt(interp, argv[3], &timeout) != TCL_OK) {
416   return TCL_ERROR;
417     }
418     result = TclUnixWaitForFile(fd, mask, timeout);
419     if (result & TCL_READABLE) {
420   Tcl_AppendElement(interp, "readable");
421     }
422     if (result & TCL_WRITABLE) {
423   Tcl_AppendElement(interp, "writable");
424     }
425     return TCL_OK;
426 }
static int TestfindexecutableCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 446 of file tclUnixTest.c.
References ckfree, NULL, TCL_ERROR, Tcl_FindExecutable(), TCL_OK, Tcl_SetResult(), TCL_VOLATILE, tclExecutableName, and tclNativeExecutableName.
Referenced by TclplatformtestInit().451 {
452     char *oldName;
453     char *oldNativeName;
454 
455     if (argc != 2) {
456   Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
457     " argv0\"", (char *) NULL);
458   return TCL_ERROR;
459     }
460 
461     oldName       = tclExecutableName;
462     oldNativeName = tclNativeExecutableName;
463 
464     tclExecutableName       = NULL;
465     tclNativeExecutableName = NULL;
466 
467     Tcl_FindExecutable(argv[1]);
468     if (tclExecutableName != NULL) {
469   Tcl_SetResult(interp, tclExecutableName, TCL_VOLATILE);
470   ckfree(tclExecutableName);
471     }
472     if (tclNativeExecutableName != NULL) {
473   ckfree(tclNativeExecutableName);
474     }
475 
476     tclExecutableName       = oldName;
477     tclNativeExecutableName = oldNativeName;
478 
479     return TCL_OK;
480 }
static int TestgetdefencdirCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 589 of file tclUnixTest.c.
References NULL, TCL_ERROR, TCL_OK, and tclDefaultEncodingDir.
Referenced by TclplatformtestInit().594 {
595     if (argc != 1) {
596         Tcl_AppendResult(interp,
597                 "wrong # args: should be \"", argv[0],
598                 (char *) NULL);
599         return TCL_ERROR;
600     }
601 
602     if (tclDefaultEncodingDir != NULL) {
603         Tcl_AppendResult(interp, tclDefaultEncodingDir, (char *) NULL);
604     }
605     return TCL_OK;
606 }
static int TestgetopenfileCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 500 of file tclUnixTest.c.
References NULL, TCL_ERROR, Tcl_GetOpenFile(), and TCL_OK.
Referenced by TclplatformtestInit().505 {
506     ClientData filePtr;
507 
508     if (argc != 3) {
509         Tcl_AppendResult(interp,
510                 "wrong # args: should be \"", argv[0],
511                 " channelName forWriting\"",
512                 (char *) NULL);
513         return TCL_ERROR;
514     }
515     if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr)
516             == TCL_ERROR) {
517         return TCL_ERROR;
518     }
519     if (filePtr == (ClientData) NULL) {
520         Tcl_AppendResult(interp,
521                 "Tcl_GetOpenFile succeeded but FILE * NULL!", (char *) NULL);
522         return TCL_ERROR;
523     }
524     return TCL_OK;
525 }
static int TestgotsigCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 700 of file tclUnixTest.c.
References gotsig, NULL, and TCL_OK.
Referenced by TclplatformtestInit().705 {
706     Tcl_AppendResult(interp, gotsig, (char *) NULL);
707     gotsig = "0";
708     return TCL_OK;
709 }
static int TestsetdefencdirCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 545 of file tclUnixTest.c.
References ckalloc, ckfree, NULL, TCL_ERROR, TCL_OK, and tclDefaultEncodingDir.
Referenced by TclplatformtestInit().550 {
551     if (argc != 2) {
552         Tcl_AppendResult(interp,
553                 "wrong # args: should be \"", argv[0],
554                 " defaultDir\"",
555                 (char *) NULL);
556         return TCL_ERROR;
557     }
558 
559     if (tclDefaultEncodingDir != NULL) {
560   ckfree(tclDefaultEncodingDir);
561   tclDefaultEncodingDir = NULL;
562     }
563     if (*argv[1] != '\0') {
564   tclDefaultEncodingDir = (char *)
565       ckalloc((unsigned) strlen(argv[1]) + 1);
566   strcpy(tclDefaultEncodingDir, argv[1]);
567     }
568     return TCL_OK;
569 }

Variable Documentation
char* gotsig = "0" [static]

Definition at line 60 of file tclUnixTest.c.
Referenced by AlarmHandler(), and TestgotsigCmd().Pipe testPipes[MAX_PIPES] [static]

Definition at line 54 of file tclUnixTest.c.
Referenced by TestfilehandlerCmd().

unix/tclUnixThrd.c File Reference
#include "tclInt.h"
#include "tclPort.h"
Functions
int TclpThreadCreate (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags)
int Tcl_JoinThread (Tcl_ThreadId threadId, int *state)
Tcl_ThreadId Tcl_GetCurrentThread ()
void TclpInitLock ()
void TclFinalizeLock ()
void TclpInitUnlock ()
void TclpMasterLock ()
void TclpMasterUnlock ()
Tcl_Mutex * Tcl_GetAllocMutex ()
Tcl_DirEntry * TclpReaddir (DIR *dir)
char * TclpInetNtoa (struct in_addr addr)

Function Documentation
Tcl_Mutex* Tcl_GetAllocMutex ()

Definition at line 388 of file tclUnixThrd.c.
References NULL.389 {
390 #ifdef TCL_THREADS
391     return (Tcl_Mutex *)&allocLockPtr;
392 #else
393     return NULL;
394 #endif
395 }
Tcl_ThreadId Tcl_GetCurrentThread ()

Definition at line 218 of file tclUnixThrd.c.219 {
220 #ifdef TCL_THREADS
221     return (Tcl_ThreadId) pthread_self();
222 #else
223     return (Tcl_ThreadId) 0;
224 #endif
225 }
int Tcl_JoinThread (Tcl_ThreadId threadId, int* state)

Definition at line 160 of file tclUnixThrd.c.
References TCL_ERROR, TCL_OK, and VOID.165 {
166 #ifdef TCL_THREADS
167     int result;
168 
169     result = pthread_join ((pthread_t) threadId, (VOID**) state);
170     return (result == 0) ? TCL_OK : TCL_ERROR;
171 #else
172     return TCL_ERROR;
173 #endif
174 }
void TclFinalizeLock ()

Definition at line 274 of file tclUnixThrd.c.
References initLock.
Referenced by Tcl_Finalize().275 {
276 #ifdef TCL_THREADS
277     /*
278      * You do not need to destroy mutexes that were created with the
279      * PTHREAD_MUTEX_INITIALIZER macro.  These mutexes do not need
280      * any destruction: masterLock, allocLock, and initLock.
281      */
282     pthread_mutex_unlock(&initLock);
283 #endif
284 }
char* TclpInetNtoa (struct in_addr addr)

Definition at line 831 of file tclUnixThrd.c.
References dataKey, and TCL_TSD_INIT.832 {
833 #ifdef TCL_THREADS
834     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
835     union {
836       unsigned long l;
837       unsigned char b[4];
838     } u;
839     
840     u.l = (unsigned long) addr.s_addr;
841     sprintf(tsdPtr->nabuf, "%u.%u.%u.%u", u.b[0], u.b[1], u.b[2], u.b[3]);
842     return tsdPtr->nabuf;
843 #else
844     return inet_ntoa(addr);
845 #endif
846 }
void TclpInitLock ()

Definition at line 248 of file tclUnixThrd.c.
References initLock.249 {
250 #ifdef TCL_THREADS
251     pthread_mutex_lock(&initLock);
252 #endif
253 }
void TclpInitUnlock ()

Definition at line 304 of file tclUnixThrd.c.
References initLock.305 {
306 #ifdef TCL_THREADS
307     pthread_mutex_unlock(&initLock);
308 #endif
309 }
void TclpMasterLock ()

Definition at line 334 of file tclUnixThrd.c.
References masterLock.335 {
336 #ifdef TCL_THREADS
337     pthread_mutex_lock(&masterLock);
338 #endif
339 }
void TclpMasterUnlock ()

Definition at line 360 of file tclUnixThrd.c.
References masterLock.361 {
362 #ifdef TCL_THREADS
363     pthread_mutex_unlock(&masterLock);
364 #endif
365 }
Tcl_DirEntry* TclpReaddir (DIR * dir)

Definition at line 825 of file tclUnixThrd.c.
References TclOSreaddir.826 {
827     return TclOSreaddir(dir);
828 }
int TclpThreadCreate (Tcl_ThreadId * idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags)

Definition at line 80 of file tclUnixThrd.c.
References NULL, size_t(), TCL_ERROR, TCL_OK, TCL_THREAD_JOINABLE, and TCL_THREAD_STACK_DEFAULT.
Referenced by Tcl_CreateThread(), and Tcl_InitNotifier().87 {
88 #ifdef TCL_THREADS
89     pthread_attr_t attr;
90     pthread_t theThread;
91     int result;
92 
93     pthread_attr_init(&attr);
94     pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);
95 
96 #ifdef HAVE_PTHREAD_ATTR_SETSTACKSIZE
97     if (stackSize != TCL_THREAD_STACK_DEFAULT) {
98         pthread_attr_setstacksize(&attr, (size_t) stackSize);
99 #ifdef TCL_THREAD_STACK_MIN
100     } else {
101         /*
102    * Certain systems define a thread stack size that by default is
103    * too small for many operations.  The user has the option of
104    * defining TCL_THREAD_STACK_MIN to a value large enough to work
105    * for their needs.  This would look like (for 128K min stack):
106    *    make MEM_DEBUG_FLAGS=-DTCL_THREAD_STACK_MIN=131072L
107    *
108    * This solution is not optimal, as we should allow the user to
109    * specify a size at runtime, but we don't want to slow this function
110    * down, and that would still leave the main thread at the default.
111    */
112 
113         size_t size;
114   result = pthread_attr_getstacksize(&attr, &size);
115   if (!result && (size < TCL_THREAD_STACK_MIN)) {
116       pthread_attr_setstacksize(&attr, (size_t) TCL_THREAD_STACK_MIN);
117   }
118 #endif
119     }
120 #endif
121     if (! (flags & TCL_THREAD_JOINABLE)) {
122         pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED);
123     }
124 
125 
126     if (pthread_create(&theThread, &attr,
127       (void * (*)())proc, (void *)clientData) &&
128       pthread_create(&theThread, NULL,
129         (void * (*)())proc, (void *)clientData)) {
130   result = TCL_ERROR;
131     } else {
132   *idPtr = (Tcl_ThreadId)theThread;
133   result = TCL_OK;
134     }
135     pthread_attr_destroy(&attr);
136     return result;
137 #else
138     return TCL_ERROR;
139 #endif /* TCL_THREADS */
140 }

unix/tclUnixThrd.h File Reference

unix/tclUnixTime.c File Reference
#include "tclInt.h"
#include "tclPort.h"
#include <locale.h>
Classes
struct ThreadSpecificData
Defines
#define TM_YEAR_BASE  1900
#define IsLeapYear(x)  ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))
#define TCL_GOT_TIMEZONE  1
Functions
TCL_DECLARE_MUTEX (tmMutex)
unsigned long TclpGetClicks ()
int TclpGetTimeZone (Tcl_WideInt currentTime)
void Tcl_GetTime (Tcl_Time *timePtr)
tm * TclpGetDate (TclpTime_t time, int useGMT)
size_t TclpStrftime (char *s, size_t maxsize, CONST char *format, CONST struct tm *t, int useGMT)
tm * TclpGmtime (CONST TclpTime_t tt)
tm * TclpGmtime_unix (CONST TclpTime_t timePtr)
tm * TclpLocaltime (CONST TclpTime_t tt)
tm * TclpLocaltime_unix (CONST TclpTime_t timePtr)
static void SetTZIfNecessary ()
static void CleanupMemory (ClientData ignored)
Variables
static Tcl_ThreadDataKey tmKey

Define Documentation
#define IsLeapYear(x)  ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))

Definition at line 19 of file tclUnixTime.c.#define TCL_GOT_TIMEZONE  1
#define TM_YEAR_BASE  1900

Definition at line 18 of file tclUnixTime.c.
Function Documentation
static void CleanupMemory (ClientData ignored) [static]

Definition at line 489 of file tclUnixTime.c.
References Tcl_Free().
Referenced by SetTZIfNecessary().490 {
491     Tcl_Free( lastTZ );
492 }
static void SetTZIfNecessary () [static]

Definition at line 450 of file tclUnixTime.c.
References CleanupMemory(), CONST, NULL, Tcl_Alloc(), Tcl_CreateExitHandler(), Tcl_Free(), Tcl_MutexLock, Tcl_MutexUnlock, and tzset.
Referenced by TclpGetTimeZone(), and TclpLocaltime().450                    {
451 
452     CONST char* newTZ = getenv( "TZ" );
453     Tcl_MutexLock(&tmMutex);
454     if ( newTZ == NULL ) {
455   newTZ = "";
456     }
457     if ( lastTZ == NULL || strcmp( lastTZ, newTZ ) ) {
458         tzset();
459   if ( lastTZ == NULL ) {
460       Tcl_CreateExitHandler( CleanupMemory, (ClientData) NULL );
461   } else {
462       Tcl_Free( lastTZ );
463   }
464   lastTZ = Tcl_Alloc( strlen( newTZ ) + 1 );
465   strcpy( lastTZ, newTZ );
466     }
467     Tcl_MutexUnlock(&tmMutex);
468 
469 }
TCL_DECLARE_MUTEX (tmMutex)

Definition at line 38 of file tclUnixTime.c.58           :
59  *  Number of seconds from the epoch.
60  *
61  * Side effects:
62  *  None.
63  *
64  *-----------------------------------------------------------------------------
65  */
66 
67 unsigned long
68 TclpGetSeconds()
69 {
70     return time((time_t *) NULL);
71 }

void Tcl_GetTime (Tcl_Time * timePtr)

Definition at line 249 of file tclUnixTime.c.
References gettimeofday(), and void().251 {
252     struct timeval tv;
253     struct timezone tz;
254     
255     (void) gettimeofday(&tv, &tz);
256     timePtr->sec = tv.tv_sec;
257     timePtr->usec = tv.tv_usec;
258 }
unsigned long TclpGetClicks ()

Definition at line 93 of file tclUnixTime.c.
References gettimeofday().94 {
95     unsigned long now;
96 #ifdef NO_GETTOD
97     struct tms dummy;
98 #else
99     struct timeval date;
100     struct timezone tz;
101 #endif
102 
103 #ifdef NO_GETTOD
104     now = (unsigned long) times(&dummy);
105 #else
106     gettimeofday(&date, &tz);
107     now = date.tv_sec*1000000 + date.tv_usec;
108 #endif
109 
110     return now;
111 }
struct tm* TclpGetDate (TclpTime_t time, int useGMT)

Definition at line 279 of file tclUnixTime.c.
References TclpGmtime(), and TclpLocaltime().282 {
283     if (useGMT) {
284   return TclpGmtime(time);
285     } else {
286   return TclpLocaltime(time);
287     }
288 }
int TclpGetTimeZone (Tcl_WideInt currentTime)

Definition at line 133 of file tclUnixTime.c.
References SetTZIfNecessary(), and TclpLocaltime().135 {
136     /*
137      * We prefer first to use the time zone in "struct tm" if the
138      * structure contains such a member.  Following that, we try
139      * to locate the external 'timezone' variable and use its value.
140      * If both of those methods fail, we attempt to convert a known
141      * time to local time and use the difference from UTC as the local
142      * time zone.  In all cases, we need to undo any Daylight Saving Time
143      * adjustment.
144      */
145     
146 #if defined(HAVE_TM_TZADJ)
147 #   define TCL_GOT_TIMEZONE
148 
149     /* Struct tm contains tm_tzadj - that value may be used. */
150 
151     time_t      curTime = (time_t) currentTime;
152     struct tm  *timeDataPtr = TclpLocaltime((TclpTime_t) &curTime);
153     int         timeZone;
154 
155     timeZone = timeDataPtr->tm_tzadj  / 60;
156     if (timeDataPtr->tm_isdst) {
157         timeZone += 60;
158     }
159     
160     return timeZone;
161 
162 #endif
163 
164 #if defined(HAVE_TM_GMTOFF) && !defined (TCL_GOT_TIMEZONE)
165 #   define TCL_GOT_TIMEZONE
166 
167     /* Struct tm contains tm_gmtoff - that value may be used. */
168 
169     time_t     curTime = (time_t) currentTime;
170     struct tm *timeDataPtr = TclpLocaltime((TclpTime_t) &curTime);
171     int        timeZone;
172 
173     timeZone = -(timeDataPtr->tm_gmtoff / 60);
174     if (timeDataPtr->tm_isdst) {
175         timeZone += 60;
176     }
177     
178     return timeZone;
179 
180 #endif
181 
182 #if defined(HAVE_TIMEZONE_VAR) && !defined(TCL_GOT_TIMEZONE) && !defined(USE_DELTA_FOR_TZ)
183 #   define TCL_GOT_TIMEZONE
184 
185     int        timeZone;
186 
187     /* The 'timezone' external var is present and may be used. */
188 
189     SetTZIfNecessary();
190 
191     /*
192      * Note: this is not a typo in "timezone" below!  See tzset
193      * documentation for details.
194      */
195 
196     timeZone = timezone / 60;
197     return timeZone;
198 
199 #endif
200 
201 #if !defined(TCL_GOT_TIMEZONE) 
202 #define TCL_GOT_TIMEZONE 1
203     /*
204      * Fallback - determine time zone with a known reference time.
205      */
206 
207     int timeZone;
208     time_t tt;
209     struct tm *stm;
210     tt = 849268800L;      /*    1996-11-29 12:00:00  GMT */
211     stm = TclpLocaltime((TclpTime_t) &tt); /* eg 1996-11-29  6:00:00  CST6CDT */
212     /* The calculation below assumes a max of +12 or -12 hours from GMT */
213     timeZone = (12 - stm->tm_hour)*60 + (0 - stm->tm_min);
214     if ( stm -> tm_isdst ) {
215         timeZone += 60;
216     }
217     return timeZone;  /* eg +360 for CST6CDT */
218 #endif
219 
220 #ifndef TCL_GOT_TIMEZONE
221     /*
222      * Cause compile error, we don't know how to get timezone.
223      */
224 
225 #error autoconf did not figure out how to determine the timezone. 
226 
227 #endif
228 
229 }
struct tm* TclpGmtime (CONST TclpTime_t tt)

Definition at line 346 of file tclUnixTime.c.
References CONST, ThreadSpecificData::gmtime_buf, Tcl_MutexLock, Tcl_MutexUnlock, TCL_TSD_INIT, tmKey, and VOID.
Referenced by TclpGetDate(), and TclpGmtime_unix().348 {
349     CONST time_t *timePtr = (CONST time_t *) tt;
350         /* Pointer to the number of seconds
351          * since the local system's epoch */
352 
353     /*
354      * Get a thread-local buffer to hold the returned time.
355      */
356 
357     ThreadSpecificData *tsdPtr = TCL_TSD_INIT( &tmKey );
358 #ifdef HAVE_GMTIME_R
359     gmtime_r(timePtr, &( tsdPtr->gmtime_buf ));
360 #else
361     Tcl_MutexLock( &tmMutex );
362     memcpy( (VOID *) &( tsdPtr->gmtime_buf ),
363       (VOID *) gmtime( timePtr ),
364       sizeof( struct tm ) );
365     Tcl_MutexUnlock( &tmMutex );
366 #endif    
367     return &( tsdPtr->gmtime_buf );
368 }
struct tm* TclpGmtime_unix (CONST TclpTime_t timePtr)

Definition at line 373 of file tclUnixTime.c.
References TclpGmtime().375 {
376     return TclpGmtime( timePtr );
377 }
struct tm* TclpLocaltime (CONST TclpTime_t tt)

Definition at line 397 of file tclUnixTime.c.
References CONST, ThreadSpecificData::localtime_buf, SetTZIfNecessary(), Tcl_MutexLock, Tcl_MutexUnlock, TCL_TSD_INIT, tmKey, and VOID.
Referenced by TclpGetDate(), TclpGetTimeZone(), and TclpLocaltime_unix().399 {
400     CONST time_t *timePtr = (CONST time_t *) tt;
401         /* Pointer to the number of seconds
402          * since the local system's epoch */
403     /*
404      * Get a thread-local buffer to hold the returned time.
405      */
406 
407     ThreadSpecificData *tsdPtr = TCL_TSD_INIT( &tmKey );
408     SetTZIfNecessary();
409 #ifdef HAVE_LOCALTIME_R
410     localtime_r( timePtr, &( tsdPtr->localtime_buf ) );
411 #else
412     Tcl_MutexLock( &tmMutex );
413     memcpy( (VOID *) &( tsdPtr -> localtime_buf ),
414       (VOID *) localtime( timePtr ),
415       sizeof( struct tm ) );
416     Tcl_MutexUnlock( &tmMutex );
417 #endif    
418     return &( tsdPtr->localtime_buf );
419 }
struct tm* TclpLocaltime_unix (CONST TclpTime_t timePtr)

Definition at line 424 of file tclUnixTime.c.
References TclpLocaltime().426 {
427     return TclpLocaltime( timePtr );
428 }
size_t TclpStrftime (char * s, size_t maxsize, CONST char * format, CONST struct tm * t, int useGMT)

Definition at line 308 of file tclUnixTime.c.
References IsLeapYear, and TM_YEAR_BASE.314 {
315     if (format[0] == '%' && format[1] == 'Q') {
316   /* Format as a stardate */
317   sprintf(s, "Stardate %2d%03d.%01d",
318     (((t->tm_year + TM_YEAR_BASE) + 377) - 2323),
319     (((t->tm_yday + 1) * 1000) /
320       (365 + IsLeapYear((t->tm_year + TM_YEAR_BASE)))),
321     (((t->tm_hour * 60) + t->tm_min)/144));
322   return(strlen(s));
323     }
324     setlocale(LC_TIME, "");
325     return strftime(s, maxsize, format, t);
326 }

Variable Documentation
Tcl_ThreadDataKey tmKey [static]

Definition at line 27 of file tclUnixTime.c.
Referenced by TclpGmtime(), and TclpLocaltime().

unix/tclXtNotify.c File Reference
#include <X11/Intrinsic.h>
#include <tclInt.h>
Classes
struct FileHandler
struct FileHandlerEvent
struct NotifierState
Functions
static int FileHandlerEventProc _ANSI_ARGS_ ((Tcl_Event *evPtr, int flags))
static void FileProc _ANSI_ARGS_ ((caddr_t clientData, int *source, XtInputId *id))
void InitNotifier _ANSI_ARGS_ ((void))
static void NotifierExitHandler _ANSI_ARGS_ ((ClientData clientData))
static void TimerProc _ANSI_ARGS_ ((caddr_t clientData, XtIntervalId *id))
static void CreateFileHandler _ANSI_ARGS_ ((int fd, int mask, Tcl_FileProc *proc, ClientData clientData))
static void DeleteFileHandler _ANSI_ARGS_ ((int fd))
static void SetTimer _ANSI_ARGS_ ((Tcl_Time *timePtr))
EXTERN XtAppContext TclSetAppContext _ANSI_ARGS_ ((XtAppContext ctx))
XtAppContext TclSetAppContext (XtAppContext appContext)
void InitNotifier ()
static void NotifierExitHandler (ClientData clientData)
static void SetTimer (Tcl_Time *timePtr)
static void TimerProc (caddr_t data, XtIntervalId *id)
static void CreateFileHandler (int fd, int mask, Tcl_FileProc *proc, ClientData clientData)
static void DeleteFileHandler (int fd)
static void FileProc (caddr_t clientData, int *fd, XtInputId *id)
static int FileHandlerEventProc (Tcl_Event *evPtr, int flags)
static int WaitForEvent (Tcl_Time *timePtr)
Variables
static struct NotifierState notifier
static int initialized = 0

Function Documentation
EXTERN XtAppContext TclSetAppContext _ANSI_ARGS_ ((XtAppContext ctx))
static void SetTimer _ANSI_ARGS_ ((Tcl_Time *timePtr)) [static]
static void DeleteFileHandler _ANSI_ARGS_ ((int fd)) [static]
static void CreateFileHandler _ANSI_ARGS_ ((int fd, int mask, Tcl_FileProc *proc, ClientData clientData)) [static]
static void TimerProc _ANSI_ARGS_ ((caddr_t clientData, XtIntervalId *id)) [static]
static void NotifierExitHandler _ANSI_ARGS_ ((ClientData clientData)) [static]
void InitNotifier _ANSI_ARGS_ ((void))
static void FileProc _ANSI_ARGS_ ((caddr_t clientData, int *source, XtInputId *id)) [static]
static int FileHandlerEventProc _ANSI_ARGS_ ((Tcl_Event *evPtr, int flags)) [static]
static void CreateFileHandler (int fd, int mask, Tcl_FileProc * proc, ClientData clientData) [static]

Definition at line 341 of file tclXtNotify.c.
References ckalloc, FileHandler::clientData, FileHandler::except, FileHandler::fd, FileProc(), initialized, InitNotifier(), FileHandler::mask, FileHandler::nextPtr, notifier, NULL, FileHandler::proc, FileHandler::read, FileHandler::readyMask, TCL_EXCEPTION, TCL_READABLE, TCL_WRITABLE, TclSetAppContext(), and FileHandler::write.
Referenced by InitNotifier().344                                           :
345          * indicates conditions under which
346          * proc should be called. */
347     Tcl_FileProc *proc;   /* Procedure to call for each
348          * selected event. */
349     ClientData clientData;  /* Arbitrary data to pass to proc. */
350 {
351     FileHandler *filePtr;
352 
353     if (!initialized) {
354   InitNotifier();
355     }
356 
357     TclSetAppContext(NULL);
358 
359     for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
360       filePtr = filePtr->nextPtr) {
361   if (filePtr->fd == fd) {
362       break;
363   }
364     }
365     if (filePtr == NULL) {
366   filePtr = (FileHandler*) ckalloc(sizeof(FileHandler));
367   filePtr->fd = fd;
368   filePtr->read = 0;
369   filePtr->write = 0;
370   filePtr->except = 0;
371   filePtr->readyMask = 0;
372   filePtr->mask = 0;
373   filePtr->nextPtr = notifier.firstFileHandlerPtr;
374   notifier.firstFileHandlerPtr = filePtr;
375     }
376     filePtr->proc = proc;
377     filePtr->clientData = clientData;
378 
379     /*
380      * Register the file with the Xt notifier, if it hasn't been done yet.
381      */
382 
383     if (mask & TCL_READABLE) {
384   if (!(filePtr->mask & TCL_READABLE)) {
385       filePtr->read =
386                 XtAppAddInput(notifier.appContext, fd, XtInputReadMask,
387                         FileProc, filePtr);
388   }
389     } else {
390   if (filePtr->mask & TCL_READABLE) {
391       XtRemoveInput(filePtr->read);
392   }
393     }
394     if (mask & TCL_WRITABLE) {
395   if (!(filePtr->mask & TCL_WRITABLE)) {
396       filePtr->write =
397                 XtAppAddInput(notifier.appContext, fd, XtInputWriteMask,
398                         FileProc, filePtr);
399   }
400     } else {
401   if (filePtr->mask & TCL_WRITABLE) {
402       XtRemoveInput(filePtr->write);
403   }
404     }
405     if (mask & TCL_EXCEPTION) {
406   if (!(filePtr->mask & TCL_EXCEPTION)) {
407       filePtr->except =
408                 XtAppAddInput(notifier.appContext, fd, XtInputExceptMask,
409                         FileProc, filePtr);
410   }
411     } else {
412   if (filePtr->mask & TCL_EXCEPTION) {
413       XtRemoveInput(filePtr->except);
414   }
415     }
416     filePtr->mask = mask;
417 }

static void DeleteFileHandler (int fd) [static]

Definition at line 437 of file tclXtNotify.c.
References ckfree, FileHandler::except, FileHandler::fd, initialized, InitNotifier(), FileHandler::mask, FileHandler::nextPtr, notifier, NULL, FileHandler::read, TCL_EXCEPTION, TCL_READABLE, TCL_WRITABLE, TclSetAppContext(), and FileHandler::write.
Referenced by InitNotifier().440 {
441     FileHandler *filePtr, *prevPtr;
442 
443     if (!initialized) {
444   InitNotifier();
445     }
446 
447     TclSetAppContext(NULL);
448 
449     /*
450      * Find the entry for the given file (and return if there
451      * isn't one).
452      */
453 
454     for (prevPtr = NULL, filePtr = notifier.firstFileHandlerPtr; ;
455       prevPtr = filePtr, filePtr = filePtr->nextPtr) {
456   if (filePtr == NULL) {
457       return;
458   }
459   if (filePtr->fd == fd) {
460       break;
461   }
462     }
463 
464     /*
465      * Clean up information in the callback record.
466      */
467 
468     if (prevPtr == NULL) {
469   notifier.firstFileHandlerPtr = filePtr->nextPtr;
470     } else {
471   prevPtr->nextPtr = filePtr->nextPtr;
472     }
473     if (filePtr->mask & TCL_READABLE) {
474   XtRemoveInput(filePtr->read);
475     }
476     if (filePtr->mask & TCL_WRITABLE) {
477   XtRemoveInput(filePtr->write);
478     }
479     if (filePtr->mask & TCL_EXCEPTION) {
480   XtRemoveInput(filePtr->except);
481     }
482     ckfree((char *) filePtr);
483 }
static int FileHandlerEventProc (Tcl_Event * evPtr, int flags) [static]

Definition at line 573 of file tclXtNotify.c.
References FileHandler::clientData, FileHandlerEvent::fd, FileHandler::fd, FileHandler::mask, FileHandler::nextPtr, notifier, NULL, FileHandler::proc, FileHandler::readyMask, and TCL_FILE_EVENTS.577 {
578     FileHandler *filePtr;
579     FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) evPtr;
580     int mask;
581 
582     if (!(flags & TCL_FILE_EVENTS)) {
583   return 0;
584     }
585 
586     /*
587      * Search through the file handlers to find the one whose handle matches
588      * the event.  We do this rather than keeping a pointer to the file
589      * handler directly in the event, so that the handler can be deleted
590      * while the event is queued without leaving a dangling pointer.
591      */
592 
593     for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
594       filePtr = filePtr->nextPtr) {
595   if (filePtr->fd != fileEvPtr->fd) {
596       continue;
597   }
598 
599   /*
600    * The code is tricky for two reasons:
601    * 1. The file handler's desired events could have changed
602    *    since the time when the event was queued, so AND the
603    *    ready mask with the desired mask.
604    * 2. The file could have been closed and re-opened since
605    *    the time when the event was queued.  This is why the
606    *    ready mask is stored in the file handler rather than
607    *    the queued event:  it will be zeroed when a new
608    *    file handler is created for the newly opened file.
609    */
610 
611   mask = filePtr->readyMask & filePtr->mask;
612   filePtr->readyMask = 0;
613   if (mask != 0) {
614       (*filePtr->proc)(filePtr->clientData, mask);
615   }
616   break;
617     }
618     return 1;
619 }
static void FileProc (caddr_t clientData, int * fd, XtInputId * id) [static]

Definition at line 504 of file tclXtNotify.c.
References ckalloc, FileHandler::except, FileHandler::fd, FileHandlerEvent::fd, FileHandlerEventProc(), FileHandlerEvent::header, FileHandler::mask, Tcl_Event::proc, FileHandler::read, FileHandler::readyMask, TCL_EXCEPTION, TCL_QUEUE_TAIL, Tcl_QueueEvent(), TCL_READABLE, Tcl_ServiceAll(), TCL_WRITABLE, and FileHandler::write.
Referenced by CreateFileHandler().508 {
509     FileHandler *filePtr = (FileHandler *)clientData;
510     FileHandlerEvent *fileEvPtr;
511     int mask = 0;
512 
513     /*
514      * Determine which event happened.
515      */
516 
517     if (*id == filePtr->read) {
518   mask = TCL_READABLE;
519     } else if (*id == filePtr->write) {
520   mask = TCL_WRITABLE;
521     } else if (*id == filePtr->except) {
522   mask = TCL_EXCEPTION;
523     }
524 
525     /*
526      * Ignore unwanted or duplicate events.
527      */
528 
529     if (!(filePtr->mask & mask) || (filePtr->readyMask & mask)) {
530   return;
531     }
532     
533     /*
534      * This is an interesting event, so put it onto the event queue.
535      */
536 
537     filePtr->readyMask |= mask;
538     fileEvPtr = (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent));
539     fileEvPtr->header.proc = FileHandlerEventProc;
540     fileEvPtr->fd = filePtr->fd;
541     Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
542 
543     /*
544      * Process events on the Tcl event queue before returning to Xt.
545      */
546 
547     Tcl_ServiceAll();
548 }
void InitNotifier (void)

Definition at line 189 of file tclXtNotify.c.
References CreateFileHandler(), DeleteFileHandler(), initialized, notifier, NotifierExitHandler(), NULL, SetTimer(), Tcl_CreateExitHandler(), Tcl_SetNotifier(), TclInExit(), and WaitForEvent().190 {
191     Tcl_NotifierProcs notifier;
192     /*
193      * Only reinitialize if we are not in exit handling. The notifier
194      * can get reinitialized after its own exit handler has run, because
195      * of exit handlers for the I/O and timer sub-systems (order dependency).
196      */
197 
198     if (TclInExit()) {
199         return;
200     }
201 
202     notifier.createFileHandlerProc = CreateFileHandler;
203     notifier.deleteFileHandlerProc = DeleteFileHandler;
204     notifier.setTimerProc = SetTimer;
205     notifier.waitForEventProc = WaitForEvent;
206     Tcl_SetNotifier(&notifier);
207 
208     /*
209      * DO NOT create the application context yet; doing so would prevent
210      * external applications from setting it for us to their own ones.
211      */
212     
213     initialized = 1;
214     memset(&notifier, 0, sizeof(notifier));
215     Tcl_CreateExitHandler(NotifierExitHandler, NULL);
216 }
static void NotifierExitHandler (ClientData clientData) [static]

Definition at line 236 of file tclXtNotify.c.
References notifier, NULL, and Tcl_DeleteFileHandler().238 {
239     if (notifier.currentTimeout != 0) {
240         XtRemoveTimeOut(notifier.currentTimeout);
241     }
242     for (; notifier.firstFileHandlerPtr != NULL; ) {
243         Tcl_DeleteFileHandler(notifier.firstFileHandlerPtr->fd);
244     }
245     if (notifier.appContextCreated) {
246         XtDestroyApplicationContext(notifier.appContext);
247         notifier.appContextCreated = 0;
248         notifier.appContext = NULL;
249     }
250     initialized = 0;
251 }
static void SetTimer (Tcl_Time * timePtr) [static]

Definition at line 270 of file tclXtNotify.c.
References initialized, InitNotifier(), notifier, NULL, TclSetAppContext(), and TimerProc().
Referenced by InitNotifier(), and Tcl_SetTimer().272 {
273     long timeout;
274 
275     if (!initialized) {
276   InitNotifier();
277     }
278 
279     TclSetAppContext(NULL);
280     if (notifier.currentTimeout != 0) {
281   XtRemoveTimeOut(notifier.currentTimeout);
282     }
283     if (timePtr) {
284   timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
285   notifier.currentTimeout =
286             XtAppAddTimeOut(notifier.appContext, (unsigned long) timeout,
287                     TimerProc, NULL);
288     } else {
289   notifier.currentTimeout = 0;
290     }
291 }
XtAppContext TclSetAppContext (XtAppContext appContext)

Definition at line 117 of file tclXtNotify.c.
References initialized, InitNotifier(), notifier, NULL, and panic.
Referenced by CreateFileHandler(), DeleteFileHandler(), SetTimer(), TesteventloopCmd(), and WaitForEvent().119 {
120     if (!initialized) {
121         InitNotifier();
122     }
123 
124     /*
125      * If we already have a context we check whether we were asked to set a
126      * new context. If so, we panic because we try to prevent switching
127      * contexts by mistake. Otherwise, we return the one we have.
128      */
129     
130     if (notifier.appContext != NULL) {
131         if (appContext != NULL) {
132 
133       /*
134              * We already have a context. We do not allow switching contexts
135              * after initialization, so we panic.
136              */
137         
138             panic("TclSetAppContext:  multiple application contexts");
139 
140         }
141     } else {
142 
143         /*
144          * If we get here we have not yet gotten a context, so either create
145          * one or use the one supplied by our caller.
146          */
147 
148         if (appContext == NULL) {
149 
150       /*
151              * We must create a new context and tell our caller what it is, so
152              * she can use it too.
153              */
154     
155             notifier.appContext = XtCreateApplicationContext();
156             notifier.appContextCreated = 1;
157         } else {
158 
159       /*
160              * Otherwise we remember the context that our caller gave us
161              * and use it.
162              */
163     
164             notifier.appContextCreated = 0;
165             notifier.appContext = appContext;
166         }
167     }
168     
169     return notifier.appContext;
170 }
static void TimerProc (caddr_t data, XtIntervalId * id) [static]

Definition at line 311 of file tclXtNotify.c.
References notifier, and Tcl_ServiceAll().
Referenced by SetTimer().314 {
315     if (*id != notifier.currentTimeout) {
316   return;
317     }
318     notifier.currentTimeout = 0;
319 
320     Tcl_ServiceAll();
321 }
static int WaitForEvent (Tcl_Time * timePtr) [static]

Definition at line 642 of file tclXtNotify.c.
References initialized, InitNotifier(), notifier, NULL, Tcl_Time::sec, Tcl_SetTimer(), TclSetAppContext(), and Tcl_Time::usec.
Referenced by InitNotifier().644 {
645     int timeout;
646 
647     if (!initialized) {
648   InitNotifier();
649     }
650 
651     TclSetAppContext(NULL);
652 
653     if (timePtr) {
654         timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
655         if (timeout == 0) {
656             if (XtAppPending(notifier.appContext)) {
657                 goto process;
658             } else {
659                 return 0;
660             }
661         } else {
662             Tcl_SetTimer(timePtr);
663         }
664     }
665 process:
666     XtAppProcessEvent(notifier.appContext, XtIMAll);
667     return 1;
668 }

Variable Documentation
int initialized = 0 [static]

Definition at line 72 of file tclXtNotify.c.struct NotifierState  notifier [static]

unix/tclXtTest.c File Reference
#include <X11/Intrinsic.h>
#include "tcl.h"
Functions
static int TesteventloopCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv))
void InitNotifier _ANSI_ARGS_ ((void))
int Tclxttest_Init (Tcl_Interp *interp)
static int TesteventloopCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)

Function Documentation
void InitNotifier _ANSI_ARGS_ ((void))
static int TesteventloopCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv)) [static]
int Tclxttest_Init (Tcl_Interp * interp)

Definition at line 42 of file tclXtTest.c.
References InitNotifier(), NULL, Tcl_CreateCommand(), TCL_ERROR, Tcl_InitStubs, TCL_OK, TCL_VERSION, and TesteventloopCmd().
Referenced by Tcl_AppInit().44 {
45     if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
46   return TCL_ERROR;
47     }
48     XtToolkitInitialize();
49     InitNotifier();
50     Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
51             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
52     return TCL_OK;
53 }
static int TesteventloopCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST char ** argv) [static]

Definition at line 74 of file tclXtTest.c.
References NULL, TCL_ERROR, TCL_OK, TCL_SERVICE_ALL, Tcl_SetServiceMode(), TclSetAppContext(), and void().
Referenced by TclplatformtestInit(), and Tclxttest_Init().79 {
80     static int *framePtr = NULL; /* Pointer to integer on stack frame of
81           * innermost invocation of the "wait"
82           * subcommand. */
83 
84    if (argc < 2) {
85   Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
86                 " option ... \"", (char *) NULL);
87         return TCL_ERROR;
88     }
89     if (strcmp(argv[1], "done") == 0) {
90   *framePtr = 1;
91     } else if (strcmp(argv[1], "wait") == 0) {
92   int *oldFramePtr;
93   int done;
94   int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
95 
96   /*
97    * Save the old stack frame pointer and set up the current frame.
98    */
99 
100   oldFramePtr = framePtr;
101   framePtr = &done;
102 
103   /*
104    * Enter an Xt event loop until the flag changes.
105    * Note that we do not explicitly call Tcl_ServiceEvent().
106    */
107 
108   done = 0;
109   while (!done) {
110       XtAppProcessEvent(TclSetAppContext(NULL), XtIMAll);
111   }
112   (void) Tcl_SetServiceMode(oldMode);
113   framePtr = oldFramePtr;
114     } else {
115   Tcl_AppendResult(interp, "bad option \"", argv[1],
116     "\": must be done or wait", (char *) NULL);
117   return TCL_ERROR;
118     }
119     return TCL_OK;
120 }

win/cat.c File Reference
#include <stdio.h>
#include <io.h>
#include <string.h>
Functions
int main ()

Function Documentation
int main ()

Definition at line 19 of file cat.c.20 {   
21     char buf[1024];
22     int n;
23     char *err;
24 
25     while (1) {
26   n = read(0, buf, sizeof(buf));
27   if (n <= 0) {
28       break;
29   }
30         write(1, buf, n);
31     }
32     err = (sizeof(int) == 2) ? "stderr16" : "stderr32";
33     write(2, err, strlen(err));
34 
35     return 0;
36 }

win/nmakehlp.c File Reference
#include <windows.h>
#include <stdio.h>
#include <math.h>
Classes
struct pipeinfo
Defines
#define _CRT_SECURE_NO_DEPRECATE
#define CHUNK  25
#define STATICBUFFERSIZE  1000
Functions
int CheckForCompilerFeature (const char *option)
int CheckForLinkerFeature (const char *option)
int IsIn (const char *string, const char *substring)
int GrepForDefine (const char *file, const char *string)
DWORD WINAPI ReadFromPipe (LPVOID args)
int main (int argc, char *argv[])
Variables
pipeinfo Out = {INVALID_HANDLE_VALUE, '\0'}
pipeinfo Err = {INVALID_HANDLE_VALUE, '\0'}

Define Documentation
#define _CRT_SECURE_NO_DEPRECATE

Definition at line 17 of file nmakehlp.c.#define CHUNK  25

Definition at line 44 of file nmakehlp.c.
Referenced by ReadFromPipe().#define STATICBUFFERSIZE  1000

Definition at line 45 of file nmakehlp.c.
Referenced by ReadFromPipe().
Function Documentation
int CheckForCompilerFeature (const char * option)

Definition at line 146 of file nmakehlp.c.
References BOOL(), pipeinfo::buffer, DWORD(), Err, FALSE, NULL, Out, pipeinfo::pipe, ReadFromPipe(), strstr(), and TRUE.
Referenced by main().148 {
149     STARTUPINFO si;
150     PROCESS_INFORMATION pi;
151     SECURITY_ATTRIBUTES sa;
152     DWORD threadID;
153     char msg[300];
154     BOOL ok;
155     HANDLE hProcess, h, pipeThreads[2];
156     char cmdline[100];
157 
158     hProcess = GetCurrentProcess();
159 
160     ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
161     ZeroMemory(&si, sizeof(STARTUPINFO));
162     si.cb = sizeof(STARTUPINFO);
163     si.dwFlags   = STARTF_USESTDHANDLES;
164     si.hStdInput = INVALID_HANDLE_VALUE;
165 
166     ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
167     sa.nLength = sizeof(SECURITY_ATTRIBUTES);
168     sa.lpSecurityDescriptor = NULL;
169     sa.bInheritHandle = FALSE;
170 
171     /*
172      * Create a non-inheritible pipe.
173      */
174 
175     CreatePipe(&Out.pipe, &h, &sa, 0);
176 
177     /*
178      * Dupe the write side, make it inheritible, and close the original.
179      */
180 
181     DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE,
182       DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
183 
184     /*
185      * Same as above, but for the error side.
186      */
187 
188     CreatePipe(&Err.pipe, &h, &sa, 0);
189     DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE,
190       DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
191 
192     /*
193      * Base command line.
194      */
195 
196     lstrcpy(cmdline, "cl.exe -nologo -c -TC -Zs -X ");
197 
198     /*
199      * Append our option for testing
200      */
201 
202     lstrcat(cmdline, option);
203 
204     /*
205      * Filename to compile, which exists, but is nothing and empty.
206      */
207 
208     lstrcat(cmdline, " .\\nul");
209 
210     ok = CreateProcess(
211       NULL,     /* Module name. */
212       cmdline,      /* Command line. */
213       NULL,     /* Process handle not inheritable. */
214       NULL,     /* Thread handle not inheritable. */
215       TRUE,     /* yes, inherit handles. */
216       DETACHED_PROCESS, /* No console for you. */
217       NULL,     /* Use parent's environment block. */
218       NULL,     /* Use parent's starting directory. */
219       &si,      /* Pointer to STARTUPINFO structure. */
220       &pi);     /* Pointer to PROCESS_INFORMATION structure. */
221 
222     if (!ok) {
223   DWORD err = GetLastError();
224   int chars = snprintf(msg, sizeof(msg) - 1,
225     "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
226 
227   FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
228     FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars],
229     (300-chars), 0);
230   WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
231   return 2;
232     }
233 
234     /*
235      * Close our references to the write handles that have now been inherited.
236      */
237 
238     CloseHandle(si.hStdOutput);
239     CloseHandle(si.hStdError);
240 
241     WaitForInputIdle(pi.hProcess, 5000);
242     CloseHandle(pi.hThread);
243 
244     /*
245      * Start the pipe reader threads.
246      */
247 
248     pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID);
249     pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID);
250 
251     /*
252      * Block waiting for the process to end.
253      */
254 
255     WaitForSingleObject(pi.hProcess, INFINITE);
256     CloseHandle(pi.hProcess);
257 
258     /*
259      * Wait for our pipe to get done reading, should it be a little slow.
260      */
261 
262     WaitForMultipleObjects(2, pipeThreads, TRUE, 500);
263     CloseHandle(pipeThreads[0]);
264     CloseHandle(pipeThreads[1]);
265 
266     /*
267      * Look for the commandline warning code in both streams.
268      *  - in MSVC 6 & 7 we get D4002, in MSVC 8 we get D9002.
269      */
270 
271     return !(strstr(Out.buffer, "D4002") != NULL
272              || strstr(Err.buffer, "D4002") != NULL
273              || strstr(Out.buffer, "D9002") != NULL
274              || strstr(Err.buffer, "D9002") != NULL);
275 }
int CheckForLinkerFeature (const char * option)

Definition at line 278 of file nmakehlp.c.
References BOOL(), pipeinfo::buffer, DWORD(), Err, NULL, Out, pipeinfo::pipe, ReadFromPipe(), strstr(), and TRUE.
Referenced by main().280 {
281     STARTUPINFO si;
282     PROCESS_INFORMATION pi;
283     SECURITY_ATTRIBUTES sa;
284     DWORD threadID;
285     char msg[300];
286     BOOL ok;
287     HANDLE hProcess, h, pipeThreads[2];
288     char cmdline[100];
289 
290     hProcess = GetCurrentProcess();
291 
292     ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
293     ZeroMemory(&si, sizeof(STARTUPINFO));
294     si.cb = sizeof(STARTUPINFO);
295     si.dwFlags   = STARTF_USESTDHANDLES;
296     si.hStdInput = INVALID_HANDLE_VALUE;
297 
298     ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
299     sa.nLength = sizeof(SECURITY_ATTRIBUTES);
300     sa.lpSecurityDescriptor = NULL;
301     sa.bInheritHandle = TRUE;
302 
303     /*
304      * Create a non-inheritible pipe.
305      */
306 
307     CreatePipe(&Out.pipe, &h, &sa, 0);
308 
309     /*
310      * Dupe the write side, make it inheritible, and close the original.
311      */
312 
313     DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE,
314       DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
315 
316     /*
317      * Same as above, but for the error side.
318      */
319 
320     CreatePipe(&Err.pipe, &h, &sa, 0);
321     DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE,
322       DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
323 
324     /*
325      * Base command line.
326      */
327 
328     lstrcpy(cmdline, "link.exe -nologo ");
329 
330     /*
331      * Append our option for testing.
332      */
333 
334     lstrcat(cmdline, option);
335 
336     ok = CreateProcess(
337       NULL,     /* Module name. */
338       cmdline,      /* Command line. */
339       NULL,     /* Process handle not inheritable. */
340       NULL,     /* Thread handle not inheritable. */
341       TRUE,     /* yes, inherit handles. */
342       DETACHED_PROCESS, /* No console for you. */
343       NULL,     /* Use parent's environment block. */
344       NULL,     /* Use parent's starting directory. */
345       &si,      /* Pointer to STARTUPINFO structure. */
346       &pi);     /* Pointer to PROCESS_INFORMATION structure. */
347 
348     if (!ok) {
349   DWORD err = GetLastError();
350   int chars = snprintf(msg, sizeof(msg) - 1,
351     "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
352 
353   FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
354     FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars],
355     (300-chars), 0);
356   WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
357   return 2;
358     }
359 
360     /*
361      * Close our references to the write handles that have now been inherited.
362      */
363 
364     CloseHandle(si.hStdOutput);
365     CloseHandle(si.hStdError);
366 
367     WaitForInputIdle(pi.hProcess, 5000);
368     CloseHandle(pi.hThread);
369 
370     /*
371      * Start the pipe reader threads.
372      */
373 
374     pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID);
375     pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID);
376 
377     /*
378      * Block waiting for the process to end.
379      */
380 
381     WaitForSingleObject(pi.hProcess, INFINITE);
382     CloseHandle(pi.hProcess);
383 
384     /*
385      * Wait for our pipe to get done reading, should it be a little slow.
386      */
387 
388     WaitForMultipleObjects(2, pipeThreads, TRUE, 500);
389     CloseHandle(pipeThreads[0]);
390     CloseHandle(pipeThreads[1]);
391 
392     /*
393      * Look for the commandline warning code in the stderr stream.
394      */
395 
396     return !(strstr(Out.buffer, "LNK1117") != NULL ||
397              strstr(Err.buffer, "LNK1117") != NULL ||
398              strstr(Out.buffer, "LNK4044") != NULL ||
399              strstr(Err.buffer, "LNK4044") != NULL);
400 }
int GrepForDefine (const char * file, const char * string)

Definition at line 442 of file nmakehlp.c.
References fopen, and NULL.
Referenced by main().445 {
446     FILE *f;
447     char s1[51], s2[51], s3[51];
448     int r = 0;
449     double d1;
450 
451     f = fopen(file, "rt");
452     if (f == NULL) {
453   return 0;
454     }
455 
456     do {
457   r = fscanf(f, "%50s", s1);
458   if (r == 1 && !strcmp(s1, "#define")) {
459       /*
460        * Get next two words.
461        */
462 
463       r = fscanf(f, "%50s %50s", s2, s3);
464       if (r != 2) {
465     continue;
466       }
467 
468       /*
469        * Is the first word what we're looking for?
470        */
471 
472       if (!strcmp(s2, string)) {
473     fclose(f);
474 
475     /*
476      * Add 1 past first double quote char. "8.5"
477      */
478 
479     d1 = atof(s3 + 1);      /*    8.5  */
480     while (floor(d1) != d1) {
481         d1 *= 10.0;
482     }
483     return ((int) d1);      /*    85   */
484       }
485   }
486     } while (!feof(f));
487 
488     fclose(f);
489     return 0;
490 }
int IsIn (const char * string, const char * substring)

Definition at line 428 of file nmakehlp.c.
References NULL, and strstr().
Referenced by main().431 {
432     return (strstr(string, substring) != NULL);
433 }
int main (int argc, char * argv[])

Definition at line 59 of file nmakehlp.c.
References CheckForCompilerFeature(), CheckForLinkerFeature(), DWORD(), GrepForDefine(), IsIn(), and NULL.62 {
63     char msg[300];
64     DWORD dwWritten;
65     int chars;
66 
67     /*
68      * Make sure children (cl.exe and link.exe) are kept quiet.
69      */
70 
71     SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOOPENFILEERRORBOX);
72 
73     /*
74      * Make sure the compiler and linker aren't effected by the outside world.
75      */
76 
77     SetEnvironmentVariable("CL", "");
78     SetEnvironmentVariable("LINK", "");
79 
80     if (argc > 1 && *argv[1] == '-') {
81   switch (*(argv[1]+1)) {
82   case 'c':
83       if (argc != 3) {
84     chars = snprintf(msg, sizeof(msg) - 1,
85             "usage: %s -c <compiler option>\n"
86       "Tests for whether cl.exe supports an option\n"
87       "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
88     WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
89       &dwWritten, NULL);
90     return 2;
91       }
92       return CheckForCompilerFeature(argv[2]);
93   case 'l':
94       if (argc != 3) {
95     chars = snprintf(msg, sizeof(msg) - 1,
96             "usage: %s -l <linker option>\n"
97       "Tests for whether link.exe supports an option\n"
98       "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
99     WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
100       &dwWritten, NULL);
101     return 2;
102       }
103       return CheckForLinkerFeature(argv[2]);
104   case 'f':
105       if (argc == 2) {
106     chars = snprintf(msg, sizeof(msg) - 1,
107       "usage: %s -f <string> <substring>\n"
108       "Find a substring within another\n"
109       "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
110     WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
111       &dwWritten, NULL);
112     return 2;
113       } else if (argc == 3) {
114     /*
115      * If the string is blank, there is no match.
116      */
117 
118     return 0;
119       } else {
120     return IsIn(argv[2], argv[3]);
121       }
122   case 'g':
123       if (argc == 2) {
124     chars = snprintf(msg, sizeof(msg) - 1,
125       "usage: %s -g <file> <string>\n"
126       "grep for a #define\n"
127       "exitcodes: integer of the found string (no decimals)\n",
128       argv[0]);
129     WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
130       &dwWritten, NULL);
131     return 2;
132       }
133       return GrepForDefine(argv[2], argv[3]);
134   }
135     }
136     chars = snprintf(msg, sizeof(msg) - 1,
137       "usage: %s -c|-l|-f ...\n"
138       "This is a little helper app to equalize shell differences between WinNT and\n"
139       "Win9x and get nmake.exe to accomplish its job.\n",
140       argv[0]);
141     WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL);
142     return 2;
143 }
DWORD WINAPI ReadFromPipe (LPVOID args)

Definition at line 403 of file nmakehlp.c.
References BOOL(), pipeinfo::buffer, CHUNK, DWORD(), pipeinfo::pipe, and STATICBUFFERSIZE.
Referenced by CheckForCompilerFeature(), and CheckForLinkerFeature().405 {
406     pipeinfo *pi = (pipeinfo *) args;
407     char *lastBuf = pi->buffer;
408     DWORD dwRead;
409     BOOL ok;
410 
411   again:
412     if (lastBuf - pi->buffer + CHUNK > STATICBUFFERSIZE) {
413   CloseHandle(pi->pipe);
414   return (DWORD)-1;
415     }
416     ok = ReadFile(pi->pipe, lastBuf, CHUNK, &dwRead, 0L);
417     if (!ok || dwRead == 0) {
418   CloseHandle(pi->pipe);
419   return 0;
420     }
421     lastBuf += dwRead;
422     goto again;
423 
424     return 0;  /* makes the compiler happy */
425 }

Variable Documentation
pipeinfo Err = {INVALID_HANDLE_VALUE, '\0'}

Definition at line 52 of file nmakehlp.c.
Referenced by CheckForCompilerFeature(), and CheckForLinkerFeature().pipeinfo Out = {INVALID_HANDLE_VALUE, '\0'}

Definition at line 51 of file nmakehlp.c.
Referenced by CheckForCompilerFeature(), and CheckForLinkerFeature().

win/stub16.c File Reference
#include <windows.h>
#include <stdio.h>
Defines
#define STRICT
Functions
static HANDLE CreateTempFile (void)
int main ()

Define Documentation
#define STRICT

Definition at line 15 of file stub16.c.
Function Documentation
static HANDLE CreateTempFile (void) [static]

Definition at line 180 of file stub16.c.
References NULL, and TRUE.
Referenced by main().181 {
182     char name[MAX_PATH];
183     SECURITY_ATTRIBUTES sa;
184 
185     if (GetTempPath(sizeof(name), name) == 0) {
186   return INVALID_HANDLE_VALUE;
187     }
188     if (GetTempFileName(name, "tcl", 0, name) == 0) {
189   return INVALID_HANDLE_VALUE;
190     }
191 
192     sa.nLength = sizeof(sa);
193     sa.lpSecurityDescriptor = NULL;
194     sa.bInheritHandle = TRUE;
195     return CreateFile(name, GENERIC_READ | GENERIC_WRITE, 0, &sa, 
196       CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY | FILE_FLAG_DELETE_ON_CLOSE,
197       NULL);
198 }
int main ()

Definition at line 59 of file stub16.c.
References cleanup(), CreateTempFile(), DWORD(), FALSE, NULL, and TRUE.60 {
61     DWORD dwRead, dwWrite;
62     char *cmdLine;
63     HANDLE hStdInput, hStdOutput, hStdError;
64     HANDLE hFileInput, hFileOutput, hFileError;
65     STARTUPINFO si;
66     PROCESS_INFORMATION pi;
67     char buf[8192];
68     DWORD result;
69 
70     hFileInput = INVALID_HANDLE_VALUE;
71     hFileOutput = INVALID_HANDLE_VALUE;
72     hFileError = INVALID_HANDLE_VALUE;
73     result = 1;
74 
75     /*
76      * Don't get command line from argc, argv, because the command line
77      * tokenizer will have stripped off all the escape sequences needed
78      * for quotes and backslashes, and then we'd have to put them all
79      * back in again.  Get the raw command line and parse off what we
80      * want ourselves.  The command line should be of the form:
81      *
82      * stub16.exe program arg1 arg2 ...
83      */
84 
85     cmdLine = strchr(GetCommandLine(), ' ');
86     if (cmdLine == NULL) {
87   return 1;
88     }
89     cmdLine++;
90 
91     hStdInput = GetStdHandle(STD_INPUT_HANDLE);
92     hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE);
93     hStdError = GetStdHandle(STD_ERROR_HANDLE);
94 
95     if (GetFileType(hStdInput) == FILE_TYPE_PIPE) {
96   hFileInput = CreateTempFile();
97   if (hFileInput == INVALID_HANDLE_VALUE) {
98       goto cleanup;
99   }
100   while (ReadFile(hStdInput, buf, sizeof(buf), &dwRead, NULL) != FALSE) {
101       if (dwRead == 0) {
102     break;
103       }
104       if (WriteFile(hFileInput, buf, dwRead, &dwWrite, NULL) == FALSE) {
105     goto cleanup;
106       }
107   }
108   SetFilePointer(hFileInput, 0, 0, FILE_BEGIN);
109   SetStdHandle(STD_INPUT_HANDLE, hFileInput);
110     }
111     if (GetFileType(hStdOutput) == FILE_TYPE_PIPE) {
112   hFileOutput = CreateTempFile();
113   if (hFileOutput == INVALID_HANDLE_VALUE) {
114       goto cleanup;
115   }
116   SetStdHandle(STD_OUTPUT_HANDLE, hFileOutput);
117     }
118     if (GetFileType(hStdError) == FILE_TYPE_PIPE) {
119   hFileError = CreateTempFile();
120   if (hFileError == INVALID_HANDLE_VALUE) {
121       goto cleanup;
122   }
123   SetStdHandle(STD_ERROR_HANDLE, hFileError);
124     }
125 
126     ZeroMemory(&si, sizeof(si));
127     si.cb = sizeof(si);
128     if (CreateProcess(NULL, cmdLine, NULL, NULL, TRUE, 0, NULL, NULL, &si, 
129       &pi) == FALSE) {
130   goto cleanup;
131     }
132 
133     WaitForInputIdle(pi.hProcess, 5000);
134     WaitForSingleObject(pi.hProcess, INFINITE);
135     GetExitCodeProcess(pi.hProcess, &result);
136     CloseHandle(pi.hProcess);
137     CloseHandle(pi.hThread);
138 
139     if (hFileOutput != INVALID_HANDLE_VALUE) {
140   SetFilePointer(hFileOutput, 0, 0, FILE_BEGIN);
141   while (ReadFile(hFileOutput, buf, sizeof(buf), &dwRead, NULL) != FALSE) {
142       if (dwRead == 0) {
143     break;
144       }
145       if (WriteFile(hStdOutput, buf, dwRead, &dwWrite, NULL) == FALSE) {
146     break;
147       }
148   }
149     }
150     if (hFileError != INVALID_HANDLE_VALUE) {
151   SetFilePointer(hFileError, 0, 0, FILE_BEGIN);
152   while (ReadFile(hFileError, buf, sizeof(buf), &dwRead, NULL) != FALSE) {
153       if (dwRead == 0) {
154     break;
155       }
156       if (WriteFile(hStdError, buf, dwRead, &dwWrite, NULL) == FALSE) {
157     break;
158       }
159   }
160     }
161 
162 cleanup:
163     if (hFileInput != INVALID_HANDLE_VALUE) {
164   CloseHandle(hFileInput);
165     }
166     if (hFileOutput != INVALID_HANDLE_VALUE) {
167   CloseHandle(hFileOutput);
168     }
169     if (hFileError != INVALID_HANDLE_VALUE) {
170   CloseHandle(hFileError);
171     }
172     CloseHandle(hStdInput);
173     CloseHandle(hStdOutput);
174     CloseHandle(hStdError);
175     ExitProcess(result);
176     return 1;
177 }

win/tclWin32Dll.c File Reference
#include "tclWinInt.h"
Classes
struct MountPointMap
Typedefs
typedef DWORD dwUserDefined
typedef DWORD LPVOID * lpTranslationList
typedef LPCSTR SixteenBitDLL
typedef LPCSTR LPCSTR InitName
typedef LPCSTR LPCSTR LPCSTR ProcName
typedef LPCSTR LPCSTR LPCSTR UT32PROC ** ThirtyTwoBitThunk
typedef LPCSTR LPCSTR LPCSTR UT32PROC FARPROC UT32Callback
typedef LPCSTR LPCSTR LPCSTR UT32PROC FARPROC LPVOID Buff
Functions
typedef DWORD (WINAPI UT32PROC)(LPVOID lpBuff
typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule
typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule)
BOOL APIENTRY DllMain (HINSTANCE hInst, DWORD reason, LPVOID reserved)
TCL_DECLARE_MUTEX (mountPointMap)
void TclWinInit (HINSTANCE hInst)
int TclWinGetPlatformId ()
char * TclWinNoBackslash (char *path)
int TclpCheckStackSpace ()
TclPlatformType * TclWinGetPlatform ()
void TclWinSetInterfaces (int wide)
void TclWinResetInterfaceEncodings ()
void TclWinResetInterfaces ()
char TclWinDriveLetterForVolMountPoint (CONST WCHAR *mountPoint)
TCHAR * Tcl_WinUtfToTChar (CONST char *string, int len, Tcl_DString *dsPtr)
char * Tcl_WinTCharToUtf (CONST TCHAR *string, int len, Tcl_DString *dsPtr)
int TclWinCPUID (unsigned int index, unsigned int *regsPtr)
Variables
static HINSTANCE hInstance
static int platformId
static TclWinProcs asciiProcs
static TclWinProcs unicodeProcs
TclWinProcs * tclWinProcs
static Tcl_Encoding tclWinTCharEncoding
MountPointMap * driveLetterLookup = NULL

Typedef Documentation
typedef LPCSTR LPCSTR LPCSTR UT32PROC FARPROC LPVOID Buff

Definition at line 25 of file tclWin32Dll.c.typedef DWORD dwUserDefined

Definition at line 22 of file tclWin32Dll.c.typedef LPCSTR LPCSTR InitName

Definition at line 25 of file tclWin32Dll.c.typedef DWORD LPVOID* lpTranslationList

Definition at line 22 of file tclWin32Dll.c.typedef LPCSTR LPCSTR LPCSTR ProcName

Definition at line 25 of file tclWin32Dll.c.typedef LPCSTR SixteenBitDLL

Definition at line 25 of file tclWin32Dll.c.typedef LPCSTR LPCSTR LPCSTR UT32PROC** ThirtyTwoBitThunk

Definition at line 25 of file tclWin32Dll.c.typedef LPCSTR LPCSTR LPCSTR UT32PROC FARPROC UT32Callback

Definition at line 25 of file tclWin32Dll.c.
Function Documentation
typedef BOOL (WINAPI UTREGISTER)

Referenced by CheckForCompilerFeature(), CheckForLinkerFeature(), NativeAccess(), ReadFromPipe(), SerialSetOptionProc(), Tcl_MakeFileChannel(), TclWinSetInterfaces(), and TestplatformChmod().BOOL APIENTRY DllMain (HINSTANCE hInst, DWORD reason, LPVOID reserved)

Referenced by TCL_DECLARE_MUTEX().typedef DWORD (WINAPI UT32PROC)

Referenced by ApplicationType(), CalibrationThread(), CheckForCompilerFeature(), CheckForLinkerFeature(), ConsoleCloseProc(), ConsoleInputProc(), ConsoleOutputProc(), ConsoleReaderThread(), ConsoleWriterThread(), ConvertDWORD(), ConvertFileNameFormat(), CreateSocket(), DdeServerProc(), DeleteKey(), DeleteValue(), DoCopyFile(), DoCreateDirectory(), DoRemoveJustDirectory(), DoRenameFile(), FileGetType(), FileInputProc(), FileOutputProc(), FileSeekProc(), FileWideSeekProc(), GetKeyNames(), GetType(), GetValue(), GetValueNames(), GetWinFileAttributes(), InitSockets(), main(), NativeAccess(), NativeReadReparse(), NativeStat(), NativeWriteReparse(), OpenKey(), OpenSubKey(), PipeClose2Proc(), PipeInputProc(), PipeOutputProc(), PipeReaderThread(), PipeWriterThread(), ReadFromPipe(), RecursiveDeleteKey(), SerialCloseProc(), SerialErrorStr(), SerialGetOptionProc(), SerialInputProc(), SerialOutputProc(), SerialSetOptionProc(), SerialWriterThread(), SetValue(), SetWinFileAttributes(), SocketProc(), SocketThread(), Tcl_DdeObjCmd(), TCL_DECLARE_MUTEX(), Tcl_GetHostName(), Tcl_GetTime(), Tcl_Sleep(), Tcl_WaitForEvent(), Tcl_WaitPid(), TclpCreateCommandChannel(), TclpCreateProcess(), TclpCreateTempFile(), TclpDeleteFile(), TclpDlopen(), TclpGetDefaultStdChannel(), TclpMatchInDirectory(), TclpOpenFile(), TclpOpenFileChannel(), TclpSetVariables(), TclpThreadCreate(), TclpThreadExit(), TclpUtime(), TclWinCPUID(), TclWinOpenConsoleChannel(), TclWinOpenSerialChannel(), TclWinSetInterfaces(), TclWinSymLinkDelete(), TcpCloseProc(), TcpGetOptionProc(), TcpInputProc(), TcpOutputProc(), TestExceptionCmd(), TestplatformChmod(), TestwinsleepCmd(), TraversalCopy(), TraverseWinTree(), and WaitForRead().TCL_DECLARE_MUTEX (mountPointMap)

Definition at line 230 of file tclWin32Dll.c.
References DllMain().248           :
249  *  See DllMain.
250  *
251  * Side effects:
252  *  See DllMain.
253  *
254  *----------------------------------------------------------------------
255  */
256 
257 BOOL APIENTRY
258 DllEntryPoint(hInst, reason, reserved)
259     HINSTANCE hInst;    /* Library instance handle. */
260     DWORD reason;   /* Reason this function is being called. */
261     LPVOID reserved;    /* Not used. */
262 {
263     return DllMain(hInst, reason, reserved);
264 }
265 
266 /*
267  *----------------------------------------------------------------------
268  *
269  * DllMain --
270  *
271  *  This routine is called by the VC++ C run time library init
272  *  code, or the DllEntryPoint routine.  It is responsible for
273  *  initializing various dynamically loaded libraries.
274  *
275  * Results:
276  *  TRUE on sucess, FALSE on failure.
277  *
278  * Side effects:
279  *  Establishes 32-to-16 bit thunk and initializes sockets library.
280  *
281  *----------------------------------------------------------------------
282  */
283 BOOL APIENTRY
284 DllMain(hInst, reason, reserved)
285     HINSTANCE hInst;    /* Library instance handle. */
286     DWORD reason;   /* Reason this function is being called. */
287     LPVOID reserved;    /* Not used. */
288 {
289 #ifdef HAVE_NO_SEH
290     EXCEPTION_REGISTRATION registration;
291 #endif
292 
293     switch (reason) {
294     case DLL_PROCESS_ATTACH:
295   DisableThreadLibraryCalls(hInst);
296   TclWinInit(hInst);
297   return TRUE;
298 
299     case DLL_PROCESS_DETACH:
300   /*
301    * Protect the call to Tcl_Finalize.  The OS could be unloading
302    * us from an exception handler and the state of the stack might
303    * be unstable.
304    */
305 #ifdef HAVE_NO_SEH
306         __asm__ __volatile__ (
307 
308             /*
309              * Construct an EXCEPTION_REGISTRATION to protect the
310              * call to Tcl_Finalize
311              */
312             "leal       %[registration], %%edx"         "\n\t"
313             "movl       %%fs:0,         %%eax"          "\n\t"
314             "movl       %%eax,          0x0(%%edx)"     "\n\t" /* link */
315             "leal       1f,             %%eax"          "\n\t"
316             "movl       %%eax,          0x4(%%edx)"     "\n\t" /* handler */
317             "movl       %%ebp,          0x8(%%edx)"     "\n\t" /* ebp */
318             "movl       %%esp,          0xc(%%edx)"     "\n\t" /* esp */
319             "movl       %[error],       0x10(%%edx)"    "\n\t" /* status */
320 
321             /*
322              * Link the EXCEPTION_REGISTRATION on the chain
323              */
324             "movl       %%edx,          %%fs:0"         "\n\t"
325 
326             /*
327              * Call Tcl_Finalize
328              */
329             "call       _Tcl_Finalize"                  "\n\t"
330 
331             /*
332              * Come here on a normal exit. Recover the EXCEPTION_REGISTRATION
333              * and store a TCL_OK status
334              */
335 
336             "movl       %%fs:0,         %%edx"          "\n\t"
337             "movl       %[ok],          %%eax"          "\n\t"
338             "movl       %%eax,          0x10(%%edx)"    "\n\t"
339             "jmp        2f"                             "\n"
340 
341             /*
342              * Come here on an exception. Get the EXCEPTION_REGISTRATION
343              * that we previously put on the chain.
344              */
345 
346             "1:"                                        "\t"
347             "movl       %%fs:0,         %%edx"          "\n\t"
348             "movl       0x8(%%edx),     %%edx"          "\n"
349 
350 
351             /* 
352              * Come here however we exited.  Restore context from the
353              * EXCEPTION_REGISTRATION in case the stack is unbalanced.
354              */
355 
356             "2:"                                        "\t"
357             "movl       0xc(%%edx),     %%esp"          "\n\t"
358             "movl       0x8(%%edx),     %%ebp"          "\n\t"
359             "movl       0x0(%%edx),     %%eax"          "\n\t"
360             "movl       %%eax,          %%fs:0"         "\n\t"
361 
362             :
363             /* No outputs */
364             :
365             [registration]      "m"     (registration),
366             [ok]                "i"     (TCL_OK),
367             [error]             "i"     (TCL_ERROR)
368             :
369             "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"
370             );
371 
372 #else /* HAVE_NO_SEH */
373   __try {
374       Tcl_Finalize();
375   } __except (EXCEPTION_EXECUTE_HANDLER) {
376       /* empty handler body. */
377   }
378 #endif
379 
380   break;
381     }
382 
383     return TRUE; 
384 }
385 
386 #endif /* !STATIC_BUILD */
387 #endif /* __WIN32__ */
388 
389 /*
390  *----------------------------------------------------------------------
391  *
392  * TclWinGetTclInstance --
393  *
394  *  Retrieves the global library instance handle.
395  *
396  * Results:
397  *  Returns the global library instance handle.
398  *
399  * Side effects:
400  *  None.
401  *
402  *----------------------------------------------------------------------
403  */
404 
405 HINSTANCE
406 TclWinGetTclInstance()
407 {
408     return hInstance;
409 }

char* Tcl_WinTCharToUtf (CONST TCHAR * string, int len, Tcl_DString * dsPtr)

Definition at line 1025 of file tclWin32Dll.c.
References CONST, Tcl_ExternalToUtfDString(), and tclWinTCharEncoding.
Referenced by ApplicationType(), ConvertFileNameFormat(), DoRemoveJustDirectory(), DoRenameFile(), GetKeyNames(), GetValue(), GetValueNames(), NativeStat(), Tcl_GetHostName(), TclpFilesystemPathType(), TclpGetCwd(), TclpMatchInDirectory(), TclpNativeToNormalized(), TclpObjChdir(), TclpObjNormalizePath(), TclpSetVariables(), TraversalCopy(), TraversalDelete(), TraverseWinTree(), and WinReadLinkDirectory().1032 {
1033     return Tcl_ExternalToUtfDString(tclWinTCharEncoding, 
1034       (CONST char *) string, len, dsPtr);
1035 }
TCHAR* Tcl_WinUtfToTChar (CONST char * string, int len, Tcl_DString * dsPtr)

Definition at line 1013 of file tclWin32Dll.c.
References Tcl_UtfToExternalDString(), and tclWinTCharEncoding.
Referenced by ApplicationType(), BuildCommandLine(), ConvertFileNameFormat(), DeleteKey(), DeleteValue(), GetType(), GetValue(), NativeCreateNativeRep(), NativeStat(), OpenSubKey(), SerialSetOptionProc(), SetValue(), TclpDlopen(), TclpMatchInDirectory(), TclpObjCopyDirectory(), TclpObjNormalizePath(), TclpObjRemoveDirectory(), and TclpOpenFile().1019 {
1020     return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding, 
1021       string, len, dsPtr);
1022 }
int TclpCheckStackSpace ()

Definition at line 525 of file tclWin32Dll.c.
References TCL_ERROR, TCL_OK, and TCL_WIN_STACK_THRESHOLD.526 {
527 
528 #ifdef HAVE_NO_SEH
529     EXCEPTION_REGISTRATION registration;
530 #endif
531     int retval = 0;
532 
533     /*
534      * We can recurse only if there is at least TCL_WIN_STACK_THRESHOLD
535      * bytes of stack space left.  alloca() is cheap on windows; basically
536      * it just subtracts from the stack pointer causing the OS to throw an
537      * exception if the stack pointer is set below the bottom of the stack.
538      */
539 
540 #ifdef HAVE_NO_SEH
541     __asm__ __volatile__ (
542 
543         /*
544          * Construct an EXCEPTION_REGISTRATION to protect the
545          * call to __alloca
546          */
547         "leal   %[registration], %%edx"         "\n\t"
548         "movl   %%fs:0,         %%eax"          "\n\t"
549         "movl   %%eax,          0x0(%%edx)"     "\n\t" /* link */
550         "leal   1f,             %%eax"          "\n\t"
551         "movl   %%eax,          0x4(%%edx)"     "\n\t" /* handler */
552         "movl   %%ebp,          0x8(%%edx)"     "\n\t" /* ebp */
553         "movl   %%esp,          0xc(%%edx)"     "\n\t" /* esp */
554         "movl   %[error],       0x10(%%edx)"    "\n\t" /* status */
555         
556         /*
557          * Link the EXCEPTION_REGISTRATION on the chain
558          */
559         "movl   %%edx,          %%fs:0"         "\n\t"
560 
561         /*
562          * Attempt a call to __alloca, to determine whether there's
563          * sufficient memory to be had.
564          */
565 
566         "movl   %[size],        %%eax"          "\n\t"
567         "pushl  %%eax"                          "\n\t"
568         "call   __alloca"                       "\n\t"
569 
570         /*
571          * Come here on a normal exit. Recover the EXCEPTION_REGISTRATION
572          * and store a TCL_OK status
573          */
574         "movl   %%fs:0,         %%edx"          "\n\t"
575         "movl   %[ok],          %%eax"          "\n\t"
576         "movl   %%eax,          0x10(%%edx)"    "\n\t"
577         "jmp    2f"                             "\n"
578 
579         /*
580          * Come here on an exception. Get the EXCEPTION_REGISTRATION
581          * that we previously put on the chain.
582          */
583         "1:"                                    "\t"
584         "movl   %%fs:0,         %%edx"          "\n\t"
585         "movl   0x8(%%edx),     %%edx"          "\n\t"
586         
587         /* 
588          * Come here however we exited.  Restore context from the
589          * EXCEPTION_REGISTRATION in case the stack is unbalanced.
590          */
591         
592         "2:"                                    "\t"
593         "movl   0xc(%%edx),     %%esp"          "\n\t"
594         "movl   0x8(%%edx),     %%ebp"          "\n\t"
595         "movl   0x0(%%edx),     %%eax"          "\n\t"
596         "movl   %%eax,          %%fs:0"         "\n\t"
597         
598         :
599         /* No outputs */
600         :
601         [registration]  "m"     (registration),
602         [ok]            "i"     (TCL_OK),
603         [error]         "i"     (TCL_ERROR),
604         [size]          "i"     (TCL_WIN_STACK_THRESHOLD)
605         :
606         "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"
607         );
608     retval = (registration.status == TCL_OK);
609 
610 #else /* !HAVE_NO_SEH */
611     __try {
612 #ifdef HAVE_ALLOCA_GCC_INLINE
613         __asm__ __volatile__ (
614             "movl  %0, %%eax" "\n\t"
615             "call  __alloca" "\n\t"
616             :
617             : "i"(TCL_WIN_STACK_THRESHOLD)
618             : "%eax");
619 #else
620         alloca(TCL_WIN_STACK_THRESHOLD);
621 #endif /* HAVE_ALLOCA_GCC_INLINE */
622         retval = 1;
623     } __except (EXCEPTION_EXECUTE_HANDLER) {}
624 #endif /* HAVE_NO_SEH */
625 
626     return retval;
627 }
int TclWinCPUID (unsigned int index, unsigned int * regsPtr)

Definition at line 1056 of file tclWin32Dll.c.
References DWORD(), push(), status, TCL_ERROR, and TCL_OK.
Referenced by Tcl_GetTime(), and TestwincpuidCmd().1058 {
1059 
1060 #ifdef HAVE_NO_SEH
1061     EXCEPTION_REGISTRATION registration;
1062 #endif
1063     int status = TCL_ERROR;
1064 
1065 #if defined(__GNUC__) && !defined(_WIN64)
1066 
1067     /* 
1068      * Execute the CPUID instruction with the given index, and
1069      * store results off 'regPtr'.
1070      */
1071     
1072     __asm__ __volatile__ (
1073 
1074         /*
1075          * Construct an EXCEPTION_REGISTRATION to protect the
1076          * CPUID instruction (early 486's don't have CPUID)
1077          */
1078         "leal   %[registration], %%edx"         "\n\t"
1079         "movl   %%fs:0,         %%eax"          "\n\t"
1080         "movl   %%eax,          0x0(%%edx)"     "\n\t" /* link */
1081         "leal   1f,             %%eax"          "\n\t"
1082         "movl   %%eax,          0x4(%%edx)"     "\n\t" /* handler */
1083         "movl   %%ebp,          0x8(%%edx)"     "\n\t" /* ebp */
1084         "movl   %%esp,          0xc(%%edx)"     "\n\t" /* esp */
1085         "movl   %[error],       0x10(%%edx)"    "\n\t" /* status */
1086         
1087         /*
1088          * Link the EXCEPTION_REGISTRATION on the chain
1089          */
1090         "movl   %%edx,          %%fs:0"         "\n\t"
1091 
1092         /*
1093          * Do the CPUID instruction, and save the results in
1094          * the 'regsPtr' area
1095          */
1096 
1097         "movl   %[rptr],        %%edi"          "\n\t"
1098         "movl   %[index],       %%eax"          "\n\t"
1099         "cpuid"                                 "\n\t"
1100         "movl   %%eax,          0x0(%%edi)"     "\n\t"
1101         "movl   %%ebx,          0x4(%%edi)"     "\n\t"
1102         "movl   %%ecx,          0x8(%%edi)"     "\n\t"
1103         "movl   %%edx,          0xc(%%edi)"     "\n\t"
1104 
1105         /*
1106          * Come here on a normal exit. Recover the EXCEPTION_REGISTRATION
1107          * and store a TCL_OK status
1108          */
1109         "movl   %%fs:0,         %%edx"          "\n\t"
1110         "movl   %[ok],          %%eax"          "\n\t"
1111         "movl   %%eax,          0x10(%%edx)"    "\n\t"
1112         "jmp    2f"                             "\n"
1113 
1114         /*
1115          * Come here on an exception. Get the EXCEPTION_REGISTRATION
1116          * that we previously put on the chain.
1117          */
1118         "1:"                                    "\t"
1119         "movl   %%fs:0,         %%edx"          "\n\t"
1120         "movl   0x8(%%edx),     %%edx"          "\n\t"
1121         
1122         /* 
1123          * Come here however we exited.  Restore context from the
1124          * EXCEPTION_REGISTRATION in case the stack is unbalanced.
1125          */
1126         
1127         "2:"                                    "\t"
1128         "movl   0xc(%%edx),     %%esp"          "\n\t"
1129         "movl   0x8(%%edx),     %%ebp"          "\n\t"
1130         "movl   0x0(%%edx),     %%eax"          "\n\t"
1131         "movl   %%eax,          %%fs:0"         "\n\t"
1132 
1133         : 
1134         /* No outputs */
1135         : 
1136         [index]         "m"     (index),
1137         [rptr]          "m"     (regsPtr),
1138         [registration]  "m"     (registration),
1139         [ok]            "i"     (TCL_OK),
1140         [error]         "i"     (TCL_ERROR)
1141         :
1142         "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory" );
1143     status = registration.status;
1144 
1145 #elif defined(_MSC_VER) && !defined(_WIN64)
1146 
1147     /* Define a structure in the stack frame to hold the registers */
1148 
1149     struct {
1150   DWORD dw0;
1151   DWORD dw1;
1152   DWORD dw2;
1153   DWORD dw3;
1154     } regs;
1155     regs.dw0 = index;
1156     
1157     /* Execute the CPUID instruction and save regs in the stack frame */
1158 
1159     _try {
1160   _asm {
1161       push    ebx
1162       push    ecx
1163       push    edx
1164       mov     eax, regs.dw0
1165       cpuid
1166       mov     regs.dw0, eax
1167       mov     regs.dw1, ebx
1168       mov     regs.dw2, ecx
1169       mov     regs.dw3, edx
1170             pop     edx
1171             pop     ecx
1172             pop     ebx
1173   }
1174   
1175   /* Copy regs back out to the caller */
1176 
1177   regsPtr[0]=regs.dw0;
1178   regsPtr[1]=regs.dw1;
1179   regsPtr[2]=regs.dw2;
1180   regsPtr[3]=regs.dw3;
1181 
1182   status = TCL_OK;
1183     } __except( EXCEPTION_EXECUTE_HANDLER ) {
1184     }
1185 
1186 #else
1187         /* Don't know how to do assembly code for
1188          * this compiler and/or architecture */
1189 #endif
1190     return status;
1191 }
char TclWinDriveLetterForVolMountPoint (CONST WCHAR * mountPoint)

Definition at line 850 of file tclWin32Dll.c.
References ckfree, MountPointMap::driveLetter, driveLetterLookup, MountPointMap::nextPtr, NULL, Tcl_MutexLock, Tcl_MutexUnlock, tclWinProcs, and MountPointMap::volumeName.
Referenced by WinReadLinkDirectory().851 {
852     MountPointMap *dlIter, *dlPtr2;
853     WCHAR Target[55];         /* Target of mount at mount point */
854     WCHAR drive[4] = { L'A', L':', L'\\', L'\0' };
855     
856     /* 
857      * Detect the volume mounted there.  Unfortunately, there is no
858      * simple way to map a unique volume name to a DOS drive letter.  
859      * So, we have to build an associative array.
860      */
861     
862     Tcl_MutexLock(&mountPointMap);
863     dlIter = driveLetterLookup; 
864     while (dlIter != NULL) {
865   if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
866       /* 
867        * We need to check whether this information is
868        * still valid, since either the user or various
869        * programs could have adjusted the mount points on
870        * the fly.
871        */
872       drive[0] = L'A' + (dlIter->driveLetter - 'A');
873       /* Try to read the volume mount point and see where it points */
874       if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive, 
875                  (TCHAR*)Target, 55) != 0) {
876     if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) {
877         /* Nothing has changed */
878         Tcl_MutexUnlock(&mountPointMap);
879         return dlIter->driveLetter;
880     }
881       }
882       /* 
883        * If we reach here, unfortunately, this mount point is
884        * no longer valid at all
885        */
886       if (driveLetterLookup == dlIter) {
887     dlPtr2 = dlIter;
888     driveLetterLookup = dlIter->nextPtr;
889       } else {
890     for (dlPtr2 = driveLetterLookup; 
891          dlPtr2 != NULL; dlPtr2 = dlPtr2->nextPtr) {
892         if (dlPtr2->nextPtr == dlIter) {
893       dlPtr2->nextPtr = dlIter->nextPtr;
894       dlPtr2 = dlIter;
895       break;
896         }
897     }
898       }
899       /* Now dlPtr2 points to the structure to free */
900       ckfree((char*)dlPtr2->volumeName);
901       ckfree((char*)dlPtr2);
902       /* 
903        * Restart the loop --- we could try to be clever
904        * and continue half way through, but the logic is a 
905        * bit messy, so it's cleanest just to restart
906        */
907       dlIter = driveLetterLookup;
908       continue;
909   }
910   dlIter = dlIter->nextPtr;
911     }
912    
913     /* We couldn't find it, so we must iterate over the letters */
914     
915     for (drive[0] = L'A'; drive[0] <= L'Z'; drive[0]++) {
916   /* Try to read the volume mount point and see where it points */
917   if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive, 
918              (TCHAR*)Target, 55) != 0) {
919       int alreadyStored = 0;
920       for (dlIter = driveLetterLookup; dlIter != NULL; 
921      dlIter = dlIter->nextPtr) {
922     if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) {
923         alreadyStored = 1;
924         break;
925     }
926       }
927       if (!alreadyStored) {
928     dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap));
929     dlPtr2->volumeName = TclNativeDupInternalRep(Target);
930     dlPtr2->driveLetter = 'A' + (drive[0] - L'A');
931     dlPtr2->nextPtr = driveLetterLookup;
932     driveLetterLookup  = dlPtr2;
933       }
934   }
935     }
936     /* Try again */
937     for (dlIter = driveLetterLookup; dlIter != NULL; 
938           dlIter = dlIter->nextPtr) {
939   if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
940       Tcl_MutexUnlock(&mountPointMap);
941       return dlIter->driveLetter;
942   }
943     }
944     /* 
945      * The volume doesn't appear to correspond to a drive letter -- we
946      * remember that fact and store '-1' so we don't have to look it
947      * up each time.
948      */
949     dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap));
950     dlPtr2->volumeName = TclNativeDupInternalRep((ClientData)mountPoint);
951     dlPtr2->driveLetter = -1;
952     dlPtr2->nextPtr = driveLetterLookup;
953     driveLetterLookup  = dlPtr2;
954     Tcl_MutexUnlock(&mountPointMap);
955     return -1;
956 }
TclPlatformType* TclWinGetPlatform ()

Definition at line 647 of file tclWin32Dll.c.
References tclPlatform.
Referenced by TestgetplatformCmd(), and TestsetplatformCmd().648 {
649     return &tclPlatform;
650 }
int TclWinGetPlatformId ()

Definition at line 471 of file tclWin32Dll.c.
References platformId.
Referenced by DoRemoveJustDirectory(), Registry_Init(), TclpCreateProcess(), TclpObjNormalizePath(), and TclpSetInitialEncodings().472 {
473     return platformId;
474 }
void TclWinInit (HINSTANCE hInst)

Definition at line 428 of file tclWin32Dll.c.
References asciiProcs, hInstance, panic, platformId, and tclWinProcs.
Referenced by TclpInitPlatform().430 {
431     OSVERSIONINFO os;
432 
433     hInstance = hInst;
434     os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
435     GetVersionEx(&os);
436     platformId = os.dwPlatformId;
437 
438     /*
439      * We no longer support Win32s, so just in case someone manages to
440      * get a runtime there, make sure they know that.
441      */
442 
443     if (platformId == VER_PLATFORM_WIN32s) {
444   panic("Win32s is not a supported platform");  
445     }
446 
447     tclWinProcs = &asciiProcs;
448 }
char* TclWinNoBackslash (char * path)

Definition at line 494 of file tclWin32Dll.c.
Referenced by AppendDllPath(), AppendEnvironment(), SetFsPathFromAny(), and TclpFindExecutable().496 {
497     char *p;
498 
499     for (p = path; *p != '\0'; p++) {
500   if (*p == '\\') {
501       *p = '/';
502   }
503     }
504     return path;
505 }
void TclWinResetInterfaceEncodings ()

Definition at line 787 of file tclWin32Dll.c.
References ckfree, driveLetterLookup, MountPointMap::nextPtr, NULL, Tcl_FreeEncoding(), Tcl_MutexLock, Tcl_MutexUnlock, tclWinTCharEncoding, and MountPointMap::volumeName.
Referenced by TclWinEncodingsCleanup().788 {
789     MountPointMap *dlIter, *dlIter2;
790     if (tclWinTCharEncoding != NULL) {
791   Tcl_FreeEncoding(tclWinTCharEncoding);
792   tclWinTCharEncoding = NULL;
793     }
794     /* Clean up the mount point map */
795     Tcl_MutexLock(&mountPointMap);
796     dlIter = driveLetterLookup; 
797     while (dlIter != NULL) {
798   dlIter2 = dlIter->nextPtr;
799   ckfree((char*)dlIter->volumeName);
800   ckfree((char*)dlIter);
801   dlIter = dlIter2;
802     }
803     Tcl_MutexUnlock(&mountPointMap);
804 }
void TclWinResetInterfaces ()

Definition at line 824 of file tclWin32Dll.c.
References asciiProcs, and tclWinProcs.
Referenced by TclResetFilesystem().825 {
826     tclWinProcs = &asciiProcs;
827 }
void TclWinSetInterfaces (int wide)

Definition at line 676 of file tclWin32Dll.c.
References asciiProcs, BOOL(), CONST, DWORD(), hInstance, NULL, Tcl_FreeEncoding(), Tcl_GetEncoding(), tclWinProcs, tclWinTCharEncoding, unicodeProcs, VOID, and void().
Referenced by TclpSetInitialEncodings().679 {
680     Tcl_FreeEncoding(tclWinTCharEncoding);
681 
682     if (wide) {
683   tclWinProcs = &unicodeProcs;
684   tclWinTCharEncoding = Tcl_GetEncoding(NULL, "unicode");
685   if (tclWinProcs->getFileAttributesExProc == NULL) {
686       HINSTANCE hInstance = LoadLibraryA("kernel32");
687       if (hInstance != NULL) {
688           tclWinProcs->getFileAttributesExProc = 
689       (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, 
690       LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExW");
691     tclWinProcs->createHardLinkProc = 
692       (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*, 
693       LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance, 
694       "CreateHardLinkW");
695           tclWinProcs->findFirstFileExProc = 
696       (HANDLE (WINAPI *)(CONST TCHAR*, UINT,
697       LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance, 
698       "FindFirstFileExW");
699           tclWinProcs->getVolumeNameForVMPProc = 
700       (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*, 
701       DWORD)) GetProcAddress(hInstance, 
702       "GetVolumeNameForVolumeMountPointW");
703     FreeLibrary(hInstance);
704       }
705       hInstance = LoadLibraryA("advapi32");
706       if (hInstance != NULL) {
707     tclWinProcs->getFileSecurityProc = (BOOL (WINAPI *)(
708       LPCTSTR lpFileName,
709       SECURITY_INFORMATION RequestedInformation,
710       PSECURITY_DESCRIPTOR pSecurityDescriptor,
711       DWORD nLength, LPDWORD lpnLengthNeeded))
712       GetProcAddress(hInstance, "GetFileSecurityW");
713     tclWinProcs->impersonateSelfProc = (BOOL (WINAPI *) (
714       SECURITY_IMPERSONATION_LEVEL ImpersonationLevel))
715       GetProcAddress(hInstance, "ImpersonateSelf");
716     tclWinProcs->openThreadTokenProc = (BOOL (WINAPI *) (
717       HANDLE ThreadHandle, DWORD DesiredAccess,
718       BOOL OpenAsSelf, PHANDLE TokenHandle))
719       GetProcAddress(hInstance, "OpenThreadToken");
720     tclWinProcs->revertToSelfProc = (BOOL (WINAPI *) (void))
721       GetProcAddress(hInstance, "RevertToSelf");
722     tclWinProcs->mapGenericMaskProc = (VOID (WINAPI *) (
723       PDWORD AccessMask, PGENERIC_MAPPING GenericMapping))
724       GetProcAddress(hInstance, "MapGenericMask");
725     tclWinProcs->accessCheckProc = (BOOL (WINAPI *)(
726       PSECURITY_DESCRIPTOR pSecurityDescriptor,
727       HANDLE ClientToken, DWORD DesiredAccess,
728       PGENERIC_MAPPING GenericMapping,
729       PPRIVILEGE_SET PrivilegeSet,
730       LPDWORD PrivilegeSetLength, LPDWORD GrantedAccess,
731       LPBOOL AccessStatus)) GetProcAddress(hInstance,
732       "AccessCheck");
733     FreeLibrary(hInstance);
734       }
735   }
736     } else {
737   tclWinProcs = &asciiProcs;
738   tclWinTCharEncoding = NULL;
739   if (tclWinProcs->getFileAttributesExProc == NULL) {
740       HINSTANCE hInstance = LoadLibraryA("kernel32");
741       if (hInstance != NULL) {
742     tclWinProcs->getFileAttributesExProc = 
743       (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, 
744       LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExA");
745     tclWinProcs->createHardLinkProc = 
746       (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*, 
747       LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance, 
748       "CreateHardLinkA");
749     tclWinProcs->findFirstFileExProc = 
750       (HANDLE (WINAPI *)(CONST TCHAR*, UINT,
751       LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance, 
752       "FindFirstFileExA");
753     tclWinProcs->getLongPathNameProc = NULL;
754     tclWinProcs->getVolumeNameForVMPProc = 
755       (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*, 
756       DWORD)) GetProcAddress(hInstance, 
757       "GetVolumeNameForVolumeMountPointA");
758     FreeLibrary(hInstance);
759       }
760   }
761     }
762 }
typedef VOID (WINAPI UTUNREGISTER)

Variable Documentation
TclWinProcs asciiProcs [static]

Definition at line 74 of file tclWin32Dll.c.
Referenced by Registry_Init(), TclWinInit(), TclWinResetInterfaces(), and TclWinSetInterfaces().MountPointMap* driveLetterLookup = NULL

Definition at line 229 of file tclWin32Dll.c.
Referenced by TclWinDriveLetterForVolMountPoint(), and TclWinResetInterfaceEncodings().HINSTANCE hInstance [static]

Definition at line 37 of file tclWin32Dll.c.
Referenced by TclWinInit(), TclWinSetInterfaces(), and TestplatformChmod().int platformId [static]

Definition at line 38 of file tclWin32Dll.c.
Referenced by TclpSetInitialEncodings(), TclWinGetPlatformId(), and TclWinInit().TclWinProcs* tclWinProcs

Definition at line 186 of file tclWin32Dll.c.
Referenced by ApplicationType(), ConvertFileNameFormat(), DoCopyFile(), DoCreateDirectory(), DoRemoveJustDirectory(), DoRenameFile(), GetWinFileAttributes(), NativeAccess(), NativeCreateNativeRep(), NativeIsExec(), NativeReadReparse(), NativeStat(), NativeWriteReparse(), SerialSetOptionProc(), SetWinFileAttributes(), Tcl_GetHostName(), TclNativeDupInternalRep(), TclpCreateProcess(), TclpCreateTempFile(), TclpDeleteFile(), TclpDlopen(), TclpFilesystemPathType(), TclpGetCwd(), TclpMatchInDirectory(), TclpObjChdir(), TclpObjNormalizePath(), TclpOpenFile(), TclpOpenFileChannel(), TclpUtime(), TclWinDriveLetterForVolMountPoint(), TclWinInit(), TclWinResetInterfaces(), TclWinSerialReopen(), TclWinSetInterfaces(), TclWinSymLinkDelete(), TempFileName(), TraversalCopy(), TraverseWinTree(), WinLink(), WinReadLink(), and WinReadLinkDirectory().Tcl_Encoding tclWinTCharEncoding [static]

Definition at line 187 of file tclWin32Dll.c.
Referenced by Tcl_WinTCharToUtf(), Tcl_WinUtfToTChar(), TclWinResetInterfaceEncodings(), and TclWinSetInterfaces().TclWinProcs unicodeProcs [static]

Definition at line 130 of file tclWin32Dll.c.
Referenced by Registry_Init(), and TclWinSetInterfaces().

win/tclWinChan.c File Reference
#include "tclWinInt.h"
#include "tclIO.h"
Classes
struct FileInfo
struct ThreadSpecificData
struct FileEvent
Defines
#define FILE_PENDING  (1<<0)
#define FILE_ASYNC  (1<<1)
#define FILE_APPEND  (1<<2)
#define FILE_TYPE_SERIAL  (FILE_TYPE_PIPE+1)
#define FILE_TYPE_CONSOLE  (FILE_TYPE_PIPE+2)
Functions
static int FileBlockProc _ANSI_ARGS_ ((ClientData instanceData, int mode))
static void FileChannelExitHandler _ANSI_ARGS_ ((ClientData clientData))
static void FileCheckProc _ANSI_ARGS_ ((ClientData clientData, int flags))
static int FileCloseProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp))
static int FileEventProc _ANSI_ARGS_ ((Tcl_Event *evPtr, int flags))
static int FileGetHandleProc _ANSI_ARGS_ ((ClientData instanceData, int direction, ClientData *handlePtr))
static ThreadSpecificData *FileInit _ANSI_ARGS_ ((void))
static int FileInputProc _ANSI_ARGS_ ((ClientData instanceData, char *buf, int toRead, int *errorCode))
static int FileOutputProc _ANSI_ARGS_ ((ClientData instanceData, CONST char *buf, int toWrite, int *errorCode))
static int FileSeekProc _ANSI_ARGS_ ((ClientData instanceData, long offset, int mode, int *errorCode))
static Tcl_WideInt FileWideSeekProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCode))
static DWORD FileGetType _ANSI_ARGS_ ((HANDLE handle))
static ThreadSpecificData * FileInit ()
static void FileChannelExitHandler (ClientData clientData)
void FileSetupProc (ClientData data, int flags)
static void FileCheckProc (ClientData data, int flags)
static int FileEventProc (Tcl_Event *evPtr, int flags)
static int FileBlockProc (ClientData instanceData, int mode)
static int FileCloseProc (ClientData instanceData, Tcl_Interp *interp)
static int FileSeekProc (ClientData instanceData, long offset, int mode, int *errorCodePtr)
static Tcl_WideInt FileWideSeekProc (ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCodePtr)
static int FileInputProc (ClientData instanceData, char *buf, int bufSize, int *errorCode)
static int FileOutputProc (ClientData instanceData, CONST char *buf, int toWrite, int *errorCode)
static void FileWatchProc (ClientData instanceData, int mask)
static int FileGetHandleProc (ClientData instanceData, int direction, ClientData *handlePtr)
Tcl_Channel TclpOpenFileChannel (Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions)
Tcl_Channel Tcl_MakeFileChannel (ClientData rawHandle, int mode)
Tcl_Channel TclpGetDefaultStdChannel (int type)
Tcl_Channel TclWinOpenFileChannel (HANDLE handle, char *channelName, int permissions, int appendMode)
void TclWinFlushDirtyChannels ()
static void FileThreadActionProc (ClientData instanceData, int action)
DWORD FileGetType (HANDLE handle)
Variables
static Tcl_ThreadDataKey dataKey
static Tcl_ChannelType fileChannelType

Define Documentation
#define FILE_APPEND  (1<<2)

Definition at line 24 of file tclWinChan.c.
Referenced by FileOutputProc(), and TclpOpenFileChannel().#define FILE_ASYNC  (1<<1)

Definition at line 23 of file tclWinChan.c.
Referenced by FileBlockProc().#define FILE_PENDING  (1<<0)

Definition at line 22 of file tclWinChan.c.
Referenced by FileCheckProc(), and FileEventProc().#define FILE_TYPE_CONSOLE  (FILE_TYPE_PIPE+2)

Definition at line 27 of file tclWinChan.c.
Referenced by FileGetType(), Tcl_MakeFileChannel(), and TclpOpenFileChannel().#define FILE_TYPE_SERIAL  (FILE_TYPE_PIPE+1)

Definition at line 26 of file tclWinChan.c.
Referenced by FileGetType(), Tcl_MakeFileChannel(), and TclpOpenFileChannel().
Function Documentation
static DWORD FileGetType _ANSI_ARGS_ ((HANDLE handle)) [static]
static Tcl_WideInt FileWideSeekProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCode)) [static]
static int FileSeekProc _ANSI_ARGS_ ((ClientData instanceData, long offset, int mode, int *errorCode)) [static]
static int FileOutputProc _ANSI_ARGS_ ((ClientData instanceData, CONST char *buf, int toWrite, int *errorCode)) [static]
static int FileInputProc _ANSI_ARGS_ ((ClientData instanceData, char *buf, int toRead, int *errorCode)) [static]
static ThreadSpecificData* FileInit _ANSI_ARGS_ ((void)) [static]
static int FileGetHandleProc _ANSI_ARGS_ ((ClientData instanceData, int direction, ClientData *handlePtr)) [static]
static int FileEventProc _ANSI_ARGS_ ((Tcl_Event *evPtr, int flags)) [static]
static int FileCloseProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp)) [static]
static void FileCheckProc _ANSI_ARGS_ ((ClientData clientData, int flags)) [static]
static void FileChannelExitHandler _ANSI_ARGS_ ((ClientData clientData)) [static]
static int FileBlockProc _ANSI_ARGS_ ((ClientData instanceData, int mode)) [static]
static int FileBlockProc (ClientData instanceData, int mode) [static]

Definition at line 362 of file tclWinChan.c.
References FILE_ASYNC, FileInfo::flags, and TCL_MODE_NONBLOCKING.366 {
367     FileInfo *infoPtr = (FileInfo *) instanceData;
368     
369     /*
370      * Files on Windows can not be switched between blocking and nonblocking,
371      * hence we have to emulate the behavior. This is done in the input
372      * function by checking against a bit in the state. We set or unset the
373      * bit here to cause the input function to emulate the correct behavior.
374      */
375 
376     if (mode == TCL_MODE_NONBLOCKING) {
377   infoPtr->flags |= FILE_ASYNC;
378     } else {
379   infoPtr->flags &= ~(FILE_ASYNC);
380     }
381     return 0;
382 }
static void FileChannelExitHandler (ClientData clientData) [static]

Definition at line 196 of file tclWinChan.c.
References FileCheckProc(), FileSetupProc(), NULL, and Tcl_DeleteEventSource().198 {
199     Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
200 }
static void FileCheckProc (ClientData data, int flags) [static]

Definition at line 263 of file tclWinChan.c.
References ckalloc, dataKey, FILE_PENDING, FileEventProc(), ThreadSpecificData::firstFilePtr, FileInfo::flags, FileEvent::header, FileEvent::infoPtr, FileInfo::nextPtr, NULL, Tcl_Event::proc, TCL_FILE_EVENTS, TCL_QUEUE_TAIL, Tcl_QueueEvent(), TCL_TSD_INIT, and FileInfo::watchMask.266 {
267     FileEvent *evPtr;
268     FileInfo *infoPtr;
269     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
270 
271     if (!(flags & TCL_FILE_EVENTS)) {
272   return;
273     }
274     
275     /*
276      * Queue events for any ready files that don't already have events
277      * queued (caused by persistent states that won't generate WinSock
278      * events).
279      */
280 
281     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
282       infoPtr = infoPtr->nextPtr) {
283   if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
284       infoPtr->flags |= FILE_PENDING;
285       evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
286       evPtr->header.proc = FileEventProc;
287       evPtr->infoPtr = infoPtr;
288       Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
289   }
290     }
291 }
static int FileCloseProc (ClientData instanceData, Tcl_Interp * interp) [static]

Definition at line 401 of file tclWinChan.c.
References ckfree, dataKey, errno, FALSE, FileThreadActionProc(), FileWatchProc(), ThreadSpecificData::firstFilePtr, FileInfo::handle, FileInfo::nextPtr, NULL, TCL_CHANNEL_THREAD_REMOVE, TCL_TSD_INIT, TclInThreadExit(), and TclWinConvertError().404 {
405     FileInfo *fileInfoPtr = (FileInfo *) instanceData;
406     FileInfo *infoPtr;
407     ThreadSpecificData *tsdPtr;
408     int errorCode = 0;
409 
410     /*
411      * Remove the file from the watch list.
412      */
413 
414     FileWatchProc(instanceData, 0);
415 
416     /*
417      * Don't close the Win32 handle if the handle is a standard channel
418      * during the thread exit process.  Otherwise, one thread may kill
419      * the stdio of another.
420      */
421 
422     if (!TclInThreadExit() 
423       || ((GetStdHandle(STD_INPUT_HANDLE) != fileInfoPtr->handle)
424     && (GetStdHandle(STD_OUTPUT_HANDLE) != fileInfoPtr->handle)
425     && (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) {
426   if (CloseHandle(fileInfoPtr->handle) == FALSE) {
427       TclWinConvertError(GetLastError());
428       errorCode = errno;
429   }
430     }
431 
432     /*
433      * See if this FileInfo* is still on the thread local list.
434      */
435     tsdPtr = TCL_TSD_INIT(&dataKey);
436     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
437       infoPtr = infoPtr->nextPtr) {
438   if (infoPtr == fileInfoPtr) {
439             /*
440              * This channel exists on the thread local list. It should
441              * have been removed by an earlier Thread Action call,
442              * but do that now since just deallocating fileInfoPtr would
443              * leave an deallocated pointer on the thread local list.
444              */
445       FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE);
446             break;
447         }
448     }
449     ckfree((char *)fileInfoPtr);
450     return errorCode;
451 }
static int FileEventProc (Tcl_Event * evPtr, int flags) [static]

Definition at line 314 of file tclWinChan.c.
References FileInfo::channel, dataKey, FILE_PENDING, ThreadSpecificData::firstFilePtr, FileInfo::flags, FileEvent::infoPtr, FileInfo::nextPtr, NULL, TCL_FILE_EVENTS, Tcl_NotifyChannel(), TCL_TSD_INIT, and FileInfo::watchMask.318 {
319     FileEvent *fileEvPtr = (FileEvent *)evPtr;
320     FileInfo *infoPtr;
321     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
322 
323     if (!(flags & TCL_FILE_EVENTS)) {
324   return 0;
325     }
326 
327     /*
328      * Search through the list of watched files for the one whose handle
329      * matches the event.  We do this rather than simply dereferencing
330      * the handle in the event so that files can be deleted while the
331      * event is in the queue.
332      */
333 
334     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
335       infoPtr = infoPtr->nextPtr) {
336   if (fileEvPtr->infoPtr == infoPtr) {
337       infoPtr->flags &= ~(FILE_PENDING);
338       Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask);
339       break;
340   }
341     }
342     return 1;
343 }
static int FileGetHandleProc (ClientData instanceData, int direction, ClientData * handlePtr) [static]

Definition at line 741 of file tclWinChan.c.
References FileInfo::handle, TCL_ERROR, TCL_OK, and FileInfo::validMask.745 {
746     FileInfo *infoPtr = (FileInfo *) instanceData;
747 
748     if (direction & infoPtr->validMask) {
749   *handlePtr = (ClientData) infoPtr->handle;
750   return TCL_OK;
751     } else {
752   return TCL_ERROR;
753     }
754 }
DWORD FileGetType (HANDLE handle)

Definition at line 1406 of file tclWinChan.c.
References DWORD(), FILE_TYPE_CONSOLE, and FILE_TYPE_SERIAL.
Referenced by Tcl_MakeFileChannel(), and TclpOpenFileChannel().1408 { 
1409     DWORD type;
1410     DWORD consoleParams;
1411     DCB dcb;
1412 
1413     type = GetFileType(handle);
1414 
1415     /*
1416      * If the file is a character device, we need to try to figure out
1417      * whether it is a serial port, a console, or something else.  We
1418      * test for the console case first because this is more common.
1419      */
1420     
1421     if (type == FILE_TYPE_CHAR || (type == FILE_TYPE_UNKNOWN && !GetLastError())) {
1422       if (GetConsoleMode(handle, &consoleParams)) {
1423         type = FILE_TYPE_CONSOLE;
1424       } else {
1425         dcb.DCBlength = sizeof( DCB ) ;
1426         if (GetCommState(handle, &dcb)) {
1427           type = FILE_TYPE_SERIAL;
1428         }
1429       }
1430     }
1431 
1432     return type;
1433 }
static ThreadSpecificData* FileInit () [static]

Definition at line 165 of file tclWinChan.c.
References dataKey, FileChannelExitHandler(), FileCheckProc(), FileSetupProc(), ThreadSpecificData::firstFilePtr, NULL, Tcl_CreateEventSource(), Tcl_CreateThreadExitHandler(), TCL_TSD_INIT, and TclThreadDataKeyGet().166 {
167     ThreadSpecificData *tsdPtr =
168   (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
169     if (tsdPtr == NULL) {
170   tsdPtr = TCL_TSD_INIT(&dataKey);
171   tsdPtr->firstFilePtr = NULL;
172   Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
173   Tcl_CreateThreadExitHandler(FileChannelExitHandler, NULL);
174     }
175     return tsdPtr;
176 }
static int FileInputProc (ClientData instanceData, char * buf, int bufSize, int * errorCode) [static]

Definition at line 601 of file tclWinChan.c.
References DWORD(), EPIPE, errno, FALSE, FileInfo::handle, NULL, and TclWinConvertError().607 {
608     FileInfo *infoPtr;
609     DWORD bytesRead;
610 
611     *errorCode = 0;
612     infoPtr = (FileInfo *) instanceData;
613 
614     /*
615      * Note that we will block on reads from a console buffer until a
616      * full line has been entered.  The only way I know of to get
617      * around this is to write a console driver.  We should probably
618      * do this at some point, but for now, we just block.  The same
619      * problem exists for files being read over the network.
620      */
621 
622     if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
623             (LPOVERLAPPED) NULL) != FALSE) {
624   return bytesRead;
625     }
626     
627     TclWinConvertError(GetLastError());
628     *errorCode = errno;
629     if (errno == EPIPE) {
630   return 0;
631     }
632     return -1;
633 }
static int FileOutputProc (ClientData instanceData, CONST char * buf, int toWrite, int * errorCode) [static]

Definition at line 654 of file tclWinChan.c.
References FileInfo::dirty, DWORD(), errno, FALSE, FILE_APPEND, FileInfo::flags, FileInfo::handle, NULL, and TclWinConvertError().659 {
660     FileInfo *infoPtr = (FileInfo *) instanceData;
661     DWORD bytesWritten;
662     
663     *errorCode = 0;
664 
665     /*
666      * If we are writing to a file that was opened with O_APPEND, we need to
667      * seek to the end of the file before writing the current buffer.
668      */
669 
670     if (infoPtr->flags & FILE_APPEND) {
671         SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);
672     }
673 
674     if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten,
675             (LPOVERLAPPED) NULL) == FALSE) {
676         TclWinConvertError(GetLastError());
677         *errorCode = errno;
678         return -1;
679     }
680     infoPtr->dirty = 1;
681     return bytesWritten;
682 }
static int FileSeekProc (ClientData instanceData, long offset, int mode, int * errorCodePtr) [static]

Definition at line 472 of file tclWinChan.c.
References DWORD(), EOVERFLOW, errno, FileInfo::handle, INVALID_SET_FILE_POINTER, SEEK_CUR, SEEK_SET, and TclWinConvertError().477 {
478     FileInfo *infoPtr = (FileInfo *) instanceData;
479     DWORD moveMethod;
480     DWORD newPos, newPosHigh;
481     DWORD oldPos, oldPosHigh;
482 
483     *errorCodePtr = 0;
484     if (mode == SEEK_SET) {
485         moveMethod = FILE_BEGIN;
486     } else if (mode == SEEK_CUR) {
487         moveMethod = FILE_CURRENT;
488     } else {
489         moveMethod = FILE_END;
490     }
491 
492     /*
493      * Save our current place in case we need to roll-back the seek.
494      */
495     oldPosHigh = (DWORD)0;
496     oldPos = SetFilePointer(infoPtr->handle, (LONG)0, &oldPosHigh,
497       FILE_CURRENT);
498     if (oldPos == INVALID_SET_FILE_POINTER) {
499   DWORD winError = GetLastError();
500   if (winError != NO_ERROR) {
501       TclWinConvertError(winError);
502       *errorCodePtr = errno;
503       return -1;
504   }
505     }
506 
507     newPosHigh = (DWORD)(offset < 0 ? -1 : 0);
508     newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh,
509           moveMethod);
510     if (newPos == INVALID_SET_FILE_POINTER) {
511   DWORD winError = GetLastError();
512   if (winError != NO_ERROR) {
513       TclWinConvertError(winError);
514       *errorCodePtr = errno;
515       return -1;
516   }
517     }
518 
519     /*
520      * Check for expressability in our return type, and roll-back otherwise.
521      */
522     if (newPosHigh != 0) {
523   *errorCodePtr = EOVERFLOW;
524   SetFilePointer(infoPtr->handle, (LONG)oldPos, &oldPosHigh, FILE_BEGIN);
525   return -1;
526     }
527     return (int) newPos;
528 }
void FileSetupProc (ClientData data, int flags)

Definition at line 220 of file tclWinChan.c.
References dataKey, ThreadSpecificData::firstFilePtr, FileInfo::nextPtr, NULL, TCL_FILE_EVENTS, Tcl_SetMaxBlockTime(), TCL_TSD_INIT, and FileInfo::watchMask.223 {
224     FileInfo *infoPtr;
225     Tcl_Time blockTime = { 0, 0 };
226     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
227 
228     if (!(flags & TCL_FILE_EVENTS)) {
229   return;
230     }
231     
232     /*
233      * Check to see if there is a ready file.  If so, poll.
234      */
235 
236     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
237       infoPtr = infoPtr->nextPtr) {
238   if (infoPtr->watchMask) {
239       Tcl_SetMaxBlockTime(&blockTime);
240       break;
241   }
242     }
243 }
static void FileThreadActionProc (ClientData instanceData, int action) [static]

Definition at line 1353 of file tclWinChan.c.
References dataKey, ThreadSpecificData::firstFilePtr, FileInfo::nextPtr, NULL, panic, TCL_CHANNEL_THREAD_INSERT, and TCL_TSD_INIT.1356 {
1357     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1358     FileInfo *infoPtr = (FileInfo *) instanceData;
1359 
1360     if (action == TCL_CHANNEL_THREAD_INSERT) {
1361         infoPtr->nextPtr = tsdPtr->firstFilePtr;
1362   tsdPtr->firstFilePtr = infoPtr;
1363     } else {
1364         FileInfo **nextPtrPtr;
1365   int removed = 0;
1366 
1367   for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
1368        nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
1369       if ((*nextPtrPtr) == infoPtr) {
1370           (*nextPtrPtr) = infoPtr->nextPtr;
1371     removed = 1;
1372     break;
1373       }
1374   }
1375 
1376   /*
1377    * This could happen if the channel was created in one thread
1378    * and then moved to another without updating the thread
1379    * local data in each thread.
1380    */
1381 
1382   if (!removed) {
1383       panic("file info ptr not on thread channel list");
1384   }
1385     }
1386 }
static void FileWatchProc (ClientData instanceData, int mask) [static]

Definition at line 702 of file tclWinChan.c.
References Tcl_SetMaxBlockTime(), FileInfo::validMask, and FileInfo::watchMask.707 {
708     FileInfo *infoPtr = (FileInfo *) instanceData;
709     Tcl_Time blockTime = { 0, 0 };
710 
711     /*
712      * Since the file is always ready for events, we set the block time
713      * to zero so we will poll.
714      */
715 
716     infoPtr->watchMask = mask & infoPtr->validMask;
717     if (infoPtr->watchMask) {
718   Tcl_SetMaxBlockTime(&blockTime);
719     }
720 }
static Tcl_WideInt FileWideSeekProc (ClientData instanceData, Tcl_WideInt offset, int mode, int * errorCodePtr) [static]

Definition at line 549 of file tclWinChan.c.
References DWORD(), errno, FileInfo::handle, INVALID_SET_FILE_POINTER, SEEK_CUR, SEEK_SET, and TclWinConvertError().554 {
555     FileInfo *infoPtr = (FileInfo *) instanceData;
556     DWORD moveMethod;
557     DWORD newPos, newPosHigh;
558 
559     *errorCodePtr = 0;
560     if (mode == SEEK_SET) {
561         moveMethod = FILE_BEGIN;
562     } else if (mode == SEEK_CUR) {
563         moveMethod = FILE_CURRENT;
564     } else {
565         moveMethod = FILE_END;
566     }
567 
568     newPosHigh = (DWORD)(offset >> 32);
569     newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh,
570           moveMethod);
571     if (newPos == INVALID_SET_FILE_POINTER) {
572   DWORD winError = GetLastError();
573   if (winError != NO_ERROR) {
574       TclWinConvertError(winError);
575       *errorCodePtr = errno;
576       return -1;
577   }
578     }
579     return ((Tcl_WideInt) newPos) | (((Tcl_WideInt) newPosHigh) << 32);
580 }
Tcl_Channel Tcl_MakeFileChannel (ClientData rawHandle, int mode)

Definition at line 963 of file tclWinChan.c.
References BOOL(), FALSE, FILE_TYPE_CONSOLE, FILE_TYPE_SERIAL, FileGetType(), NULL, TCL_INTEGER_SPACE, TCL_READABLE, TCL_WRITABLE, TclpCreateCommandChannel(), TclWinMakeFile(), TclWinOpenConsoleChannel(), TclWinOpenFileChannel(), and TclWinOpenSerialChannel().967 {
968 #ifdef HAVE_NO_SEH
969     EXCEPTION_REGISTRATION registration;
970 #endif
971     char channelName[16 + TCL_INTEGER_SPACE];
972     Tcl_Channel channel = NULL;
973     HANDLE handle = (HANDLE) rawHandle;
974     HANDLE dupedHandle;
975     TclFile readFile = NULL;
976     TclFile writeFile = NULL;
977     BOOL result;
978 
979     if (mode == 0) {
980   return NULL;
981     }
982 
983     switch (FileGetType(handle))
984     {
985     case FILE_TYPE_SERIAL:
986   channel = TclWinOpenSerialChannel(handle, channelName, mode);
987   break;
988     case FILE_TYPE_CONSOLE:
989   channel = TclWinOpenConsoleChannel(handle, channelName, mode);
990   break;
991     case FILE_TYPE_PIPE:
992   if (mode & TCL_READABLE)
993   {
994       readFile = TclWinMakeFile(handle);
995   }
996   if (mode & TCL_WRITABLE)
997   {
998       writeFile = TclWinMakeFile(handle);
999   }
1000   channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
1001   break;
1002 
1003     case FILE_TYPE_DISK:
1004     case FILE_TYPE_CHAR:
1005   channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
1006   break;
1007   
1008     case FILE_TYPE_UNKNOWN:
1009     default:
1010   /*
1011    * The handle is of an unknown type.  Test the validity of this OS
1012    * handle by duplicating it, then closing the dupe.  The Win32 API
1013    * doesn't provide an IsValidHandle() function, so we have to emulate
1014    * it here.  This test will not work on a console handle reliably,
1015    * which is why we can't test every handle that comes into this
1016    * function in this way.
1017    */
1018 
1019   result = DuplicateHandle(GetCurrentProcess(), handle,
1020     GetCurrentProcess(), &dupedHandle, 0, FALSE,
1021     DUPLICATE_SAME_ACCESS);
1022 
1023   if (result == 0) {
1024       /* 
1025        * Unable to make a duplicate. It's definately invalid at this
1026        * point.
1027        */
1028 
1029       return NULL;
1030   }
1031 
1032   /*
1033    * Use structured exception handling (Win32 SEH) to protect the close
1034    * of this duped handle which might throw EXCEPTION_INVALID_HANDLE.
1035    */
1036 
1037   result = 0;
1038 #ifndef HAVE_NO_SEH
1039   __try {
1040       CloseHandle(dupedHandle);
1041       result = 1;
1042   } __except (EXCEPTION_EXECUTE_HANDLER) {}
1043 #else
1044   /*
1045    * Don't have SEH available, do things the hard way.
1046    * Note that this needs to be one block of asm, to avoid stack
1047    * imbalance; also, it is illegal for one asm block to contain 
1048    * a jump to another.
1049    */
1050   
1051   __asm__ __volatile__ (
1052 
1053       /*
1054        * Pick up parameters before messing with the stack
1055        */
1056 
1057       "movl       %[dupedHandle], %%ebx"          "\n\t"
1058 
1059       /*
1060        * Construct an EXCEPTION_REGISTRATION to protect the
1061        * call to CloseHandle
1062        */
1063       "leal       %[registration], %%edx"         "\n\t"
1064       "movl       %%fs:0,         %%eax"          "\n\t"
1065       "movl       %%eax,          0x0(%%edx)"     "\n\t" /* link */
1066       "leal       1f,             %%eax"          "\n\t"
1067       "movl       %%eax,          0x4(%%edx)"     "\n\t" /* handler */
1068       "movl       %%ebp,          0x8(%%edx)"     "\n\t" /* ebp */
1069       "movl       %%esp,          0xc(%%edx)"     "\n\t" /* esp */
1070       "movl       $0,             0x10(%%edx)"    "\n\t" /* status */
1071   
1072       /* Link the EXCEPTION_REGISTRATION on the chain */
1073       
1074       "movl       %%edx,          %%fs:0"         "\n\t"
1075       
1076       /* Call CloseHandle( dupedHandle ) */
1077       
1078       "pushl      %%ebx"                          "\n\t"
1079       "call       _CloseHandle@4"                 "\n\t"
1080       
1081       /* 
1082        * Come here on normal exit.  Recover the EXCEPTION_REGISTRATION
1083        * and put a TRUE status return into it.
1084        */
1085       
1086       "movl       %%fs:0,         %%edx"          "\n\t"
1087       "movl $1,   %%eax"    "\n\t"
1088       "movl       %%eax,          0x10(%%edx)"    "\n\t"
1089       "jmp        2f"                             "\n"
1090       
1091       /*
1092        * Come here on an exception.  Recover the EXCEPTION_REGISTRATION
1093        */
1094       
1095       "1:"                                        "\t"
1096       "movl       %%fs:0,         %%edx"          "\n\t"
1097       "movl       0x8(%%edx),     %%edx"          "\n\t"
1098       
1099       /* 
1100        * Come here however we exited.  Restore context from the
1101        * EXCEPTION_REGISTRATION in case the stack is unbalanced.
1102        */
1103       
1104       "2:"                                        "\t"
1105       "movl       0xc(%%edx),     %%esp"          "\n\t"
1106       "movl       0x8(%%edx),     %%ebp"          "\n\t"
1107       "movl       0x0(%%edx),     %%eax"          "\n\t"
1108       "movl       %%eax,          %%fs:0"         "\n\t"
1109       
1110       :
1111       /* No outputs */
1112       :
1113       [registration]  "m"     (registration),
1114       [dupedHandle]   "m"     (dupedHandle)
1115       :
1116       "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"
1117       );
1118   result = registration.status;
1119 
1120 #endif
1121   if (result == FALSE) {
1122       return NULL;
1123   }
1124 
1125   /* Fall through, the handle is valid. */
1126 
1127   /*
1128    * Create the undefined channel, anyways, because we know the handle
1129    * is valid to something.
1130    */
1131 
1132   channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
1133     }
1134 
1135     return channel;
1136 }
Tcl_Channel TclpGetDefaultStdChannel (int type)

Definition at line 1156 of file tclWinChan.c.
References DWORD(), NULL, panic, Tcl_Close(), TCL_ERROR, Tcl_MakeFileChannel(), TCL_READABLE, Tcl_SetChannelOption(), TCL_STDERR, TCL_STDIN, TCL_STDOUT, and TCL_WRITABLE.1158 {
1159     Tcl_Channel channel;
1160     HANDLE handle;
1161     int mode;
1162     char *bufMode;
1163     DWORD handleId;   /* Standard handle to retrieve. */
1164 
1165 
1166     switch (type) {
1167   case TCL_STDIN:
1168       handleId = STD_INPUT_HANDLE;
1169       mode = TCL_READABLE;
1170       bufMode = "line";
1171       break;
1172   case TCL_STDOUT:
1173       handleId = STD_OUTPUT_HANDLE;
1174       mode = TCL_WRITABLE;
1175       bufMode = "line";
1176       break;
1177   case TCL_STDERR:
1178       handleId = STD_ERROR_HANDLE;
1179       mode = TCL_WRITABLE;
1180       bufMode = "none";
1181       break;
1182   default:
1183       panic("TclGetDefaultStdChannel: Unexpected channel type");
1184       break;
1185     }
1186 
1187     handle = GetStdHandle(handleId);
1188 
1189     /*
1190      * Note that we need to check for 0 because Windows may return 0 if this
1191      * is not a console mode application, even though this is not a valid
1192      * handle.
1193      */
1194 
1195     if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
1196   return (Tcl_Channel) NULL;
1197     }
1198 
1199     channel = Tcl_MakeFileChannel(handle, mode);
1200 
1201     if (channel == NULL) {
1202   return (Tcl_Channel) NULL;
1203     }
1204 
1205     /*
1206      * Set up the normal channel options for stdio handles.
1207      */
1208 
1209     if ((Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-translation",
1210             "auto") == TCL_ERROR)
1211       || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-eofchar",
1212         "\032 {}") == TCL_ERROR)
1213       || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel,
1214         "-buffering", bufMode) == TCL_ERROR)) {
1215         Tcl_Close((Tcl_Interp *) NULL, channel);
1216         return (Tcl_Channel) NULL;
1217     }
1218     return channel;
1219 }
Tcl_Channel TclpOpenFileChannel (Tcl_Interp * interp, Tcl_Obj * pathPtr, int mode, int permissions)

Definition at line 776 of file tclWinChan.c.
References CONST, DWORD(), FILE_APPEND, FILE_TYPE_CONSOLE, FILE_TYPE_SERIAL, FileGetType(), NULL, panic, Tcl_FSGetNativePath(), Tcl_GetString(), TCL_INTEGER_SPACE, Tcl_PosixError(), TCL_READABLE, TCL_WRITABLE, TclpCreateCommandChannel(), TclWinConvertError(), TclWinMakeFile(), TclWinOpenConsoleChannel(), TclWinOpenFileChannel(), TclWinOpenSerialChannel(), tclWinProcs, and TclWinSerialReopen().784 {
785     Tcl_Channel channel = 0;
786     int channelPermissions;
787     DWORD accessMode, createMode, shareMode, flags;
788     CONST TCHAR *nativeName;
789     HANDLE handle;
790     char channelName[16 + TCL_INTEGER_SPACE];
791     TclFile readFile = NULL;
792     TclFile writeFile = NULL;
793 
794     nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr);
795     if (nativeName == NULL) {
796   return NULL;
797     }
798     
799     switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
800   case O_RDONLY:
801       accessMode = GENERIC_READ;
802       channelPermissions = TCL_READABLE;
803       break;
804   case O_WRONLY:
805       accessMode = GENERIC_WRITE;
806       channelPermissions = TCL_WRITABLE;
807       break;
808   case O_RDWR:
809       accessMode = (GENERIC_READ | GENERIC_WRITE);
810       channelPermissions = (TCL_READABLE | TCL_WRITABLE);
811       break;
812   default:
813       panic("TclpOpenFileChannel: invalid mode value");
814       break;
815     }
816 
817     /*
818      * Map the creation flags to the NT create mode.
819      */
820 
821     switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
822   case (O_CREAT | O_EXCL):
823   case (O_CREAT | O_EXCL | O_TRUNC):
824       createMode = CREATE_NEW;
825       break;
826   case (O_CREAT | O_TRUNC):
827       createMode = CREATE_ALWAYS;
828       break;
829   case O_CREAT:
830       createMode = OPEN_ALWAYS;
831       break;
832   case O_TRUNC:
833   case (O_TRUNC | O_EXCL):
834       createMode = TRUNCATE_EXISTING;
835       break;
836   default:
837       createMode = OPEN_EXISTING;
838       break;
839     }
840 
841     /*
842      * If the file is being created, get the file attributes from the
843      * permissions argument, else use the existing file attributes.
844      */
845 
846     if (mode & O_CREAT) {
847         if (permissions & S_IWRITE) {
848             flags = FILE_ATTRIBUTE_NORMAL;
849         } else {
850             flags = FILE_ATTRIBUTE_READONLY;
851         }
852     } else {
853   flags = (*tclWinProcs->getFileAttributesProc)(nativeName);
854         if (flags == 0xFFFFFFFF) {
855       flags = 0;
856   }
857     }
858 
859     /*
860      * Set up the file sharing mode.  We want to allow simultaneous access.
861      */
862 
863     shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
864 
865     /*
866      * Now we get to create the file.
867      */
868 
869     handle = (*tclWinProcs->createFileProc)(nativeName, accessMode, 
870       shareMode, NULL, createMode, flags, (HANDLE) NULL);
871 
872     if (handle == INVALID_HANDLE_VALUE) {
873   DWORD err;
874   err = GetLastError();
875   if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
876       err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
877   }
878         TclWinConvertError(err);
879   if (interp != (Tcl_Interp *) NULL) {
880             Tcl_AppendResult(interp, "couldn't open \"", 
881            Tcl_GetString(pathPtr), "\": ",
882            Tcl_PosixError(interp), (char *) NULL);
883         }
884         return NULL;
885     }
886     
887     channel = NULL;
888 
889     switch ( FileGetType(handle) ) {
890     case FILE_TYPE_SERIAL:
891   /*
892    * Reopen channel for OVERLAPPED operation
893    * Normally this shouldn't fail, because the channel exists
894    */
895   handle = TclWinSerialReopen(handle, nativeName, accessMode);
896   if (handle == INVALID_HANDLE_VALUE) {
897       TclWinConvertError(GetLastError());
898       if (interp != (Tcl_Interp *) NULL) {
899     Tcl_AppendResult(interp, "couldn't reopen serial \"",
900       Tcl_GetString(pathPtr), "\": ",
901       Tcl_PosixError(interp), (char *) NULL);
902       }
903       return NULL;
904   }
905   channel = TclWinOpenSerialChannel(handle, channelName,
906           channelPermissions);
907   break;
908     case FILE_TYPE_CONSOLE:
909   channel = TclWinOpenConsoleChannel(handle, channelName,
910           channelPermissions);
911   break;
912     case FILE_TYPE_PIPE:
913   if (channelPermissions & TCL_READABLE) {
914       readFile = TclWinMakeFile(handle);
915   }
916   if (channelPermissions & TCL_WRITABLE) {
917       writeFile = TclWinMakeFile(handle);
918   }
919   channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
920   break;
921     case FILE_TYPE_CHAR:
922     case FILE_TYPE_DISK:
923     case FILE_TYPE_UNKNOWN:
924   channel = TclWinOpenFileChannel(handle, channelName,
925           channelPermissions,
926           (mode & O_APPEND) ? FILE_APPEND : 0);
927   break;
928 
929     default:
930   /*
931    * The handle is of an unknown type, probably /dev/nul equivalent
932    * or possibly a closed handle.  
933    */
934   
935   channel = NULL;
936   Tcl_AppendResult(interp, "couldn't open \"", 
937        Tcl_GetString(pathPtr), "\": ",
938        "bad file type", (char *) NULL);
939   break;
940     }
941 
942     return channel;
943 }
void TclWinFlushDirtyChannels ()

Definition at line 1314 of file tclWinChan.c.
References FileInfo::dirty, FileInit(), ThreadSpecificData::firstFilePtr, FileInfo::handle, FileInfo::nextPtr, and NULL.
Referenced by TclpObjLstat(), and TclpObjStat().1315 {
1316     FileInfo *infoPtr;
1317     ThreadSpecificData *tsdPtr;
1318 
1319     tsdPtr = FileInit();
1320 
1321     /*
1322      * Flush all channels which are dirty, i.e. may have data pending
1323      * in the OS
1324      */
1325     
1326     for (infoPtr = tsdPtr->firstFilePtr;
1327    infoPtr != NULL; 
1328    infoPtr = infoPtr->nextPtr) {
1329   if (infoPtr->dirty) {
1330       FlushFileBuffers(infoPtr->handle);
1331       infoPtr->dirty = 0;
1332   }
1333     }
1334 }
Tcl_Channel TclWinOpenFileChannel (HANDLE handle, char * channelName, int permissions, int appendMode)

Definition at line 1243 of file tclWinChan.c.
References FileInfo::channel, ckalloc, FileInfo::dirty, fileChannelType, FileInit(), ThreadSpecificData::firstFilePtr, FileInfo::flags, FileInfo::handle, FileInfo::nextPtr, NULL, Tcl_CreateChannel(), Tcl_SetChannelOption(), FileInfo::validMask, and FileInfo::watchMask.
Referenced by Tcl_MakeFileChannel(), and TclpOpenFileChannel().1248 {
1249     FileInfo *infoPtr;
1250     ThreadSpecificData *tsdPtr;
1251 
1252     tsdPtr = FileInit();
1253 
1254     /*
1255      * See if a channel with this handle already exists.
1256      */
1257     
1258     for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; 
1259    infoPtr = infoPtr->nextPtr) {
1260   if (infoPtr->handle == (HANDLE) handle) {
1261       return (permissions == infoPtr->validMask) ? infoPtr->channel : NULL;
1262   }
1263     }
1264 
1265     infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
1266     /* TIP #218. Removed the code inserting the new structure
1267      * into the global list. This is now handled in the thread
1268      * action callbacks, and only there.
1269      */
1270     infoPtr->nextPtr = NULL;
1271     infoPtr->validMask = permissions;
1272     infoPtr->watchMask = 0;
1273     infoPtr->flags = appendMode;
1274     infoPtr->handle = handle;
1275     infoPtr->dirty = 0;
1276     wsprintfA(channelName, "file%lx", (int) infoPtr);
1277     
1278     infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
1279       (ClientData) infoPtr, permissions);
1280     
1281     /*
1282      * Files have default translation of AUTO and ^Z eof char, which
1283      * means that a ^Z will be accepted as EOF when reading.
1284      */
1285     
1286     Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
1287     Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
1288 
1289     return infoPtr->channel;
1290 }

Variable Documentation
Tcl_ThreadDataKey dataKey [static]

Definition at line 56 of file tclWinChan.c.Tcl_ChannelType fileChannelType [static]
Initial value: {
    "file",     
    TCL_CHANNEL_VERSION_4,  
    FileCloseProc,    
    FileInputProc,    
    FileOutputProc,   
    FileSeekProc,   
    NULL,     
    NULL,     
    FileWatchProc,    
    FileGetHandleProc,    
    NULL,     
    FileBlockProc,    
    NULL,     
    NULL,     
    FileWideSeekProc,   
    FileThreadActionProc, 
}
Definition at line 109 of file tclWinChan.c.

win/tclWinConsole.c File Reference
#include "tclWinInt.h"
#include <fcntl.h>
#include <io.h>
#include <sys/stat.h>
Classes
struct ThreadSpecificData
struct ConsoleEvent
Defines
#define CONSOLE_PENDING  (1<<0)
#define CONSOLE_ASYNC  (1<<1)
#define CONSOLE_EOF  (1<<2)
#define CONSOLE_BUFFERED  (1<<3)
#define CONSOLE_BUFFER_SIZE  (8*1024)
Functions
TCL_DECLARE_MUTEX (consoleMutex)
static int ConsoleBlockModeProc (ClientData instanceData, int mode)
static void ConsoleCheckProc (ClientData clientData, int flags)
static int ConsoleCloseProc (ClientData instanceData, Tcl_Interp *interp)
static int ConsoleEventProc (Tcl_Event *evPtr, int flags)
static void ConsoleExitHandler (ClientData clientData)
static int ConsoleGetHandleProc (ClientData instanceData, int direction, ClientData *handlePtr)
static void ConsoleInit (void)
static int ConsoleInputProc (ClientData instanceData, char *buf, int toRead, int *errorCode)
static int ConsoleOutputProc (ClientData instanceData, CONST char *buf, int toWrite, int *errorCode)
static DWORD WINAPI ConsoleReaderThread (LPVOID arg)
static void ConsoleSetupProc (ClientData clientData, int flags)
static void ConsoleWatchProc (ClientData instanceData, int mask)
static DWORD WINAPI ConsoleWriterThread (LPVOID arg)
static void ProcExitHandler (ClientData clientData)
static int WaitForRead (ConsoleInfo *infoPtr, int blocking)
static void ConsoleThreadActionProc _ANSI_ARGS_ ((ClientData instanceData, int action))
Tcl_Channel TclWinOpenConsoleChannel (HANDLE handle, char *channelName, int permissions)
static void ConsoleThreadActionProc (ClientData instanceData, int action)
Variables
static int initialized = 0
ConsoleInfo
static Tcl_ThreadDataKey dataKey
static Tcl_ChannelType consoleChannelType

Define Documentation
#define CONSOLE_ASYNC  (1<<1)

Referenced by ConsoleBlockModeProc(), ConsoleInputProc(), and ConsoleOutputProc().#define CONSOLE_BUFFER_SIZE  (8*1024)

Referenced by ConsoleReaderThread(), and TCL_DECLARE_MUTEX().#define CONSOLE_BUFFERED  (1<<3)

Referenced by ConsoleInputProc(), ConsoleReaderThread(), and WaitForRead().#define CONSOLE_EOF  (1<<2)

Referenced by ConsoleEventProc(), ConsoleReaderThread(), and WaitForRead().#define CONSOLE_PENDING  (1<<0)

Referenced by ConsoleCheckProc(), and ConsoleEventProc().
Function Documentation
static void ConsoleThreadActionProc _ANSI_ARGS_ ((ClientData instanceData, int action)) [static]
static int ConsoleBlockModeProc (ClientData instanceData, int mode) [static]

Definition at line 424 of file tclWinConsole.c.
References CONSOLE_ASYNC, ConsoleInfo, and TCL_MODE_NONBLOCKING.428 {
429     ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
430     
431     /*
432      * Consoles on Windows can not be switched between blocking and nonblocking,
433      * hence we have to emulate the behavior. This is done in the input
434      * function by checking against a bit in the state. We set or unset the
435      * bit here to cause the input function to emulate the correct behavior.
436      */
437 
438     if (mode == TCL_MODE_NONBLOCKING) {
439   infoPtr->flags |= CONSOLE_ASYNC;
440     } else {
441   infoPtr->flags &= ~(CONSOLE_ASYNC);
442     }
443     return 0;
444 }
static void ConsoleCheckProc (ClientData clientData, int flags) [static]

Definition at line 355 of file tclWinConsole.c.
References ckalloc, CONSOLE_PENDING, ConsoleEventProc(), ConsoleInfo, ThreadSpecificData::firstConsolePtr, ConsoleEvent::header, ConsoleEvent::infoPtr, NULL, Tcl_Event::proc, TCL_FILE_EVENTS, TCL_QUEUE_TAIL, Tcl_QueueEvent(), TCL_READABLE, TCL_TSD_INIT, TCL_WRITABLE, and WaitForRead().
Referenced by ConsoleExitHandler(), and ConsoleInit().358 {
359     ConsoleInfo *infoPtr;
360     ConsoleEvent *evPtr;
361     int needEvent;
362     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
363 
364     if (!(flags & TCL_FILE_EVENTS)) {
365   return;
366     }
367     
368     /*
369      * Queue events for any ready consoles that don't already have events
370      * queued.
371      */
372 
373     for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL; 
374       infoPtr = infoPtr->nextPtr) {
375   if (infoPtr->flags & CONSOLE_PENDING) {
376       continue;
377   }
378   
379   /*
380    * Queue an event if the console is signaled for reading or writing.
381    */
382 
383   needEvent = 0;
384   if (infoPtr->watchMask & TCL_WRITABLE) {
385       if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
386     needEvent = 1;
387       }
388   }
389   
390   if (infoPtr->watchMask & TCL_READABLE) {
391       if (WaitForRead(infoPtr, 0) >= 0) {
392     needEvent = 1;
393       }
394   }
395 
396   if (needEvent) {
397       infoPtr->flags |= CONSOLE_PENDING;
398       evPtr = (ConsoleEvent *) ckalloc(sizeof(ConsoleEvent));
399       evPtr->header.proc = ConsoleEventProc;
400       evPtr->infoPtr = infoPtr;
401       Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
402   }
403     }
404 }
static int ConsoleCloseProc (ClientData instanceData, Tcl_Interp * interp) [static]

Definition at line 463 of file tclWinConsole.c.
References ckfree, ConsoleInfo, DWORD(), errno, FALSE, ThreadSpecificData::firstConsolePtr, NULL, Tcl_MutexLock, Tcl_MutexUnlock, TCL_READABLE, TCL_TSD_INIT, TCL_WRITABLE, TclInThreadExit(), and TclWinConvertError().466 {
467     ConsoleInfo *consolePtr = (ConsoleInfo *) instanceData;
468     int errorCode;
469     ConsoleInfo *infoPtr, **nextPtrPtr;
470     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
471     DWORD exitCode;
472 
473     errorCode = 0;
474     
475     /*
476      * Clean up the background thread if necessary.  Note that this
477      * must be done before we can close the file, since the 
478      * thread may be blocking trying to read from the console.
479      */
480     
481     if (consolePtr->readThread) {
482 
483   /*
484    * The thread may already have closed on it's own.  Check it's
485    * exit code.
486    */
487 
488   GetExitCodeThread(consolePtr->readThread, &exitCode);
489 
490   if (exitCode == STILL_ACTIVE) {
491 
492       /*
493        * Set the stop event so that if the reader thread is blocked
494        * in ConsoleReaderThread on WaitForMultipleEvents, it will exit
495        * cleanly.
496        */
497 
498       SetEvent(consolePtr->stopReader);
499 
500       /*
501        * Wait at most 20 milliseconds for the reader thread to close.
502        */
503 
504       if (WaitForSingleObject(consolePtr->readThread, 20)
505         == WAIT_TIMEOUT) {
506     /*
507      * Forcibly terminate the background thread as a last
508      * resort.  Note that we need to guard against
509      * terminating the thread while it is in the middle of
510      * Tcl_ThreadAlert because it won't be able to release
511      * the notifier lock.
512      */
513 
514     Tcl_MutexLock(&consoleMutex);
515 
516     /* BUG: this leaks memory. */
517     TerminateThread(consolePtr->readThread, 0);
518     Tcl_MutexUnlock(&consoleMutex);
519       }
520   }
521 
522   CloseHandle(consolePtr->readThread);
523   CloseHandle(consolePtr->readable);
524   CloseHandle(consolePtr->startReader);
525   CloseHandle(consolePtr->stopReader);
526   consolePtr->readThread = NULL;
527     }
528     consolePtr->validMask &= ~TCL_READABLE;
529 
530     /*
531      * Wait for the writer thread to finish the current buffer, then
532      * terminate the thread and close the handles.  If the channel is
533      * nonblocking, there should be no pending write operations.
534      */
535     
536     if (consolePtr->writeThread) {
537   if (consolePtr->toWrite) {
538       /*
539        * We only need to wait if there is something to write.
540        * This may prevent infinite wait on exit. [python bug 216289]
541        */
542       WaitForSingleObject(consolePtr->writable, INFINITE);
543   }
544 
545   /*
546    * The thread may already have closed on it's own.  Check it's
547    * exit code.
548    */
549 
550   GetExitCodeThread(consolePtr->writeThread, &exitCode);
551 
552   if (exitCode == STILL_ACTIVE) {
553       /*
554        * Set the stop event so that if the reader thread is blocked
555        * in ConsoleWriterThread on WaitForMultipleEvents, it will
556        * exit cleanly.
557        */
558 
559       SetEvent(consolePtr->stopWriter);
560 
561       /*
562        * Wait at most 20 milliseconds for the writer thread to close.
563        */
564 
565       if (WaitForSingleObject(consolePtr->writeThread, 20)
566         == WAIT_TIMEOUT) {
567     /*
568      * Forcibly terminate the background thread as a last
569      * resort.  Note that we need to guard against
570      * terminating the thread while it is in the middle of
571      * Tcl_ThreadAlert because it won't be able to release
572      * the notifier lock.
573      */
574 
575     Tcl_MutexLock(&consoleMutex);
576 
577     /* BUG: this leaks memory. */
578     TerminateThread(consolePtr->writeThread, 0);
579     Tcl_MutexUnlock(&consoleMutex);
580       }
581   }
582 
583   CloseHandle(consolePtr->writeThread);
584   CloseHandle(consolePtr->writable);
585   CloseHandle(consolePtr->startWriter);
586   CloseHandle(consolePtr->stopWriter);
587   consolePtr->writeThread = NULL;
588     }
589     consolePtr->validMask &= ~TCL_WRITABLE;
590 
591 
592     /*
593      * Don't close the Win32 handle if the handle is a standard channel
594      * during the thread exit process.  Otherwise, one thread may kill
595      * the stdio of another.
596      */
597 
598     if (!TclInThreadExit() 
599       || ((GetStdHandle(STD_INPUT_HANDLE) != consolePtr->handle)
600     && (GetStdHandle(STD_OUTPUT_HANDLE) != consolePtr->handle)
601     && (GetStdHandle(STD_ERROR_HANDLE) != consolePtr->handle))) {
602   if (CloseHandle(consolePtr->handle) == FALSE) {
603       TclWinConvertError(GetLastError());
604       errorCode = errno;
605   }
606     }
607     
608     consolePtr->watchMask &= consolePtr->validMask;
609 
610     /*
611      * Remove the file from the list of watched files.
612      */
613 
614     for (nextPtrPtr = &(tsdPtr->firstConsolePtr), infoPtr = *nextPtrPtr;
615       infoPtr != NULL;
616       nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
617   if (infoPtr == (ConsoleInfo *)consolePtr) {
618       *nextPtrPtr = infoPtr->nextPtr;
619       break;
620   }
621     }
622     if (consolePtr->writeBuf != NULL) {
623   ckfree(consolePtr->writeBuf);
624   consolePtr->writeBuf = 0;
625     }
626     ckfree((char*) consolePtr);
627 
628     return errorCode;
629 }
static int ConsoleEventProc (Tcl_Event * evPtr, int flags) [static]

Definition at line 831 of file tclWinConsole.c.
References CONSOLE_EOF, CONSOLE_PENDING, ConsoleInfo, ThreadSpecificData::firstConsolePtr, ConsoleEvent::infoPtr, NULL, TCL_FILE_EVENTS, Tcl_NotifyChannel(), TCL_READABLE, TCL_TSD_INIT, TCL_WRITABLE, and WaitForRead().
Referenced by ConsoleCheckProc().835 {
836     ConsoleEvent *consoleEvPtr = (ConsoleEvent *)evPtr;
837     ConsoleInfo *infoPtr;
838     int mask;
839     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
840 
841     if (!(flags & TCL_FILE_EVENTS)) {
842   return 0;
843     }
844 
845     /*
846      * Search through the list of watched consoles for the one whose handle
847      * matches the event.  We do this rather than simply dereferencing
848      * the handle in the event so that consoles can be deleted while the
849      * event is in the queue.
850      */
851 
852     for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
853       infoPtr = infoPtr->nextPtr) {
854   if (consoleEvPtr->infoPtr == infoPtr) {
855       infoPtr->flags &= ~(CONSOLE_PENDING);
856       break;
857   }
858     }
859 
860     /*
861      * Remove stale events.
862      */
863 
864     if (!infoPtr) {
865   return 1;
866     }
867 
868     /*
869      * Check to see if the console is readable.  Note
870      * that we can't tell if a console is writable, so we always report it
871      * as being writable unless we have detected EOF.
872      */
873 
874     mask = 0;
875     if (infoPtr->watchMask & TCL_WRITABLE) {
876   if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
877       mask = TCL_WRITABLE;
878   }
879     }
880 
881     if (infoPtr->watchMask & TCL_READABLE) {
882   if (WaitForRead(infoPtr, 0) >= 0) {
883       if (infoPtr->readFlags & CONSOLE_EOF) {
884     mask = TCL_READABLE;
885       } else {
886     mask |= TCL_READABLE;
887       }
888   } 
889     }
890 
891     /*
892      * Inform the channel of the events.
893      */
894 
895     Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask);
896     return 1;
897 }
static void ConsoleExitHandler (ClientData clientData) [static]

Definition at line 252 of file tclWinConsole.c.
References ConsoleCheckProc(), ConsoleSetupProc(), NULL, and Tcl_DeleteEventSource().
Referenced by ConsoleInit().254 {
255     Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
256 }
static int ConsoleGetHandleProc (ClientData instanceData, int direction, ClientData * handlePtr) [static]

Definition at line 979 of file tclWinConsole.c.
References ConsoleInfo, and TCL_OK.983 {
984     ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
985 
986     *handlePtr = (ClientData) infoPtr->handle;
987     return TCL_OK;
988 }
static void ConsoleInit (void) [static]

Definition at line 207 of file tclWinConsole.c.
References ConsoleCheckProc(), ConsoleExitHandler(), ConsoleSetupProc(), ThreadSpecificData::firstConsolePtr, initialized, NULL, ProcExitHandler(), Tcl_CreateEventSource(), Tcl_CreateExitHandler(), Tcl_CreateThreadExitHandler(), Tcl_MutexLock, Tcl_MutexUnlock, TCL_TSD_INIT, and TclThreadDataKeyGet().
Referenced by ConsoleThreadActionProc(), and TclWinOpenConsoleChannel().208 {
209     ThreadSpecificData *tsdPtr;
210 
211     /*
212      * Check the initialized flag first, then check again in the mutex.
213      * This is a speed enhancement.
214      */
215 
216     if (!initialized) {
217   Tcl_MutexLock(&consoleMutex);
218   if (!initialized) {
219       initialized = 1;
220       Tcl_CreateExitHandler(ProcExitHandler, NULL);
221   }
222   Tcl_MutexUnlock(&consoleMutex);
223     }
224 
225     tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
226     if (tsdPtr == NULL) {
227   tsdPtr = TCL_TSD_INIT(&dataKey);
228   tsdPtr->firstConsolePtr = NULL;
229   Tcl_CreateEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
230   Tcl_CreateThreadExitHandler(ConsoleExitHandler, NULL);
231     }
232 }
static int ConsoleInputProc (ClientData instanceData, char * buf, int toRead, int * errorCode) [static]

Definition at line 650 of file tclWinConsole.c.
References CONSOLE_ASYNC, CONSOLE_BUFFERED, ConsoleInfo, DWORD(), errno, NULL, size_t(), TRUE, and WaitForRead().656 {
657     ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
658     DWORD count, bytesRead = 0;
659     int result;
660 
661     *errorCode = 0;
662 
663     /*
664      * Synchronize with the reader thread.
665      */
666     
667     result = WaitForRead(infoPtr, (infoPtr->flags & CONSOLE_ASYNC) ? 0 : 1);
668     
669     /*
670      * If an error occurred, return immediately.
671      */
672     
673     if (result == -1) {
674   *errorCode = errno;
675   return -1;
676     }
677 
678     if (infoPtr->readFlags & CONSOLE_BUFFERED) {
679   /*
680    * Data is stored in the buffer.
681    */
682 
683   if (bufSize < (infoPtr->bytesRead - infoPtr->offset)) {
684       memcpy(buf, &infoPtr->buffer[infoPtr->offset], (size_t) bufSize);
685       bytesRead = bufSize;
686       infoPtr->offset += bufSize;
687   } else {
688       memcpy(buf, &infoPtr->buffer[infoPtr->offset], (size_t) bufSize);
689       bytesRead = infoPtr->bytesRead - infoPtr->offset;
690 
691       /*
692        * Reset the buffer
693        */
694       
695       infoPtr->readFlags &= ~CONSOLE_BUFFERED;
696       infoPtr->offset = 0;
697   }
698 
699   return bytesRead;
700     }
701     
702     /*
703      * Attempt to read bufSize bytes.  The read will return immediately
704      * if there is any data available.  Otherwise it will block until
705      * at least one byte is available or an EOF occurs.
706      */
707 
708     if (ReadConsole(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &count,
709         (LPOVERLAPPED) NULL) == TRUE) {
710   buf[count] = '\0';
711   return count;
712     }
713 
714     return -1;
715 }
static int ConsoleOutputProc (ClientData instanceData, CONST char * buf, int toWrite, int * errorCode) [static]

Definition at line 736 of file tclWinConsole.c.
References ckalloc, ckfree, CONSOLE_ASYNC, ConsoleInfo, DWORD(), EAGAIN, errno, FALSE, NULL, size_t(), and TclWinConvertError().741 {
742     ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
743     DWORD bytesWritten, timeout;
744     
745     *errorCode = 0;
746     timeout = (infoPtr->flags & CONSOLE_ASYNC) ? 0 : INFINITE;
747     if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) {
748   /*
749    * The writer thread is blocked waiting for a write to complete
750    * and the channel is in non-blocking mode.
751    */
752 
753   errno = EAGAIN;
754   goto error;
755     }
756     
757     /*
758      * Check for a background error on the last write.
759      */
760 
761     if (infoPtr->writeError) {
762   TclWinConvertError(infoPtr->writeError);
763   infoPtr->writeError = 0;
764   goto error;
765     }
766 
767     if (infoPtr->flags & CONSOLE_ASYNC) {
768   /*
769    * The console is non-blocking, so copy the data into the output
770    * buffer and restart the writer thread.
771    */
772 
773   if (toWrite > infoPtr->writeBufLen) {
774       /*
775        * Reallocate the buffer to be large enough to hold the data.
776        */
777 
778       if (infoPtr->writeBuf) {
779     ckfree(infoPtr->writeBuf);
780       }
781       infoPtr->writeBufLen = toWrite;
782       infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
783   }
784   memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
785   infoPtr->toWrite = toWrite;
786   ResetEvent(infoPtr->writable);
787   SetEvent(infoPtr->startWriter);
788   bytesWritten = toWrite;
789     } else {
790   /*
791    * In the blocking case, just try to write the buffer directly.
792    * This avoids an unnecessary copy.
793    */
794 
795   if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite,
796     &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
797       TclWinConvertError(GetLastError());
798       goto error;
799   }
800     }
801     return bytesWritten;
802 
803     error:
804     *errorCode = errno;
805     return -1;
806 
807 }
static DWORD WINAPI ConsoleReaderThread (LPVOID arg) [static]

Definition at line 1114 of file tclWinConsole.c.
References CONSOLE_BUFFER_SIZE, CONSOLE_BUFFERED, CONSOLE_EOF, ConsoleInfo, DWORD(), FALSE, NULL, Tcl_MutexLock, Tcl_MutexUnlock, and Tcl_ThreadAlert().
Referenced by TclWinOpenConsoleChannel().1115 {
1116     ConsoleInfo *infoPtr = (ConsoleInfo *)arg;
1117     HANDLE *handle = infoPtr->handle;
1118     DWORD count, waitResult;
1119     HANDLE wEvents[2];
1120 
1121     /* The first event takes precedence. */
1122     wEvents[0] = infoPtr->stopReader;
1123     wEvents[1] = infoPtr->startReader;
1124 
1125     for (;;) {
1126   /*
1127    * Wait for the main thread to signal before attempting to wait.
1128    */
1129 
1130   waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
1131 
1132   if (waitResult != (WAIT_OBJECT_0 + 1)) {
1133       /*
1134        * The start event was not signaled.  It must be the stop event
1135        * or an error, so exit this thread.
1136        */
1137 
1138       break;
1139   }
1140 
1141   count = 0;
1142 
1143   /* 
1144    * Look for data on the console, but first ignore any events
1145    * that are not KEY_EVENTs 
1146    */
1147   if (ReadConsoleA(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE,
1148     (LPDWORD) &infoPtr->bytesRead, NULL) != FALSE) {
1149       /*
1150        * Data was stored in the buffer.
1151        */
1152       
1153       infoPtr->readFlags |= CONSOLE_BUFFERED;
1154   } else {
1155       DWORD err;
1156       err = GetLastError();
1157       
1158       if (err == EOF) {
1159     infoPtr->readFlags = CONSOLE_EOF;
1160       }
1161   }
1162 
1163   /*
1164    * Signal the main thread by signalling the readable event and
1165    * then waking up the notifier thread.
1166    */
1167 
1168   SetEvent(infoPtr->readable);
1169 
1170   /*
1171    * Alert the foreground thread.  Note that we need to treat this like
1172    * a critical section so the foreground thread does not terminate
1173    * this thread while we are holding a mutex in the notifier code.
1174    */
1175 
1176   Tcl_MutexLock(&consoleMutex);
1177   if (infoPtr->threadId != NULL) {
1178       /* TIP #218. When in flight ignore the event, no one will receive it anyway */
1179       Tcl_ThreadAlert(infoPtr->threadId);
1180   }
1181   Tcl_MutexUnlock(&consoleMutex);
1182     }
1183 
1184     return 0;
1185 }
void ConsoleSetupProc (ClientData clientData, int flags) [static]

Definition at line 302 of file tclWinConsole.c.
References ConsoleInfo, ThreadSpecificData::firstConsolePtr, NULL, TCL_FILE_EVENTS, TCL_READABLE, Tcl_SetMaxBlockTime(), TCL_TSD_INIT, TCL_WRITABLE, and WaitForRead().
Referenced by ConsoleExitHandler(), and ConsoleInit().305 {
306     ConsoleInfo *infoPtr;
307     Tcl_Time blockTime = { 0, 0 };
308     int block = 1;
309     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
310 
311     if (!(flags & TCL_FILE_EVENTS)) {
312   return;
313     }
314     
315     /*
316      * Look to see if any events are already pending.  If they are, poll.
317      */
318 
319     for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL; 
320       infoPtr = infoPtr->nextPtr) {
321   if (infoPtr->watchMask & TCL_WRITABLE) {
322       if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
323     block = 0;
324       }
325   }
326   if (infoPtr->watchMask & TCL_READABLE) {
327       if (WaitForRead(infoPtr, 0) >= 0) {
328     block = 0;
329       }
330   }
331     }
332     if (!block) {
333   Tcl_SetMaxBlockTime(&blockTime);
334     }
335 }
static void ConsoleThreadActionProc (ClientData instanceData, int action) [static]

Definition at line 1392 of file tclWinConsole.c.
References ConsoleInfo, ConsoleInit(), NULL, TCL_CHANNEL_THREAD_INSERT, Tcl_GetChannelThread(), Tcl_MutexLock, and Tcl_MutexUnlock.1395 {
1396     ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
1397 
1398     /* We do not access firstConsolePtr in the thread structures. This is
1399      * not for all serials managed by the thread, but only those we are
1400      * watching. Removal of the filevent handlers before transfer thus
1401      * takes care of this structure.
1402      */
1403 
1404     Tcl_MutexLock(&consoleMutex);
1405     if (action == TCL_CHANNEL_THREAD_INSERT) {
1406         /* We can't copy the thread information from the channel when
1407    * the channel is created. At this time the channel back
1408    * pointer has not been set yet. However in that case the
1409    * threadId has already been set by TclpCreateCommandChannel
1410    * itself, so the structure is still good.
1411    */
1412 
1413         ConsoleInit ();
1414         if (infoPtr->channel != NULL) {
1415       infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel);
1416   }
1417     } else {
1418   infoPtr->threadId = NULL;
1419     }
1420     Tcl_MutexUnlock(&consoleMutex);
1421 }
static void ConsoleWatchProc (ClientData instanceData, int mask) [static]

Definition at line 917 of file tclWinConsole.c.
References ConsoleInfo, ThreadSpecificData::firstConsolePtr, NULL, Tcl_SetMaxBlockTime(), and TCL_TSD_INIT.922 {
923     ConsoleInfo **nextPtrPtr, *ptr;
924     ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
925     int oldMask = infoPtr->watchMask;
926     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
927 
928     /*
929      * Since most of the work is handled by the background threads,
930      * we just need to update the watchMask and then force the notifier
931      * to poll once. 
932      */
933 
934     infoPtr->watchMask = mask & infoPtr->validMask;
935     if (infoPtr->watchMask) {
936   Tcl_Time blockTime = { 0, 0 };
937   if (!oldMask) {
938       infoPtr->nextPtr = tsdPtr->firstConsolePtr;
939       tsdPtr->firstConsolePtr = infoPtr;
940   }
941   Tcl_SetMaxBlockTime(&blockTime);
942     } else {
943   if (oldMask) {
944       /*
945        * Remove the console from the list of watched consoles.
946        */
947 
948       for (nextPtrPtr = &(tsdPtr->firstConsolePtr), ptr = *nextPtrPtr;
949      ptr != NULL;
950      nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
951     if (infoPtr == ptr) {
952         *nextPtrPtr = ptr->nextPtr;
953         break;
954     }
955       }
956   }
957     }
958 }
static DWORD WINAPI ConsoleWriterThread (LPVOID arg) [static]

Definition at line 1206 of file tclWinConsole.c.
References ConsoleInfo, DWORD(), FALSE, NULL, Tcl_MutexLock, Tcl_MutexUnlock, and Tcl_ThreadAlert().
Referenced by TclWinOpenConsoleChannel().1207 {
1208 
1209     ConsoleInfo *infoPtr = (ConsoleInfo *)arg;
1210     HANDLE *handle = infoPtr->handle;
1211     DWORD count, toWrite, waitResult;
1212     char *buf;
1213     HANDLE wEvents[2];
1214 
1215     /* The first event takes precedence. */
1216     wEvents[0] = infoPtr->stopWriter;
1217     wEvents[1] = infoPtr->startWriter;
1218 
1219     for (;;) {
1220   /*
1221    * Wait for the main thread to signal before attempting to write.
1222    */
1223 
1224   waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
1225 
1226   if (waitResult != (WAIT_OBJECT_0 + 1)) {
1227       /*
1228        * The start event was not signaled.  It must be the stop event
1229        * or an error, so exit this thread.
1230        */
1231 
1232       break;
1233   }
1234 
1235   buf = infoPtr->writeBuf;
1236   toWrite = infoPtr->toWrite;
1237 
1238   /*
1239    * Loop until all of the bytes are written or an error occurs.
1240    */
1241 
1242   while (toWrite > 0) {
1243       if (WriteConsoleA(handle, buf, toWrite, &count, NULL) == FALSE) {
1244     infoPtr->writeError = GetLastError();
1245     break;
1246       } else {
1247     toWrite -= count;
1248     buf += count;
1249       }
1250   }
1251 
1252   /*
1253    * Signal the main thread by signalling the writable event and
1254    * then waking up the notifier thread.
1255    */
1256   
1257   SetEvent(infoPtr->writable);
1258 
1259   /*
1260    * Alert the foreground thread.  Note that we need to treat this like
1261    * a critical section so the foreground thread does not terminate
1262    * this thread while we are holding a mutex in the notifier code.
1263    */
1264 
1265   Tcl_MutexLock(&consoleMutex);
1266   if (infoPtr->threadId != NULL) {
1267       /* TIP #218. When in flight ignore the event, no one will receive it anyway */
1268       Tcl_ThreadAlert(infoPtr->threadId);
1269   }
1270   Tcl_MutexUnlock(&consoleMutex);
1271     }
1272 
1273     return 0;
1274 }
static void ProcExitHandler (ClientData clientData) [static]

Definition at line 276 of file tclWinConsole.c.
References initialized, Tcl_MutexLock, and Tcl_MutexUnlock.
Referenced by ConsoleInit(), and SerialInit().278 {
279     Tcl_MutexLock(&consoleMutex);
280     initialized = 0;
281     Tcl_MutexUnlock(&consoleMutex);
282 }
TCL_DECLARE_MUTEX (consoleMutex)

Definition at line 34 of file tclWinConsole.c.
References CONSOLE_BUFFER_SIZE, ConsoleInfo, and DWORD().56                            {
57     HANDLE handle;
58     int type;
59     struct ConsoleInfo *nextPtr;/* Pointer to next registered console. */
60     Tcl_Channel channel;  /* Pointer to channel structure. */
61     int validMask;    /* OR'ed combination of TCL_READABLE,
62          * TCL_WRITABLE, or TCL_EXCEPTION: indicates
63          * which operations are valid on the file. */
64     int watchMask;    /* OR'ed combination of TCL_READABLE,
65          * TCL_WRITABLE, or TCL_EXCEPTION: indicates
66          * which events should be reported. */
67     int flags;      /* State flags, see above for a list. */
68     Tcl_ThreadId threadId;  /* Thread to which events should be reported.
69          * This value is used by the reader/writer
70          * threads. */
71     HANDLE writeThread;   /* Handle to writer thread. */
72     HANDLE readThread;    /* Handle to reader thread. */
73     HANDLE writable;    /* Manual-reset event to signal when the
74          * writer thread has finished waiting for
75          * the current buffer to be written. */
76     HANDLE readable;    /* Manual-reset event to signal when the
77          * reader thread has finished waiting for
78          * input. */
79     HANDLE startWriter;   /* Auto-reset event used by the main thread to
80          * signal when the writer thread should attempt
81          * to write to the console. */
82     HANDLE stopWriter;    /* Auto-reset event used by the main thread to
83          * signal when the writer thread should exit.
84          */
85     HANDLE startReader;   /* Auto-reset event used by the main thread to
86          * signal when the reader thread should attempt
87          * to read from the console. */
88     HANDLE stopReader;    /* Auto-reset event used by the main thread to
89          * signal when the reader thread should exit.
90          */
91     DWORD writeError;   /* An error caused by the last background
92          * write.  Set to 0 if no error has been
93          * detected.  This word is shared with the
94          * writer thread so access must be
95          * synchronized with the writable object.
96          */
97     char *writeBuf;   /* Current background output buffer.
98          * Access is synchronized with the writable
99          * object. */
100     int writeBufLen;    /* Size of write buffer.  Access is
101          * synchronized with the writable
102          * object. */
103     int toWrite;    /* Current amount to be written.  Access is
104          * synchronized with the writable object. */
105     int readFlags;    /* Flags that are shared with the reader
106          * thread.  Access is synchronized with the
107          * readable object.  */
108     int bytesRead;              /* number of bytes in the buffer */
109     int offset;                 /* number of bytes read out of the buffer */
110     char buffer[CONSOLE_BUFFER_SIZE];
111                                 /* Data consumed by reader thread. */
112 } ConsoleInfo;
Tcl_Channel TclWinOpenConsoleChannel (HANDLE handle, char * channelName, int permissions)

Definition at line 1297 of file tclWinConsole.c.
References ckalloc, consoleChannelType, ConsoleInfo, ConsoleInit(), ConsoleReaderThread(), ConsoleWriterThread(), DWORD(), FALSE, NULL, Tcl_CreateChannel(), Tcl_GetCurrentThread(), TCL_INTEGER_SPACE, TCL_READABLE, Tcl_SetChannelOption(), TCL_WRITABLE, and TRUE.
Referenced by Tcl_MakeFileChannel(), and TclpOpenFileChannel().1301 {
1302     char encoding[4 + TCL_INTEGER_SPACE];
1303     ConsoleInfo *infoPtr;
1304     DWORD id, modes;
1305 
1306     ConsoleInit();
1307 
1308     /*
1309      * See if a channel with this handle already exists.
1310      */
1311     
1312     infoPtr = (ConsoleInfo *) ckalloc((unsigned) sizeof(ConsoleInfo));
1313     memset(infoPtr, 0, sizeof(ConsoleInfo));
1314 
1315     infoPtr->validMask = permissions;
1316     infoPtr->handle = handle;
1317     infoPtr->channel = (Tcl_Channel) NULL;
1318 
1319     wsprintfA(encoding, "cp%d", GetConsoleCP());
1320 
1321     infoPtr->threadId = Tcl_GetCurrentThread();
1322 
1323     /*
1324      * Use the pointer for the name of the result channel.
1325      * This keeps the channel names unique, since some may share
1326      * handles (stdin/stdout/stderr for instance).
1327      */
1328 
1329     wsprintfA(channelName, "file%lx", (int) infoPtr);
1330     
1331     infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName,
1332             (ClientData) infoPtr, permissions);
1333 
1334     if (permissions & TCL_READABLE) {
1335   /*
1336    * Make sure the console input buffer is ready for only character
1337    * input notifications and the buffer is set for line buffering.
1338    * IOW, we only want to catch when complete lines are ready for
1339    * reading.
1340    */
1341   GetConsoleMode(infoPtr->handle, &modes);
1342   modes &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT);
1343   modes |= ENABLE_LINE_INPUT;
1344   SetConsoleMode(infoPtr->handle, modes);
1345 
1346   infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL);
1347   infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL);
1348   infoPtr->stopReader = CreateEvent(NULL, FALSE, FALSE, NULL);
1349   infoPtr->readThread = CreateThread(NULL, 256, ConsoleReaderThread,
1350           infoPtr, 0, &id);
1351   SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
1352     }
1353 
1354     if (permissions & TCL_WRITABLE) {
1355   infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL);
1356   infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
1357   infoPtr->stopWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
1358   infoPtr->writeThread = CreateThread(NULL, 256, ConsoleWriterThread,
1359           infoPtr, 0, &id);
1360   SetThreadPriority(infoPtr->writeThread, THREAD_PRIORITY_HIGHEST);
1361     }
1362 
1363     /*
1364      * Files have default translation of AUTO and ^Z eof char, which
1365      * means that a ^Z will be accepted as EOF when reading.
1366      */
1367     
1368     Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
1369     Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
1370     Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding);
1371 
1372     return infoPtr->channel;
1373 }
static int WaitForRead (ConsoleInfo * infoPtr, int blocking) [static]

Definition at line 1014 of file tclWinConsole.c.
References CONSOLE_BUFFERED, CONSOLE_EOF, DWORD(), EAGAIN, errno, FALSE, and TclWinConvertError().
Referenced by ConsoleCheckProc(), ConsoleEventProc(), ConsoleInputProc(), ConsoleSetupProc(), PipeCheckProc(), PipeEventProc(), PipeInputProc(), and PipeSetupProc().1018 {
1019     DWORD timeout, count;
1020     HANDLE *handle = infoPtr->handle;
1021     INPUT_RECORD input;
1022     
1023     while (1) {
1024   /*
1025    * Synchronize with the reader thread.
1026    */
1027        
1028   timeout = blocking ? INFINITE : 0;
1029   if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) {
1030       /*
1031        * The reader thread is blocked waiting for data and the channel
1032        * is in non-blocking mode.
1033        */
1034       errno = EAGAIN;
1035       return -1;
1036   }
1037   
1038   /*
1039    * At this point, the two threads are synchronized, so it is safe
1040    * to access shared state.
1041    */
1042   
1043   /*
1044    * If the console has hit EOF, it is always readable.
1045    */
1046   
1047   if (infoPtr->readFlags & CONSOLE_EOF) {
1048       return 1;
1049   }
1050   
1051   if (PeekConsoleInput(handle, &input, 1, &count) == FALSE) {
1052             /*
1053        * Check to see if the peek failed because of EOF.
1054        */
1055       
1056       TclWinConvertError(GetLastError());
1057       
1058       if (errno == EOF) {
1059     infoPtr->readFlags |= CONSOLE_EOF;
1060     return 1;
1061       }
1062 
1063       /*
1064        * Ignore errors if there is data in the buffer.
1065        */
1066       
1067       if (infoPtr->readFlags & CONSOLE_BUFFERED) {
1068     return 0;
1069       } else {
1070     return -1;
1071       }
1072   }
1073 
1074   /*
1075    * If there is data in the buffer, the console must be
1076    * readable (since it is a line-oriented device).
1077    */
1078 
1079   if (infoPtr->readFlags & CONSOLE_BUFFERED) {
1080       return 1;
1081   }
1082 
1083   
1084   /*
1085    * There wasn't any data available, so reset the thread and
1086    * try again.
1087    */
1088     
1089   ResetEvent(infoPtr->readable);
1090   SetEvent(infoPtr->startReader);
1091     }
1092 }

Variable Documentation
Tcl_ChannelType consoleChannelType [static]
Initial value: {
    "console",      
    TCL_CHANNEL_VERSION_4,  
    ConsoleCloseProc,   
    ConsoleInputProc,   
    ConsoleOutputProc,    
    NULL,     
    NULL,     
    NULL,     
    ConsoleWatchProc,   
    ConsoleGetHandleProc, 
    NULL,     
    ConsoleBlockModeProc, 
    NULL,     
    NULL,     
    NULL,                       
    ConsoleThreadActionProc,    
}
Definition at line 171 of file tclWinConsole.c.ConsoleInfo

Definition at line 112 of file tclWinConsole.c.
Referenced by ConsoleBlockModeProc(), ConsoleCheckProc(), ConsoleCloseProc(), ConsoleEventProc(), ConsoleGetHandleProc(), ConsoleInputProc(), ConsoleOutputProc(), ConsoleReaderThread(), ConsoleSetupProc(), ConsoleThreadActionProc(), ConsoleWatchProc(), ConsoleWriterThread(), TCL_DECLARE_MUTEX(), and TclWinOpenConsoleChannel().Tcl_ThreadDataKey dataKey [static]

Definition at line 123 of file tclWinConsole.c.int initialized = 0 [static]

Definition at line 26 of file tclWinConsole.c.

win/tclWinDde.c File Reference
#include "tclPort.h"
#include <dde.h>
#include <ddeml.h>
#include <tchar.h>
Classes
struct RegisteredInterp
struct Conversation
struct ThreadSpecificData
struct ddeEnumServices
Defines
#define TCL_STORAGE_CLASS  DLLEXPORT
#define TCL_DDE_VERSION  "1.2.4"
#define TCL_DDE_PACKAGE_NAME  "dde"
#define TCL_DDE_SERVICE_NAME  "TclEval"
Functions
TCL_DECLARE_MUTEX (ddeMutex)
static void Initialize (void)
static char * DdeSetServerName (Tcl_Interp *interp, char *name)
static void DeleteProc (ClientData clientData)
static Tcl_Obj * ExecuteRemoteObject (RegisteredInterp *riPtr, Tcl_Obj *ddeObjectPtr)
static HDDEDATA CALLBACK DdeServerProc (UINT uType, UINT uFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData, DWORD dwData1, DWORD dwData2)
static void DdeExitProc (ClientData clientData)
static int MakeDdeConnection (Tcl_Interp *interp, char *name, HCONV *ddeConvPtr)
LRESULT CALLBACK DdeClientWindowProc (HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam)
static LRESULT DdeServicesOnAck (HWND hwnd, WPARAM wParam, LPARAM lParam)
static int DdeCreateClient (ddeEnumServices *es)
static BOOL CALLBACK DdeEnumWindowsCallback (HWND hwndTarget, LPARAM lParam)
static int DdeGetServicesList (Tcl_Interp *interp, char *serviceName, char *topicName)
static void SetDdeError (Tcl_Interp *interp)
int Tcl_DdeObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
Variables
static Tcl_ThreadDataKey dataKey
static HSZ ddeServiceGlobal = 0
static DWORD ddeInstance
static int ddeIsServer = 0

Define Documentation
#define TCL_DDE_PACKAGE_NAME  "dde"

Definition at line 75 of file tclWinDde.c.
Referenced by TCL_DECLARE_MUTEX().#define TCL_DDE_SERVICE_NAME  "TclEval"

Definition at line 76 of file tclWinDde.c.
Referenced by Initialize().#define TCL_DDE_VERSION  "1.2.4"

Definition at line 74 of file tclWinDde.c.
Referenced by TCL_DECLARE_MUTEX().#define TCL_STORAGE_CLASS  DLLEXPORT

Definition at line 28 of file tclWinDde.c.
Function Documentation
LRESULT CALLBACK DdeClientWindowProc (HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam)

Definition at line 816 of file tclWinDde.c.
References DdeServicesOnAck().
Referenced by DdeCreateClient().817 {
818     LRESULT lr = 0L;
819 
820     switch (uMsg) {
821   case WM_CREATE: {
822       LPCREATESTRUCT lpcs = (LPCREATESTRUCT)lParam;
823       ddeEnumServices *es;
824       es = (ddeEnumServices*)lpcs->lpCreateParams;
825 #ifdef _WIN64
826       SetWindowLongPtr(hwnd, GWLP_USERDATA, (long)es);
827 #else
828       SetWindowLong(hwnd, GWL_USERDATA, (long)es);
829 #endif
830       break;
831   }
832   case WM_DDE_ACK:
833       lr =  DdeServicesOnAck(hwnd, wParam, lParam);
834       break;
835   default:
836       lr = DefWindowProc(hwnd, uMsg, wParam, lParam);
837     }
838     return lr;
839 }
static int DdeCreateClient (ddeEnumServices * es) [static]

Definition at line 794 of file tclWinDde.c.
References DdeClientWindowProc(), ddeEnumServices::hwnd, NULL, and TCL_OK.
Referenced by DdeGetServicesList().795 {
796     WNDCLASSEX wc;
797     static const char *szDdeClientClassName = "TclEval client class";
798     static const char *szDdeClientWindowName = "TclEval client window";
799 
800     memset(&wc, 0, sizeof(wc));
801     wc.cbSize = sizeof(wc);
802     wc.lpfnWndProc = DdeClientWindowProc;
803     wc.lpszClassName = szDdeClientClassName;
804     wc.cbWndExtra = sizeof(ddeEnumServices*);
805 
806     /* register and create the callback window */
807     RegisterClassEx(&wc);
808     es->hwnd = CreateWindowEx(0, szDdeClientClassName,
809             szDdeClientWindowName,
810             WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL,
811             (LPVOID)es);
812     return TCL_OK;
813 }
static BOOL CALLBACK DdeEnumWindowsCallback (HWND hwndTarget, LPARAM lParam) [static]

Definition at line 884 of file tclWinDde.c.
References ddeEnumServices::hwnd, ddeEnumServices::service, ddeEnumServices::topic, and TRUE.
Referenced by DdeGetServicesList().885 {
886     LRESULT dwResult = 0;
887     ddeEnumServices *es = (ddeEnumServices *)lParam;
888     SendMessageTimeout(hwndTarget, WM_DDE_INITIATE,
889            (WPARAM)es->hwnd,
890            MAKELONG(es->service, es->topic),
891            SMTO_ABORTIFHUNG, 1000, &dwResult);
892     return TRUE;
893 }
static void DdeExitProc (ClientData clientData) [static]

Definition at line 707 of file tclWinDde.c.
References ddeInstance, and NULL.
Referenced by Initialize(), and TCL_DECLARE_MUTEX().709 {
710     DdeNameService(ddeInstance, NULL, 0, DNS_UNREGISTER);
711     DdeUninitialize(ddeInstance);
712     ddeInstance = 0;
713 }
static int DdeGetServicesList (Tcl_Interp * interp, char * serviceName, char * topicName) [static]

Definition at line 896 of file tclWinDde.c.
References DdeCreateClient(), DdeEnumWindowsCallback(), ddeEnumServices::interp, NULL, ddeEnumServices::result, ddeEnumServices::service, TCL_OK, Tcl_ResetResult(), and ddeEnumServices::topic.
Referenced by Tcl_DdeObjCmd().897 {
898     ddeEnumServices es;
899     int r = TCL_OK;
900     es.interp = interp;
901     es.result = TCL_OK;
902     es.service = (serviceName == NULL) 
903   ? (ATOM)NULL : GlobalAddAtom(serviceName);
904     es.topic = (topicName == NULL) 
905   ? (ATOM)NULL : GlobalAddAtom(topicName);
906     
907     Tcl_ResetResult(interp); /* our list is to be appended to result. */
908     DdeCreateClient(&es);
909     EnumWindows(DdeEnumWindowsCallback, (LPARAM)&es);
910     
911     if (IsWindow(es.hwnd))
912         DestroyWindow(es.hwnd);
913     if (es.service != (ATOM)NULL)
914   GlobalDeleteAtom(es.service);
915     if (es.topic != (ATOM)NULL)
916   GlobalDeleteAtom(es.topic);
917     return es.result;
918 }
static HDDEDATA CALLBACK DdeServerProc (UINT uType, UINT uFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData, DWORD dwData1, DWORD dwData2) [static]

Definition at line 436 of file tclWinDde.c.
References ckalloc, ckfree, ThreadSpecificData::currentConversations, dataKey, ddeInstance, DWORD(), ExecuteRemoteObject(), FALSE, Conversation::hConv, RegisteredInterp::interp, ThreadSpecificData::interpListPtr, RegisteredInterp::name, Conversation::nextPtr, RegisteredInterp::nextPtr, NULL, Conversation::returnPackagePtr, Conversation::riPtr, Tcl_DecrRefCount, Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringSetLength(), Tcl_DStringValue, Tcl_GetStringFromObj(), Tcl_GetVar2Ex(), TCL_GLOBAL_ONLY, Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_TSD_INIT, and TRUE.
Referenced by Initialize().450 {
451     Tcl_DString dString;
452     int len;
453     DWORD dlen;
454     char *utilString;
455     Tcl_Obj *ddeObjectPtr;
456     HDDEDATA ddeReturn = NULL;
457     RegisteredInterp *riPtr;
458     Conversation *convPtr, *prevConvPtr;
459     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
460 
461     switch(uType) {
462   case XTYP_CONNECT:
463 
464       /*
465        * Dde is trying to initialize a conversation with us. Check
466        * and make sure we have a valid topic.
467        */
468 
469       len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
470       Tcl_DStringInit(&dString);
471       Tcl_DStringSetLength(&dString, len);
472       utilString = Tcl_DStringValue(&dString);
473       DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
474         CP_WINANSI);
475 
476       for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
477         riPtr = riPtr->nextPtr) {
478     if (stricmp(utilString, riPtr->name) == 0) {
479         Tcl_DStringFree(&dString);
480         return (HDDEDATA) TRUE;
481     }
482       }
483 
484       Tcl_DStringFree(&dString);
485       return (HDDEDATA) FALSE;
486 
487   case XTYP_CONNECT_CONFIRM:
488 
489       /*
490        * Dde has decided that we can connect, so it gives us a 
491        * conversation handle. We need to keep track of it
492        * so we know which execution result to return in an
493        * XTYP_REQUEST.
494        */
495 
496       len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
497       Tcl_DStringInit(&dString);
498       Tcl_DStringSetLength(&dString, len);
499       utilString = Tcl_DStringValue(&dString);
500       DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, 
501         CP_WINANSI);
502       for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; 
503         riPtr = riPtr->nextPtr) {
504     if (stricmp(riPtr->name, utilString) == 0) {
505         convPtr = (Conversation *) ckalloc(sizeof(Conversation));
506         convPtr->nextPtr = tsdPtr->currentConversations;
507         convPtr->returnPackagePtr = NULL;
508         convPtr->hConv = hConv;
509         convPtr->riPtr = riPtr;
510         tsdPtr->currentConversations = convPtr;
511         break;
512     }
513       }
514       Tcl_DStringFree(&dString);
515       return (HDDEDATA) TRUE;
516 
517   case XTYP_DISCONNECT:
518 
519       /*
520        * The client has disconnected from our server. Forget this
521        * conversation.
522        */
523 
524       for (convPtr = tsdPtr->currentConversations, prevConvPtr = NULL;
525         convPtr != NULL; 
526         prevConvPtr = convPtr, convPtr = convPtr->nextPtr) {
527     if (hConv == convPtr->hConv) {
528         if (prevConvPtr == NULL) {
529       tsdPtr->currentConversations = convPtr->nextPtr;
530         } else {
531       prevConvPtr->nextPtr = convPtr->nextPtr;
532         }
533         if (convPtr->returnPackagePtr != NULL) {
534       Tcl_DecrRefCount(convPtr->returnPackagePtr);
535         }
536         ckfree((char *) convPtr);
537         break;
538     }
539       }
540       return (HDDEDATA) TRUE;
541 
542   case XTYP_REQUEST:
543 
544       /*
545        * This could be either a request for a value of a Tcl variable,
546        * or it could be the send command requesting the results of the
547        * last execute.
548        */
549 
550       if (uFmt != CF_TEXT) {
551     return (HDDEDATA) FALSE;
552       }
553 
554       ddeReturn = (HDDEDATA) FALSE;
555       for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
556         && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
557     /*
558      * Empty loop body.
559      */
560       }
561 
562       if (convPtr != NULL) {
563     char *returnString;
564 
565     len = DdeQueryString(ddeInstance, ddeItem, NULL, 0,
566       CP_WINANSI);
567     Tcl_DStringInit(&dString);
568     Tcl_DStringSetLength(&dString, len);
569     utilString = Tcl_DStringValue(&dString);
570     DdeQueryString(ddeInstance, ddeItem, utilString, 
571                         (DWORD) len + 1, CP_WINANSI);
572     if (stricmp(utilString, "$TCLEVAL$EXECUTE$RESULT") == 0) {
573         returnString =
574             Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
575         ddeReturn = DdeCreateDataHandle(ddeInstance,
576           returnString, (DWORD) len+1, 0, ddeItem, CF_TEXT,
577           0);
578     } else {
579         Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex(
580           convPtr->riPtr->interp, utilString, NULL, 
581           TCL_GLOBAL_ONLY);
582         if (variableObjPtr != NULL) {
583       returnString = Tcl_GetStringFromObj(variableObjPtr,
584         &len);
585       ddeReturn = DdeCreateDataHandle(ddeInstance,
586         returnString, (DWORD) len+1, 0, ddeItem,
587         CF_TEXT, 0);
588         } else {
589       ddeReturn = NULL;
590         }
591     }
592     Tcl_DStringFree(&dString);
593       }
594       return ddeReturn;
595 
596   case XTYP_EXECUTE: {
597 
598       /*
599        * Execute this script. The results will be saved into
600        * a list object which will be retreived later. See
601        * ExecuteRemoteObject.
602        */
603 
604       Tcl_Obj *returnPackagePtr;
605 
606       for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
607         && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
608     /*
609      * Empty loop body.
610      */
611 
612       }
613 
614       if (convPtr == NULL) {
615     return (HDDEDATA) DDE_FNOTPROCESSED;
616       }
617 
618       utilString = (char *) DdeAccessData(hData, &dlen);
619       len = dlen;
620       ddeObjectPtr = Tcl_NewStringObj(utilString, -1);
621       Tcl_IncrRefCount(ddeObjectPtr);
622       DdeUnaccessData(hData);
623       if (convPtr->returnPackagePtr != NULL) {
624     Tcl_DecrRefCount(convPtr->returnPackagePtr);
625       }
626       convPtr->returnPackagePtr = NULL;
627       returnPackagePtr = 
628         ExecuteRemoteObject(convPtr->riPtr, ddeObjectPtr);
629       Tcl_IncrRefCount(returnPackagePtr);
630       for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
631         && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
632     /*
633      * Empty loop body.
634      */
635 
636       }
637       if (convPtr != NULL) {
638     convPtr->returnPackagePtr = returnPackagePtr;
639       } else {
640     Tcl_DecrRefCount(returnPackagePtr);
641       }
642       Tcl_DecrRefCount(ddeObjectPtr);
643       if (returnPackagePtr == NULL) {
644     return (HDDEDATA) DDE_FNOTPROCESSED;
645       } else {
646     return (HDDEDATA) DDE_FACK;
647       }
648   }
649       
650   case XTYP_WILDCONNECT: {
651 
652       /*
653        * Dde wants a list of services and topics that we support.
654        */
655 
656       HSZPAIR *returnPtr;
657       int i;
658       int numItems;
659 
660       for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL;
661         i++, riPtr = riPtr->nextPtr) {
662     /*
663      * Empty loop body.
664      */
665 
666       }
667 
668       numItems = i;
669       ddeReturn = DdeCreateDataHandle(ddeInstance, NULL,
670         (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0);
671       returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &dlen);
672       len = dlen;
673       for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; 
674         i++, riPtr = riPtr->nextPtr) {
675     returnPtr[i].hszSvc = DdeCreateStringHandle(
676                         ddeInstance, "TclEval", CP_WINANSI);
677     returnPtr[i].hszTopic = DdeCreateStringHandle(
678                         ddeInstance, riPtr->name, CP_WINANSI);
679       }
680       returnPtr[i].hszSvc = NULL;
681       returnPtr[i].hszTopic = NULL;
682       DdeUnaccessData(ddeReturn);
683       return ddeReturn;
684   }
685 
686     }
687     return NULL;
688 }
static LRESULT DdeServicesOnAck (HWND hwnd, WPARAM wParam, LPARAM lParam) [static]

Definition at line 842 of file tclWinDde.c.
References ddeEnumServices::interp, NULL, ddeEnumServices::service, Tcl_GetObjResult(), Tcl_ListObjAppendElement(), Tcl_NewListObj(), Tcl_NewStringObj(), and ddeEnumServices::topic.
Referenced by DdeClientWindowProc().843 {
844     HWND hwndRemote = (HWND)wParam;
845     ATOM service = (ATOM)LOWORD(lParam);
846     ATOM topic = (ATOM)HIWORD(lParam);
847     ddeEnumServices *es;
848     TCHAR sz[255];
849 
850 #ifdef _WIN64
851     es = (ddeEnumServices *)GetWindowLongPtr(hwnd, GWLP_USERDATA);
852 #else
853     es = (ddeEnumServices *)GetWindowLong(hwnd, GWL_USERDATA);
854 #endif
855 
856     if ((es->service == (ATOM)NULL || es->service == service)
857   && (es->topic == (ATOM)NULL || es->topic == topic)) {
858   Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL);
859 
860   GlobalGetAtomName(service, sz, 255);
861   Tcl_ListObjAppendElement(es->interp, matchPtr,
862     Tcl_NewStringObj(sz, -1));
863   GlobalGetAtomName(topic, sz, 255);
864   Tcl_ListObjAppendElement(es->interp, matchPtr,
865     Tcl_NewStringObj(sz, -1));
866   /* Adding the hwnd as a third list element provides a unique
867    * identifier in the case of multiple servers with the name
868    * application and topic names.
869    */
870   /* Needs a TIP though
871    * Tcl_ListObjAppendElement(es->interp, matchPtr,
872    *  Tcl_NewLongObj((long)hwndRemote));
873    */
874   Tcl_ListObjAppendElement(es->interp,
875     Tcl_GetObjResult(es->interp), matchPtr);
876     }
877 
878     /* tell the server we are no longer interested */
879     PostMessage(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L);
880     return 0L;
881 }
static char* DdeSetServerName (Tcl_Interp * interp, char * name) [static]

Definition at line 233 of file tclWinDde.c.
References ckalloc, dataKey, DeleteProc(), Initialize(), RegisteredInterp::interp, ThreadSpecificData::interpListPtr, RegisteredInterp::name, RegisteredInterp::nextPtr, NULL, Tcl_CreateObjCommand(), Tcl_DdeObjCmd(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_HideCommand(), Tcl_IsSafe(), and TCL_TSD_INIT.
Referenced by Tcl_DdeObjCmd().240 {
241     int suffix, offset;
242     RegisteredInterp *riPtr, *prevPtr;
243     Tcl_DString dString;
244     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
245 
246     /*
247      * See if the application is already registered; if so, remove its
248      * current name from the registry. The deletion of the command
249      * will take care of disposing of this entry.
250      */
251 
252     for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL; 
253       prevPtr = riPtr, riPtr = riPtr->nextPtr) {
254   if (riPtr->interp == interp) {
255       if (name != NULL) {
256     if (prevPtr == NULL) {
257         tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;
258     } else {
259         prevPtr->nextPtr = riPtr->nextPtr;
260     }
261     break;
262       } else {
263     /*
264      * the name was NULL, so the caller is asking for
265      * the name of the current interp.
266      */
267 
268     return riPtr->name;
269       }
270   }
271     }
272 
273     if (name == NULL) {
274   /*
275    * the name was NULL, so the caller is asking for
276    * the name of the current interp, but it doesn't
277    * have a name.
278    */
279 
280   return "";
281     }
282     
283     /*
284      * Pick a name to use for the application.  Use "name" if it's not
285      * already in use.  Otherwise add a suffix such as " #2", trying
286      * larger and larger numbers until we eventually find one that is
287      * unique.
288      */
289 
290     suffix = 1;
291     offset = 0;
292     Tcl_DStringInit(&dString);
293 
294     /*
295      * We have found a unique name. Now add it to the registry.
296      */
297 
298     riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
299     riPtr->interp = interp;
300     riPtr->name = ckalloc((unsigned int) strlen(name) + 1);
301     riPtr->nextPtr = tsdPtr->interpListPtr;
302     tsdPtr->interpListPtr = riPtr;
303     strcpy(riPtr->name, name);
304 
305     Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd,
306       (ClientData) riPtr, DeleteProc);
307     if (Tcl_IsSafe(interp)) {
308   Tcl_HideCommand(interp, "dde", "dde");
309     }
310     Tcl_DStringFree(&dString);
311 
312     /*
313      * re-initialize with the new name
314      */
315     Initialize();
316     
317     return riPtr->name;
318 }
static void DeleteProc (ClientData clientData) [static]

Definition at line 337 of file tclWinDde.c.
References ckfree, dataKey, ThreadSpecificData::interpListPtr, RegisteredInterp::name, RegisteredInterp::nextPtr, NULL, TCL_DYNAMIC, Tcl_EventuallyFree(), and TCL_TSD_INIT.
Referenced by DdeSetServerName().340 {
341     RegisteredInterp *riPtr = (RegisteredInterp *) clientData;
342     RegisteredInterp *searchPtr, *prevPtr;
343     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
344 
345     for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL;
346       (searchPtr != NULL) && (searchPtr != riPtr);
347       prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) {
348   /*
349    * Empty loop body.
350    */
351     }
352 
353     if (searchPtr != NULL) {
354   if (prevPtr == NULL) {
355       tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;
356   } else {
357       prevPtr->nextPtr = searchPtr->nextPtr;
358   }
359     }
360     ckfree(riPtr->name);
361     Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
362 }
static Tcl_Obj* ExecuteRemoteObject (RegisteredInterp * riPtr, Tcl_Obj * ddeObjectPtr) [static]

Definition at line 389 of file tclWinDde.c.
References RegisteredInterp::interp, NULL, TCL_ERROR, TCL_EVAL_GLOBAL, Tcl_EvalObjEx(), Tcl_GetObjResult(), Tcl_GetVar2Ex(), TCL_GLOBAL_ONLY, Tcl_ListObjAppendElement(), Tcl_NewIntObj(), and Tcl_NewListObj().
Referenced by DdeServerProc().392 {
393     Tcl_Obj *errorObjPtr;
394     Tcl_Obj *returnPackagePtr;
395     int result;
396 
397     result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);
398     returnPackagePtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
399     Tcl_ListObjAppendElement(NULL, returnPackagePtr,
400       Tcl_NewIntObj(result));
401     Tcl_ListObjAppendElement(NULL, returnPackagePtr,
402       Tcl_GetObjResult(riPtr->interp));
403     if (result == TCL_ERROR) {
404   errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL,
405     TCL_GLOBAL_ONLY);
406   Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
407   errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorInfo", NULL,
408     TCL_GLOBAL_ONLY);
409         Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
410     }
411 
412     return returnPackagePtr;
413 }
static void Initialize (void) [static]

Definition at line 159 of file tclWinDde.c.
References dataKey, DdeExitProc(), ddeInstance, ddeIsServer, DdeServerProc(), ddeServiceGlobal, ThreadSpecificData::interpListPtr, NULL, Tcl_CreateExitHandler(), TCL_DDE_SERVICE_NAME, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_TSD_INIT.
Referenced by DdeSetServerName(), and Tcl_DdeObjCmd().160 {
161     int nameFound = 0;
162     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
163     
164     /*
165      * See if the application is already registered; if so, remove its
166      * current name from the registry. The deletion of the command
167      * will take care of disposing of this entry.
168      */
169 
170     if (tsdPtr->interpListPtr != NULL) {
171   nameFound = 1;
172     }
173 
174     /*
175      * Make sure that the DDE server is there. This is done only once,
176      * add an exit handler tear it down.
177      */
178 
179     if (ddeInstance == 0) {
180   Tcl_MutexLock(&ddeMutex);
181   if (ddeInstance == 0) {
182       if (DdeInitialize(&ddeInstance, DdeServerProc,
183         CBF_SKIP_REGISTRATIONS
184         | CBF_SKIP_UNREGISTRATIONS
185         | CBF_FAIL_POKES, 0) 
186         != DMLERR_NO_ERROR) {
187     ddeInstance = 0;
188       }
189   }
190   Tcl_MutexUnlock(&ddeMutex);
191     }
192     if ((ddeServiceGlobal == 0) && (nameFound != 0)) {
193   Tcl_MutexLock(&ddeMutex);
194   if ((ddeServiceGlobal == 0) && (nameFound != 0)) {
195       ddeIsServer = 1;
196       Tcl_CreateExitHandler(DdeExitProc, NULL);
197       ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, \
198         TCL_DDE_SERVICE_NAME, 0);
199       DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER);
200   } else {
201       ddeIsServer = 0;
202   }
203   Tcl_MutexUnlock(&ddeMutex);
204     }
205 }    
static int MakeDdeConnection (Tcl_Interp * interp, char * name, HCONV * ddeConvPtr) [static]

Definition at line 734 of file tclWinDde.c.
References ddeInstance, NULL, TCL_ERROR, and TCL_OK.
Referenced by Tcl_DdeObjCmd().738 {
739     HSZ ddeTopic, ddeService;
740     HCONV ddeConv;
741     
742     ddeService = DdeCreateStringHandle(ddeInstance, "TclEval", 0);
743     ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0);
744 
745     ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
746     DdeFreeStringHandle(ddeInstance, ddeService);
747     DdeFreeStringHandle(ddeInstance, ddeTopic);
748 
749     if (ddeConv == (HCONV) NULL) {
750   if (interp != NULL) {
751       Tcl_AppendResult(interp, "no registered server named \"",
752         name, "\"", (char *) NULL);
753   }
754   return TCL_ERROR;
755     }
756 
757     *ddeConvPtr = ddeConv;
758     return TCL_OK;
759 }
static void SetDdeError (Tcl_Interp * interp) [static]

Definition at line 939 of file tclWinDde.c.
References ddeInstance, Tcl_GetObjResult(), and Tcl_SetStringObj().
Referenced by Tcl_DdeObjCmd().941 {
942     Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
943     int err;
944 
945     err = DdeGetLastError(ddeInstance);
946     switch (err) {
947   case DMLERR_DATAACKTIMEOUT:
948   case DMLERR_EXECACKTIMEOUT:
949   case DMLERR_POKEACKTIMEOUT:
950       Tcl_SetStringObj(resultPtr,
951         "remote interpreter did not respond", -1);
952       break;
953 
954   case DMLERR_BUSY:
955       Tcl_SetStringObj(resultPtr, "remote server is busy", -1);
956       break;
957 
958   case DMLERR_NOTPROCESSED:
959       Tcl_SetStringObj(resultPtr, 
960         "remote server cannot handle this command", -1);
961       break;
962 
963   default:
964       Tcl_SetStringObj(resultPtr, "dde command failed", -1);
965     }
966 }
int Tcl_DdeObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])

Definition at line 986 of file tclWinDde.c.
References CONST, dataKey, DdeGetServicesList(), ddeInstance, DdeSetServerName(), DWORD(), Initialize(), ThreadSpecificData::interpListPtr, MakeDdeConnection(), RegisteredInterp::name, RegisteredInterp::nextPtr, NULL, SetDdeError(), Tcl_AddObjErrorInfo(), Tcl_ConcatObj(), Tcl_DecrRefCount, TCL_ERROR, TCL_EVAL_GLOBAL, Tcl_EvalObjEx(), Tcl_GetIndexFromObj(), Tcl_GetIntFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_GetVar2Ex(), TCL_GLOBAL_ONLY, Tcl_IncrRefCount, Tcl_ListObjIndex(), Tcl_NewByteArrayObj(), Tcl_NewObj(), Tcl_NewStringObj(), TCL_OK, Tcl_Preserve(), Tcl_Release(), Tcl_ResetResult(), Tcl_SetObjErrorCode(), Tcl_SetObjLength(), Tcl_SetObjResult(), Tcl_SetStringObj(), TCL_TSD_INIT, and Tcl_WrongNumArgs().
Referenced by DdeSetServerName(), and TCL_DECLARE_MUTEX().991 {
992     enum {
993   DDE_SERVERNAME,
994   DDE_EXECUTE,
995   DDE_POKE,
996   DDE_REQUEST,
997   DDE_SERVICES,
998   DDE_EVAL
999     };
1000 
1001     static CONST char *ddeCommands[] = {"servername", "execute", "poke",
1002           "request", "services", "eval", 
1003     (char *) NULL};
1004     static CONST char *ddeOptions[] = {"-async", (char *) NULL};
1005     static CONST char *ddeReqOptions[] = {"-binary", (char *) NULL};
1006     int index, argIndex;
1007     int async = 0, binary = 0;
1008     int result = TCL_OK;
1009     HSZ ddeService = NULL;
1010     HSZ ddeTopic = NULL;
1011     HSZ ddeItem = NULL;
1012     HDDEDATA ddeData = NULL;
1013     HDDEDATA ddeItemData = NULL;
1014     HCONV hConv = NULL;
1015     HSZ ddeCookie = 0;
1016     char *serviceName, *topicName, *itemString, *dataString;
1017     char *string;
1018     int firstArg, length, dataLength;
1019     DWORD ddeResult;
1020     HDDEDATA ddeReturn;
1021     RegisteredInterp *riPtr;
1022     Tcl_Interp *sendInterp;
1023     Tcl_Obj *objPtr;
1024     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1025 
1026     /*
1027      * Initialize DDE server/client
1028      */
1029     
1030     if (objc < 2) {
1031   Tcl_WrongNumArgs(interp, 1, objv, 
1032     "?-async? serviceName topicName value");
1033   return TCL_ERROR;
1034     }
1035 
1036     if (Tcl_GetIndexFromObj(interp, objv[1], ddeCommands, "command", 0,
1037       &index) != TCL_OK) {
1038   return TCL_ERROR;
1039     }
1040 
1041     switch (index) {
1042   case DDE_SERVERNAME:
1043       if ((objc != 3) && (objc != 2)) {
1044     Tcl_WrongNumArgs(interp, 1, objv, "servername ?serverName?");
1045     return TCL_ERROR;
1046       }
1047       firstArg = (objc - 1);
1048       break;
1049   case DDE_EXECUTE:
1050       if ((objc < 5) || (objc > 6)) {
1051     Tcl_WrongNumArgs(interp, 1, objv, 
1052       "execute ?-async? serviceName topicName value");
1053     return TCL_ERROR;
1054       }
1055       if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
1056         &argIndex) != TCL_OK) {
1057     if (objc != 5) {
1058         Tcl_WrongNumArgs(interp, 1, objv,
1059           "execute ?-async? serviceName topicName value");
1060         return TCL_ERROR;
1061     }
1062     async = 0;
1063     firstArg = 2;
1064       } else {
1065     if (objc != 6) {
1066         Tcl_WrongNumArgs(interp, 1, objv,
1067           "execute ?-async? serviceName topicName value");
1068         return TCL_ERROR;
1069     }
1070     async = 1;
1071     firstArg = 3;
1072       }
1073       break;
1074   case DDE_POKE:
1075       if (objc != 6) {
1076     Tcl_WrongNumArgs(interp, 1, objv,
1077       "poke serviceName topicName item value");
1078     return TCL_ERROR;
1079       }
1080       firstArg = 2;
1081       break;
1082   case DDE_REQUEST:
1083       if ((objc < 5) || (objc > 6)) {
1084     Tcl_WrongNumArgs(interp, 1, objv, 
1085       "request ?-binary? serviceName topicName value");
1086     return TCL_ERROR;
1087       }
1088       if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0,
1089         &argIndex) != TCL_OK) {
1090     if (objc != 5) {
1091         Tcl_WrongNumArgs(interp, 1, objv,
1092           "request ?-binary? serviceName topicName value");
1093         return TCL_ERROR;
1094     }
1095     binary = 0;
1096     firstArg = 2;
1097       } else {
1098     if (objc != 6) {
1099         Tcl_WrongNumArgs(interp, 1, objv,
1100           "request ?-binary? serviceName topicName value");
1101         return TCL_ERROR;
1102     }
1103     binary = 1;
1104     firstArg = 3;
1105       }
1106       break;
1107   case DDE_SERVICES:
1108       if (objc != 4) {
1109     Tcl_WrongNumArgs(interp, 1, objv,
1110       "services serviceName topicName");
1111     return TCL_ERROR;
1112       }
1113       firstArg = 2;
1114       break;
1115   case DDE_EVAL:
1116       if (objc < 4) {
1117     Tcl_WrongNumArgs(interp, 1, objv, 
1118       "eval ?-async? serviceName args");
1119     return TCL_ERROR;
1120       }
1121       if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
1122         &argIndex) != TCL_OK) {
1123     if (objc < 4) {
1124         Tcl_WrongNumArgs(interp, 1, objv,
1125           "eval ?-async? serviceName args");
1126         return TCL_ERROR;
1127     }
1128     async = 0;
1129     firstArg = 2;
1130       } else {
1131     if (objc < 5) {
1132         Tcl_WrongNumArgs(interp, 1, objv,
1133           "eval ?-async? serviceName args");
1134         return TCL_ERROR;
1135     }
1136     async = 1;
1137     firstArg = 3;
1138       }
1139       break;
1140     }
1141 
1142     Initialize();
1143 
1144     if (firstArg != 1) {
1145   serviceName = Tcl_GetStringFromObj(objv[firstArg], &length);
1146     } else {
1147   length = 0;
1148     }
1149 
1150     if (length == 0) {
1151   serviceName = NULL;
1152     } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
1153   ddeService = DdeCreateStringHandle(ddeInstance, serviceName,
1154     CP_WINANSI);
1155     }
1156 
1157     if ((index != DDE_SERVERNAME) &&(index != DDE_EVAL)) {
1158   topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length);
1159   if (length == 0) {
1160       topicName = NULL;
1161   } else {
1162       ddeTopic = DdeCreateStringHandle(ddeInstance, 
1163         topicName, CP_WINANSI);
1164   }
1165     }
1166 
1167     switch (index) {
1168   case DDE_SERVERNAME: {
1169       serviceName = DdeSetServerName(interp, serviceName);
1170       if (serviceName != NULL) {
1171     Tcl_SetStringObj(Tcl_GetObjResult(interp),
1172       serviceName, -1);
1173       } else {
1174     Tcl_ResetResult(interp);
1175       }
1176       break;
1177   }
1178   case DDE_EXECUTE: {
1179       dataString = Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);
1180       if (dataLength == 0) {
1181     Tcl_SetStringObj(Tcl_GetObjResult(interp),
1182       "cannot execute null data", -1);
1183     result = TCL_ERROR;
1184     break;
1185       }
1186       hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
1187       DdeFreeStringHandle(ddeInstance, ddeService);
1188       DdeFreeStringHandle(ddeInstance, ddeTopic);
1189 
1190       if (hConv == NULL) {
1191     SetDdeError(interp);
1192     result = TCL_ERROR;
1193     break;
1194       }
1195 
1196       ddeData = DdeCreateDataHandle(ddeInstance, dataString,
1197         (DWORD) dataLength+1, 0, 0, CF_TEXT, 0);
1198       if (ddeData != NULL) {
1199     if (async) {
1200         DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0, 
1201           CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
1202         DdeAbandonTransaction(ddeInstance, hConv, 
1203           ddeResult);
1204     } else {
1205         ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,
1206           hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL);
1207         if (ddeReturn == 0) {
1208       SetDdeError(interp);
1209       result = TCL_ERROR;
1210         }
1211     }
1212     DdeFreeDataHandle(ddeData);
1213       } else {
1214     SetDdeError(interp);
1215     result = TCL_ERROR;
1216       }
1217       break;
1218   }
1219   case DDE_REQUEST: {
1220       itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
1221       if (length == 0) {
1222     Tcl_SetStringObj(Tcl_GetObjResult(interp),
1223       "cannot request value of null data", -1);
1224     goto errorNoResult;
1225       }
1226       hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
1227       DdeFreeStringHandle(ddeInstance, ddeService);
1228       DdeFreeStringHandle(ddeInstance, ddeTopic);
1229       
1230       if (hConv == NULL) {
1231     SetDdeError(interp);
1232     result = TCL_ERROR;
1233       } else {
1234     Tcl_Obj *returnObjPtr;
1235     ddeItem = DdeCreateStringHandle(ddeInstance, 
1236                         itemString, CP_WINANSI);
1237     if (ddeItem != NULL) {
1238         ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
1239           CF_TEXT, XTYP_REQUEST, 5000, NULL);
1240         if (ddeData == NULL) {
1241       SetDdeError(interp);
1242       result = TCL_ERROR;
1243         } else {
1244       DWORD tmp;
1245       dataString = DdeAccessData(ddeData, &tmp);
1246       dataLength = tmp;
1247       if (binary) {
1248           returnObjPtr = Tcl_NewByteArrayObj(dataString,
1249             dataLength);
1250       } else {
1251           returnObjPtr = Tcl_NewStringObj(dataString, -1);
1252       }
1253       DdeUnaccessData(ddeData);
1254       DdeFreeDataHandle(ddeData);
1255       Tcl_SetObjResult(interp, returnObjPtr);
1256         }
1257     } else {
1258         SetDdeError(interp);
1259         result = TCL_ERROR;
1260     }
1261       }
1262 
1263       break;
1264   }
1265   case DDE_POKE: {
1266       itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
1267       if (length == 0) {
1268     Tcl_SetStringObj(Tcl_GetObjResult(interp),
1269       "cannot have a null item", -1);
1270     goto errorNoResult;
1271       }
1272       dataString = Tcl_GetStringFromObj(objv[firstArg + 3], &length);
1273       
1274       hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
1275       DdeFreeStringHandle(ddeInstance, ddeService);
1276       DdeFreeStringHandle(ddeInstance, ddeTopic);
1277 
1278       if (hConv == NULL) {
1279     SetDdeError(interp);
1280     result = TCL_ERROR;
1281       } else {
1282     ddeItem = DdeCreateStringHandle(ddeInstance, itemString,
1283       CP_WINANSI);
1284     if (ddeItem != NULL) {
1285         ddeData = DdeClientTransaction(dataString, (DWORD) length+1,
1286           hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL);
1287         if (ddeData == NULL) {
1288       SetDdeError(interp);
1289       result = TCL_ERROR;
1290         }
1291     } else {
1292         SetDdeError(interp);
1293         result = TCL_ERROR;
1294     }
1295       }
1296       break;
1297   }
1298 
1299   case DDE_SERVICES: {
1300       result = DdeGetServicesList(interp, serviceName, topicName);
1301       break;
1302   }
1303   case DDE_EVAL: {
1304       if (serviceName == NULL) {
1305     Tcl_SetStringObj(Tcl_GetObjResult(interp),
1306       "invalid service name \"\"", -1);
1307     goto errorNoResult;
1308       }
1309 
1310       objc -= (async + 3);
1311       ((Tcl_Obj **) objv) += (async + 3);
1312 
1313             /*
1314        * See if the target interpreter is local.  If so, execute
1315        * the command directly without going through the DDE server.
1316        * Don't exchange objects between interps.  The target interp could
1317        * compile an object, producing a bytecode structure that refers to 
1318        * other objects owned by the target interp.  If the target interp 
1319        * is then deleted, the bytecode structure would be referring to 
1320        * deallocated objects.
1321        */
1322       
1323       for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
1324      riPtr = riPtr->nextPtr) {
1325     if (stricmp(serviceName, riPtr->name) == 0) {
1326         break;
1327     }
1328       }
1329 
1330       if (riPtr != NULL) {
1331     /*
1332      * This command is to a local interp. No need to go through
1333      * the server.
1334      */
1335     
1336     Tcl_Preserve((ClientData) riPtr);
1337     sendInterp = riPtr->interp;
1338     Tcl_Preserve((ClientData) sendInterp);
1339     
1340     /*
1341      * Don't exchange objects between interps.  The target interp
1342      * would compile an object, producing a bytecode structure that
1343      * refers to other objects owned by the target interp.  If the
1344      * target interp is then deleted, the bytecode structure would
1345      * be referring to deallocated objects.
1346      */
1347 
1348     if (objc == 1) {
1349         result = Tcl_EvalObjEx(sendInterp, objv[0],
1350           TCL_EVAL_GLOBAL);
1351     } else {
1352         objPtr = Tcl_ConcatObj(objc, objv);
1353         Tcl_IncrRefCount(objPtr);
1354         result = Tcl_EvalObjEx(sendInterp, objPtr,
1355           TCL_EVAL_GLOBAL);
1356         Tcl_DecrRefCount(objPtr);
1357     }
1358     if (interp != sendInterp) {
1359         if (result == TCL_ERROR) {
1360       /*
1361        * An error occurred, so transfer error information
1362        * from the destination interpreter back to our
1363        * interpreter.
1364        */
1365       
1366       Tcl_ResetResult(interp);
1367       objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL, 
1368         TCL_GLOBAL_ONLY);
1369       string = Tcl_GetStringFromObj(objPtr, &length);
1370       Tcl_AddObjErrorInfo(interp, string, length);
1371       
1372       objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL,
1373         TCL_GLOBAL_ONLY);
1374       Tcl_SetObjErrorCode(interp, objPtr);
1375         }
1376         Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));
1377     }
1378     Tcl_Release((ClientData) riPtr);
1379     Tcl_Release((ClientData) sendInterp);
1380       } else {
1381     /*
1382      * This is a non-local request. Send the script to the server
1383      * and poll it for a result.
1384      */
1385     
1386     if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
1387         goto error;
1388     }
1389     
1390     objPtr = Tcl_ConcatObj(objc, objv);
1391     string = Tcl_GetStringFromObj(objPtr, &length);
1392     ddeItemData = DdeCreateDataHandle(ddeInstance, string,
1393       (DWORD) length+1, 0, 0, CF_TEXT, 0);
1394     
1395     if (async) {
1396         ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
1397           0xFFFFFFFF, hConv, 0,
1398           CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
1399         DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
1400     } else {
1401         ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
1402           0xFFFFFFFF, hConv, 0,
1403           CF_TEXT, XTYP_EXECUTE, 30000, NULL);
1404         if (ddeData != 0) {
1405       
1406       ddeCookie = DdeCreateStringHandle(ddeInstance, 
1407         "$TCLEVAL$EXECUTE$RESULT", CP_WINANSI);
1408       ddeData = DdeClientTransaction(NULL, 0, hConv,
1409         ddeCookie, CF_TEXT, XTYP_REQUEST, 30000, NULL);
1410         }
1411     }
1412 
1413     Tcl_DecrRefCount(objPtr);
1414     
1415     if (ddeData == 0) {
1416         SetDdeError(interp);
1417         goto errorNoResult;
1418     }
1419     
1420     if (async == 0) {
1421         Tcl_Obj *resultPtr;
1422         
1423         /*
1424          * The return handle has a two or four element list in
1425          * it. The first element is the return code (TCL_OK,
1426          * TCL_ERROR, etc.). The second is the result of the
1427          * script. If the return code is TCL_ERROR, then the third
1428          * element is the value of the variable "errorCode", and
1429          * the fourth is the value of the variable "errorInfo".
1430          */
1431         
1432         resultPtr = Tcl_NewObj();
1433         length = DdeGetData(ddeData, NULL, 0, 0);
1434         Tcl_SetObjLength(resultPtr, length);
1435         string = Tcl_GetString(resultPtr);
1436         DdeGetData(ddeData, string, (DWORD) length, 0);
1437         Tcl_SetObjLength(resultPtr, (int) strlen(string));
1438         
1439         if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr)
1440           != TCL_OK) {
1441       Tcl_DecrRefCount(resultPtr);
1442       goto error;
1443         }
1444         if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
1445       Tcl_DecrRefCount(resultPtr);
1446       goto error;
1447         }
1448         if (result == TCL_ERROR) {
1449       Tcl_ResetResult(interp);
1450 
1451       if (Tcl_ListObjIndex(NULL, resultPtr, 3, &objPtr)
1452         != TCL_OK) {
1453           Tcl_DecrRefCount(resultPtr);
1454           goto error;
1455       }
1456       length = -1;
1457       string = Tcl_GetStringFromObj(objPtr, &length);
1458       Tcl_AddObjErrorInfo(interp, string, length);
1459       
1460       Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr);
1461       Tcl_SetObjErrorCode(interp, objPtr);
1462         }
1463         if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr)
1464           != TCL_OK) {
1465       Tcl_DecrRefCount(resultPtr);
1466       goto error;
1467         }
1468         Tcl_SetObjResult(interp, objPtr);
1469         Tcl_DecrRefCount(resultPtr);
1470     }
1471       }
1472   }
1473     }
1474     if (ddeCookie != NULL) {
1475   DdeFreeStringHandle(ddeInstance, ddeCookie);
1476     }
1477     if (ddeItem != NULL) {
1478   DdeFreeStringHandle(ddeInstance, ddeItem);
1479     }
1480     if (ddeItemData != NULL) {
1481   DdeFreeDataHandle(ddeItemData);
1482     }
1483     if (ddeData != NULL) {
1484   DdeFreeDataHandle(ddeData);
1485     }
1486     if (hConv != NULL) {
1487   DdeDisconnect(hConv);
1488     }
1489     return result;
1490 
1491     error:
1492     Tcl_SetStringObj(Tcl_GetObjResult(interp),
1493       "invalid data returned from server", -1);
1494 
1495     errorNoResult:
1496     if (ddeCookie != NULL) {
1497   DdeFreeStringHandle(ddeInstance, ddeCookie);
1498     }
1499     if (ddeItem != NULL) {
1500   DdeFreeStringHandle(ddeInstance, ddeItem);
1501     }
1502     if (ddeItemData != NULL) {
1503   DdeFreeDataHandle(ddeItemData);
1504     }
1505     if (ddeData != NULL) {
1506   DdeFreeDataHandle(ddeData);
1507     }
1508     if (hConv != NULL) {
1509   DdeDisconnect(hConv);
1510     }
1511     return TCL_ERROR;
1512 }
TCL_DECLARE_MUTEX (ddeMutex)

Definition at line 78 of file tclWinDde.c.
References dataKey, DdeExitProc(), NULL, Tcl_CreateExitHandler(), Tcl_CreateObjCommand(), TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, Tcl_DdeObjCmd(), TCL_ERROR, Tcl_InitStubs, Tcl_PkgProvide(), and TCL_TSD_INIT.114           :
115  *  A standard Tcl result.
116  *
117  * Side effects:
118  *  None.
119  *
120  *----------------------------------------------------------------------
121  */
122 
123 int
124 Dde_Init(
125     Tcl_Interp *interp)
126 {
127     ThreadSpecificData *tsdPtr;
128 
129     if (!Tcl_InitStubs(interp, "8.0", 0)) {
130   return TCL_ERROR;
131     }
132 
133     Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, NULL, NULL);
134 
135     tsdPtr = TCL_TSD_INIT(&dataKey);
136 
137     Tcl_CreateExitHandler(DdeExitProc, NULL);
138 
139     return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
140 }


Variable Documentation
Tcl_ThreadDataKey dataKey [static]

Definition at line 63 of file tclWinDde.c.DWORD ddeInstance [static]

Definition at line 70 of file tclWinDde.c.
Referenced by DdeExitProc(), DdeServerProc(), Initialize(), MakeDdeConnection(), SetDdeError(), and Tcl_DdeObjCmd().int ddeIsServer = 0 [static]

Definition at line 72 of file tclWinDde.c.
Referenced by Initialize().HSZ ddeServiceGlobal = 0 [static]

Definition at line 69 of file tclWinDde.c.
Referenced by Initialize().

win/tclWinError.c File Reference
#include "tclWinInt.h"
Functions
void TclWinConvertError (DWORD errCode)
void TclWinConvertWSAError (DWORD errCode)
Variables
static char errorTable []
static const unsigned int tableLen = sizeof(errorTable)
static int wsaErrorTable []

Function Documentation
void TclWinConvertError (DWORD errCode)

Definition at line 357 of file tclWinError.c.
References EINVAL, errorTable, tableLen, and Tcl_SetErrno().
Referenced by ApplicationType(), ConsoleCloseProc(), ConsoleOutputProc(), DoCopyFile(), DoCreateDirectory(), DoRemoveJustDirectory(), DoRenameFile(), FileCloseProc(), FileInputProc(), FileOutputProc(), FileSeekProc(), FileWideSeekProc(), InitSockets(), NativeAccess(), NativeReadReparse(), NativeWriteReparse(), PipeInputProc(), PipeOutputProc(), SerialCloseProc(), SerialInputProc(), SerialOutputProc(), StatError(), TclpCloseFile(), TclpCreatePipe(), TclpCreateProcess(), TclpCreateTempFile(), TclpDeleteFile(), TclpDlopen(), TclpGetCwd(), TclpMatchInDirectory(), TclpObjChdir(), TclpOpenFile(), TclpOpenFileChannel(), TclpUtime(), TclWinSymLinkDelete(), TestvolumetypeCmd(), TraversalCopy(), TraverseWinTree(), WaitForRead(), WinLink(), and WinReadLink().359 {
360     if (errCode >= tableLen) {
361   Tcl_SetErrno(EINVAL);
362     } else {
363   Tcl_SetErrno(errorTable[errCode]);
364     }
365 }
void TclWinConvertWSAError (DWORD errCode)

Definition at line 384 of file tclWinError.c.
References EINVAL, Tcl_SetErrno(), and wsaErrorTable.
Referenced by CreateSocket(), InitSockets(), SocketProc(), TcpCloseProc(), TcpGetOptionProc(), TcpInputProc(), and TcpOutputProc().386 {
387     if ((errCode >= WSAEWOULDBLOCK) && (errCode <= WSAEREMOTE)) {
388   Tcl_SetErrno(wsaErrorTable[errCode - WSAEWOULDBLOCK]);
389     } else {
390   Tcl_SetErrno(EINVAL);
391     }
392 }

Variable Documentation
char errorTable[] [static]

Definition at line 22 of file tclWinError.c.
Referenced by TclWinConvertError().const unsigned int tableLen = sizeof(errorTable) [static]

Definition at line 293 of file tclWinError.c.
Referenced by TclWinConvertError().int wsaErrorTable[] [static]

Definition at line 300 of file tclWinError.c.
Referenced by TclWinConvertWSAError().

win/tclWinFCmd.c File Reference
#include "tclWinInt.h"
Defines
#define DOTREE_PRED  1
#define DOTREE_POSTD  2
#define DOTREE_F  3
Typedefs
typedef int( TraversalProc )(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, int type, Tcl_DString *errorPtr)
Enumerations
enum { WIN_ARCHIVE_ATTRIBUTE, WIN_HIDDEN_ATTRIBUTE, WIN_LONGNAME_ATTRIBUTE, WIN_READONLY_ATTRIBUTE, WIN_SHORTNAME_ATTRIBUTE, WIN_SYSTEM_ATTRIBUTE }
Functions
static int GetWinFileAttributes _ANSI_ARGS_ ((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr))
static int SetWinFileAttributes _ANSI_ARGS_ ((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr))
static void StatError (Tcl_Interp *interp, Tcl_Obj *fileName)
static int ConvertFileNameFormat (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, int longShort, Tcl_Obj **attributePtrPtr)
static int DoCopyFile (CONST TCHAR *srcPtr, CONST TCHAR *dstPtr)
static int DoCreateDirectory (CONST TCHAR *pathPtr)
static int DoRemoveJustDirectory (CONST TCHAR *nativeSrc, int ignoreError, Tcl_DString *errorPtr)
static int DoRemoveDirectory (Tcl_DString *pathPtr, int recursive, Tcl_DString *errorPtr)
static int DoRenameFile (CONST TCHAR *nativeSrc, CONST TCHAR *dstPtr)
static int TraversalCopy (CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, int type, Tcl_DString *errorPtr)
static int TraversalDelete (CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, int type, Tcl_DString *errorPtr)
static int TraverseWinTree (TraversalProc *traverseProc, Tcl_DString *sourcePtr, Tcl_DString *dstPtr, Tcl_DString *errorPtr)
int TclpObjRenameFile (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
int TclpObjCopyFile (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
int TclpObjDeleteFile (Tcl_Obj *pathPtr)
int TclpDeleteFile (CONST TCHAR *nativePath)
int TclpObjCreateDirectory (Tcl_Obj *pathPtr)
int TclpObjCopyDirectory (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr)
int TclpObjRemoveDirectory (Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr)
static int GetWinFileAttributes (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)
static int GetWinFileLongName (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)
static int GetWinFileShortName (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)
static int SetWinFileAttributes (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr)
static int CannotSetAttribute (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr)
Tcl_Obj * TclpObjListVolumes (void)
Variables
static int attributeArray []
CONST char * tclpFileAttrStrings []
CONST TclFileAttrProcs tclpFileAttrProcs []

Define Documentation
#define DOTREE_F  3

Definition at line 24 of file tclWinFCmd.c.#define DOTREE_POSTD  2

Definition at line 23 of file tclWinFCmd.c.#define DOTREE_PRED  1

Definition at line 22 of file tclWinFCmd.c.
Typedef Documentation
typedef int( TraversalProc)(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, int type, Tcl_DString *errorPtr)

Definition at line 100 of file tclWinFCmd.c.
Enumeration Type Documentation
anonymous enum

Enumerator: 
WIN_ARCHIVE_ATTRIBUTE  
WIN_HIDDEN_ATTRIBUTE  
WIN_LONGNAME_ATTRIBUTE  
WIN_READONLY_ATTRIBUTE  
WIN_SHORTNAME_ATTRIBUTE  
WIN_SYSTEM_ATTRIBUTE  

Definition at line 50 of file tclWinFCmd.c.50      {
51     WIN_ARCHIVE_ATTRIBUTE,
52     WIN_HIDDEN_ATTRIBUTE,
53     WIN_LONGNAME_ATTRIBUTE,
54     WIN_READONLY_ATTRIBUTE,
55     WIN_SHORTNAME_ATTRIBUTE,
56     WIN_SYSTEM_ATTRIBUTE
57 };

Function Documentation
static int SetWinFileAttributes _ANSI_ARGS_ ((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr)) [static]
static int GetWinFileAttributes _ANSI_ARGS_ ((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)) [static]
static int CannotSetAttribute (Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj * attributePtr) [static]

Definition at line 1882 of file tclWinFCmd.c.
References NULL, TCL_ERROR, Tcl_GetObjResult(), and Tcl_GetString().1887 {
1888     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
1889       "cannot set attribute \"", tclpFileAttrStrings[objIndex],
1890       "\" for file \"", Tcl_GetString(fileName), 
1891       "\": attribute is readonly", 
1892       (char *) NULL);
1893     return TCL_ERROR;
1894 }
static int ConvertFileNameFormat (Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, int longShort, Tcl_Obj ** attributePtrPtr) [static]

Definition at line 1595 of file tclWinFCmd.c.
References WIN32_FIND_DATAT::a, cleanup(), DWORD(), NULL, StatError(), Tcl_AppendToObj(), Tcl_DecrRefCount, Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringValue, TCL_ERROR, Tcl_FSJoinPath(), Tcl_FSSplitPath(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_ListObjIndex(), Tcl_ListObjReplace(), Tcl_NewStringObj(), TCL_OK, Tcl_UniCharToUpper(), Tcl_WinTCharToUtf(), Tcl_WinUtfToTChar(), tclWinProcs, UCHAR, TclWinProcs::useWide, and WIN32_FIND_DATAT::w.
Referenced by GetWinFileLongName(), and GetWinFileShortName().1601 {
1602     int pathc, i;
1603     Tcl_Obj *splitPath;
1604     int result = TCL_OK;
1605 
1606     splitPath = Tcl_FSSplitPath(fileName, &pathc);
1607 
1608     if (splitPath == NULL || pathc == 0) {
1609   if (interp != NULL) {
1610       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
1611     "could not read \"", Tcl_GetString(fileName),
1612     "\": no such file or directory", 
1613     (char *) NULL);
1614   }
1615   result = TCL_ERROR;
1616   goto cleanup;
1617     }
1618     
1619     for (i = 0; i < pathc; i++) {
1620   Tcl_Obj *elt;
1621   char *pathv;
1622   int pathLen;
1623   Tcl_ListObjIndex(NULL, splitPath, i, &elt);
1624   
1625   pathv = Tcl_GetStringFromObj(elt, &pathLen);
1626   if ((pathv[0] == '/')
1627     || ((pathLen == 3) && (pathv[1] == ':'))
1628     || (strcmp(pathv, ".") == 0)
1629     || (strcmp(pathv, "..") == 0)) {
1630       /*
1631        * Handle "/", "//machine/export", "c:/", "." or ".." by just
1632        * copying the string literally.  Uppercase the drive letter,
1633        * just because it looks better under Windows to do so.
1634        */
1635 
1636       simple:
1637       /* Here we are modifying the string representation in place */
1638       /* I believe this is legal, since this won't affect any 
1639        * file representation this thing may have. */
1640       pathv[0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[0]));
1641   } else {
1642       Tcl_Obj *tempPath;
1643       Tcl_DString ds;
1644       Tcl_DString dsTemp;
1645       TCHAR *nativeName;
1646       char *tempString;
1647       int tempLen;
1648       WIN32_FIND_DATAT data;
1649       HANDLE handle;
1650       DWORD attr;
1651 
1652       tempPath = Tcl_FSJoinPath(splitPath, i+1);
1653       Tcl_IncrRefCount(tempPath);
1654       /* 
1655        * We'd like to call Tcl_FSGetNativePath(tempPath)
1656        * but that is likely to lead to infinite loops 
1657        */
1658       Tcl_DStringInit(&ds);
1659       tempString = Tcl_GetStringFromObj(tempPath,&tempLen);
1660       nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds);
1661       Tcl_DecrRefCount(tempPath);
1662       handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
1663       if (handle == INVALID_HANDLE_VALUE) {
1664     /*
1665      * FindFirstFile() doesn't like root directories.  We 
1666      * would only get a root directory here if the caller
1667      * specified "c:" or "c:." and the current directory on the
1668      * drive was the root directory
1669      */
1670 
1671     attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
1672     if ((attr != 0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
1673         Tcl_DStringFree(&ds);
1674         goto simple;
1675     }
1676       }
1677 
1678       if (handle == INVALID_HANDLE_VALUE) {
1679     Tcl_DStringFree(&ds);
1680     if (interp != NULL) {
1681         StatError(interp, fileName);
1682     }
1683     result = TCL_ERROR;
1684     goto cleanup;
1685       }
1686       if (tclWinProcs->useWide) {
1687     nativeName = (TCHAR *) data.w.cAlternateFileName;
1688     if (longShort) {
1689         if (data.w.cFileName[0] != '\0') {
1690       nativeName = (TCHAR *) data.w.cFileName;
1691         } 
1692     } else {
1693         if (data.w.cAlternateFileName[0] == '\0') {
1694       nativeName = (TCHAR *) data.w.cFileName;
1695         }
1696     }
1697       } else {
1698     nativeName = (TCHAR *) data.a.cAlternateFileName;
1699     if (longShort) {
1700         if (data.a.cFileName[0] != '\0') {
1701       nativeName = (TCHAR *) data.a.cFileName;
1702         } 
1703     } else {
1704         if (data.a.cAlternateFileName[0] == '\0') {
1705       nativeName = (TCHAR *) data.a.cFileName;
1706         }
1707     }
1708       }
1709 
1710       /*
1711        * Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying 
1712        * to dereference nativeName as a Unicode string.  I have proven 
1713        * to myself that purify is wrong by running the following 
1714        * example when nativeName == data.w.cAlternateFileName and 
1715        * noting that purify doesn't complain about the first line,
1716        * but does complain about the second.
1717        *
1718        *  fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]);
1719        *  fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]);
1720        */
1721 
1722       Tcl_DStringInit(&dsTemp);
1723       Tcl_WinTCharToUtf(nativeName, -1, &dsTemp);
1724       /* Deal with issues of tildes being absolute */
1725       if (Tcl_DStringValue(&dsTemp)[0] == '~') {
1726     tempPath = Tcl_NewStringObj("./",2);
1727     Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), 
1728         Tcl_DStringLength(&dsTemp));
1729       } else {
1730     tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), 
1731               Tcl_DStringLength(&dsTemp));
1732       }
1733       Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
1734       Tcl_DStringFree(&ds);
1735       Tcl_DStringFree(&dsTemp);
1736       FindClose(handle);
1737   }
1738     }
1739 
1740     *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1);
1741 
1742 cleanup:
1743     if (splitPath != NULL) {
1744   Tcl_DecrRefCount(splitPath);
1745     }
1746   
1747     return result;
1748 }
static int DoCopyFile (CONST TCHAR * srcPtr, CONST TCHAR * dstPtr) [static]

Definition at line 551 of file tclWinFCmd.c.
References DWORD(), EACCES, EBADF, EISDIR, ENOENT, FALSE, FILE_ATTRIBUTE_REPARSE_POINT, NULL, TCL_ERROR, Tcl_GetErrno(), TCL_OK, Tcl_SetErrno(), TclWinConvertError(), tclWinProcs, and TclWinSymLinkCopyDirectory().554 {
555 #ifdef HAVE_NO_SEH
556     EXCEPTION_REGISTRATION registration;
557 #endif
558     int retval = -1;
559 
560     /*
561      * The CopyFile API acts differently under Win95/98 and NT
562      * WRT NULL and "". Avoid passing these values.
563      */
564 
565     if (nativeSrc == NULL || nativeSrc[0] == '\0' ||
566         nativeDst == NULL || nativeDst[0] == '\0') {
567   Tcl_SetErrno(ENOENT);
568   return TCL_ERROR;
569     }
570     
571     /*
572      * The CopyFile API would throw an exception under NT if one
573      * of the arguments is a char block device.
574      */
575 
576 #ifndef HAVE_NO_SEH
577     __try {
578   if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
579       retval = TCL_OK;
580   }
581     } __except (EXCEPTION_EXECUTE_HANDLER) {}
582 #else
583 
584     /*
585      * Don't have SEH available, do things the hard way.
586      * Note that this needs to be one block of asm, to avoid stack
587      * imbalance; also, it is illegal for one asm block to contain 
588      * a jump to another.
589      */
590 
591     __asm__ __volatile__ (
592 
593   /*
594    * Pick up parameters before messing with the stack
595    */
596 
597   "movl       %[nativeDst],   %%ebx"          "\n\t"
598         "movl       %[nativeSrc],   %%ecx"          "\n\t"
599   /*
600    * Construct an EXCEPTION_REGISTRATION to protect the
601    * call to CopyFile
602    */
603   "leal       %[registration], %%edx"         "\n\t"
604   "movl       %%fs:0,         %%eax"          "\n\t"
605   "movl       %%eax,          0x0(%%edx)"     "\n\t" /* link */
606   "leal       1f,             %%eax"          "\n\t"
607   "movl       %%eax,          0x4(%%edx)"     "\n\t" /* handler */
608   "movl       %%ebp,          0x8(%%edx)"     "\n\t" /* ebp */
609   "movl       %%esp,          0xc(%%edx)"     "\n\t" /* esp */
610   "movl       $0,             0x10(%%edx)"    "\n\t" /* status */
611   
612   /* Link the EXCEPTION_REGISTRATION on the chain */
613   
614   "movl       %%edx,          %%fs:0"         "\n\t"
615   
616   /* Call CopyFile( nativeSrc, nativeDst, 0 ) */
617   
618   "movl     %[copyFile],    %%eax"      "\n\t"
619   "pushl      $0"           "\n\t"
620   "pushl      %%ebx"          "\n\t"
621   "pushl      %%ecx"          "\n\t"
622   "call     *%%eax"         "\n\t"
623   
624   /* 
625    * Come here on normal exit.  Recover the EXCEPTION_REGISTRATION
626    * and put the status return from CopyFile into it.
627    */
628   
629   "movl     %%fs:0,     %%edx"      "\n\t"
630   "movl     %%eax,      0x10(%%edx)"    "\n\t"
631   "jmp      2f"           "\n"
632   
633   /*
634    * Come here on an exception.  Recover the EXCEPTION_REGISTRATION
635    */
636   
637   "1:"              "\t"
638   "movl       %%fs:0,         %%edx"          "\n\t"
639   "movl       0x8(%%edx),     %%edx"          "\n\t"
640   
641   /* 
642    * Come here however we exited.  Restore context from the
643    * EXCEPTION_REGISTRATION in case the stack is unbalanced.
644    */
645   
646   "2:"                                        "\t"
647   "movl       0xc(%%edx),     %%esp"          "\n\t"
648   "movl       0x8(%%edx),     %%ebp"          "\n\t"
649   "movl       0x0(%%edx),     %%eax"          "\n\t"
650   "movl       %%eax,          %%fs:0"         "\n\t"
651   
652   :
653   /* No outputs */
654         :
655   [registration]  "m"     (registration),
656   [nativeDst] "m"     (nativeDst),
657   [nativeSrc]     "m"     (nativeSrc),
658   [copyFile]      "r"     (tclWinProcs->copyFileProc)
659         :
660   "%eax", "%ebx", "%ecx", "%edx", "memory"
661         );
662     if (registration.status != FALSE) {
663   retval = TCL_OK;
664     }
665 #endif
666 
667     if (retval != -1)
668         return retval;
669 
670     TclWinConvertError(GetLastError());
671     if (Tcl_GetErrno() == EBADF) {
672   Tcl_SetErrno(EACCES);
673   return TCL_ERROR;
674     }
675     if (Tcl_GetErrno() == EACCES) {
676   DWORD srcAttr, dstAttr;
677 
678   srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
679   dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
680   if (srcAttr != 0xffffffff) {
681       if (dstAttr == 0xffffffff) {
682     dstAttr = 0;
683       }
684       if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) ||
685         (dstAttr & FILE_ATTRIBUTE_DIRECTORY)) {
686     if (srcAttr & FILE_ATTRIBUTE_REPARSE_POINT) {
687         /* Source is a symbolic link -- copy it */
688         if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == 0) {
689             return TCL_OK;
690         }
691     }
692     Tcl_SetErrno(EISDIR);
693       }
694       if (dstAttr & FILE_ATTRIBUTE_READONLY) {
695     (*tclWinProcs->setFileAttributesProc)(nativeDst, 
696       dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY));
697     if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
698         return TCL_OK;
699     }
700     /*
701      * Still can't copy onto dst.  Return that error, and
702      * restore attributes of dst.
703      */
704 
705     TclWinConvertError(GetLastError());
706     (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
707       }
708   }
709     }
710     return TCL_ERROR;
711 }
static int DoCreateDirectory (CONST TCHAR * pathPtr) [static]

Definition at line 855 of file tclWinFCmd.c.
References DWORD(), NULL, TCL_ERROR, TCL_OK, TclWinConvertError(), and tclWinProcs.857 {
858     DWORD error;
859     if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) {
860   error = GetLastError();
861   TclWinConvertError(error);
862   return TCL_ERROR;
863     }   
864     return TCL_OK;
865 }
static int DoRemoveDirectory (Tcl_DString * pathPtr, int recursive, Tcl_DString * errorPtr) [static]

Definition at line 1135 of file tclWinFCmd.c.
References DoRemoveJustDirectory(), EEXIST, NULL, Tcl_DStringValue, TCL_ERROR, Tcl_GetErrno(), TraversalDelete(), and TraverseWinTree().1144 {
1145     int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive, 
1146             errorPtr);
1147     
1148     if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) {
1149   /*
1150    * The directory is nonempty, but the recursive flag has been
1151    * specified, so we recursively remove all the files in the directory.
1152    */
1153   return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr);
1154     } else {
1155   return res;
1156     }
1157 }
static int DoRemoveJustDirectory (CONST TCHAR * nativeSrc, int ignoreError, Tcl_DString * errorPtr) [static]

Definition at line 1007 of file tclWinFCmd.c.
References CONST, DWORD(), EACCES, EEXIST, ENOENT, ENOTDIR, ENOTEMPTY, FALSE, FILE_ATTRIBUTE_REPARSE_POINT, find(), NULL, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), TCL_ERROR, Tcl_GetErrno(), TCL_OK, Tcl_SetErrno(), Tcl_WinTCharToUtf(), TclWinConvertError(), TclWinGetPlatformId(), tclWinProcs, and TclWinSymLinkDelete().
Referenced by DoRemoveDirectory(), DoRenameFile(), TclpObjRemoveDirectory(), and TraversalDelete().1016 {
1017     /*
1018      * The RemoveDirectory API acts differently under Win95/98 and NT
1019      * WRT NULL and "". Avoid passing these values.
1020      */
1021 
1022     if (nativePath == NULL || nativePath[0] == '\0') {
1023   Tcl_SetErrno(ENOENT);
1024   goto end;
1025     }
1026 
1027     if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
1028   return TCL_OK;
1029     }
1030     TclWinConvertError(GetLastError());
1031 
1032     if (Tcl_GetErrno() == EACCES) {
1033   DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
1034   if (attr != 0xffffffff) {
1035       if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
1036     /* 
1037      * Windows 95 reports calling RemoveDirectory on a file as an 
1038      * EACCES, not an ENOTDIR.
1039      */
1040     
1041     Tcl_SetErrno(ENOTDIR);
1042     goto end;
1043       }
1044 
1045       if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
1046     /* It is a symbolic link -- remove it */
1047     if (TclWinSymLinkDelete(nativePath, 1) != 0) {
1048         goto end;
1049     }
1050       }
1051       
1052       if (attr & FILE_ATTRIBUTE_READONLY) {
1053     attr &= ~FILE_ATTRIBUTE_READONLY;
1054     if ((*tclWinProcs->setFileAttributesProc)(nativePath, attr) == FALSE) {
1055         goto end;
1056     }
1057     if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
1058         return TCL_OK;
1059     }
1060     TclWinConvertError(GetLastError());
1061     (*tclWinProcs->setFileAttributesProc)(nativePath, 
1062       attr | FILE_ATTRIBUTE_READONLY);
1063       }
1064 
1065       /* 
1066        * Windows 95 and Win32s report removing a non-empty directory 
1067        * as EACCES, not EEXIST.  If the directory is not empty,
1068        * change errno so caller knows what's going on.
1069        */
1070 
1071       if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) {
1072     CONST char *path, *find;
1073     HANDLE handle;
1074     WIN32_FIND_DATAA data;
1075     Tcl_DString buffer;
1076     int len;
1077 
1078     path = (CONST char *) nativePath;
1079 
1080     Tcl_DStringInit(&buffer);
1081     len = strlen(path);
1082     find = Tcl_DStringAppend(&buffer, path, len);
1083     if ((len > 0) && (find[len - 1] != '\\')) {
1084         Tcl_DStringAppend(&buffer, "\\", 1);
1085     }
1086     find = Tcl_DStringAppend(&buffer, "*.*", 3);
1087     handle = FindFirstFileA(find, &data);
1088     if (handle != INVALID_HANDLE_VALUE) {
1089         while (1) {
1090       if ((strcmp(data.cFileName, ".") != 0)
1091         && (strcmp(data.cFileName, "..") != 0)) {
1092           /*
1093            * Found something in this directory.
1094            */
1095 
1096           Tcl_SetErrno(EEXIST);
1097           break;
1098       }
1099       if (FindNextFileA(handle, &data) == FALSE) {
1100           break;
1101       }
1102         }
1103         FindClose(handle);
1104     }
1105     Tcl_DStringFree(&buffer);
1106       }
1107   }
1108     }
1109     if (Tcl_GetErrno() == ENOTEMPTY) {
1110   /* 
1111    * The caller depends on EEXIST to signify that the directory is
1112    * not empty, not ENOTEMPTY. 
1113    */
1114 
1115   Tcl_SetErrno(EEXIST);
1116     }
1117     if ((ignoreError != 0) && (Tcl_GetErrno() == EEXIST)) {
1118   /* 
1119    * If we're being recursive, this error may actually
1120    * be ok, so we don't want to initialise the errorPtr
1121    * yet.
1122    */
1123   return TCL_ERROR;
1124     }
1125 
1126     end:
1127     if (errorPtr != NULL) {
1128   Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
1129     }
1130     return TCL_ERROR;
1131 
1132 }
static int DoRenameFile (CONST TCHAR * nativeSrc, CONST TCHAR * dstPtr) [static]

Definition at line 179 of file tclWinFCmd.c.
References TclWinProcs::charLowerProc(), ckfree, CONST, DoRemoveJustDirectory(), DWORD(), EACCES, EBADF, EEXIST, EINVAL, EISDIR, ENAMETOOLONG, ENOENT, ENOTDIR, errno, EXDEV, FALSE, NULL, size_t(), Tcl_DStringFree(), Tcl_DStringLength, TCL_ERROR, Tcl_GetErrno(), TCL_OK, Tcl_SetErrno(), Tcl_SplitPath(), Tcl_WinTCharToUtf(), TclWinConvertError(), tclWinProcs, and TclWinProcs::useWide.184 {    
185 #ifdef HAVE_NO_SEH
186     EXCEPTION_REGISTRATION registration;
187 #endif
188     DWORD srcAttr, dstAttr;
189     int retval = -1;
190 
191     /*
192      * The MoveFile API acts differently under Win95/98 and NT
193      * WRT NULL and "". Avoid passing these values.
194      */
195 
196     if (nativeSrc == NULL || nativeSrc[0] == '\0' ||
197         nativeDst == NULL || nativeDst[0] == '\0') {
198   Tcl_SetErrno(ENOENT);
199   return TCL_ERROR;
200     }
201 
202     /*
203      * The MoveFile API would throw an exception under NT
204      * if one of the arguments is a char block device.
205      */
206 
207 #ifndef HAVE_NO_SEH
208     __try {
209   if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
210       retval = TCL_OK;
211   }
212     } __except (EXCEPTION_EXECUTE_HANDLER) {}
213 #else
214 
215     /*
216      * Don't have SEH available, do things the hard way.
217      * Note that this needs to be one block of asm, to avoid stack
218      * imbalance; also, it is illegal for one asm block to contain 
219      * a jump to another.
220      */
221 
222     __asm__ __volatile__ (
223   /*
224    * Pick up params before messing with the stack */
225 
226   "movl     %[nativeDst],   %%ebx"      "\n\t"
227   "movl       %[nativeSrc],   %%ecx"          "\n\t"
228 
229   /*
230    * Construct an EXCEPTION_REGISTRATION to protect the
231    * call to MoveFile
232    */
233   "leal       %[registration], %%edx"         "\n\t"
234   "movl       %%fs:0,         %%eax"          "\n\t"
235   "movl       %%eax,          0x0(%%edx)"     "\n\t" /* link */
236   "leal       1f,             %%eax"          "\n\t"
237   "movl       %%eax,          0x4(%%edx)"     "\n\t" /* handler */
238   "movl       %%ebp,          0x8(%%edx)"     "\n\t" /* ebp */
239   "movl       %%esp,          0xc(%%edx)"     "\n\t" /* esp */
240   "movl       $0,             0x10(%%edx)"    "\n\t" /* status */
241   
242   /* Link the EXCEPTION_REGISTRATION on the chain */
243   
244   "movl       %%edx,          %%fs:0"         "\n\t"
245   
246   /* Call MoveFile( nativeSrc, nativeDst ) */
247   
248   "pushl      %%ebx"          "\n\t"
249   "pushl      %%ecx"          "\n\t"
250   "movl     %[moveFile],    %%eax"      "\n\t"
251   "call     *%%eax"         "\n\t"
252   
253   /* 
254    * Come here on normal exit.  Recover the EXCEPTION_REGISTRATION
255    * and put the status return from MoveFile into it.
256    */
257   
258   "movl     %%fs:0,     %%edx"      "\n\t"
259   "movl     %%eax,      0x10(%%edx)"    "\n\t"
260   "jmp      2f"           "\n"
261   
262   /*
263    * Come here on an exception.  Recover the EXCEPTION_REGISTRATION
264    */
265   
266   "1:"              "\t"
267   "movl       %%fs:0,         %%edx"          "\n\t"
268   "movl       0x8(%%edx),     %%edx"          "\n\t"
269   
270   /* 
271    * Come here however we exited.  Restore context from the
272    * EXCEPTION_REGISTRATION in case the stack is unbalanced.
273    */
274   
275   "2:"                                        "\t"
276   "movl       0xc(%%edx),     %%esp"          "\n\t"
277   "movl       0x8(%%edx),     %%ebp"          "\n\t"
278   "movl       0x0(%%edx),     %%eax"          "\n\t"
279   "movl       %%eax,          %%fs:0"         "\n\t"
280   
281   :
282   /* No outputs */
283         :
284   [registration]  "m"     (registration),
285   [nativeDst] "m"     (nativeDst),
286   [nativeSrc]     "m"     (nativeSrc),
287   [moveFile]      "r"     (tclWinProcs->moveFileProc)
288         :
289   "%eax", "%ebx", "%ecx", "%edx", "memory"
290         );
291     if (registration.status != FALSE) {
292   retval = TCL_OK;
293     }
294 #endif
295 
296     if (retval != -1)
297         return retval;
298 
299     TclWinConvertError(GetLastError());
300 
301     srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
302     dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
303     if (srcAttr == 0xffffffff) {
304   if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, NULL) >= MAX_PATH) {
305       errno = ENAMETOOLONG;
306       return TCL_ERROR;
307   }
308   srcAttr = 0;
309     }
310     if (dstAttr == 0xffffffff) {
311   if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL, NULL) >= MAX_PATH) {
312       errno = ENAMETOOLONG;
313       return TCL_ERROR;
314   }
315   dstAttr = 0;
316     }
317 
318     if (errno == EBADF) {
319   errno = EACCES;
320   return TCL_ERROR;
321     }
322     if (errno == EACCES) {
323   decode:
324   if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
325       TCHAR *nativeSrcRest, *nativeDstRest;
326       CONST char **srcArgv, **dstArgv;
327       int size, srcArgc, dstArgc;
328       WCHAR nativeSrcPath[MAX_PATH];
329       WCHAR nativeDstPath[MAX_PATH];
330       Tcl_DString srcString, dstString;
331       CONST char *src, *dst;
332 
333       size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH, 
334         nativeSrcPath, &nativeSrcRest);
335       if ((size == 0) || (size > MAX_PATH)) {
336     return TCL_ERROR;
337       }
338       size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, 
339         nativeDstPath, &nativeDstRest);
340       if ((size == 0) || (size > MAX_PATH)) {
341     return TCL_ERROR;
342       }
343       (*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath);
344       (*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath);
345 
346       src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString);
347       dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString);
348       if (strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString)) == 0) {
349     /*
350      * Trying to move a directory into itself.
351      */
352 
353     errno = EINVAL;
354     Tcl_DStringFree(&srcString);
355     Tcl_DStringFree(&dstString);
356     return TCL_ERROR;
357       }
358       Tcl_SplitPath(src, &srcArgc, &srcArgv);
359       Tcl_SplitPath(dst, &dstArgc, &dstArgv);
360       Tcl_DStringFree(&srcString);
361       Tcl_DStringFree(&dstString);
362 
363       if (srcArgc == 1) {
364     /*
365      * They are trying to move a root directory.  Whether
366      * or not it is across filesystems, this cannot be
367      * done.
368      */
369 
370     Tcl_SetErrno(EINVAL);
371       } else if ((srcArgc > 0) && (dstArgc > 0) &&
372         (strcmp(srcArgv[0], dstArgv[0]) != 0)) {
373     /*
374      * If src is a directory and dst filesystem != src
375      * filesystem, errno should be EXDEV.  It is very
376      * important to get this behavior, so that the caller
377      * can respond to a cross filesystem rename by
378      * simulating it with copy and delete.  The MoveFile
379      * system call already handles the case of moving a
380      * file between filesystems.
381      */
382 
383     Tcl_SetErrno(EXDEV);
384       }
385 
386       ckfree((char *) srcArgv);
387       ckfree((char *) dstArgv);
388   }
389 
390   /*
391    * Other types of access failure is that dst is a read-only
392    * filesystem, that an open file referred to src or dest, or that
393    * src or dest specified the current working directory on the
394    * current filesystem.  EACCES is returned for those cases.
395    */
396 
397     } else if (Tcl_GetErrno() == EEXIST) {
398   /*
399    * Reports EEXIST any time the target already exists.  If it makes
400    * sense, remove the old file and try renaming again.
401    */
402 
403   if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
404       if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
405     /*
406      * Overwrite empty dst directory with src directory.  The
407      * following call will remove an empty directory.  If it
408      * fails, it's because it wasn't empty.
409      */
410 
411     if (DoRemoveJustDirectory(nativeDst, 0, NULL) == TCL_OK) {
412         /*
413          * Now that that empty directory is gone, we can try
414          * renaming again.  If that fails, we'll put this empty
415          * directory back, for completeness.
416          */
417 
418         if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
419       return TCL_OK;
420         }
421 
422         /*
423          * Some new error has occurred.  Don't know what it
424          * could be, but report this one.
425          */
426 
427         TclWinConvertError(GetLastError());
428         (*tclWinProcs->createDirectoryProc)(nativeDst, NULL);
429         (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
430         if (Tcl_GetErrno() == EACCES) {
431       /*
432        * Decode the EACCES to a more meaningful error.
433        */
434 
435       goto decode;
436         }
437     }
438       } else {  /* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
439     Tcl_SetErrno(ENOTDIR);
440       }
441   } else {    /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
442       if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
443     Tcl_SetErrno(EISDIR);
444       } else {
445     /*
446      * Overwrite existing file by:
447      * 
448      * 1. Rename existing file to temp name.
449      * 2. Rename old file to new name.
450      * 3. If success, delete temp file.  If failure,
451      *    put temp file back to old name.
452      */
453 
454     TCHAR *nativeRest, *nativeTmp, *nativePrefix;
455     int result, size;
456     WCHAR tempBuf[MAX_PATH];
457     
458     size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, 
459       tempBuf, &nativeRest);
460     if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) {
461         return TCL_ERROR;
462     }
463     nativeTmp = (TCHAR *) tempBuf;
464     ((char *) nativeRest)[0] = '\0';
465     ((char *) nativeRest)[1] = '\0';    /* In case it's Unicode. */
466 
467     result = TCL_ERROR;
468     nativePrefix = (tclWinProcs->useWide) 
469       ? (TCHAR *) L"tclr" : (TCHAR *) "tclr";
470     if ((*tclWinProcs->getTempFileNameProc)(nativeTmp, 
471       nativePrefix, 0, tempBuf) != 0) {
472         /*
473          * Strictly speaking, need the following DeleteFile and
474          * MoveFile to be joined as an atomic operation so no
475          * other app comes along in the meantime and creates the
476          * same temp file.
477          */
478          
479         nativeTmp = (TCHAR *) tempBuf;
480         (*tclWinProcs->deleteFileProc)(nativeTmp);
481         if ((*tclWinProcs->moveFileProc)(nativeDst, nativeTmp) != FALSE) {
482       if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
483           (*tclWinProcs->setFileAttributesProc)(nativeTmp, 
484             FILE_ATTRIBUTE_NORMAL);
485           (*tclWinProcs->deleteFileProc)(nativeTmp);
486           return TCL_OK;
487       } else {
488           (*tclWinProcs->deleteFileProc)(nativeDst);
489           (*tclWinProcs->moveFileProc)(nativeTmp, nativeDst);
490       }
491         } 
492 
493         /*
494          * Can't backup dst file or move src file.  Return that
495          * error.  Could happen if an open file refers to dst.
496          */
497 
498         TclWinConvertError(GetLastError());
499         if (Tcl_GetErrno() == EACCES) {
500       /*
501        * Decode the EACCES to a more meaningful error.
502        */
503 
504       goto decode;
505         }
506     }
507     return result;
508       }
509   }
510     }
511     return TCL_ERROR;
512 }
static int GetWinFileAttributes (Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj ** attributePtrPtr) [static]

Definition at line 1521 of file tclWinFCmd.c.
References CONST, DWORD(), StatError(), TCL_ERROR, Tcl_FSGetNativePath(), Tcl_GetStringFromObj(), Tcl_NewBooleanObj(), TCL_OK, tclWinProcs, and WIN_HIDDEN_ATTRIBUTE.1526 {
1527     DWORD result;
1528     CONST TCHAR *nativeName;
1529     int attr;
1530     
1531     nativeName = Tcl_FSGetNativePath(fileName);
1532     result = (*tclWinProcs->getFileAttributesProc)(nativeName);
1533 
1534     if (result == 0xffffffff) {
1535   StatError(interp, fileName);
1536   return TCL_ERROR;
1537     }
1538 
1539     attr = (int)(result & attributeArray[objIndex]);
1540     if ((objIndex == WIN_HIDDEN_ATTRIBUTE) && (attr != 0)) {
1541   /* 
1542    * It is hidden.  However there is a bug on some Windows
1543    * OSes in which root volumes (drives) formatted as NTFS
1544    * are declared hidden when they are not (and cannot be).
1545    * 
1546    * We test for, and fix that case, here.
1547    */
1548   int len;
1549   char *str = Tcl_GetStringFromObj(fileName,&len);
1550   if (len < 4) {
1551       if (len == 0) {
1552     /* 
1553      * Not sure if this is possible, but we pass it on
1554      * anyway 
1555      */
1556       } else if (len == 1 && (str[0] == '/' || str[0] == '\\')) {
1557     /* Path is pointing to the root volume */
1558     attr = 0;
1559       } else if ((str[1] == ':') 
1560            && (len == 2 || (str[2] == '/' || str[2] == '\\'))) {
1561     /* Path is of the form 'x:' or 'x:/' or 'x:\' */
1562     attr = 0;
1563       }
1564   }
1565     }
1566     *attributePtrPtr = Tcl_NewBooleanObj(attr);
1567     return TCL_OK;
1568 }
static int GetWinFileLongName (Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj ** attributePtrPtr) [static]

Definition at line 1770 of file tclWinFCmd.c.
References ConvertFileNameFormat().1775 {
1776     return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr);
1777 }
static int GetWinFileShortName (Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj ** attributePtrPtr) [static]

Definition at line 1799 of file tclWinFCmd.c.
References ConvertFileNameFormat().1804 {
1805     return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr);
1806 }
static int SetWinFileAttributes (Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj * attributePtr) [static]

Definition at line 1826 of file tclWinFCmd.c.
References CONST, DWORD(), StatError(), TCL_ERROR, Tcl_FSGetNativePath(), Tcl_GetBooleanFromObj(), TCL_OK, and tclWinProcs.1831 {
1832     DWORD fileAttributes;
1833     int yesNo;
1834     int result;
1835     CONST TCHAR *nativeName;
1836 
1837     nativeName = Tcl_FSGetNativePath(fileName);
1838     fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName);
1839 
1840     if (fileAttributes == 0xffffffff) {
1841   StatError(interp, fileName);
1842   return TCL_ERROR;
1843     }
1844 
1845     result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);
1846     if (result != TCL_OK) {
1847   return result;
1848     }
1849 
1850     if (yesNo) {
1851   fileAttributes |= (attributeArray[objIndex]);
1852     } else {
1853   fileAttributes &= ~(attributeArray[objIndex]);
1854     }
1855 
1856     if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) {
1857   StatError(interp, fileName);
1858   return TCL_ERROR;
1859     }
1860 
1861     return result;
1862 }
static void StatError (Tcl_Interp * interp, Tcl_Obj * fileName) [static]

Definition at line 1489 of file tclWinFCmd.c.
References NULL, Tcl_GetObjResult(), Tcl_GetString(), Tcl_PosixError(), and TclWinConvertError().
Referenced by ConvertFileNameFormat(), GetWinFileAttributes(), and SetWinFileAttributes().1493 {
1494     TclWinConvertError(GetLastError());
1495     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
1496          "could not read \"", Tcl_GetString(fileName), 
1497          "\": ", Tcl_PosixError(interp), 
1498          (char *) NULL);
1499 }
int TclpDeleteFile (CONST TCHAR * nativePath)

Definition at line 746 of file tclWinFCmd.c.
References DWORD(), EACCES, EINVAL, EISDIR, ENOENT, FALSE, FILE_ATTRIBUTE_REPARSE_POINT, NULL, TCL_ERROR, Tcl_GetErrno(), TCL_OK, Tcl_SetErrno(), TclWinConvertError(), tclWinProcs, and TclWinSymLinkDelete().748 {
749     DWORD attr;
750 
751     /*
752      * The DeleteFile API acts differently under Win95/98 and NT
753      * WRT NULL and "". Avoid passing these values.
754      */
755 
756     if (nativePath == NULL || nativePath[0] == '\0') {
757   Tcl_SetErrno(ENOENT);
758   return TCL_ERROR;
759     }
760 
761     if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) {
762   return TCL_OK;
763     }
764     TclWinConvertError(GetLastError());
765 
766     if (Tcl_GetErrno() == EACCES) {
767         attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
768   if (attr != 0xffffffff) {
769       if (attr & FILE_ATTRIBUTE_DIRECTORY) {
770     if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
771         /* It is a symbolic link -- remove it */
772         if (TclWinSymLinkDelete(nativePath, 0) == 0) {
773             return TCL_OK;
774         }
775     }
776     
777     /* 
778      * If we fall through here, it is a directory.
779      * 
780      * Windows NT reports removing a directory as EACCES instead
781      * of EISDIR.
782      */
783 
784     Tcl_SetErrno(EISDIR);
785       } else if (attr & FILE_ATTRIBUTE_READONLY) {
786     int res = (*tclWinProcs->setFileAttributesProc)(nativePath, 
787       attr & ~((DWORD)FILE_ATTRIBUTE_READONLY));
788     if ((res != 0) && ((*tclWinProcs->deleteFileProc)(nativePath)
789       != FALSE)) {
790         return TCL_OK;
791     }
792     TclWinConvertError(GetLastError());
793     if (res != 0) {
794         (*tclWinProcs->setFileAttributesProc)(nativePath, attr);
795     }
796       }
797   }
798     } else if (Tcl_GetErrno() == ENOENT) {
799         attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
800   if (attr != 0xffffffff) {
801       if (attr & FILE_ATTRIBUTE_DIRECTORY) {
802         /*
803      * Windows 95 reports removing a directory as ENOENT instead 
804      * of EISDIR. 
805      */
806 
807     Tcl_SetErrno(EISDIR);
808       }
809   }
810     } else if (Tcl_GetErrno() == EINVAL) {
811   /*
812    * Windows NT reports removing a char device as EINVAL instead of
813    * EACCES.
814    */
815 
816   Tcl_SetErrno(EACCES);
817     }
818 
819     return TCL_ERROR;
820 }
int TclpObjCopyDirectory (Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr, Tcl_Obj ** errorPtr)

Definition at line 894 of file tclWinFCmd.c.
References NULL, Tcl_DStringFree(), Tcl_DStringValue, TCL_ERROR, Tcl_FSGetNormalizedPath(), Tcl_GetString(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_OK, Tcl_WinUtfToTChar(), TraversalCopy(), and TraverseWinTree().898 {
899     Tcl_DString ds;
900     Tcl_DString srcString, dstString;
901     Tcl_Obj *normSrcPtr, *normDestPtr;
902     int ret;
903 
904     normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr);
905     if (normSrcPtr == NULL) {
906   return TCL_ERROR;
907     }
908     Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString);
909     normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr);
910     if (normDestPtr == NULL) {
911   return TCL_ERROR;
912     }
913     Tcl_WinUtfToTChar(Tcl_GetString(normDestPtr), -1, &dstString);
914 
915     ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds);
916 
917     Tcl_DStringFree(&srcString);
918     Tcl_DStringFree(&dstString);
919 
920     if (ret != TCL_OK) {
921   if (!strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normSrcPtr))) {
922       *errorPtr = srcPathPtr;
923   } else if (!strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normDestPtr))) {
924       *errorPtr = destPathPtr;
925   } else {
926       *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
927   }
928   Tcl_DStringFree(&ds);
929   Tcl_IncrRefCount(*errorPtr);
930     }
931     return ret;
932 }
int TclpObjCopyFile (Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)

Definition at line 542 of file tclWinFCmd.c.
References DoCopyFile(), and Tcl_FSGetNativePath().545 {
546     return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
547           Tcl_FSGetNativePath(destPathPtr));
548 }
int TclpObjCreateDirectory (Tcl_Obj * pathPtr)

Definition at line 848 of file tclWinFCmd.c.
References DoCreateDirectory(), and Tcl_FSGetNativePath().850 {
851     return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
852 }
int TclpObjDeleteFile (Tcl_Obj * pathPtr)

Definition at line 739 of file tclWinFCmd.c.
References Tcl_FSGetNativePath(), and TclpDeleteFile().741 {
742     return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr));
743 }
Tcl_Obj* TclpObjListVolumes (void)

Definition at line 1914 of file tclWinFCmd.c.
References NULL, Tcl_IncrRefCount, Tcl_ListObjAppendElement(), Tcl_NewObj(), and Tcl_NewStringObj().1915 {
1916     Tcl_Obj *resultPtr, *elemPtr;
1917     char buf[40 * 4];   /* There couldn't be more than 30 drives??? */
1918     int i;
1919     char *p;
1920 
1921     resultPtr = Tcl_NewObj();
1922 
1923     /*
1924      * On Win32s:
1925      * GetLogicalDriveStrings() isn't implemented.
1926      * GetLogicalDrives() returns incorrect information.
1927      */
1928 
1929     if (GetLogicalDriveStringsA(sizeof(buf), buf) == 0) {
1930   /*
1931    * GetVolumeInformation() will detects all drives, but causes
1932    * chattering on empty floppy drives.  We only do this if 
1933    * GetLogicalDriveStrings() didn't work.  It has also been reported
1934    * that on some laptops it takes a while for GetVolumeInformation()
1935    * to return when pinging an empty floppy drive, another reason to 
1936    * try to avoid calling it.
1937    */
1938 
1939   buf[1] = ':';
1940   buf[2] = '/';
1941   buf[3] = '\0';
1942 
1943   for (i = 0; i < 26; i++) {
1944       buf[0] = (char) ('a' + i);
1945       if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)  
1946         || (GetLastError() == ERROR_NOT_READY)) {
1947     elemPtr = Tcl_NewStringObj(buf, -1);
1948     Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
1949       }
1950   }
1951     } else {
1952   for (p = buf; *p != '\0'; p += 4) {
1953       p[2] = '/';
1954       elemPtr = Tcl_NewStringObj(p, -1);
1955       Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
1956   }
1957     }
1958     
1959     Tcl_IncrRefCount(resultPtr);
1960     return resultPtr;
1961 }
int TclpObjRemoveDirectory (Tcl_Obj * pathPtr, int recursive, Tcl_Obj ** errorPtr)

Definition at line 964 of file tclWinFCmd.c.
References DoRemoveDirectory(), DoRemoveJustDirectory(), NULL, Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, TCL_ERROR, Tcl_FSGetNativePath(), Tcl_FSGetNormalizedPath(), Tcl_GetString(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_OK, and Tcl_WinUtfToTChar().968 {
969     Tcl_DString ds;
970     Tcl_Obj *normPtr = NULL;
971     int ret;
972     if (recursive) {
973   /* 
974    * In the recursive case, the string rep is used to construct a
975    * Tcl_DString which may be used extensively, so we can't
976    * optimize this case easily.
977    */
978   Tcl_DString native;
979   normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
980   if (normPtr == NULL) {
981       return TCL_ERROR;
982   }
983   Tcl_WinUtfToTChar(Tcl_GetString(normPtr), -1, &native);
984   ret = DoRemoveDirectory(&native, recursive, &ds);
985   Tcl_DStringFree(&native);
986     } else {
987   ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), 
988             0, &ds);
989     }
990     if (ret != TCL_OK) {
991   int len = Tcl_DStringLength(&ds);
992   if (len > 0) {
993       if (normPtr != NULL 
994         && !strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normPtr))) {
995     *errorPtr = pathPtr;
996       } else {
997     *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
998       }
999       Tcl_IncrRefCount(*errorPtr);
1000   }
1001   Tcl_DStringFree(&ds);
1002     }
1003     return ret;
1004 }
int TclpObjRenameFile (Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)

Definition at line 170 of file tclWinFCmd.c.
References DoRenameFile(), and Tcl_FSGetNativePath().173 {
174     return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), 
175       Tcl_FSGetNativePath(destPathPtr));
176 }
static int TraversalCopy (CONST TCHAR * srcPtr, CONST TCHAR * dstPtr, int type, Tcl_DString * errorPtr) [static]

Definition at line 1378 of file tclWinFCmd.c.
References DoCopyFile(), DoCreateDirectory(), DOTREE_F, DOTREE_POSTD, DOTREE_PRED, DWORD(), FALSE, NULL, TCL_ERROR, TCL_OK, Tcl_WinTCharToUtf(), TclWinConvertError(), and tclWinProcs.1384 {
1385     switch (type) {
1386   case DOTREE_F: {
1387       if (DoCopyFile(nativeSrc, nativeDst) == TCL_OK) {
1388     return TCL_OK;
1389       }
1390       break;
1391   }
1392   case DOTREE_PRED: {
1393       if (DoCreateDirectory(nativeDst) == TCL_OK) {
1394     DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
1395     if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) != FALSE) {
1396         return TCL_OK;
1397     }
1398     TclWinConvertError(GetLastError());
1399       }
1400       break;
1401   }
1402         case DOTREE_POSTD: {
1403       return TCL_OK;
1404   }
1405     }
1406 
1407     /*
1408      * There shouldn't be a problem with src, because we already
1409      * checked it to get here.
1410      */
1411 
1412     if (errorPtr != NULL) {
1413   Tcl_WinTCharToUtf(nativeDst, -1, errorPtr);
1414     }
1415     return TCL_ERROR;
1416 }
static int TraversalDelete (CONST TCHAR * srcPtr, CONST TCHAR * dstPtr, int type, Tcl_DString * errorPtr) [static]

Definition at line 1440 of file tclWinFCmd.c.
References DoRemoveJustDirectory(), DOTREE_F, DOTREE_POSTD, DOTREE_PRED, NULL, TCL_ERROR, TCL_OK, Tcl_WinTCharToUtf(), and TclpDeleteFile().1446 {
1447     switch (type) {
1448   case DOTREE_F: {
1449       if (TclpDeleteFile(nativeSrc) == TCL_OK) {
1450     return TCL_OK;
1451       }
1452       break;
1453   }
1454   case DOTREE_PRED: {
1455       return TCL_OK;
1456   }
1457   case DOTREE_POSTD: {
1458       if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) {
1459     return TCL_OK;
1460       }
1461       break;
1462   }
1463     }
1464 
1465     if (errorPtr != NULL) {
1466   Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr);
1467     }
1468     return TCL_ERROR;
1469 }
static int TraverseWinTree (TraversalProc * traverseProc, Tcl_DString * sourcePtr, Tcl_DString * dstPtr, Tcl_DString * errorPtr) [static]

Definition at line 1182 of file tclWinFCmd.c.
References WIN32_FIND_DATAT::a, DOTREE_F, DOTREE_POSTD, DOTREE_PRED, DWORD(), NULL, Tcl_DStringAppend(), Tcl_DStringLength, Tcl_DStringSetLength(), Tcl_DStringValue, TCL_ERROR, TCL_OK, Tcl_WinTCharToUtf(), TclWinConvertError(), tclWinProcs, TclWinProcs::useWide, and WIN32_FIND_DATAT::w.
Referenced by DoRemoveDirectory(), and TclpObjCopyDirectory().1193 {
1194     DWORD sourceAttr;
1195     TCHAR *nativeSource, *nativeTarget, *nativeErrfile;
1196     int result, found, sourceLen, targetLen, oldSourceLen, oldTargetLen;
1197     HANDLE handle;
1198     WIN32_FIND_DATAT data;
1199 
1200     nativeErrfile = NULL;
1201     result = TCL_OK;
1202     oldTargetLen = 0;   /* lint. */
1203 
1204     nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
1205     nativeTarget = (TCHAR *) (targetPtr == NULL 
1206             ? NULL : Tcl_DStringValue(targetPtr));
1207     
1208     oldSourceLen = Tcl_DStringLength(sourcePtr);
1209     sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource);
1210     if (sourceAttr == 0xffffffff) {
1211   nativeErrfile = nativeSource;
1212   goto end;
1213     }
1214     if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
1215   /*
1216    * Process the regular file
1217    */
1218 
1219   return (*traverseProc)(nativeSource, nativeTarget, DOTREE_F, errorPtr);
1220     }
1221 
1222     if (tclWinProcs->useWide) {
1223   Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1);
1224   Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
1225     } else {
1226   Tcl_DStringAppend(sourcePtr, "\\*.*", 4);
1227     }
1228     nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
1229     handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data);
1230     if (handle == INVALID_HANDLE_VALUE) {      
1231   /* 
1232    * Can't read directory
1233    */
1234 
1235   TclWinConvertError(GetLastError());
1236   nativeErrfile = nativeSource;
1237   goto end;
1238     }
1239 
1240     nativeSource[oldSourceLen + 1] = '\0';
1241     Tcl_DStringSetLength(sourcePtr, oldSourceLen);
1242     result = (*traverseProc)(nativeSource, nativeTarget, DOTREE_PRED, errorPtr);
1243     if (result != TCL_OK) {
1244   FindClose(handle);
1245   return result;
1246     }
1247 
1248     sourceLen = oldSourceLen;
1249 
1250     if (tclWinProcs->useWide) {
1251   sourceLen += sizeof(WCHAR);
1252   Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1);
1253   Tcl_DStringSetLength(sourcePtr, sourceLen);
1254     } else {
1255   sourceLen += 1;
1256   Tcl_DStringAppend(sourcePtr, "\\", 1);
1257     }
1258     if (targetPtr != NULL) {
1259   oldTargetLen = Tcl_DStringLength(targetPtr);
1260 
1261   targetLen = oldTargetLen;
1262   if (tclWinProcs->useWide) {
1263       targetLen += sizeof(WCHAR);
1264       Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1);
1265       Tcl_DStringSetLength(targetPtr, targetLen);
1266   } else {
1267       targetLen += 1;
1268       Tcl_DStringAppend(targetPtr, "\\", 1);
1269   }
1270     }
1271 
1272     found = 1;
1273     for ( ; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
1274   TCHAR *nativeName;
1275   int len;
1276 
1277   if (tclWinProcs->useWide) {
1278       WCHAR *wp;
1279 
1280       wp = data.w.cFileName;
1281       if (*wp == '.') {
1282     wp++;
1283     if (*wp == '.') {
1284         wp++;
1285     }
1286     if (*wp == '\0') {
1287         continue;
1288     }
1289       }
1290       nativeName = (TCHAR *) data.w.cFileName;
1291       len = wcslen(data.w.cFileName) * sizeof(WCHAR);
1292   } else {
1293       if ((strcmp(data.a.cFileName, ".") == 0) 
1294         || (strcmp(data.a.cFileName, "..") == 0)) {
1295     continue;
1296       }
1297       nativeName = (TCHAR *) data.a.cFileName;
1298       len = strlen(data.a.cFileName);
1299   }
1300 
1301   /* 
1302    * Append name after slash, and recurse on the file. 
1303    */
1304 
1305   Tcl_DStringAppend(sourcePtr, (char *) nativeName, len + 1);
1306   Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
1307   if (targetPtr != NULL) {
1308       Tcl_DStringAppend(targetPtr, (char *) nativeName, len + 1);
1309       Tcl_DStringSetLength(targetPtr, Tcl_DStringLength(targetPtr) - 1);
1310   }
1311   result = TraverseWinTree(traverseProc, sourcePtr, targetPtr, 
1312     errorPtr);
1313   if (result != TCL_OK) {
1314       break;
1315   }
1316 
1317   /*
1318    * Remove name after slash.
1319    */
1320 
1321   Tcl_DStringSetLength(sourcePtr, sourceLen);
1322   if (targetPtr != NULL) {
1323       Tcl_DStringSetLength(targetPtr, targetLen);
1324   }
1325     }
1326     FindClose(handle);
1327 
1328     /*
1329      * Strip off the trailing slash we added
1330      */
1331 
1332     Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1);
1333     Tcl_DStringSetLength(sourcePtr, oldSourceLen);
1334     if (targetPtr != NULL) {
1335   Tcl_DStringSetLength(targetPtr, oldTargetLen + 1);
1336   Tcl_DStringSetLength(targetPtr, oldTargetLen);
1337     }
1338     if (result == TCL_OK) {
1339   /*
1340    * Call traverseProc() on a directory after visiting all the
1341    * files in that directory.
1342    */
1343 
1344   result = (*traverseProc)(Tcl_DStringValue(sourcePtr), 
1345       (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)), 
1346       DOTREE_POSTD, errorPtr);
1347     }
1348     end:
1349     if (nativeErrfile != NULL) {
1350   TclWinConvertError(GetLastError());
1351   if (errorPtr != NULL) {
1352       Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr);
1353   }
1354   result = TCL_ERROR;
1355     }
1356 
1357     return result;
1358 }

Variable Documentation
int attributeArray[] [static]
Initial value: {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,
  0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM}
Definition at line 59 of file tclWinFCmd.c.CONST TclFileAttrProcs tclpFileAttrProcs[]
Initial value: {
  {GetWinFileAttributes, SetWinFileAttributes},
  {GetWinFileAttributes, SetWinFileAttributes},
  {GetWinFileLongName, CannotSetAttribute},
  {GetWinFileAttributes, SetWinFileAttributes},
  {GetWinFileShortName, CannotSetAttribute},
  {GetWinFileAttributes, SetWinFileAttributes}}
Definition at line 68 of file tclWinFCmd.c.CONST char* tclpFileAttrStrings[]
Initial value: {
  "-archive", "-hidden", "-longname", "-readonly",
  "-shortname", "-system", (char *) NULL
}
Definition at line 63 of file tclWinFCmd.c.

win/tclWinFile.c File Reference
#include "tclWinInt.h"
#include <winioctl.h>
#include <sys/stat.h>
#include <shlobj.h>
#include <lmaccess.h>
Classes
struct _REPARSE_DATA_BUFFER
struct DUMMY_REPARSE_BUFFER
Defines
#define POSIX_EPOCH_AS_FILETIME  116444736000000000
#define IO_REPARSE_TAG_RESERVED_ONE  0x000000001
#define IO_REPARSE_TAG_RESERVED_RANGE  0x000000001
#define IO_REPARSE_TAG_VALID_VALUES  0x0E000FFFF
#define IO_REPARSE_TAG_HSM  0x0C0000004
#define IO_REPARSE_TAG_NSS  0x080000005
#define IO_REPARSE_TAG_NSSRECOVER  0x080000006
#define IO_REPARSE_TAG_SIS  0x080000007
#define IO_REPARSE_TAG_DFS  0x080000008
#define IO_REPARSE_TAG_RESERVED_ZERO  0x00000000
#define FILE_FLAG_OPEN_REPARSE_POINT  0x00200000
#define IO_REPARSE_TAG_MOUNT_POINT  0xA0000003
#define IsReparseTagValid(x)  (!((x)&~IO_REPARSE_TAG_VALID_VALUES)&&((x)>IO_REPARSE_TAG_RESERVED_RANGE))
#define IO_REPARSE_TAG_SYMBOLIC_LINK  IO_REPARSE_TAG_RESERVED_ZERO
#define FILE_SPECIAL_ACCESS  (FILE_ANY_ACCESS)
#define FSCTL_SET_REPARSE_POINT  CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 41, METHOD_BUFFERED, FILE_SPECIAL_ACCESS)
#define FSCTL_GET_REPARSE_POINT  CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 42, METHOD_BUFFERED, FILE_ANY_ACCESS)
#define FSCTL_DELETE_REPARSE_POINT  CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 43, METHOD_BUFFERED, FILE_SPECIAL_ACCESS)
#define INVALID_FILE_ATTRIBUTES  ((DWORD)-1)
#define MAX_REPARSE_SIZE  17000
#define REPARSE_MOUNTPOINT_HEADER_SIZE  8
#define HAVE_NO_FINDEX_ENUMS
#define VOL_BUF_SIZE  32
Typedefs
typedef _REPARSE_DATA_BUFFER REPARSE_DATA_BUFFER
typedef enum _FINDEX_INFO_LEVELS FINDEX_INFO_LEVELS
typedef enum _FINDEX_SEARCH_OPS FINDEX_SEARCH_OPS
typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC (LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr)
typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC (LPVOID Buffer)
typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC (LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr)
Enumerations
enum _FINDEX_INFO_LEVELS { FindExInfoStandard, FindExInfoMaxInfoLevel }
enum _FINDEX_SEARCH_OPS { FindExSearchNameMatch, FindExSearchLimitToDirectories, FindExSearchLimitToDevices, FindExSearchMaxSearchOp }
Functions
static time_t ToCTime (FILETIME fileTime)
static void FromCTime (time_t posixTime, FILETIME *fileTime)
static int NativeAccess (CONST TCHAR *path, int mode)
static int NativeStat (CONST TCHAR *path, Tcl_StatBuf *statPtr, int checkLinks)
static unsigned short NativeStatMode (DWORD attr, int checkLinks, int isExec)
static int NativeIsExec (CONST TCHAR *path)
static int NativeReadReparse (CONST TCHAR *LinkDirectory, REPARSE_DATA_BUFFER *buffer)
static int NativeWriteReparse (CONST TCHAR *LinkDirectory, REPARSE_DATA_BUFFER *buffer)
static int NativeMatchType (int isDrive, DWORD attr, CONST TCHAR *nativeName, Tcl_GlobTypeData *types)
static int WinIsDrive (CONST char *name, int nameLen)
static int WinIsReserved (CONST char *path)
static Tcl_Obj * WinReadLink (CONST TCHAR *LinkSource)
static Tcl_Obj * WinReadLinkDirectory (CONST TCHAR *LinkDirectory)
static int WinLink (CONST TCHAR *LinkSource, CONST TCHAR *LinkTarget, int linkAction)
static int WinSymLinkDirectory (CONST TCHAR *LinkDirectory, CONST TCHAR *LinkTarget)
int TclWinSymLinkCopyDirectory (CONST TCHAR *LinkOriginal, CONST TCHAR *LinkCopy)
int TclWinSymLinkDelete (CONST TCHAR *LinkOriginal, int linkOnly)
char * TclpFindExecutable (CONST char *argv0)
int TclpMatchInDirectory (Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types)
char * TclpGetUserHome (CONST char *name, Tcl_DString *bufferPtr)
int TclpObjChdir (Tcl_Obj *pathPtr)
CONST char * TclpGetCwd (Tcl_Interp *interp, Tcl_DString *bufferPtr)
int TclpObjStat (Tcl_Obj *pathPtr, Tcl_StatBuf *statPtr)
Tcl_Obj * TclpObjGetCwd (Tcl_Interp *interp)
int TclpObjAccess (Tcl_Obj *pathPtr, int mode)
int TclpObjLstat (Tcl_Obj *pathPtr, Tcl_StatBuf *statPtr)
Tcl_Obj * TclpFilesystemPathType (Tcl_Obj *pathObjPtr)
int TclpObjNormalizePath (Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint)
int TclpUtime (Tcl_Obj *pathPtr, struct utimbuf *tval)

Define Documentation
#define FILE_FLAG_OPEN_REPARSE_POINT  0x00200000

Definition at line 66 of file tclWinFile.c.
Referenced by NativeReadReparse(), NativeWriteReparse(), and TclWinSymLinkDelete().#define FILE_SPECIAL_ACCESS  (FILE_ANY_ACCESS)

Definition at line 78 of file tclWinFile.c.#define FSCTL_DELETE_REPARSE_POINT  CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 43, METHOD_BUFFERED, FILE_SPECIAL_ACCESS)

Definition at line 83 of file tclWinFile.c.
Referenced by TclWinSymLinkDelete().#define FSCTL_GET_REPARSE_POINT  CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 42, METHOD_BUFFERED, FILE_ANY_ACCESS)

Definition at line 82 of file tclWinFile.c.
Referenced by NativeReadReparse().#define FSCTL_SET_REPARSE_POINT  CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 41, METHOD_BUFFERED, FILE_SPECIAL_ACCESS)

Definition at line 81 of file tclWinFile.c.
Referenced by NativeWriteReparse().#define HAVE_NO_FINDEX_ENUMS

Definition at line 144 of file tclWinFile.c.#define INVALID_FILE_ATTRIBUTES  ((DWORD)-1)

Definition at line 86 of file tclWinFile.c.
Referenced by NativeStat(), TclpObjNormalizePath(), and TclpUtime().#define IO_REPARSE_TAG_DFS  0x080000008

Definition at line 59 of file tclWinFile.c.#define IO_REPARSE_TAG_HSM  0x0C0000004

Definition at line 47 of file tclWinFile.c.#define IO_REPARSE_TAG_MOUNT_POINT  0xA0000003

Definition at line 69 of file tclWinFile.c.
Referenced by TclWinSymLinkDelete(), WinReadLinkDirectory(), and WinSymLinkDirectory().#define IO_REPARSE_TAG_NSS  0x080000005

Definition at line 50 of file tclWinFile.c.#define IO_REPARSE_TAG_NSSRECOVER  0x080000006

Definition at line 53 of file tclWinFile.c.#define IO_REPARSE_TAG_RESERVED_ONE  0x000000001

Definition at line 38 of file tclWinFile.c.#define IO_REPARSE_TAG_RESERVED_RANGE  0x000000001

Definition at line 41 of file tclWinFile.c.#define IO_REPARSE_TAG_RESERVED_ZERO  0x00000000

Definition at line 63 of file tclWinFile.c.#define IO_REPARSE_TAG_SIS  0x080000007

Definition at line 56 of file tclWinFile.c.#define IO_REPARSE_TAG_SYMBOLIC_LINK  IO_REPARSE_TAG_RESERVED_ZERO

Definition at line 75 of file tclWinFile.c.
Referenced by WinReadLinkDirectory().#define IO_REPARSE_TAG_VALID_VALUES  0x0E000FFFF

Definition at line 44 of file tclWinFile.c.#define IsReparseTagValid(x)  (!((x)&~IO_REPARSE_TAG_VALID_VALUES)&&((x)>IO_REPARSE_TAG_RESERVED_RANGE))

Definition at line 72 of file tclWinFile.c.
Referenced by NativeReadReparse().#define MAX_REPARSE_SIZE  17000

Definition at line 94 of file tclWinFile.c.#define POSIX_EPOCH_AS_FILETIME  116444736000000000

Definition at line 30 of file tclWinFile.c.
Referenced by FromCTime(), and ToCTime().#define REPARSE_MOUNTPOINT_HEADER_SIZE  8

Definition at line 108 of file tclWinFile.c.
Referenced by NativeWriteReparse(), and TclWinSymLinkDelete().#define VOL_BUF_SIZE  32

Referenced by TclpFilesystemPathType(), and TestvolumetypeCmd().
Typedef Documentation
typedef enum _FINDEX_INFO_LEVELS  FINDEX_INFO_LEVELS
typedef enum _FINDEX_SEARCH_OPS  FINDEX_SEARCH_OPS
typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC(LPVOID Buffer)

Definition at line 170 of file tclWinFile.c.typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC(LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr)

Definition at line 173 of file tclWinFile.c.typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC(LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr)

Definition at line 167 of file tclWinFile.c.typedef struct _REPARSE_DATA_BUFFER  REPARSE_DATA_BUFFER

Enumeration Type Documentation
enum _FINDEX_INFO_LEVELS

Enumerator: 
FindExInfoStandard  
FindExInfoMaxInfoLevel  

Definition at line 149 of file tclWinFile.c.149                                  {
150   FindExInfoStandard,
151   FindExInfoMaxInfoLevel
152 } FINDEX_INFO_LEVELS;
enum _FINDEX_SEARCH_OPS

Enumerator: 
FindExSearchNameMatch  
FindExSearchLimitToDirectories  
FindExSearchLimitToDevices  
FindExSearchMaxSearchOp  

Definition at line 153 of file tclWinFile.c.153                                 {
154   FindExSearchNameMatch,
155   FindExSearchLimitToDirectories,
156   FindExSearchLimitToDevices,
157   FindExSearchMaxSearchOp
158 } FINDEX_SEARCH_OPS;

Function Documentation
static void FromCTime (time_t posixTime, FILETIME * fileTime) [static]

Definition at line 2072 of file tclWinFile.c.
References POSIX_EPOCH_AS_FILETIME.
Referenced by TclpUtime().2075 {
2076     LARGE_INTEGER convertedTime;
2077     convertedTime.QuadPart = ((LONGLONG) posixTime) * 10000000
2078   + POSIX_EPOCH_AS_FILETIME;
2079     fileTime->dwLowDateTime = convertedTime.LowPart;
2080     fileTime->dwHighDateTime = convertedTime.HighPart;
2081 }
static int NativeAccess (CONST TCHAR * path, int mode) [static]

Definition at line 1328 of file tclWinFile.c.
References BOOL(), DWORD(), EACCES, F_OK, FALSE, NativeIsExec(), NULL, R_OK, Tcl_SetErrno(), TclWinConvertError(), tclWinProcs, W_OK, and X_OK.
Referenced by TclpObjAccess().1331 {
1332     DWORD attr;
1333 
1334     attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
1335 
1336     if (attr == 0xffffffff) {
1337   /*
1338    * File doesn't exist.
1339    */
1340 
1341   TclWinConvertError(GetLastError());
1342   return -1;
1343     }
1344 
1345     if ((mode & W_OK) 
1346       && (tclWinProcs->getFileSecurityProc == NULL)
1347       && (attr & FILE_ATTRIBUTE_READONLY)) {
1348   /*
1349    * We don't have the advanced 'getFileSecurityProc', and
1350    * our attributes say the file is not writable.  If we
1351    * do have 'getFileSecurityProc', we'll do a more
1352    * robust XP-related check below.
1353    */
1354 
1355   Tcl_SetErrno(EACCES);
1356   return -1;
1357     }
1358 
1359     if (mode & X_OK) {
1360   if (!(attr & FILE_ATTRIBUTE_DIRECTORY) && !NativeIsExec(nativePath)) {
1361       /*
1362        * It's not a directory and doesn't have the correct extension.
1363        * Therefore it can't be executable
1364        */
1365 
1366       Tcl_SetErrno(EACCES);
1367       return -1;
1368   }
1369     }
1370 
1371     /*
1372      * It looks as if the permissions are ok, but if we are on NT, 2000 or XP,
1373      * we have a more complex permissions structure so we try to check that.
1374      * The code below is remarkably complex for such a simple thing as finding
1375      * what permissions the OS has set for a file.
1376      *
1377      * If we are simply checking for file existence, then we don't need all
1378      * these complications (which are really quite slow: with this code 'file
1379      * readable' is 5-6 times slower than 'file exists').
1380      */
1381 
1382     if ((mode != F_OK) && (tclWinProcs->getFileSecurityProc != NULL)) {
1383   SECURITY_DESCRIPTOR *sdPtr = NULL;
1384   unsigned long size;
1385   GENERIC_MAPPING genMap;
1386   HANDLE hToken = NULL;
1387   DWORD desiredAccess = 0;
1388   DWORD grantedAccess = 0;
1389   BOOL accessYesNo = FALSE;
1390   PRIVILEGE_SET privSet;
1391   DWORD privSetSize = sizeof(PRIVILEGE_SET);
1392   int error;
1393 
1394   /*
1395    * First find out how big the buffer needs to be
1396    */
1397 
1398   size = 0;
1399   (*tclWinProcs->getFileSecurityProc)(nativePath,
1400     OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION
1401     | DACL_SECURITY_INFORMATION, 0, 0, &size);
1402 
1403   /*
1404    * Should have failed with ERROR_INSUFFICIENT_BUFFER
1405    */
1406 
1407   error = GetLastError();
1408   if (error != ERROR_INSUFFICIENT_BUFFER) {
1409       /*
1410        * Most likely case is ERROR_ACCESS_DENIED, which we will convert
1411        * to EACCES - just what we want!
1412        */
1413 
1414       TclWinConvertError((DWORD)error);
1415       return -1;
1416   }
1417 
1418   /*
1419    * Now size contains the size of buffer needed
1420    */
1421 
1422   sdPtr = (SECURITY_DESCRIPTOR *) HeapAlloc(GetProcessHeap(), 0, size);
1423 
1424   if (sdPtr == NULL) {
1425       goto accessError;
1426   }
1427 
1428   /*
1429    * Call GetFileSecurity() for real
1430    */
1431 
1432   if (!(*tclWinProcs->getFileSecurityProc)(nativePath,
1433     OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION
1434     | DACL_SECURITY_INFORMATION, sdPtr, size, &size)) {
1435       /*
1436        * Error getting owner SD
1437        */
1438 
1439       goto accessError;
1440   }
1441 
1442   /*
1443    * Perform security impersonation of the user and open the
1444    * resulting thread token.
1445    */
1446 
1447   if (!(*tclWinProcs->impersonateSelfProc)(SecurityImpersonation)) {
1448       /*
1449        * Unable to perform security impersonation.
1450        */
1451       
1452       goto accessError;
1453   }
1454   if (!(*tclWinProcs->openThreadTokenProc)(GetCurrentThread (),
1455     TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken)) {
1456       /*
1457        * Unable to get current thread's token.
1458        */
1459       
1460       goto accessError;
1461   }
1462   
1463   (*tclWinProcs->revertToSelfProc)();
1464   
1465   /*
1466    * Setup desiredAccess according to the access priveleges we are
1467    * checking.
1468    */
1469 
1470   if (mode & R_OK) {
1471       desiredAccess |= FILE_GENERIC_READ;
1472   }
1473   if (mode & W_OK) {
1474       desiredAccess |= FILE_GENERIC_WRITE;
1475   }
1476   if (mode & X_OK) {
1477       desiredAccess |= FILE_GENERIC_EXECUTE;
1478   }
1479 
1480   memset (&genMap, 0x0, sizeof (GENERIC_MAPPING));
1481   genMap.GenericRead = FILE_GENERIC_READ;
1482   genMap.GenericWrite = FILE_GENERIC_WRITE;
1483   genMap.GenericExecute = FILE_GENERIC_EXECUTE;
1484   genMap.GenericAll = FILE_ALL_ACCESS;
1485   
1486   /*
1487    * Perform access check using the token.
1488    */
1489 
1490   if (!(*tclWinProcs->accessCheckProc)(sdPtr, hToken, desiredAccess,
1491     &genMap, &privSet, &privSetSize, &grantedAccess,
1492     &accessYesNo)) {
1493       /*
1494        * Unable to perform access check.
1495        */
1496 
1497   accessError:
1498       TclWinConvertError(GetLastError());
1499       if (sdPtr != NULL) {
1500     HeapFree(GetProcessHeap(), 0, sdPtr);
1501       }
1502       if (hToken != NULL) {
1503     CloseHandle(hToken);
1504       }
1505       return -1;
1506   }
1507 
1508   /*
1509    * Clean up.
1510    */
1511 
1512   HeapFree(GetProcessHeap (), 0, sdPtr);
1513   CloseHandle(hToken);
1514   if (!accessYesNo) {
1515       Tcl_SetErrno(EACCES);
1516       return -1;
1517   }
1518   /*
1519    * For directories the above checks are ok.  For files, though,
1520    * we must still check the 'attr' value.
1521    */
1522   if ((mode & W_OK)
1523     && !(attr & FILE_ATTRIBUTE_DIRECTORY)
1524     && (attr & FILE_ATTRIBUTE_READONLY)) {
1525       Tcl_SetErrno(EACCES);
1526       return -1;
1527   }
1528     }
1529     return 0;
1530 }
static int NativeIsExec (CONST TCHAR * path) [static]

Definition at line 1547 of file tclWinFile.c.
References CONST, NULL, tclWinProcs, and TclWinProcs::useWide.
Referenced by NativeAccess(), NativeMatchType(), and NativeStat().1549 {
1550     if (tclWinProcs->useWide) {
1551   CONST WCHAR *path;
1552   int len;
1553 
1554   path = (CONST WCHAR*)nativePath;
1555   len = wcslen(path);
1556 
1557   if (len < 5) {
1558       return 0;
1559   }
1560 
1561   if (path[len-4] != L'.') {
1562       return 0;
1563   }
1564 
1565   /*
1566    * Use wide-char case-insensitive comparison
1567    */
1568   if ((_wcsicmp(path+len-3,L"exe") == 0)
1569     || (_wcsicmp(path+len-3,L"com") == 0)
1570     || (_wcsicmp(path+len-3,L"bat") == 0)) {
1571       return 1;
1572   }
1573     } else {
1574   CONST char *p;
1575 
1576   /* We are only looking for pure ascii */
1577 
1578   p = strrchr((CONST char*)nativePath, '.');
1579   if (p != NULL) {
1580       p++;
1581       /* 
1582        * Note: in the old code, stat considered '.pif' files as
1583        * executable, whereas access did not.
1584        */
1585       if ((stricmp(p, "exe") == 0)
1586         || (stricmp(p, "com") == 0)
1587         || (stricmp(p, "bat") == 0)) {
1588     /*
1589      * File that ends with .exe, .com, or .bat is executable.
1590      */
1591 
1592     return 1;
1593       }
1594   }
1595     }
1596     return 0;
1597 }
static int NativeMatchType (int isDrive, DWORD attr, CONST TCHAR * nativeName, Tcl_GlobTypeData * types) [static]

Definition at line 1089 of file tclWinFile.c.
References NativeIsExec(), NativeStatMode(), NULL, S_ISBLK, S_ISCHR, S_ISDIR, S_ISFIFO, S_ISLNK, S_ISREG, S_ISSOCK, TCL_GLOB_PERM_HIDDEN, TCL_GLOB_PERM_R, TCL_GLOB_PERM_RONLY, TCL_GLOB_PERM_W, TCL_GLOB_PERM_X, TCL_GLOB_TYPE_BLOCK, TCL_GLOB_TYPE_CHAR, TCL_GLOB_TYPE_DIR, TCL_GLOB_TYPE_FILE, TCL_GLOB_TYPE_LINK, TCL_GLOB_TYPE_PIPE, and TCL_GLOB_TYPE_SOCK.1095 {
1096     /*
1097      * 'attr' represents the attributes of the file, but we only
1098      * want to retrieve this info if it is absolutely necessary
1099      * because it is an expensive call.  Unfortunately, to deal
1100      * with hidden files properly, we must always retrieve it.
1101      */
1102 
1103     if (types == NULL) {
1104   /* If invisible, don't return the file */
1105   if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
1106       return 0;
1107   }
1108     } else {
1109   if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
1110       /* If invisible */
1111       if ((types->perm == 0) || 
1112         !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
1113     return 0;
1114       }
1115   } else {
1116       /* Visible */
1117       if (types->perm & TCL_GLOB_PERM_HIDDEN) {
1118     return 0;
1119       }
1120   }
1121   
1122   if (types->perm != 0) {
1123       if (
1124     ((types->perm & TCL_GLOB_PERM_RONLY) &&
1125       !(attr & FILE_ATTRIBUTE_READONLY)) ||
1126     ((types->perm & TCL_GLOB_PERM_R) &&
1127       (0 /* File exists => R_OK on Windows */)) ||
1128     ((types->perm & TCL_GLOB_PERM_W) &&
1129       (attr & FILE_ATTRIBUTE_READONLY)) ||
1130     ((types->perm & TCL_GLOB_PERM_X) &&
1131       (!(attr & FILE_ATTRIBUTE_DIRECTORY)
1132        && !NativeIsExec(nativeName)))
1133     ) {
1134     return 0;
1135       }
1136   }
1137   if ((types->type & TCL_GLOB_TYPE_DIR) 
1138       && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
1139       /* Quicker test for directory, which is a common case */
1140       return 1;
1141   } else if (types->type != 0) {
1142       unsigned short st_mode;
1143       int isExec = NativeIsExec(nativeName);
1144       
1145       st_mode = NativeStatMode(attr, 0, isExec);
1146 
1147       /*
1148        * In order bcdpfls as in 'find -t'
1149        */
1150       if (
1151     ((types->type & TCL_GLOB_TYPE_BLOCK) &&
1152       S_ISBLK(st_mode)) ||
1153     ((types->type & TCL_GLOB_TYPE_CHAR) &&
1154       S_ISCHR(st_mode)) ||
1155     ((types->type & TCL_GLOB_TYPE_DIR) &&
1156       S_ISDIR(st_mode)) ||
1157     ((types->type & TCL_GLOB_TYPE_PIPE) &&
1158       S_ISFIFO(st_mode)) ||
1159     ((types->type & TCL_GLOB_TYPE_FILE) &&
1160       S_ISREG(st_mode))
1161 #ifdef S_ISSOCK
1162     || ((types->type & TCL_GLOB_TYPE_SOCK) &&
1163       S_ISSOCK(st_mode))
1164 #endif
1165     ) {
1166     /* Do nothing -- this file is ok */
1167       } else {
1168 #ifdef S_ISLNK
1169     if (types->type & TCL_GLOB_TYPE_LINK) {
1170         st_mode = NativeStatMode(attr, 1, isExec);
1171         if (S_ISLNK(st_mode)) {
1172       return 1;
1173         }
1174     }
1175 #endif
1176     return 0;
1177       }
1178   }   
1179     } 
1180     return 1;
1181 }
static int NativeReadReparse (CONST TCHAR * LinkDirectory, REPARSE_DATA_BUFFER * buffer) [static]

Definition at line 588 of file tclWinFile.c.
References DWORD(), EINVAL, FILE_FLAG_OPEN_REPARSE_POINT, FSCTL_GET_REPARSE_POINT, IsReparseTagValid, NULL, _REPARSE_DATA_BUFFER::ReparseTag, Tcl_SetErrno(), TclWinConvertError(), and tclWinProcs.
Referenced by TclWinSymLinkCopyDirectory(), and WinReadLinkDirectory().591 {
592     HANDLE hFile;
593     DWORD returnedLength;
594    
595     hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_READ, 0,
596   NULL, OPEN_EXISTING, 
597   FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
598     if (hFile == INVALID_HANDLE_VALUE) {
599   /* Error creating directory */
600   TclWinConvertError(GetLastError());
601   return -1;
602     }
603     /* Get the link */
604     if (!DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, NULL, 
605        0, buffer, sizeof(DUMMY_REPARSE_BUFFER), 
606        &returnedLength, NULL)) {  
607   /* Error setting junction */
608   TclWinConvertError(GetLastError());
609   CloseHandle(hFile);
610   return -1;
611     }
612     CloseHandle(hFile);
613     
614     if (!IsReparseTagValid(buffer->ReparseTag)) {
615   Tcl_SetErrno(EINVAL);
616   return -1;
617     }
618     return 0;
619 }
static int NativeStat (CONST TCHAR * path, Tcl_StatBuf * statPtr, int checkLinks) [static]

Definition at line 1826 of file tclWinFile.c.
References WIN32_FIND_DATAT::a, CONST, DWORD(), ENOENT, INVALID_FILE_ATTRIBUTES, NativeIsExec(), NativeStatMode(), NULL, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringLength, Tcl_SetErrno(), Tcl_UniCharToLower(), Tcl_WinTCharToUtf(), Tcl_WinUtfToTChar(), tclWinProcs, ToCTime(), and TRUE.
Referenced by TclpObjLstat(), and TclpObjStat().1830 {
1831     Tcl_DString ds;
1832     DWORD attr;
1833     WCHAR nativeFullPath[MAX_PATH];
1834     TCHAR *nativePart;
1835     CONST char *fullPath;
1836     int dev;
1837     unsigned short mode;
1838     
1839     if (tclWinProcs->getFileAttributesExProc == NULL) {
1840         /* 
1841          * We don't have the faster attributes proc, so we're
1842          * probably running on Win95
1843          */
1844   WIN32_FIND_DATAT data;
1845   HANDLE handle;
1846 
1847   handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data);
1848   if (handle == INVALID_HANDLE_VALUE) {
1849       /* 
1850        * FindFirstFile() doesn't work on root directories, so call
1851        * GetFileAttributes() to see if the specified file exists.
1852        */
1853 
1854       attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
1855       if (attr == INVALID_FILE_ATTRIBUTES) {
1856     Tcl_SetErrno(ENOENT);
1857     return -1;
1858       }
1859 
1860       /* 
1861        * Make up some fake information for this file.  It has the 
1862        * correct file attributes and a time of 0.
1863        */
1864 
1865       memset(&data, 0, sizeof(data));
1866       data.a.dwFileAttributes = attr;
1867   } else {
1868       FindClose(handle);
1869   }
1870 
1871     
1872   (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath,
1873     &nativePart);
1874 
1875   fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
1876 
1877   dev = -1;
1878   if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
1879       CONST char *p;
1880       DWORD dw;
1881       CONST TCHAR *nativeVol;
1882       Tcl_DString volString;
1883 
1884       p = strchr(fullPath + 2, '\\');
1885       p = strchr(p + 1, '\\');
1886       if (p == NULL) {
1887     /*
1888      * Add terminating backslash to fullpath or 
1889      * GetVolumeInformation() won't work.
1890      */
1891 
1892     fullPath = Tcl_DStringAppend(&ds, "\\", 1);
1893     p = fullPath + Tcl_DStringLength(&ds);
1894       } else {
1895     p++;
1896       }
1897       nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
1898       dw = (DWORD) -1;
1899       (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
1900         NULL, NULL, NULL, 0);
1901       /*
1902        * GetFullPathName() turns special devices like "NUL" into
1903        * "\\.\NUL", but GetVolumeInformation() returns failure for
1904        * "\\.\NUL".  This will cause "NUL" to get a drive number of
1905        * -1, which makes about as much sense as anything since the
1906        * special devices don't live on any drive.
1907        */
1908 
1909       dev = dw;
1910       Tcl_DStringFree(&volString);
1911   } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {
1912       dev = Tcl_UniCharToLower(fullPath[0]) - 'a';
1913   }
1914   Tcl_DStringFree(&ds);
1915   
1916   attr = data.a.dwFileAttributes;
1917 
1918   statPtr->st_size  = ((Tcl_WideInt)data.a.nFileSizeLow) |
1919     (((Tcl_WideInt)data.a.nFileSizeHigh) << 32);
1920   statPtr->st_atime = ToCTime(data.a.ftLastAccessTime);
1921   statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime);
1922   statPtr->st_ctime = ToCTime(data.a.ftCreationTime);
1923     } else {
1924   WIN32_FILE_ATTRIBUTE_DATA data;
1925   if((*tclWinProcs->getFileAttributesExProc)(nativePath,
1926                GetFileExInfoStandard,
1927                &data) != TRUE) {
1928       Tcl_SetErrno(ENOENT);
1929       return -1;
1930   }
1931 
1932     
1933   (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, 
1934               nativeFullPath, &nativePart);
1935 
1936   fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
1937 
1938   dev = -1;
1939   if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
1940       CONST char *p;
1941       DWORD dw;
1942       CONST TCHAR *nativeVol;
1943       Tcl_DString volString;
1944 
1945       p = strchr(fullPath + 2, '\\');
1946       p = strchr(p + 1, '\\');
1947       if (p == NULL) {
1948     /*
1949      * Add terminating backslash to fullpath or 
1950      * GetVolumeInformation() won't work.
1951      */
1952 
1953     fullPath = Tcl_DStringAppend(&ds, "\\", 1);
1954     p = fullPath + Tcl_DStringLength(&ds);
1955       } else {
1956     p++;
1957       }
1958       nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
1959       dw = (DWORD) -1;
1960       (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
1961         NULL, NULL, NULL, 0);
1962       /*
1963        * GetFullPathName() turns special devices like "NUL" into
1964        * "\\.\NUL", but GetVolumeInformation() returns failure for
1965        * "\\.\NUL".  This will cause "NUL" to get a drive number of
1966        * -1, which makes about as much sense as anything since the
1967        * special devices don't live on any drive.
1968        */
1969 
1970       dev = dw;
1971       Tcl_DStringFree(&volString);
1972   } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {
1973       dev = Tcl_UniCharToLower(fullPath[0]) - 'a';
1974   }
1975   Tcl_DStringFree(&ds);
1976   
1977   attr = data.dwFileAttributes;
1978   
1979   statPtr->st_size  = ((Tcl_WideInt)data.nFileSizeLow) |
1980     (((Tcl_WideInt)data.nFileSizeHigh) << 32);
1981   statPtr->st_atime = ToCTime(data.ftLastAccessTime);
1982   statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
1983   statPtr->st_ctime = ToCTime(data.ftCreationTime);
1984     }
1985 
1986     mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath));
1987     
1988     statPtr->st_dev = (dev_t) dev;
1989     statPtr->st_ino = 0;
1990     statPtr->st_mode  = mode;
1991     statPtr->st_nlink = 1;
1992     statPtr->st_uid = 0;
1993     statPtr->st_gid = 0;
1994     statPtr->st_rdev  = (dev_t) dev;
1995     return 0;
1996 }
static unsigned short NativeStatMode (DWORD attr, int checkLinks, int isExec) [static]

Definition at line 2008 of file tclWinFile.c.
References FILE_ATTRIBUTE_REPARSE_POINT, and S_IFLNK.
Referenced by NativeMatchType(), and NativeStat().2009 {
2010     int mode;
2011     if (checkLinks && (attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
2012   /* It is a link */
2013   mode = S_IFLNK;
2014     } else {
2015   mode  = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG;
2016     }
2017     mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD | S_IWRITE;
2018     if (isExec) {
2019   mode |= S_IEXEC;
2020     }
2021     
2022     /*
2023      * Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and 
2024      * other positions.
2025      */
2026 
2027     mode |= (mode & 0x0700) >> 3;
2028     mode |= (mode & 0x0700) >> 6;
2029     return (unsigned short)mode;
2030 }
static int NativeWriteReparse (CONST TCHAR * LinkDirectory, REPARSE_DATA_BUFFER * buffer) [static]

Definition at line 632 of file tclWinFile.c.
References DWORD(), FILE_FLAG_OPEN_REPARSE_POINT, FSCTL_SET_REPARSE_POINT, NULL, REPARSE_MOUNTPOINT_HEADER_SIZE, _REPARSE_DATA_BUFFER::ReparseDataLength, TclWinConvertError(), and tclWinProcs.
Referenced by TclWinSymLinkCopyDirectory(), and WinSymLinkDirectory().635 {
636     HANDLE hFile;
637     DWORD returnedLength;
638     
639     /* Create the directory - it must not already exist */
640     if ((*tclWinProcs->createDirectoryProc)(LinkDirectory, NULL) == 0) {
641   /* Error creating directory */
642   TclWinConvertError(GetLastError());
643   return -1;
644     }
645     hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_WRITE, 0,
646   NULL, OPEN_EXISTING, 
647   FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
648     if (hFile == INVALID_HANDLE_VALUE) {
649   /* Error creating directory */
650   TclWinConvertError(GetLastError());
651   return -1;
652     }
653     /* Set the link */
654     if (!DeviceIoControl(hFile, FSCTL_SET_REPARSE_POINT, buffer, 
655        (DWORD) buffer->ReparseDataLength 
656        + REPARSE_MOUNTPOINT_HEADER_SIZE,
657        NULL, 0, &returnedLength, NULL)) { 
658   /* Error setting junction */
659   TclWinConvertError(GetLastError());
660   CloseHandle(hFile);
661   (*tclWinProcs->removeDirectoryProc)(LinkDirectory);
662   return -1;
663     }
664     CloseHandle(hFile);
665     /* We succeeded */
666     return 0;
667 }
Tcl_Obj* TclpFilesystemPathType (Tcl_Obj* pathObjPtr)

Definition at line 2252 of file tclWinFile.c.
References CONST, NULL, Tcl_DecrRefCount, Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, Tcl_FSGetNativePath(), Tcl_FSGetNormalizedPath(), Tcl_GetString(), Tcl_IncrRefCount, Tcl_NewStringObj(), Tcl_WinTCharToUtf(), tclWinProcs, and VOL_BUF_SIZE.2254 {
2255 #define VOL_BUF_SIZE 32
2256     int found;
2257     WCHAR volType[VOL_BUF_SIZE];
2258     char* firstSeparator;
2259     CONST char *path;
2260     
2261     Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathObjPtr);
2262     if (normPath == NULL) return NULL;
2263     path = Tcl_GetString(normPath);
2264     if (path == NULL) return NULL;
2265     
2266     firstSeparator = strchr(path, '/');
2267     if (firstSeparator == NULL) {
2268   found = tclWinProcs->getVolumeInformationProc(
2269     Tcl_FSGetNativePath(pathObjPtr), NULL, 0, NULL, NULL, 
2270     NULL, (WCHAR *)volType, VOL_BUF_SIZE);
2271     } else {
2272   Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1);
2273   Tcl_IncrRefCount(driveName);
2274   found = tclWinProcs->getVolumeInformationProc(
2275     Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL, 
2276     NULL, (WCHAR *)volType, VOL_BUF_SIZE);
2277   Tcl_DecrRefCount(driveName);
2278     }
2279 
2280     if (found == 0) {
2281   return NULL;
2282     } else {
2283   Tcl_DString ds;
2284   Tcl_Obj *objPtr;
2285   
2286   Tcl_WinTCharToUtf((CONST char *)volType, -1, &ds);
2287   objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
2288   Tcl_DStringFree(&ds);
2289   return objPtr;
2290     }
2291 #undef VOL_BUF_SIZE
2292 }
char* TclpFindExecutable (CONST char * argv0)

Definition at line 693 of file tclWinFile.c.
References ckalloc, NULL, TCL_UTF_MAX, tclNativeExecutableName, and TclWinNoBackslash().696 {
697     WCHAR wName[MAX_PATH];
698     char name[MAX_PATH * TCL_UTF_MAX];
699 
700     if (argv0 == NULL) {
701   return NULL;
702     }
703     if (tclNativeExecutableName != NULL) {
704   return tclNativeExecutableName;
705     }
706 
707     /*
708      * Under Windows we ignore argv0, and return the path for the file used to
709      * create this process.
710      */
711 
712     if (GetModuleFileNameW(NULL, wName, MAX_PATH) == 0) {
713   GetModuleFileNameA(NULL, name, sizeof(name));
714     } else {
715   WideCharToMultiByte(CP_UTF8, 0, wName, -1, 
716     name, sizeof(name), NULL, NULL);
717     }
718 
719     tclNativeExecutableName = ckalloc((unsigned) (strlen(name) + 1));
720     strcpy(tclNativeExecutableName, name);
721 
722     TclWinNoBackslash(tclNativeExecutableName);
723     return tclNativeExecutableName;
724 }
CONST char* TclpGetCwd (Tcl_Interp * interp, Tcl_DString * bufferPtr)

Definition at line 1714 of file tclWinFile.c.
References NULL, Tcl_DStringValue, Tcl_PosixError(), Tcl_WinTCharToUtf(), TclWinConvertError(), tclWinProcs, and TclWinProcs::useWide.1718 {
1719     WCHAR buffer[MAX_PATH];
1720     char *p;
1721 
1722     if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) {
1723   TclWinConvertError(GetLastError());
1724   if (interp != NULL) {
1725       Tcl_AppendResult(interp,
1726         "error getting working directory name: ",
1727         Tcl_PosixError(interp), (char *) NULL);
1728   }
1729   return NULL;
1730     }
1731 
1732     /*
1733      * Watch for the weird Windows c:\\UNC syntax.
1734      */
1735 
1736     if (tclWinProcs->useWide) {
1737   WCHAR *native;
1738 
1739   native = (WCHAR *) buffer;
1740   if ((native[0] != '\0') && (native[1] == ':') 
1741     && (native[2] == '\\') && (native[3] == '\\')) {
1742       native += 2;
1743   }
1744   Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
1745     } else {
1746   char *native;
1747 
1748   native = (char *) buffer;
1749   if ((native[0] != '\0') && (native[1] == ':') 
1750     && (native[2] == '\\') && (native[3] == '\\')) {
1751       native += 2;
1752   }
1753   Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
1754     }
1755 
1756     /*
1757      * Convert to forward slashes for easier use in scripts.
1758      */
1759         
1760     for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
1761   if (*p == '\\') {
1762       *p = '/';
1763   }
1764     }
1765     return Tcl_DStringValue(bufferPtr);
1766 }
char* TclpGetUserHome (CONST char * name, Tcl_DString * bufferPtr)

Definition at line 1205 of file tclWinFile.c.
References NULL, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, Tcl_UniCharToUtfDString(), and Tcl_UtfToUniCharDString().1209 {
1210     char *result;
1211     HINSTANCE netapiInst;
1212 
1213     result = NULL;
1214 
1215     Tcl_DStringInit(bufferPtr);
1216 
1217     netapiInst = LoadLibraryA("netapi32.dll");
1218     if (netapiInst != NULL) {
1219   NETAPIBUFFERFREEPROC *netApiBufferFreeProc;
1220   NETGETDCNAMEPROC *netGetDCNameProc;
1221   NETUSERGETINFOPROC *netUserGetInfoProc;
1222 
1223   netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *)
1224     GetProcAddress(netapiInst, "NetApiBufferFree");
1225   netGetDCNameProc = (NETGETDCNAMEPROC *) 
1226     GetProcAddress(netapiInst, "NetGetDCName");
1227   netUserGetInfoProc = (NETUSERGETINFOPROC *) 
1228     GetProcAddress(netapiInst, "NetUserGetInfo");
1229   if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL)
1230     && (netApiBufferFreeProc != NULL)) {
1231       USER_INFO_1 *uiPtr;
1232       Tcl_DString ds;
1233       int nameLen, badDomain;
1234       char *domain;
1235       WCHAR *wName, *wHomeDir, *wDomain;
1236       WCHAR buf[MAX_PATH];
1237 
1238       badDomain = 0;
1239       nameLen = -1;
1240       wDomain = NULL;
1241       domain = strchr(name, '@');
1242       if (domain != NULL) {
1243     Tcl_DStringInit(&ds);
1244     wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
1245     badDomain = (*netGetDCNameProc)(NULL, wName,
1246       (LPBYTE *) &wDomain);
1247     Tcl_DStringFree(&ds);
1248     nameLen = domain - name;
1249       }
1250       if (badDomain == 0) {
1251     Tcl_DStringInit(&ds);
1252     wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
1253     if ((*netUserGetInfoProc)(wDomain, wName, 1,
1254       (LPBYTE *) &uiPtr) == 0) {
1255         wHomeDir = uiPtr->usri1_home_dir;
1256         if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
1257       Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir),
1258         bufferPtr);
1259         } else {
1260       /* 
1261        * User exists but has no home dir.  Return
1262        * "{Windows Drive}:/users/default".
1263        */
1264 
1265       GetWindowsDirectoryW(buf, MAX_PATH);
1266       Tcl_UniCharToUtfDString(buf, 2, bufferPtr);
1267       Tcl_DStringAppend(bufferPtr, "/users/default", -1);
1268         }
1269         result = Tcl_DStringValue(bufferPtr);
1270         (*netApiBufferFreeProc)((void *) uiPtr);
1271     }
1272     Tcl_DStringFree(&ds);
1273       }
1274       if (wDomain != NULL) {
1275     (*netApiBufferFreeProc)((void *) wDomain);
1276       }
1277   }
1278   FreeLibrary(netapiInst);
1279     }
1280     if (result == NULL) {
1281   /*
1282    * Look in the "Password Lists" section of system.ini for the 
1283    * local user.  There are also entries in that section that begin 
1284    * with a "*" character that are used by Windows for other 
1285    * purposes; ignore user names beginning with a "*".
1286    */
1287 
1288   char buf[MAX_PATH];
1289 
1290   if (name[0] != '*') {
1291       if (GetPrivateProfileStringA("Password Lists", name, "", buf, 
1292         MAX_PATH, "system.ini") > 0) {
1293     /* 
1294      * User exists, but there is no such thing as a home 
1295      * directory in system.ini.  Return "{Windows drive}:/".
1296      */
1297 
1298     GetWindowsDirectoryA(buf, MAX_PATH);
1299     Tcl_DStringAppend(bufferPtr, buf, 3);
1300     result = Tcl_DStringValue(bufferPtr);
1301       }
1302   }
1303     }
1304 
1305     return result;
1306 }
int TclpMatchInDirectory (Tcl_Interp * interp, Tcl_Obj * resultPtr, Tcl_Obj * pathPtr, CONST char * pattern, Tcl_GlobTypeData * types)

Definition at line 746 of file tclWinFile.c.
References WIN32_FIND_DATAT::a, CONST, DWORD(), NativeMatchType(), NULL, Tcl_DecrRefCount, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringSetLength(), Tcl_DStringValue, TCL_ERROR, Tcl_FSGetNativePath(), Tcl_FSGetNormalizedPath(), Tcl_FSGetTranslatedPath(), Tcl_GetStringFromObj(), Tcl_ListObjAppendElement(), TCL_OK, Tcl_PosixError(), Tcl_ResetResult(), Tcl_StringCaseMatch(), Tcl_WinTCharToUtf(), Tcl_WinUtfToTChar(), TclNewFSPathObj(), TclWinConvertError(), tclWinProcs, TRUE, TclWinProcs::useWide, WIN32_FIND_DATAT::w, and WinIsDrive().754 {
755     CONST TCHAR *native;
756 
757     if (pattern == NULL || (*pattern == '\0')) {
758   Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
759   if (norm != NULL) {
760       /* Match a single file directly */
761       int len;
762       DWORD attr;
763       CONST char *str = Tcl_GetStringFromObj(norm,&len);
764 
765       native = (CONST TCHAR*) Tcl_FSGetNativePath(pathPtr);
766       
767       if (tclWinProcs->getFileAttributesExProc == NULL) {
768     attr = (*tclWinProcs->getFileAttributesProc)(native);
769     if (attr == 0xffffffff) {
770         return TCL_OK;
771     }
772       } else {
773     WIN32_FILE_ATTRIBUTE_DATA data;
774     if ((*tclWinProcs->getFileAttributesExProc)(native,
775       GetFileExInfoStandard, &data) != TRUE) {
776         return TCL_OK;
777     }
778     attr = data.dwFileAttributes;
779       }
780       if (NativeMatchType(WinIsDrive(str,len), attr, 
781         native, types)) {
782     Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
783       }
784   }
785   return TCL_OK;
786     } else {
787   DWORD attr;
788   HANDLE handle;
789   WIN32_FIND_DATAT data;
790   CONST char *dirName;
791   int dirLength;
792   int matchSpecialDots;
793   Tcl_DString ds;        /* native encoding of dir */
794   Tcl_DString dsOrig;    /* utf-8 encoding of dir */
795   Tcl_DString dirString; /* utf-8 encoding of dir with \'s */
796   Tcl_Obj *fileNamePtr;
797 
798   /*
799    * Convert the path to normalized form since some interfaces only
800    * accept backslashes.  Also, ensure that the directory ends with a
801    * separator character.
802    */
803 
804   fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
805   if (fileNamePtr == NULL) {
806       return TCL_ERROR;
807   }
808   Tcl_DStringInit(&dsOrig);
809   dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
810   Tcl_DStringAppend(&dsOrig, dirName, dirLength);
811   
812   Tcl_DStringInit(&dirString);
813   if (dirLength == 0) {
814       Tcl_DStringAppend(&dirString, ".\\", 2);
815   } else {
816       char *p;
817 
818       Tcl_DStringAppend(&dirString, dirName, dirLength);
819       for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) {
820     if (*p == '/') {
821         *p = '\\';
822     }
823       }
824       p--;
825       /* Make sure we have a trailing directory delimiter */
826       if ((*p != '\\') && (*p != ':')) {
827     Tcl_DStringAppend(&dirString, "\\", 1);
828     Tcl_DStringAppend(&dsOrig, "/", 1);
829     dirLength++;
830       }
831   }
832   dirName = Tcl_DStringValue(&dirString);
833   Tcl_DecrRefCount(fileNamePtr);
834   
835   /*
836    * First verify that the specified path is actually a directory.
837    */
838 
839   native = Tcl_WinUtfToTChar(dirName, Tcl_DStringLength(&dirString),
840     &ds);
841   attr = (*tclWinProcs->getFileAttributesProc)(native);
842   Tcl_DStringFree(&ds);
843 
844   if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
845       Tcl_DStringFree(&dirString);
846       return TCL_OK;
847   }
848 
849   /*
850    * We need to check all files in the directory, so append a *.*
851    * to the path. 
852    */
853 
854   dirName = Tcl_DStringAppend(&dirString, "*.*", 3);
855   native = Tcl_WinUtfToTChar(dirName, -1, &ds);
856   handle = (*tclWinProcs->findFirstFileProc)(native, &data);
857 
858   if (handle == INVALID_HANDLE_VALUE) {
859       TclWinConvertError(GetLastError());
860       Tcl_DStringFree(&ds);
861       Tcl_DStringFree(&dirString);
862       Tcl_ResetResult(interp);
863       Tcl_AppendResult(interp, "couldn't read directory \"",
864         Tcl_DStringValue(&dsOrig), "\": ", 
865         Tcl_PosixError(interp), (char *) NULL);
866       Tcl_DStringFree(&dsOrig);
867       return TCL_ERROR;
868   }
869   Tcl_DStringFree(&ds);
870 
871   /*
872    * Check to see if the pattern should match the special
873    * . and .. names, referring to the current directory,
874    * or the directory above.  We need a special check for
875    * this because paths beginning with a dot are not considered
876    * hidden on Windows, and so otherwise a relative glob like
877    * 'glob -join * *' will actually return './. ../..' etc.
878    */
879 
880   if ((pattern[0] == '.')
881     || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
882       matchSpecialDots = 1;
883   } else {
884       matchSpecialDots = 0;
885   }
886 
887   /*
888    * Now iterate over all of the files in the directory, starting
889    * with the first one we found.
890    */
891 
892   do {
893       CONST char *utfname;
894       int checkDrive = 0;
895       int isDrive;
896       DWORD attr;
897       
898       if (tclWinProcs->useWide) {
899     native = (CONST TCHAR *) data.w.cFileName;
900     attr = data.w.dwFileAttributes;
901       } else {
902     native = (CONST TCHAR *) data.a.cFileName;
903     attr = data.a.dwFileAttributes;
904       }
905       
906       utfname = Tcl_WinTCharToUtf(native, -1, &ds);
907 
908       if (!matchSpecialDots) {
909     /* If it is exactly '.' or '..' then we ignore it */
910     if ((utfname[0] == '.') && (utfname[1] == '\0' 
911       || (utfname[1] == '.' && utfname[2] == '\0'))) {
912         Tcl_DStringFree(&ds);
913         continue;
914     }
915       } else if (utfname[0] == '.' && utfname[1] == '.'
916         && utfname[2] == '\0') {
917     /* 
918      * Have to check if this is a drive below, so we can
919      * correctly match 'hidden' and not hidden files.
920      */
921     checkDrive = 1;
922       }
923       
924       /*
925        * Check to see if the file matches the pattern.  Note that
926        * we are ignoring the case sensitivity flag because Windows
927        * doesn't honor case even if the volume is case sensitive.
928        * If the volume also doesn't preserve case, then we
929        * previously returned the lower case form of the name.  This
930        * didn't seem quite right since there are
931        * non-case-preserving volumes that actually return mixed
932        * case.  So now we are returning exactly what we get from
933        * the system.
934        */
935 
936       if (Tcl_StringCaseMatch(utfname, pattern, 1)) {
937     /*
938      * If the file matches, then we need to process the remainder
939      * of the path.
940      */
941 
942     if (checkDrive) {
943         CONST char *fullname = Tcl_DStringAppend(&dsOrig, utfname,
944           Tcl_DStringLength(&ds));
945         isDrive = WinIsDrive(fullname, Tcl_DStringLength(&dsOrig));
946         Tcl_DStringSetLength(&dsOrig, dirLength);
947     } else {
948         isDrive = 0;
949     }
950     if (NativeMatchType(isDrive, attr, native, types)) {
951         Tcl_ListObjAppendElement(interp, resultPtr, 
952           TclNewFSPathObj(pathPtr, utfname,
953             Tcl_DStringLength(&ds)));
954     }
955       }
956 
957       /*
958        * Free ds here to ensure that native is valid above.
959        */
960       Tcl_DStringFree(&ds);
961   } while ((*tclWinProcs->findNextFileProc)(handle, &data) == TRUE);
962 
963   FindClose(handle);
964   Tcl_DStringFree(&dirString);
965   Tcl_DStringFree(&dsOrig);
966   return TCL_OK;
967     }
968 }
int TclpObjAccess (Tcl_Obj * pathPtr, int mode)

Definition at line 2178 of file tclWinFile.c.
References CONST, NativeAccess(), and Tcl_FSGetNativePath().2181 {
2182     return NativeAccess((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), mode);
2183 }
int TclpObjChdir (Tcl_Obj * pathPtr)

Definition at line 1616 of file tclWinFile.c.
References _ANSI_ARGS_, CONST, Tcl_DStringFree(), Tcl_FSGetNativePath(), Tcl_WinTCharToUtf(), TclWinConvertError(), and tclWinProcs.1618 {
1619     int result;
1620     CONST TCHAR *nativePath;
1621 #ifdef __CYGWIN__
1622     extern int cygwin_conv_to_posix_path 
1623   _ANSI_ARGS_((CONST char *, char *));
1624     char posixPath[MAX_PATH+1];
1625     CONST char *path;
1626     Tcl_DString ds;
1627 #endif /* __CYGWIN__ */
1628 
1629     nativePath = (CONST TCHAR *) Tcl_FSGetNativePath(pathPtr);
1630 #ifdef __CYGWIN__
1631     /* Cygwin chdir only groks POSIX path. */
1632     path = Tcl_WinTCharToUtf(nativePath, -1, &ds);
1633     cygwin_conv_to_posix_path(path, posixPath);
1634     result = (chdir(posixPath) == 0 ? 1 : 0);
1635     Tcl_DStringFree(&ds);
1636 #else /* __CYGWIN__ */
1637     result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath);
1638 #endif /* __CYGWIN__ */
1639 
1640     if (result == 0) {
1641   TclWinConvertError(GetLastError());
1642   return -1;
1643     }
1644     return 0;
1645 }
Tcl_Obj* TclpObjGetCwd (Tcl_Interp * interp)

Definition at line 2163 of file tclWinFile.c.
References NULL, Tcl_DStringFree(), Tcl_DStringValue, Tcl_IncrRefCount, Tcl_NewStringObj(), and TclpGetCwd().2165 {
2166     Tcl_DString ds;
2167     if (TclpGetCwd(interp, &ds) != NULL) {
2168   Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
2169   Tcl_IncrRefCount(cwdPtr);
2170   Tcl_DStringFree(&ds);
2171   return cwdPtr;
2172     } else {
2173   return NULL;
2174     }
2175 }
int TclpObjLstat (Tcl_Obj * pathPtr, Tcl_StatBuf * statPtr)

Definition at line 2186 of file tclWinFile.c.
References CONST, NativeStat(), Tcl_FSGetNativePath(), and TclWinFlushDirtyChannels().2189 {
2190     /*
2191      * Ensure correct file sizes by forcing the OS to write any
2192      * pending data to disk. This is done only for channels which are
2193      * dirty, i.e. have been written to since the last flush here.
2194      */
2195 
2196     TclWinFlushDirtyChannels ();
2197 
2198     return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 1);
2199 }
int TclpObjNormalizePath (Tcl_Interp * interp, Tcl_Obj * pathPtr, int nextCheckpoint)

Definition at line 2317 of file tclWinFile.c.
References CONST, FILE_ATTRIBUTE_REPARSE_POINT, INVALID_FILE_ATTRIBUTES, NULL, Tcl_AppendToObj(), Tcl_DecrRefCount, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringValue, Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_NewStringObj(), Tcl_SetStringObj(), Tcl_UtfToExternalDString(), Tcl_WinTCharToUtf(), Tcl_WinUtfToTChar(), TclWinGetPlatformId(), tclWinProcs, TRUE, VER_PLATFORM_WIN32_WINDOWS, WinIsReserved(), and WinReadLinkDirectory().2321 {
2322     char *lastValidPathEnd = NULL;
2323     /* This will hold the normalized string */
2324     Tcl_DString dsNorm;
2325     char *path;
2326     char *currentPathEndPosition;
2327 
2328     Tcl_DStringInit(&dsNorm);
2329     path = Tcl_GetString(pathPtr);
2330 
2331     if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) {
2332   /* 
2333    * We're on Win95, 98 or ME.  There are two assumptions
2334    * in this block of code.  First that the native (NULL)
2335    * encoding is basically ascii, and second that symbolic
2336    * links are not possible.  Both of these assumptions
2337    * appear to be true of these operating systems.
2338    */
2339   int isDrive = 1;
2340   Tcl_DString ds;
2341 
2342   currentPathEndPosition = path + nextCheckpoint;
2343         if (*currentPathEndPosition == '/') {
2344       currentPathEndPosition++;
2345         }
2346   while (1) {
2347       char cur = *currentPathEndPosition;
2348       if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {
2349     /* Reached directory separator, or end of string */
2350     CONST char *nativePath = Tcl_UtfToExternalDString(NULL, path, 
2351           currentPathEndPosition - path, &ds);
2352 
2353     /*
2354      * Now we convert the tail of the current path to its
2355      * 'long form', and append it to 'dsNorm' which holds
2356      * the current normalized path, if the file exists.
2357      */
2358     if (isDrive) {
2359         if (GetFileAttributesA(nativePath) == INVALID_FILE_ATTRIBUTES) {
2360       /* File doesn't exist */
2361       if (isDrive) {
2362           int len = WinIsReserved(path);
2363           if (len > 0) {
2364         /* Actually it does exist - COM1, etc */
2365         int i;
2366         for (i=0;i<len;i++) {
2367             if (nativePath[i] >= 'a') {
2368           ((char*)nativePath)[i] -= ('a' - 'A');
2369             }
2370         }
2371         Tcl_DStringAppend(&dsNorm, nativePath, len);
2372         lastValidPathEnd = currentPathEndPosition;
2373           }
2374       }
2375       Tcl_DStringFree(&ds);
2376       break;
2377         }
2378         if (nativePath[0] >= 'a') {
2379       ((char*)nativePath)[0] -= ('a' - 'A');
2380         }
2381         Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds));
2382     } else {
2383         WIN32_FIND_DATA fData;
2384         HANDLE handle;
2385         
2386         handle = FindFirstFileA(nativePath, &fData);
2387         if (handle == INVALID_HANDLE_VALUE) {
2388       if (GetFileAttributesA(nativePath) 
2389           == INVALID_FILE_ATTRIBUTES) {
2390           /* File doesn't exist */
2391           Tcl_DStringFree(&ds);
2392           break;
2393       }
2394       /* This is usually the '/' in 'c:/' at end of string */
2395       Tcl_DStringAppend(&dsNorm,"/", 1);
2396         } else {
2397       char *nativeName;
2398       if (fData.cFileName[0] != '\0') {
2399           nativeName = fData.cFileName;
2400       } else {
2401           nativeName = fData.cAlternateFileName;
2402       }
2403       FindClose(handle);
2404       Tcl_DStringAppend(&dsNorm,"/", 1);
2405       Tcl_DStringAppend(&dsNorm,nativeName,-1);
2406         }
2407     }
2408     Tcl_DStringFree(&ds);
2409     lastValidPathEnd = currentPathEndPosition;
2410     if (cur == 0) {
2411         break;
2412     }
2413     /* 
2414      * If we get here, we've got past one directory
2415      * delimiter, so we know it is no longer a drive 
2416      */
2417     isDrive = 0;
2418       }
2419       currentPathEndPosition++;
2420   }
2421     } else {
2422   /* We're on WinNT or 2000 or XP */
2423   Tcl_Obj *temp = NULL;
2424   int isDrive = 1;
2425   Tcl_DString ds;
2426 
2427   currentPathEndPosition = path + nextCheckpoint;
2428   if (*currentPathEndPosition == '/') {
2429       currentPathEndPosition++;
2430   }
2431   while (1) {
2432       char cur = *currentPathEndPosition;
2433       if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {
2434     /* Reached directory separator, or end of string */
2435     WIN32_FILE_ATTRIBUTE_DATA data;
2436     CONST char *nativePath = Tcl_WinUtfToTChar(path, 
2437           currentPathEndPosition - path, &ds);
2438     if ((*tclWinProcs->getFileAttributesExProc)(nativePath,
2439         GetFileExInfoStandard, &data) != TRUE) {
2440         /* File doesn't exist */
2441         if (isDrive) {
2442       int len = WinIsReserved(path);
2443       if (len > 0) {
2444           /* Actually it does exist - COM1, etc */
2445           int i;
2446           for (i=0;i<len;i++) {
2447         WCHAR wc = ((WCHAR*)nativePath)[i];
2448         if (wc >= L'a') {
2449             wc -= (L'a' - L'A');
2450             ((WCHAR*)nativePath)[i] = wc;
2451         }
2452           }
2453           Tcl_DStringAppend(&dsNorm, nativePath,
2454                 sizeof(WCHAR)*len);
2455           lastValidPathEnd = currentPathEndPosition;
2456       }
2457         }
2458         Tcl_DStringFree(&ds);
2459         break;
2460     }
2461 
2462     /* 
2463      * File 'nativePath' does exist if we get here.  We
2464      * now want to check if it is a symlink and otherwise
2465      * continue with the rest of the path.
2466      */
2467     
2468     /* 
2469      * Check for symlinks, except at last component
2470      * of path (we don't follow final symlinks). Also
2471      * a drive (C:/) for example, may sometimes have
2472      * the reparse flag set for some reason I don't
2473      * understand.  We therefore don't perform this
2474      * check for drives.
2475      */
2476     if (cur != 0 && !isDrive && (data.dwFileAttributes 
2477          & FILE_ATTRIBUTE_REPARSE_POINT)) {
2478         Tcl_Obj *to = WinReadLinkDirectory(nativePath);
2479         if (to != NULL) {
2480       /* Read the reparse point ok */
2481       /* Tcl_GetStringFromObj(to, &pathLen); */
2482       nextCheckpoint = 0; /* pathLen */
2483       Tcl_AppendToObj(to, currentPathEndPosition, -1);
2484       /* Convert link to forward slashes */
2485       for (path = Tcl_GetString(to); *path != 0; path++) {
2486           if (*path == '\\') *path = '/';
2487       }
2488       path = Tcl_GetString(to);
2489       currentPathEndPosition = path + nextCheckpoint;
2490       if (temp != NULL) {
2491           Tcl_DecrRefCount(temp);
2492       }
2493       temp = to;
2494       /* Reset variables so we can restart normalization */
2495       isDrive = 1;
2496       Tcl_DStringFree(&dsNorm);
2497       Tcl_DStringInit(&dsNorm);
2498       Tcl_DStringFree(&ds);
2499       continue;
2500         }
2501     }
2502     /*
2503      * Now we convert the tail of the current path to its
2504      * 'long form', and append it to 'dsNorm' which holds
2505      * the current normalized path
2506      */
2507     if (isDrive) {
2508         WCHAR drive = ((WCHAR*)nativePath)[0];
2509         if (drive >= L'a') {
2510             drive -= (L'a' - L'A');
2511       ((WCHAR*)nativePath)[0] = drive;
2512         }
2513         Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds));
2514     } else {
2515         char *checkDots = NULL;
2516         
2517         if (lastValidPathEnd[1] == '.') {
2518       checkDots = lastValidPathEnd + 1;
2519       while (checkDots < currentPathEndPosition) {
2520           if (*checkDots != '.') {
2521         checkDots = NULL;
2522         break;
2523           }
2524           checkDots++;
2525       }
2526         }
2527         if (checkDots != NULL) {
2528       int dotLen = currentPathEndPosition - lastValidPathEnd;
2529       /* 
2530        * Path is just dots.  We shouldn't really
2531        * ever see a path like that.  However, to be
2532        * nice we at least don't mangle the path -- 
2533        * we just add the dots as a path segment and
2534        * continue
2535        */
2536       Tcl_DStringAppend(&dsNorm,
2537             (TCHAR*)((WCHAR*)(nativePath 
2538             + Tcl_DStringLength(&ds)) 
2539             - dotLen),
2540             (int)(dotLen * sizeof(WCHAR)));
2541         } else {
2542       /* Normal path */
2543       WIN32_FIND_DATAW fData;
2544       HANDLE handle;
2545       
2546       handle = FindFirstFileW((WCHAR*)nativePath, &fData);
2547       if (handle == INVALID_HANDLE_VALUE) {
2548           /* This is usually the '/' in 'c:/' at end of string */
2549           Tcl_DStringAppend(&dsNorm,(CONST char*)L"/", 
2550                 sizeof(WCHAR));
2551       } else {
2552           WCHAR *nativeName;
2553           if (fData.cFileName[0] != '\0') {
2554         nativeName = fData.cFileName;
2555           } else {
2556         nativeName = fData.cAlternateFileName;
2557           }
2558           FindClose(handle);
2559           Tcl_DStringAppend(&dsNorm,(CONST char*)L"/", 
2560                 sizeof(WCHAR));
2561           Tcl_DStringAppend(&dsNorm,(TCHAR*)nativeName, 
2562                 (int) (wcslen(nativeName)*sizeof(WCHAR)));
2563       }
2564         }
2565     }
2566     Tcl_DStringFree(&ds);
2567     lastValidPathEnd = currentPathEndPosition;
2568     if (cur == 0) {
2569         break;
2570     }
2571     /* 
2572      * If we get here, we've got past one directory
2573      * delimiter, so we know it is no longer a drive 
2574      */
2575     isDrive = 0;
2576       }
2577       currentPathEndPosition++;
2578   }
2579     }
2580     /* Common code path for all Windows platforms */
2581     nextCheckpoint = currentPathEndPosition - path;
2582     if (lastValidPathEnd != NULL) {
2583   /* 
2584    * Concatenate the normalized string in dsNorm with the
2585    * tail of the path which we didn't recognise.  The
2586    * string in dsNorm is in the native encoding, so we
2587    * have to convert it to Utf.
2588    */
2589   Tcl_DString dsTemp;
2590   Tcl_WinTCharToUtf(Tcl_DStringValue(&dsNorm), 
2591         Tcl_DStringLength(&dsNorm), &dsTemp);
2592   nextCheckpoint = Tcl_DStringLength(&dsTemp);
2593   if (*lastValidPathEnd != 0) {
2594       /* Not the end of the string */
2595       int len;
2596       char *path;
2597       Tcl_Obj *tmpPathPtr;
2598       tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), 
2599             nextCheckpoint);
2600       Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);
2601       path = Tcl_GetStringFromObj(tmpPathPtr, &len);
2602       Tcl_SetStringObj(pathPtr, path, len);
2603       Tcl_DecrRefCount(tmpPathPtr);
2604   } else {
2605       /* End of string was reached above */
2606       Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&dsTemp),
2607            nextCheckpoint);
2608   }
2609   Tcl_DStringFree(&dsTemp);
2610     }
2611     Tcl_DStringFree(&dsNorm);
2612     return nextCheckpoint;
2613 }
int TclpObjStat (Tcl_Obj * pathPtr, Tcl_StatBuf * statPtr)

Definition at line 1769 of file tclWinFile.c.
References CONST, ENOENT, NativeStat(), NULL, Tcl_DecrRefCount, Tcl_FSGetNativePath(), Tcl_FSGetTranslatedPath(), Tcl_GetString(), Tcl_SetErrno(), and TclWinFlushDirtyChannels().1772 {
1773 #ifdef OLD_API
1774     Tcl_Obj *transPtr;
1775     /*
1776      * Eliminate file names containing wildcard characters, or subsequent 
1777      * call to FindFirstFile() will expand them, matching some other file.
1778      */
1779 
1780     transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
1781     if (transPtr == NULL || (strpbrk(Tcl_GetString(transPtr), "?*") != NULL)) {
1782   if (transPtr != NULL) {
1783       Tcl_DecrRefCount(transPtr);
1784   }
1785   Tcl_SetErrno(ENOENT);
1786   return -1;
1787     }
1788     Tcl_DecrRefCount(transPtr);
1789 #endif
1790     
1791     /*
1792      * Ensure correct file sizes by forcing the OS to write any
1793      * pending data to disk. This is done only for channels which are
1794      * dirty, i.e. have been written to since the last flush here.
1795      */
1796 
1797     TclWinFlushDirtyChannels ();
1798 
1799     return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 0);
1800 }
int TclpUtime (Tcl_Obj * pathPtr, struct utimbuf * tval)

Definition at line 2633 of file tclWinFile.c.
References CONST, DWORD(), FromCTime(), INVALID_FILE_ATTRIBUTES, NULL, Tcl_FSGetNativePath(), TclWinConvertError(), and tclWinProcs.2636 {
2637     int res = 0;
2638     HANDLE fileHandle;
2639     CONST TCHAR *native;
2640     DWORD attr = 0;
2641     DWORD flags = FILE_ATTRIBUTE_NORMAL;
2642     FILETIME lastAccessTime, lastModTime;
2643 
2644     FromCTime(tval->actime, &lastAccessTime);
2645     FromCTime(tval->modtime, &lastModTime);
2646 
2647     native = (CONST TCHAR *)Tcl_FSGetNativePath(pathPtr);
2648 
2649     attr = (*tclWinProcs->getFileAttributesProc)(native);
2650 
2651     if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) {
2652   flags = FILE_FLAG_BACKUP_SEMANTICS;
2653     }
2654 
2655     /*
2656      * We use the native APIs (not 'utime') because there are some daylight
2657      * savings complications that utime gets wrong.
2658      */
2659 
2660     fileHandle = (tclWinProcs->createFileProc) (
2661       native, FILE_WRITE_ATTRIBUTES, 0, NULL,
2662       OPEN_EXISTING, flags, NULL);
2663 
2664     if (fileHandle == INVALID_HANDLE_VALUE ||
2665       !SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) {
2666   TclWinConvertError(GetLastError());
2667   res = -1;
2668     }
2669     if (fileHandle != INVALID_HANDLE_VALUE) {
2670   CloseHandle(fileHandle);
2671     }
2672     return res;
2673 }
int TclWinSymLinkCopyDirectory (CONST TCHAR* LinkOriginal, CONST TCHAR* LinkCopy)

Definition at line 391 of file tclWinFile.c.
References NativeReadReparse(), and NativeWriteReparse().
Referenced by DoCopyFile().394 {
395     DUMMY_REPARSE_BUFFER dummy;
396     REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
397     
398     if (NativeReadReparse(LinkOriginal, reparseBuffer)) {
399   return -1;
400     }
401     return NativeWriteReparse(LinkCopy, reparseBuffer);
402 }
int TclWinSymLinkDelete (CONST TCHAR* LinkOriginal, int linkOnly)

Definition at line 419 of file tclWinFile.c.
References DWORD(), FILE_FLAG_OPEN_REPARSE_POINT, FSCTL_DELETE_REPARSE_POINT, IO_REPARSE_TAG_MOUNT_POINT, NULL, REPARSE_MOUNTPOINT_HEADER_SIZE, _REPARSE_DATA_BUFFER::ReparseTag, TclWinConvertError(), and tclWinProcs.
Referenced by DoRemoveJustDirectory(), and TclpDeleteFile().422 {
423     /* It is a symbolic link -- remove it */
424     DUMMY_REPARSE_BUFFER dummy;
425     REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
426     HANDLE hFile;
427     DWORD returnedLength;
428     memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
429     reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
430     hFile = (*tclWinProcs->createFileProc)(LinkOriginal, GENERIC_WRITE, 0,
431   NULL, OPEN_EXISTING, 
432   FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
433     if (hFile != INVALID_HANDLE_VALUE) {
434   if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer, 
435            REPARSE_MOUNTPOINT_HEADER_SIZE,
436            NULL, 0, &returnedLength, NULL)) { 
437       /* Error setting junction */
438       TclWinConvertError(GetLastError());
439       CloseHandle(hFile);
440   } else {
441       CloseHandle(hFile);
442       if (!linkOnly) {
443           (*tclWinProcs->removeDirectoryProc)(LinkOriginal);
444       }
445       return 0;
446   }
447     }
448     return -1;
449 }
static time_t ToCTime (FILETIME fileTime) [static]

Definition at line 2046 of file tclWinFile.c.
References POSIX_EPOCH_AS_FILETIME.
Referenced by NativeStat().2048 {
2049     LARGE_INTEGER convertedTime;
2050 
2051     convertedTime.LowPart = fileTime.dwLowDateTime;
2052     convertedTime.HighPart = (LONG) fileTime.dwHighDateTime;
2053 
2054     return (time_t) ((convertedTime.QuadPart
2055       - (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000);
2056 }
static int WinIsDrive (CONST char * name, int nameLen) [static]

Definition at line 976 of file tclWinFile.c.
Referenced by TclpMatchInDirectory().979 {
980     int remove = 0;
981     while (len > 4) {
982         if ((name[len-1] != '.' || name[len-2] != '.') 
983       || (name[len-3] != '/' && name[len-3] != '\\')) {
984             /* We don't have '/..' at the end */
985       if (remove == 0) {
986           break;
987       }
988       remove--;
989       while (len > 0) {
990     len--;
991     if (name[len] == '/' || name[len] == '\\') {
992         break;
993     }
994       }
995       if (len < 4) {
996           len++;
997     break;
998       }
999         } else {
1000       /* We do have '/..' */
1001       len -= 3;
1002       remove++;
1003         }
1004     }
1005     if (len < 4) {
1006   if (len == 0) {
1007       /* 
1008        * Not sure if this is possible, but we pass it on
1009        * anyway 
1010        */
1011   } else if (len == 1 && (name[0] == '/' || name[0] == '\\')) {
1012       /* Path is pointing to the root volume */
1013       return 1;
1014   } else if ((name[1] == ':') 
1015        && (len == 2 || (name[2] == '/' || name[2] == '\\'))) {
1016       /* Path is of the form 'x:' or 'x:/' or 'x:\' */
1017       return 1;
1018   }
1019     }
1020     return 0;
1021 }
static int WinIsReserved (CONST char * path) [static]

Definition at line 1028 of file tclWinFile.c.
Referenced by TclpObjNormalizePath().1030 {
1031     if ((path[0] == 'c' || path[0] == 'C') 
1032   && (path[1] == 'o' || path[1] == 'O')) {
1033   if ((path[2] == 'm' || path[2] == 'M')
1034       && path[3] >= '1' && path[3] <= '4') {
1035       /* May have match for 'com[1-4]:?', which is a serial port */
1036       if (path[4] == '\0') {
1037     return 4;
1038       } else if (path [4] == ':' && path[5] == '\0') {
1039     return 4;
1040       }
1041   } else if ((path[2] == 'n' || path[2] == 'N') && path[3] == '\0') {
1042       /* Have match for 'con' */
1043       return 3;
1044   }
1045     } else if ((path[0] == 'l' || path[0] == 'L')
1046          && (path[1] == 'p' || path[1] == 'P')
1047          && (path[2] == 't' || path[2] == 'T')) {
1048   if (path[3] >= '1' && path[3] <= '3') {
1049       /* May have match for 'lpt[1-3]:?' */
1050       if (path[4] == '\0') {
1051     return 4;
1052       } else if (path [4] == ':' && path[5] == '\0') {
1053     return 4;
1054       }
1055   }
1056     } else if (stricmp(path, "prn") == 0) {
1057   /* Have match for 'prn' */
1058   return 3;
1059     } else if (stricmp(path, "nul") == 0) {
1060   /* Have match for 'nul' */
1061   return 3;
1062     } else if (stricmp(path, "aux") == 0) {
1063   /* Have match for 'aux' */
1064   return 3;
1065     }
1066     return 0;
1067 }
static int WinLink (CONST TCHAR * LinkSource, CONST TCHAR * LinkTarget, int linkAction) [static]

Definition at line 207 of file tclWinFile.c.
References EEXIST, EISDIR, ENODEV, ENOTDIR, NULL, TCL_CREATE_HARD_LINK, TCL_CREATE_SYMBOLIC_LINK, Tcl_SetErrno(), TclWinConvertError(), tclWinProcs, and WinSymLinkDirectory().211 {
212     WCHAR tempFileName[MAX_PATH];
213     TCHAR*  tempFilePart;
214     int         attr;
215     
216     /* Get the full path referenced by the target */
217     if (!(*tclWinProcs->getFullPathNameProc)(LinkTarget, 
218         MAX_PATH, tempFileName, &tempFilePart)) {
219   /* Invalid file */
220   TclWinConvertError(GetLastError());
221   return -1;
222     }
223 
224     /* Make sure source file doesn't exist */
225     attr = (*tclWinProcs->getFileAttributesProc)(LinkSource);
226     if (attr != 0xffffffff) {
227   Tcl_SetErrno(EEXIST);
228   return -1;
229     }
230 
231     /* Get the full path referenced by the directory */
232     if (!(*tclWinProcs->getFullPathNameProc)(LinkSource, 
233         MAX_PATH, tempFileName, &tempFilePart)) {
234   /* Invalid file */
235   TclWinConvertError(GetLastError());
236   return -1;
237     }
238     /* Check the target */
239     attr = (*tclWinProcs->getFileAttributesProc)(LinkTarget);
240     if (attr == 0xffffffff) {
241   /* The target doesn't exist */
242   TclWinConvertError(GetLastError());
243   return -1;
244     } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
245   /* It is a file */
246   if (tclWinProcs->createHardLinkProc == NULL) {
247       Tcl_SetErrno(ENOTDIR);
248       return -1;
249   }
250   if (linkAction & TCL_CREATE_HARD_LINK) {
251       if (!(*tclWinProcs->createHardLinkProc)(LinkSource, LinkTarget, NULL)) {
252     TclWinConvertError(GetLastError());
253     return -1;
254       }
255       return 0;
256   } else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
257       /* Can't symlink files */
258       Tcl_SetErrno(ENOTDIR);
259       return -1;
260   } else {
261       Tcl_SetErrno(ENODEV);
262       return -1;
263   }
264     } else {
265   if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
266       return WinSymLinkDirectory(LinkSource, LinkTarget);
267   } else if (linkAction & TCL_CREATE_HARD_LINK) {
268       /* Can't hard link directories */
269       Tcl_SetErrno(EISDIR);
270       return -1;
271   } else {
272       Tcl_SetErrno(ENODEV);
273       return -1;
274   }
275     }
276 }
static Tcl_Obj * WinReadLink (CONST TCHAR * LinkSource) [static]

Definition at line 287 of file tclWinFile.c.
References ENOTDIR, NULL, Tcl_SetErrno(), TclWinConvertError(), tclWinProcs, and WinReadLinkDirectory().289 {
290     WCHAR tempFileName[MAX_PATH];
291     TCHAR*  tempFilePart;
292     int         attr;
293     
294     /* Get the full path referenced by the target */
295     if (!(*tclWinProcs->getFullPathNameProc)(LinkSource, 
296         MAX_PATH, tempFileName, &tempFilePart)) {
297   /* Invalid file */
298   TclWinConvertError(GetLastError());
299   return NULL;
300     }
301 
302     /* Make sure source file does exist */
303     attr = (*tclWinProcs->getFileAttributesProc)(LinkSource);
304     if (attr == 0xffffffff) {
305   /* The source doesn't exist */
306   TclWinConvertError(GetLastError());
307   return NULL;
308     } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
309   /* It is a file - this is not yet supported */
310   Tcl_SetErrno(ENOTDIR);
311   return NULL;
312     } else {
313   return WinReadLinkDirectory(LinkSource);
314     }
315 }
static Tcl_Obj * WinReadLinkDirectory (CONST TCHAR * LinkDirectory) [static]

Definition at line 470 of file tclWinFile.c.
References CONST, EINVAL, FILE_ATTRIBUTE_REPARSE_POINT, IO_REPARSE_TAG_MOUNT_POINT, IO_REPARSE_TAG_SYMBOLIC_LINK, NativeReadReparse(), NULL, _REPARSE_DATA_BUFFER::PathBuffer, _REPARSE_DATA_BUFFER::ReparseTag, _REPARSE_DATA_BUFFER::SymbolicLinkReparseBuffer, Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, Tcl_IncrRefCount, Tcl_NewStringObj(), Tcl_SetErrno(), Tcl_WinTCharToUtf(), TclWinDriveLetterForVolMountPoint(), and tclWinProcs.
Referenced by TclpObjNormalizePath(), and WinReadLink().472 {
473     int attr;
474     DUMMY_REPARSE_BUFFER dummy;
475     REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
476     
477     attr = (*tclWinProcs->getFileAttributesProc)(LinkDirectory);
478     if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
479   Tcl_SetErrno(EINVAL);
480   return NULL;
481     }
482     if (NativeReadReparse(LinkDirectory, reparseBuffer)) {
483         return NULL;
484     }
485     
486     switch (reparseBuffer->ReparseTag) {
487   case 0x80000000|IO_REPARSE_TAG_SYMBOLIC_LINK: 
488   case IO_REPARSE_TAG_SYMBOLIC_LINK: 
489   case IO_REPARSE_TAG_MOUNT_POINT: {
490       Tcl_Obj *retVal;
491       Tcl_DString ds;
492       CONST char *copy;
493       int len;
494       int offset = 0;
495       
496       /* 
497        * Certain native path representations on Windows have a
498        * special prefix to indicate that they are to be treated
499        * specially.  For example extremely long paths, or symlinks,
500        * or volumes mounted inside directories.
501        * 
502        * There is an assumption in this code that 'wide' interfaces
503        * are being used (see tclWin32Dll.c), which is true for the
504        * only systems which support reparse tags at present.  If
505        * that changes in the future, this code will have to be
506        * generalised.
507        */
508       if (reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer[0] 
509                                                      == L'\\') {
510     /* Check whether this is a mounted volume */
511     if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, 
512           L"\\??\\Volume{",11) == 0) {
513         char drive;
514         /* 
515          * There is some confusion between \??\ and \\?\ which
516          * we have to fix here.  It doesn't seem very well
517          * documented.
518          */
519         reparseBuffer->SymbolicLinkReparseBuffer
520                                           .PathBuffer[1] = L'\\';
521         /* 
522          * Check if a corresponding drive letter exists, and
523          * use that if it is found
524          */
525         drive = TclWinDriveLetterForVolMountPoint(reparseBuffer
526           ->SymbolicLinkReparseBuffer.PathBuffer);
527         if (drive != -1) {
528       char driveSpec[3] = {
529           drive, ':', '\0'
530       };
531       retVal = Tcl_NewStringObj(driveSpec,2);
532       Tcl_IncrRefCount(retVal);
533       return retVal;
534         }
535         /* 
536          * This is actually a mounted drive, which doesn't
537          * exists as a DOS drive letter.  This means the path
538          * isn't actually a link, although we partially treat
539          * it like one ('file type' will return 'link'), but
540          * then the link will actually just be treated like
541          * an ordinary directory.  I don't believe any
542          * serious inconsistency will arise from this, but it
543          * is something to be aware of.
544          */
545         Tcl_SetErrno(EINVAL);
546         return NULL;
547     } else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer
548            .PathBuffer, L"\\\\?\\",4) == 0) {
549         /* Strip off the prefix */
550         offset = 4;
551     } else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer
552            .PathBuffer, L"\\??\\",4) == 0) {
553         /* Strip off the prefix */
554         offset = 4;
555     }
556       }
557       
558       Tcl_WinTCharToUtf(
559     (CONST char*)reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, 
560     (int)reparseBuffer->SymbolicLinkReparseBuffer
561     .SubstituteNameLength, &ds);
562   
563       copy = Tcl_DStringValue(&ds)+offset;
564       len = Tcl_DStringLength(&ds)-offset;
565       retVal = Tcl_NewStringObj(copy,len);
566       Tcl_IncrRefCount(retVal);
567       Tcl_DStringFree(&ds);
568       return retVal;
569   }
570     }
571     Tcl_SetErrno(EINVAL);
572     return NULL;
573 }
static int WinSymLinkDirectory (CONST TCHAR * LinkDirectory, CONST TCHAR * LinkTarget) [static]

Definition at line 332 of file tclWinFile.c.
References IO_REPARSE_TAG_MOUNT_POINT, NativeWriteReparse(), _REPARSE_DATA_BUFFER::ReparseDataLength, _REPARSE_DATA_BUFFER::ReparseTag, _REPARSE_DATA_BUFFER::Reserved, _REPARSE_DATA_BUFFER::SymbolicLinkReparseBuffer, and VOID.
Referenced by WinLink().335 {
336     DUMMY_REPARSE_BUFFER dummy;
337     REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
338     int         len;
339     WCHAR       nativeTarget[MAX_PATH];
340     WCHAR       *loop;
341     
342     /* Make the native target name */
343     memcpy((VOID*)nativeTarget, (VOID*)L"\\??\\", 4*sizeof(WCHAR));
344     memcpy((VOID*)(nativeTarget + 4), (VOID*)LinkTarget, 
345      sizeof(WCHAR)*(1+wcslen((WCHAR*)LinkTarget)));
346     len = wcslen(nativeTarget);
347     /* 
348      * We must have backslashes only.  This is VERY IMPORTANT.
349      * If we have any forward slashes everything appears to work,
350      * but the resulting symlink is useless!
351      */
352     for (loop = nativeTarget; *loop != 0; loop++) {
353   if (*loop == L'/') *loop = L'\\';
354     }
355     if ((nativeTarget[len-1] == L'\\') && (nativeTarget[len-2] != L':')) {
356   nativeTarget[len-1] = 0;
357     }
358     
359     /* Build the reparse info */
360     memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
361     reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
362     reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength = 
363       wcslen(nativeTarget) * sizeof(WCHAR);
364     reparseBuffer->Reserved = 0;
365     reparseBuffer->SymbolicLinkReparseBuffer.PrintNameLength = 0;
366     reparseBuffer->SymbolicLinkReparseBuffer.PrintNameOffset = 
367       reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength 
368       + sizeof(WCHAR);
369     memcpy(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, nativeTarget, 
370       sizeof(WCHAR) 
371       + reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength);
372     reparseBuffer->ReparseDataLength = 
373       reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength + 12;
374   
375     return NativeWriteReparse(LinkDirectory, reparseBuffer);
376 }

win/tclWinInit.c File Reference
#include "tclWinInt.h"
#include <winnt.h>
#include <winbase.h>
#include <lmcons.h>
#include "tclInitScript.h"
Classes
struct OemId
Defines
#define PROCESSOR_ARCHITECTURE_INTEL  0
#define PROCESSOR_ARCHITECTURE_MIPS  1
#define PROCESSOR_ARCHITECTURE_ALPHA  2
#define PROCESSOR_ARCHITECTURE_PPC  3
#define PROCESSOR_ARCHITECTURE_SHX  4
#define PROCESSOR_ARCHITECTURE_ARM  5
#define PROCESSOR_ARCHITECTURE_IA64  6
#define PROCESSOR_ARCHITECTURE_ALPHA64  7
#define PROCESSOR_ARCHITECTURE_MSIL  8
#define PROCESSOR_ARCHITECTURE_AMD64  9
#define PROCESSOR_ARCHITECTURE_IA32_ON_WIN64  10
#define PROCESSOR_ARCHITECTURE_UNKNOWN  0xFFFF
#define NUMPLATFORMS  4
#define NUMPROCESSORS  11
#define LIBRARY_SIZE  32
Functions
static void AppendEnvironment (Tcl_Obj *listPtr, CONST char *lib)
static void AppendDllPath (Tcl_Obj *listPtr, HMODULE hModule, CONST char *lib)
static int ToUtf (CONST WCHAR *wSrc, char *dst)
void TclpInitPlatform ()
int TclpInitLibraryPath (CONST char *path)
void TclWinEncodingsCleanup ()
void TclpSetInitialEncodings ()
void TclpSetVariables (Tcl_Interp *interp)
int TclpFindVariable (CONST char *name, int *lengthPtr)
int Tcl_Init (Tcl_Interp *interp)
void Tcl_SourceRCFile (Tcl_Interp *interp)
Variables
static char * platforms [NUMPLATFORMS]
static char * processors [NUMPROCESSORS]
static Tcl_Encoding binaryEncoding = NULL
static int libraryPathEncodingFixed = 0

Define Documentation
#define LIBRARY_SIZE  32
#define NUMPLATFORMS  4

Definition at line 77 of file tclWinInit.c.
Referenced by TclpSetVariables().#define NUMPROCESSORS  11

Definition at line 82 of file tclWinInit.c.
Referenced by TclpSetVariables().#define PROCESSOR_ARCHITECTURE_ALPHA  2

Definition at line 41 of file tclWinInit.c.#define PROCESSOR_ARCHITECTURE_ALPHA64  7

Definition at line 56 of file tclWinInit.c.#define PROCESSOR_ARCHITECTURE_AMD64  9

Definition at line 62 of file tclWinInit.c.#define PROCESSOR_ARCHITECTURE_ARM  5

Definition at line 50 of file tclWinInit.c.#define PROCESSOR_ARCHITECTURE_IA32_ON_WIN64  10

Definition at line 65 of file tclWinInit.c.#define PROCESSOR_ARCHITECTURE_IA64  6

Definition at line 53 of file tclWinInit.c.#define PROCESSOR_ARCHITECTURE_INTEL  0

Definition at line 35 of file tclWinInit.c.#define PROCESSOR_ARCHITECTURE_MIPS  1

Definition at line 38 of file tclWinInit.c.#define PROCESSOR_ARCHITECTURE_MSIL  8

Definition at line 59 of file tclWinInit.c.#define PROCESSOR_ARCHITECTURE_PPC  3

Definition at line 44 of file tclWinInit.c.#define PROCESSOR_ARCHITECTURE_SHX  4

Definition at line 47 of file tclWinInit.c.#define PROCESSOR_ARCHITECTURE_UNKNOWN  0xFFFF

Definition at line 68 of file tclWinInit.c.
Function Documentation
static void AppendDllPath (Tcl_Obj * listPtr, HMODULE hModule, CONST char * lib) [static]

Definition at line 452 of file tclWinInit.c.
References LIBRARY_SIZE, NULL, Tcl_ListObjAppendElement(), Tcl_NewStringObj(), TCL_UTF_MAX, TclWinNoBackslash(), and ToUtf().
Referenced by TclpInitLibraryPath().456 {
457     WCHAR wName[MAX_PATH + LIBRARY_SIZE];
458     char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
459 
460     if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) {
461   GetModuleFileNameA(hModule, name, MAX_PATH);
462     } else {
463   ToUtf(wName, name);
464     }
465     if (lib != NULL) {
466   char *end, *p;
467 
468   end = strrchr(name, '\\');
469   *end = '\0';
470   p = strrchr(name, '\\');
471   if (p != NULL) {
472       end = p;
473   }
474   *end = '\\';
475   strcpy(end + 1, lib);
476     }
477     TclWinNoBackslash(name);
478     Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(name, -1));
479 }
static void AppendEnvironment (Tcl_Obj * listPtr, CONST char * lib) [static]

Definition at line 357 of file tclWinInit.c.
References ckfree, CONST, NULL, Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_JoinPath(), Tcl_ListObjAppendElement(), Tcl_NewStringObj(), Tcl_SplitPath(), TCL_UTF_MAX, TclWinNoBackslash(), and ToUtf().
Referenced by TclpInitLibraryPath().360 {
361     int pathc;
362     WCHAR wBuf[MAX_PATH];
363     char buf[MAX_PATH * TCL_UTF_MAX];
364     Tcl_Obj *objPtr;
365     Tcl_DString ds;
366     CONST char **pathv;
367     char *shortlib;
368 
369     /*
370      * The shortlib value needs to be the tail component of the
371      * lib path. For example, "lib/tcl8.4" -> "tcl8.4" while
372      * "usr/share/tcl8.5" -> "tcl8.5".
373      */
374     for (shortlib = (char *) (lib + strlen(lib) - 1); shortlib > lib ; shortlib--) {
375         if (*shortlib == '/') { 
376             if (shortlib == (lib + strlen(lib) - 1)) {
377                 Tcl_Panic("last character in lib cannot be '/'");
378             }
379             shortlib++;
380             break;
381         }
382     }
383     if (shortlib == lib) {
384         Tcl_Panic("no '/' character found in lib");
385     }
386 
387     /*
388      * The "L" preceeding the TCL_LIBRARY string is used to tell VC++
389      * that this is a unicode string.
390      */
391     
392     if (GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH) == 0) {
393         buf[0] = '\0';
394   GetEnvironmentVariableA("TCL_LIBRARY", buf, MAX_PATH);
395     } else {
396   ToUtf(wBuf, buf);
397     }
398 
399     if (buf[0] != '\0') {
400   objPtr = Tcl_NewStringObj(buf, -1);
401   Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
402 
403   TclWinNoBackslash(buf);
404   Tcl_SplitPath(buf, &pathc, &pathv);
405 
406   /* 
407    * The lstrcmpi() will work even if pathv[pathc - 1] is random
408    * UTF-8 chars because I know shortlib is ascii.
409    */
410 
411   if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) {
412       CONST char *str;
413       /*
414        * TCL_LIBRARY is set but refers to a different tcl
415        * installation than the current version.  Try fiddling with the
416        * specified directory to make it refer to this installation by
417        * removing the old "tclX.Y" and substituting the current
418        * version string.
419        */
420       
421       pathv[pathc - 1] = shortlib;
422       Tcl_DStringInit(&ds);
423       str = Tcl_JoinPath(pathc, pathv, &ds);
424       objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
425       Tcl_DStringFree(&ds);
426   } else {
427       objPtr = Tcl_NewStringObj(buf, -1);
428   }
429   Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
430   ckfree((char *) pathv);
431     }
432 }
int Tcl_Init (Tcl_Interp * interp)

Definition at line 835 of file tclWinInit.c.
References initScript, NULL, Tcl_DecrRefCount, TCL_ERROR, Tcl_Eval(), TCL_GLOBAL_ONLY, Tcl_IncrRefCount, Tcl_NewObj(), Tcl_SetVar2Ex(), TclGetLibraryPath(), and tclPreInitScript.837 {
838     Tcl_Obj *pathPtr;
839 
840     if (tclPreInitScript != NULL) {
841   if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
842       return (TCL_ERROR);
843   };
844     }
845 
846     pathPtr = TclGetLibraryPath();
847     if (pathPtr == NULL) {
848   pathPtr = Tcl_NewObj();
849     }
850     Tcl_IncrRefCount(pathPtr);    
851     Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
852     Tcl_DecrRefCount(pathPtr);    
853     return Tcl_Eval(interp, initScript);
854 }
void Tcl_SourceRCFile (Tcl_Interp * interp)

Definition at line 875 of file tclWinInit.c.
References CONST, NULL, Tcl_Close(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_EvalFile(), Tcl_GetObjResult(), Tcl_GetStdChannel(), Tcl_GetVar(), TCL_GLOBAL_ONLY, TCL_OK, Tcl_OpenFileChannel(), TCL_STDERR, Tcl_TranslateFileName(), Tcl_WriteChars(), and Tcl_WriteObj().877 {
878     Tcl_DString temp;
879     CONST char *fileName;
880     Tcl_Channel errChannel;
881 
882     fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
883 
884     if (fileName != NULL) {
885         Tcl_Channel c;
886   CONST char *fullName;
887 
888         Tcl_DStringInit(&temp);
889   fullName = Tcl_TranslateFileName(interp, fileName, &temp);
890   if (fullName == NULL) {
891       /*
892        * Couldn't translate the file name (e.g. it referred to a
893        * bogus user or there was no HOME environment variable).
894        * Just do nothing.
895        */
896   } else {
897 
898       /*
899        * Test for the existence of the rc file before trying to read it.
900        */
901 
902             c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
903             if (c != (Tcl_Channel) NULL) {
904                 Tcl_Close(NULL, c);
905     if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
906         errChannel = Tcl_GetStdChannel(TCL_STDERR);
907         if (errChannel) {
908       Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
909       Tcl_WriteChars(errChannel, "\n", 1);
910         }
911     }
912       }
913   }
914         Tcl_DStringFree(&temp);
915     }
916 }
int TclpFindVariable (CONST char * name, int * lengthPtr)

Definition at line 753 of file tclWinInit.c.
References ckalloc, ckfree, CONST, environ, NULL, size_t(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringSetLength(), Tcl_ExternalToUtfDString(), Tcl_UtfToUpper(), and VOID.760 {
761     int i, length, result = -1;
762     register CONST char *env, *p1, *p2;
763     char *envUpper, *nameUpper;
764     Tcl_DString envString;
765 
766     /*
767      * Convert the name to all upper case for the case insensitive
768      * comparison.
769      */
770 
771     length = strlen(name);
772     nameUpper = (char *) ckalloc((unsigned) length+1);
773     memcpy((VOID *) nameUpper, (VOID *) name, (size_t) length+1);
774     Tcl_UtfToUpper(nameUpper);
775     
776     Tcl_DStringInit(&envString);
777     for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
778   /*
779    * Chop the env string off after the equal sign, then Convert
780    * the name to all upper case, so we do not have to convert
781    * all the characters after the equal sign.
782    */
783   
784   envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
785   p1 = strchr(envUpper, '=');
786   if (p1 == NULL) {
787       continue;
788   }
789   length = (int) (p1 - envUpper);
790   Tcl_DStringSetLength(&envString, length+1);
791   Tcl_UtfToUpper(envUpper);
792 
793   p1 = envUpper;
794   p2 = nameUpper;
795   for (; *p2 == *p1; p1++, p2++) {
796       /* NULL loop body. */
797   }
798   if ((*p1 == '=') && (*p2 == '\0')) {
799       *lengthPtr = length;
800       result = i;
801       goto done;
802   }
803   
804   Tcl_DStringFree(&envString);
805     }
806     
807     *lengthPtr = i;
808 
809     done:
810     Tcl_DStringFree(&envString);
811     ckfree(nameUpper);
812     return result;
813 }
int TclpInitLibraryPath (CONST char * path)

Definition at line 177 of file tclWinInit.c.
References AppendDllPath(), AppendEnvironment(), ckalloc, ckfree, CONST, LIBRARY_SIZE, NULL, Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_GetDefaultEncodingDir(), Tcl_JoinPath(), Tcl_ListObjAppendElement(), Tcl_NewObj(), Tcl_NewStringObj(), TCL_PATCH_LEVEL, Tcl_SplitPath(), TCL_VERSION, and TclSetLibraryPath().180 {
181 #define LIBRARY_SIZE      32
182     Tcl_Obj *pathPtr, *objPtr;
183     CONST char *str;
184     Tcl_DString ds;
185     int pathc;
186     CONST char **pathv;
187     char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE];
188 
189     Tcl_DStringInit(&ds);
190     pathPtr = Tcl_NewObj();
191 
192     /*
193      * Initialize the substrings used when locating an executable.  The
194      * installLib variable computes the path as though the executable
195      * is installed.  The developLib computes the path as though the
196      * executable is run from a develpment directory.
197      */
198 
199     sprintf(installLib, "lib/tcl%s", TCL_VERSION);
200     sprintf(developLib, "tcl%s/library", TCL_PATCH_LEVEL);
201 
202     /*
203      * Look for the library relative to default encoding dir.
204      */
205 
206     str = Tcl_GetDefaultEncodingDir();
207     if ((str != NULL) && (str[0] != '\0')) {
208   objPtr = Tcl_NewStringObj(str, -1);
209   Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
210     }
211 
212     /*
213      * Look for the library relative to the TCL_LIBRARY env variable.
214      * If the last dirname in the TCL_LIBRARY path does not match the
215      * last dirname in the installLib variable, use the last dir name
216      * of installLib in addition to the orginal TCL_LIBRARY path.
217      */
218 
219     AppendEnvironment(pathPtr, installLib);
220 
221     /*
222      * Look for the library relative to the DLL.  Only use the installLib
223      * because in practice, the DLL is always installed.
224      */
225 
226     AppendDllPath(pathPtr, TclWinGetTclInstance(), installLib);
227     
228 
229     /*
230      * Look for the library relative to the executable.  This algorithm
231      * should be the same as the one in the tcl_findLibrary procedure.
232      *
233      * This code looks in the following directories:
234      *
235      *  <bindir>/../<installLib>
236      *    (e.g. /usr/local/bin/../lib/tcl8.4)
237      *  <bindir>/../../<installLib>
238      *    (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.4)
239      *  <bindir>/../library
240      *    (e.g. /usr/src/tcl8.4.0/unix/../library)
241      *  <bindir>/../../library
242      *    (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../library)
243      *  <bindir>/../../<developLib>
244      *    (e.g. /usr/src/tcl8.4.0/unix/../../tcl8.4.0/library)
245      *  <bindir>/../../../<developLib>
246      *     (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../../tcl8.4.0/library)
247      */
248      
249     /*
250      * The variable path holds an absolute path.  Take care not to
251      * overwrite pathv[0] since that might produce a relative path.
252      */
253 
254     if (path != NULL) {
255   int i, origc;
256   CONST char **origv;
257 
258   Tcl_SplitPath(path, &origc, &origv);
259   pathc = 0;
260   pathv = (CONST char **) ckalloc((unsigned int)(origc * sizeof(char *)));
261   for (i=0; i< origc; i++) {
262       if (origv[i][0] == '.') {
263     if (strcmp(origv[i], ".") == 0) {
264         /* do nothing */
265     } else if (strcmp(origv[i], "..") == 0) {
266         pathc--;
267     } else {
268         pathv[pathc++] = origv[i];
269     }
270       } else {
271     pathv[pathc++] = origv[i];
272       }
273   }
274   if (pathc > 2) {
275       str = pathv[pathc - 2];
276       pathv[pathc - 2] = installLib;
277       path = Tcl_JoinPath(pathc - 1, pathv, &ds);
278       pathv[pathc - 2] = str;
279       objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
280       Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
281       Tcl_DStringFree(&ds);
282   }
283   if (pathc > 3) {
284       str = pathv[pathc - 3];
285       pathv[pathc - 3] = installLib;
286       path = Tcl_JoinPath(pathc - 2, pathv, &ds);
287       pathv[pathc - 3] = str;
288       objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
289       Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
290       Tcl_DStringFree(&ds);
291   }
292   if (pathc > 2) {
293       str = pathv[pathc - 2];
294       pathv[pathc - 2] = "library";
295       path = Tcl_JoinPath(pathc - 1, pathv, &ds);
296       pathv[pathc - 2] = str;
297       objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
298       Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
299       Tcl_DStringFree(&ds);
300   }
301   if (pathc > 3) {
302       str = pathv[pathc - 3];
303       pathv[pathc - 3] = "library";
304       path = Tcl_JoinPath(pathc - 2, pathv, &ds);
305       pathv[pathc - 3] = str;
306       objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
307       Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
308       Tcl_DStringFree(&ds);
309   }
310   if (pathc > 3) {
311       str = pathv[pathc - 3];
312       pathv[pathc - 3] = developLib;
313       path = Tcl_JoinPath(pathc - 2, pathv, &ds);
314       pathv[pathc - 3] = str;
315       objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
316       Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
317       Tcl_DStringFree(&ds);
318   }
319   if (pathc > 4) {
320       str = pathv[pathc - 4];
321       pathv[pathc - 4] = developLib;
322       path = Tcl_JoinPath(pathc - 3, pathv, &ds);
323       pathv[pathc - 4] = str;
324       objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
325       Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
326       Tcl_DStringFree(&ds);
327   }
328   ckfree((char *) origv);
329   ckfree((char *) pathv);
330     }
331 
332     TclSetLibraryPath(pathPtr);
333 
334     return 0; /* 0 indicates that pathPtr is clean (true) utf */
335 }
void TclpInitPlatform ()

Definition at line 125 of file tclWinInit.c.
References NULL, TCL_PLATFORM_WINDOWS, tclPlatform, and TclWinInit().126 {
127     tclPlatform = TCL_PLATFORM_WINDOWS;
128 
129     /*
130      * The following code stops Windows 3.X and Windows NT 3.51 from 
131      * automatically putting up Sharing Violation dialogs, e.g, when 
132      * someone tries to access a file that is locked or a drive with no 
133      * disk in it.  Tcl already returns the appropriate error to the 
134      * caller, and they can decide to put up their own dialog in response 
135      * to that failure.  
136      *
137      * Under 95 and NT 4.0, this is a NOOP because the system doesn't 
138      * automatically put up dialogs when the above operations fail.
139      */
140 
141     SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS);
142 
143 #ifdef STATIC_BUILD
144     /*
145      * If we are in a statically linked executable, then we need to
146      * explicitly initialize the Windows function tables here since
147      * DllMain() will not be invoked.
148      */
149 
150     TclWinInit(GetModuleHandle(NULL));
151 #endif
152 }
void TclpSetInitialEncodings ()

Definition at line 568 of file tclWinInit.c.
References binaryEncoding, CONST, libraryPathEncodingFixed, NULL, platformId, Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, Tcl_ExternalToUtfDString(), Tcl_GetEncoding(), Tcl_GetStringFromObj(), TCL_INTEGER_SPACE, Tcl_ListObjGetElements(), Tcl_SetStringObj(), Tcl_SetSystemEncoding(), TclGetLibraryPath(), TclWinGetPlatformId(), TclWinSetInterfaces(), and VER_PLATFORM_WIN32_CE.569 {
570     CONST char *encoding;
571     char buf[4 + TCL_INTEGER_SPACE];
572 
573     if (libraryPathEncodingFixed == 0) {
574   int platformId, useWide;
575 
576   platformId = TclWinGetPlatformId();
577   useWide = ((platformId == VER_PLATFORM_WIN32_NT)
578     || (platformId == VER_PLATFORM_WIN32_CE));
579   TclWinSetInterfaces(useWide);
580 
581   wsprintfA(buf, "cp%d", GetACP());
582   Tcl_SetSystemEncoding(NULL, buf);
583 
584   if (!useWide) {
585       Tcl_Obj *pathPtr = TclGetLibraryPath();
586       if (pathPtr != NULL) {
587     int i, objc;
588     Tcl_Obj **objv;
589     
590     objc = 0;
591     Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
592     for (i = 0; i < objc; i++) {
593         int length;
594         char *string;
595         Tcl_DString ds;
596 
597         string = Tcl_GetStringFromObj(objv[i], &length);
598         Tcl_ExternalToUtfDString(NULL, string, length, &ds);
599         Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds), 
600           Tcl_DStringLength(&ds));
601         Tcl_DStringFree(&ds);
602     }
603       }
604   }
605   
606   libraryPathEncodingFixed = 1;
607     } else {
608   wsprintfA(buf, "cp%d", GetACP());
609   Tcl_SetSystemEncoding(NULL, buf);
610     }
611 
612     /* This is only ever called from the startup thread */
613     if (binaryEncoding == NULL) {
614   /*
615    * Keep this encoding preloaded.  The IO package uses it for
616    * gets on a binary channel.
617    */
618   encoding = "iso8859-1";
619   binaryEncoding = Tcl_GetEncoding(NULL, encoding);
620     }
621 }
void TclpSetVariables (Tcl_Interp * interp)

Definition at line 642 of file tclWinInit.c.
References CONST, DWORD(), GetUserName(), NULL, NUMPLATFORMS, NUMPROCESSORS, platforms, processors, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringValue, Tcl_GetVar2(), TCL_GLOBAL_ONLY, TCL_INTEGER_SPACE, Tcl_SetVar2(), Tcl_WinTCharToUtf(), TclGetEnv(), and OemId::wProcessorArchitecture.644 {     
645     CONST char *ptr;
646     char buffer[TCL_INTEGER_SPACE * 2];
647     SYSTEM_INFO sysInfo;
648     OemId *oemId;
649     OSVERSIONINFOA osInfo;
650     Tcl_DString ds;
651     TCHAR szUserName[ UNLEN+1 ];
652     DWORD dwUserNameLen = sizeof(szUserName);
653 
654     osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
655     GetVersionExA(&osInfo);
656 
657     oemId = (OemId *) &sysInfo;
658     GetSystemInfo(&sysInfo);
659 
660     /*
661      * Define the tcl_platform array.
662      */
663 
664     Tcl_SetVar2(interp, "tcl_platform", "platform", "windows",
665       TCL_GLOBAL_ONLY);
666     if (osInfo.dwPlatformId < NUMPLATFORMS) {
667   Tcl_SetVar2(interp, "tcl_platform", "os",
668     platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY);
669     }
670     wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
671     Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
672     if (oemId->wProcessorArchitecture < NUMPROCESSORS) {
673   Tcl_SetVar2(interp, "tcl_platform", "machine",
674     processors[oemId->wProcessorArchitecture],
675     TCL_GLOBAL_ONLY);
676     }
677 
678 #ifdef _DEBUG
679     /*
680      * The existence of the "debug" element of the tcl_platform array indicates
681      * that this particular Tcl shell has been compiled with debug information.
682      * Using "info exists tcl_platform(debug)" a Tcl script can direct the 
683      * interpreter to load debug versions of DLLs with the load command.
684      */
685 
686     Tcl_SetVar2(interp, "tcl_platform", "debug", "1",
687       TCL_GLOBAL_ONLY);
688 #endif
689 
690     /*
691      * Set up the HOME environment variable from the HOMEDRIVE & HOMEPATH
692      * environment variables, if necessary.
693      */
694 
695     Tcl_DStringInit(&ds);
696     ptr = Tcl_GetVar2(interp, "env", "HOME", TCL_GLOBAL_ONLY);
697     if (ptr == NULL) {
698   ptr = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY);
699   if (ptr != NULL) {
700       Tcl_DStringAppend(&ds, ptr, -1);
701   }
702   ptr = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY);
703   if (ptr != NULL) {
704       Tcl_DStringAppend(&ds, ptr, -1);
705   }
706   if (Tcl_DStringLength(&ds) > 0) {
707       Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds),
708         TCL_GLOBAL_ONLY);
709   } else {
710       Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY);
711   }
712     }
713 
714     /*
715      * Initialize the user name from the environment first, since this is much
716      * faster than asking the system.
717      */
718 
719     Tcl_DStringInit( &ds );
720     if (TclGetEnv("USERNAME", &ds) == NULL) {
721 
722   if ( GetUserName( szUserName, &dwUserNameLen ) != 0 ) {
723       Tcl_WinTCharToUtf( szUserName, dwUserNameLen, &ds );
724   } 
725     }
726     Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds),
727       TCL_GLOBAL_ONLY);
728     Tcl_DStringFree(&ds);
729 }
void TclWinEncodingsCleanup ()

Definition at line 533 of file tclWinInit.c.
References binaryEncoding, libraryPathEncodingFixed, NULL, Tcl_FreeEncoding(), and TclWinResetInterfaceEncodings().
Referenced by TclFinalizeFilesystem().534 {
535     TclWinResetInterfaceEncodings();
536     libraryPathEncodingFixed = 0;
537     if (binaryEncoding != NULL) {
538   Tcl_FreeEncoding(binaryEncoding);
539   binaryEncoding = NULL;
540     }
541 }
static int ToUtf (CONST WCHAR * wSrc, char * dst) [static]

Definition at line 498 of file tclWinInit.c.
References Tcl_UniCharToUtf().
Referenced by AppendDllPath(), and AppendEnvironment().501 {
502     char *start;
503 
504     start = dst;
505     while (*wSrc != '\0') {
506   dst += Tcl_UniCharToUtf(*wSrc, dst);
507   wSrc++;
508     }
509     *dst = '\0';
510     return (int) (dst - start);
511 }

Variable Documentation
Tcl_Encoding binaryEncoding = NULL [static]

Definition at line 89 of file tclWinInit.c.int libraryPathEncodingFixed = 0 [static]

Definition at line 91 of file tclWinInit.c.char* platforms[NUMPLATFORMS] [static]
Initial value: {
    "Win32s", "Windows 95", "Windows NT", "Windows CE"
}
Definition at line 78 of file tclWinInit.c.
Referenced by TclpSetVariables().char* processors[NUMPROCESSORS] [static]
Initial value: {
    "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
    "amd64", "ia32_on_win64"
}
Definition at line 83 of file tclWinInit.c.
Referenced by TclpSetVariables().

win/tclWinInt.h File Reference
#include "tclInt.h"
#include "tclPort.h"
#include "tclIntPlatDecls.h"
Classes
union WIN32_FIND_DATAT
struct TclWinProcs
Defines
#define TCL_WIN_STACK_THRESHOLD  0x8000
#define VER_PLATFORM_WIN32_WINDOWS  1
#define VER_PLATFORM_WIN32_CE  3
#define FILE_ATTRIBUTE_REPARSE_POINT  0x00000400
#define TCL_STORAGE_CLASS  DLLIMPORT
Functions
EXTERN void TclWinEncodingsCleanup ()
EXTERN void TclWinResetInterfaceEncodings ()
EXTERN void TclWinInit (HINSTANCE hInst)
EXTERN int TclWinSymLinkCopyDirectory (CONST TCHAR *LinkOriginal, CONST TCHAR *LinkCopy)
EXTERN int TclWinSymLinkDelete (CONST TCHAR *LinkOriginal, int linkOnly)
EXTERN char TclWinDriveLetterForVolMountPoint (CONST WCHAR *mountPoint)
Variables
EXTERN TclWinProcs * tclWinProcs

Define Documentation
#define FILE_ATTRIBUTE_REPARSE_POINT  0x00000400

Definition at line 181 of file tclWinInt.h.
Referenced by DoCopyFile(), DoRemoveJustDirectory(), NativeStatMode(), TclpDeleteFile(), TclpObjNormalizePath(), and WinReadLinkDirectory().#define TCL_STORAGE_CLASS  DLLIMPORT

Definition at line 187 of file tclWinInt.h.#define TCL_WIN_STACK_THRESHOLD  0x8000

Definition at line 30 of file tclWinInt.h.
Referenced by TclpCheckStackSpace().#define VER_PLATFORM_WIN32_CE  3

Definition at line 47 of file tclWinInt.h.
Referenced by TclpSetInitialEncodings().#define VER_PLATFORM_WIN32_WINDOWS  1

Definition at line 44 of file tclWinInt.h.
Referenced by TclpCreateProcess(), and TclpObjNormalizePath().
Function Documentation
EXTERN char TclWinDriveLetterForVolMountPoint (CONST WCHAR * mountPoint)

Definition at line 850 of file tclWin32Dll.c.
References ckfree, MountPointMap::driveLetter, driveLetterLookup, MountPointMap::nextPtr, NULL, Tcl_MutexLock, Tcl_MutexUnlock, tclWinProcs, and MountPointMap::volumeName.
Referenced by WinReadLinkDirectory().851 {
852     MountPointMap *dlIter, *dlPtr2;
853     WCHAR Target[55];         /* Target of mount at mount point */
854     WCHAR drive[4] = { L'A', L':', L'\\', L'\0' };
855     
856     /* 
857      * Detect the volume mounted there.  Unfortunately, there is no
858      * simple way to map a unique volume name to a DOS drive letter.  
859      * So, we have to build an associative array.
860      */
861     
862     Tcl_MutexLock(&mountPointMap);
863     dlIter = driveLetterLookup; 
864     while (dlIter != NULL) {
865   if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
866       /* 
867        * We need to check whether this information is
868        * still valid, since either the user or various
869        * programs could have adjusted the mount points on
870        * the fly.
871        */
872       drive[0] = L'A' + (dlIter->driveLetter - 'A');
873       /* Try to read the volume mount point and see where it points */
874       if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive, 
875                  (TCHAR*)Target, 55) != 0) {
876     if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) {
877         /* Nothing has changed */
878         Tcl_MutexUnlock(&mountPointMap);
879         return dlIter->driveLetter;
880     }
881       }
882       /* 
883        * If we reach here, unfortunately, this mount point is
884        * no longer valid at all
885        */
886       if (driveLetterLookup == dlIter) {
887     dlPtr2 = dlIter;
888     driveLetterLookup = dlIter->nextPtr;
889       } else {
890     for (dlPtr2 = driveLetterLookup; 
891          dlPtr2 != NULL; dlPtr2 = dlPtr2->nextPtr) {
892         if (dlPtr2->nextPtr == dlIter) {
893       dlPtr2->nextPtr = dlIter->nextPtr;
894       dlPtr2 = dlIter;
895       break;
896         }
897     }
898       }
899       /* Now dlPtr2 points to the structure to free */
900       ckfree((char*)dlPtr2->volumeName);
901       ckfree((char*)dlPtr2);
902       /* 
903        * Restart the loop --- we could try to be clever
904        * and continue half way through, but the logic is a 
905        * bit messy, so it's cleanest just to restart
906        */
907       dlIter = driveLetterLookup;
908       continue;
909   }
910   dlIter = dlIter->nextPtr;
911     }
912    
913     /* We couldn't find it, so we must iterate over the letters */
914     
915     for (drive[0] = L'A'; drive[0] <= L'Z'; drive[0]++) {
916   /* Try to read the volume mount point and see where it points */
917   if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive, 
918              (TCHAR*)Target, 55) != 0) {
919       int alreadyStored = 0;
920       for (dlIter = driveLetterLookup; dlIter != NULL; 
921      dlIter = dlIter->nextPtr) {
922     if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) {
923         alreadyStored = 1;
924         break;
925     }
926       }
927       if (!alreadyStored) {
928     dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap));
929     dlPtr2->volumeName = TclNativeDupInternalRep(Target);
930     dlPtr2->driveLetter = 'A' + (drive[0] - L'A');
931     dlPtr2->nextPtr = driveLetterLookup;
932     driveLetterLookup  = dlPtr2;
933       }
934   }
935     }
936     /* Try again */
937     for (dlIter = driveLetterLookup; dlIter != NULL; 
938           dlIter = dlIter->nextPtr) {
939   if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
940       Tcl_MutexUnlock(&mountPointMap);
941       return dlIter->driveLetter;
942   }
943     }
944     /* 
945      * The volume doesn't appear to correspond to a drive letter -- we
946      * remember that fact and store '-1' so we don't have to look it
947      * up each time.
948      */
949     dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap));
950     dlPtr2->volumeName = TclNativeDupInternalRep((ClientData)mountPoint);
951     dlPtr2->driveLetter = -1;
952     dlPtr2->nextPtr = driveLetterLookup;
953     driveLetterLookup  = dlPtr2;
954     Tcl_MutexUnlock(&mountPointMap);
955     return -1;
956 }
EXTERN void TclWinEncodingsCleanup ()

Definition at line 533 of file tclWinInit.c.
References binaryEncoding, libraryPathEncodingFixed, NULL, Tcl_FreeEncoding(), and TclWinResetInterfaceEncodings().
Referenced by TclFinalizeFilesystem().534 {
535     TclWinResetInterfaceEncodings();
536     libraryPathEncodingFixed = 0;
537     if (binaryEncoding != NULL) {
538   Tcl_FreeEncoding(binaryEncoding);
539   binaryEncoding = NULL;
540     }
541 }
EXTERN void TclWinInit (HINSTANCE hInst)

Definition at line 428 of file tclWin32Dll.c.
References asciiProcs, hInstance, panic, platformId, and tclWinProcs.
Referenced by TclpInitPlatform().430 {
431     OSVERSIONINFO os;
432 
433     hInstance = hInst;
434     os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
435     GetVersionEx(&os);
436     platformId = os.dwPlatformId;
437 
438     /*
439      * We no longer support Win32s, so just in case someone manages to
440      * get a runtime there, make sure they know that.
441      */
442 
443     if (platformId == VER_PLATFORM_WIN32s) {
444   panic("Win32s is not a supported platform");  
445     }
446 
447     tclWinProcs = &asciiProcs;
448 }
EXTERN void TclWinResetInterfaceEncodings ()

Definition at line 787 of file tclWin32Dll.c.
References ckfree, driveLetterLookup, MountPointMap::nextPtr, NULL, Tcl_FreeEncoding(), Tcl_MutexLock, Tcl_MutexUnlock, tclWinTCharEncoding, and MountPointMap::volumeName.
Referenced by TclWinEncodingsCleanup().788 {
789     MountPointMap *dlIter, *dlIter2;
790     if (tclWinTCharEncoding != NULL) {
791   Tcl_FreeEncoding(tclWinTCharEncoding);
792   tclWinTCharEncoding = NULL;
793     }
794     /* Clean up the mount point map */
795     Tcl_MutexLock(&mountPointMap);
796     dlIter = driveLetterLookup; 
797     while (dlIter != NULL) {
798   dlIter2 = dlIter->nextPtr;
799   ckfree((char*)dlIter->volumeName);
800   ckfree((char*)dlIter);
801   dlIter = dlIter2;
802     }
803     Tcl_MutexUnlock(&mountPointMap);
804 }
EXTERN int TclWinSymLinkCopyDirectory (CONST TCHAR * LinkOriginal, CONST TCHAR * LinkCopy)

Definition at line 391 of file tclWinFile.c.
References NativeReadReparse(), and NativeWriteReparse().
Referenced by DoCopyFile().394 {
395     DUMMY_REPARSE_BUFFER dummy;
396     REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
397     
398     if (NativeReadReparse(LinkOriginal, reparseBuffer)) {
399   return -1;
400     }
401     return NativeWriteReparse(LinkCopy, reparseBuffer);
402 }
EXTERN int TclWinSymLinkDelete (CONST TCHAR * LinkOriginal, int linkOnly)

Definition at line 419 of file tclWinFile.c.
References DWORD(), FILE_FLAG_OPEN_REPARSE_POINT, FSCTL_DELETE_REPARSE_POINT, IO_REPARSE_TAG_MOUNT_POINT, NULL, REPARSE_MOUNTPOINT_HEADER_SIZE, _REPARSE_DATA_BUFFER::ReparseTag, TclWinConvertError(), and tclWinProcs.
Referenced by DoRemoveJustDirectory(), and TclpDeleteFile().422 {
423     /* It is a symbolic link -- remove it */
424     DUMMY_REPARSE_BUFFER dummy;
425     REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
426     HANDLE hFile;
427     DWORD returnedLength;
428     memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
429     reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
430     hFile = (*tclWinProcs->createFileProc)(LinkOriginal, GENERIC_WRITE, 0,
431   NULL, OPEN_EXISTING, 
432   FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
433     if (hFile != INVALID_HANDLE_VALUE) {
434   if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer, 
435            REPARSE_MOUNTPOINT_HEADER_SIZE,
436            NULL, 0, &returnedLength, NULL)) { 
437       /* Error setting junction */
438       TclWinConvertError(GetLastError());
439       CloseHandle(hFile);
440   } else {
441       CloseHandle(hFile);
442       if (!linkOnly) {
443           (*tclWinProcs->removeDirectoryProc)(LinkOriginal);
444       }
445       return 0;
446   }
447     }
448     return -1;
449 }

Variable Documentation
EXTERN TclWinProcs* tclWinProcs

Definition at line 156 of file tclWinInt.h.

win/tclWinLoad.c File Reference
#include "tclWinInt.h"
Functions
int TclpDlopen (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr)
Tcl_PackageInitProc * TclpFindSymbol (Tcl_Interp *interp, Tcl_LoadHandle loadHandle, CONST char *symbol)
void TclpUnloadFile (Tcl_LoadHandle loadHandle)
int TclGuessPackageName (CONST char *fileName, Tcl_DString *bufPtr)

Function Documentation
int TclGuessPackageName (CONST char * fileName, Tcl_DString * bufPtr)

Definition at line 223 of file tclWinLoad.c.228 {
229     return 0;
230 }
int TclpDlopen (Tcl_Interp * interp, Tcl_Obj * pathPtr, Tcl_LoadHandle * loadHandle, Tcl_FSUnloadFileProc ** unloadProcPtr)

Definition at line 38 of file tclWinLoad.c.
References ckalloc, CONST, DWORD(), NULL, Tcl_DStringFree(), TCL_ERROR, Tcl_FSGetNativePath(), Tcl_GetString(), TCL_INTEGER_SPACE, TCL_OK, Tcl_PosixError(), Tcl_WinUtfToTChar(), TclpUnloadFile(), TclWinConvertError(), and tclWinProcs.49 {
50     HINSTANCE handle;
51     CONST TCHAR *nativeName;
52 
53     /* 
54      * First try the full path the user gave us.  This is particularly
55      * important if the cwd is inside a vfs, and we are trying to load
56      * using a relative path.
57      */
58     nativeName = Tcl_FSGetNativePath(pathPtr);
59     handle = (*tclWinProcs->loadLibraryProc)(nativeName);
60     if (handle == NULL) {
61   /* 
62    * Let the OS loader examine the binary search path for
63    * whatever string the user gave us which hopefully refers
64    * to a file on the binary path
65    */
66   Tcl_DString ds;
67         char *fileName = Tcl_GetString(pathPtr);
68   nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
69   handle = (*tclWinProcs->loadLibraryProc)(nativeName);
70   Tcl_DStringFree(&ds);
71     }
72 
73     *loadHandle = (Tcl_LoadHandle) handle;
74     
75     if (handle == NULL) {
76   DWORD lastError = GetLastError();
77 #if 0
78   /*
79    * It would be ideal if the FormatMessage stuff worked better,
80    * but unfortunately it doesn't seem to want to...
81    */
82   LPTSTR lpMsgBuf;
83   char *buf;
84   int size;
85   size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
86     FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0,
87     (LPTSTR) &lpMsgBuf, 0, NULL);
88   buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1);
89   sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf);
90 #endif
91   Tcl_AppendResult(interp, "couldn't load library \"",
92        Tcl_GetString(pathPtr), "\": ", (char *) NULL);
93   /*
94    * Check for possible DLL errors.  This doesn't work quite right,
95    * because Windows seems to only return ERROR_MOD_NOT_FOUND for
96    * just about any problem, but it's better than nothing.  It'd be
97    * even better if there was a way to get what DLLs
98    */
99   switch (lastError) {
100       case ERROR_MOD_NOT_FOUND:
101       case ERROR_DLL_NOT_FOUND:
102     Tcl_AppendResult(interp, "this library or a dependent library",
103       " could not be found in library path",
104       (char *) NULL);
105     break;
106       case ERROR_PROC_NOT_FOUND:
107     Tcl_AppendResult(interp, "could not find specified procedure",
108       (char *) NULL);
109     break;
110       case ERROR_INVALID_DLL:
111     Tcl_AppendResult(interp, "this library or a dependent library",
112       " is damaged", (char *) NULL);
113     break;
114       case ERROR_DLL_INIT_FAILED:
115     Tcl_AppendResult(interp, "the library initialization",
116       " routine failed", (char *) NULL);
117     break;
118       default:
119     TclWinConvertError(lastError);
120     Tcl_AppendResult(interp, Tcl_PosixError(interp),
121       (char *) NULL);
122   }
123   return TCL_ERROR;
124     } else {
125   *unloadProcPtr = &TclpUnloadFile;
126     }
127     return TCL_OK;
128 }
Tcl_PackageInitProc* TclpFindSymbol (Tcl_Interp * interp, Tcl_LoadHandle loadHandle, CONST char * symbol)

Definition at line 146 of file tclWinLoad.c.
References NULL, Tcl_DStringAppend(), Tcl_DStringFree(), and Tcl_DStringInit().150 {
151     Tcl_PackageInitProc *proc = NULL;
152     HINSTANCE handle = (HINSTANCE)loadHandle;
153 
154     /*
155      * For each symbol, check for both Symbol and _Symbol, since Borland
156      * generates C symbols with a leading '_' by default.
157      */
158 
159     proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
160     if (proc == NULL) {
161   Tcl_DString ds;
162   Tcl_DStringInit(&ds);
163   Tcl_DStringAppend(&ds, "_", 1);
164   symbol = Tcl_DStringAppend(&ds, symbol, -1);
165   proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
166   Tcl_DStringFree(&ds);
167     }
168     return proc;
169 }
void TclpUnloadFile (Tcl_LoadHandle loadHandle)

Definition at line 190 of file tclWinLoad.c.195 {
196     HINSTANCE handle;
197 
198     handle = (HINSTANCE) loadHandle;
199     FreeLibrary(handle);
200 }

win/tclWinMtherr.c File Reference
#include "tclWinInt.h"
#include <math.h>
Functions
int _matherr (struct exception *xPtr)

Function Documentation
int _matherr (struct exception * xPtr)

Definition at line 40 of file tclWinMtherr.c.
References EDOM, ERANGE, and errno.42 {
43     if ((xPtr->type == DOMAIN)
44 #ifdef __BORLANDC__
45       || (xPtr->type == TLOSS)
46 #endif
47       || (xPtr->type == SING)) {
48   errno = EDOM;
49     } else {
50   errno = ERANGE;
51     }
52     return 1;
53 }

win/tclWinNotify.c File Reference
#include "tclWinInt.h"
Classes
struct ThreadSpecificData
Defines
#define INTERVAL_TIMER  1
#define WM_WAKEUP  WM_USER
Functions
TCL_DECLARE_MUTEX (notifierMutex)
void Tcl_FinalizeNotifier (ClientData clientData)
void Tcl_AlertNotifier (ClientData clientData)
void Tcl_SetTimer (Tcl_Time *timePtr)
void Tcl_ServiceModeHook (int mode)
static LRESULT CALLBACK NotifierProc (HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam)
int Tcl_WaitForEvent (Tcl_Time *timePtr)
void Tcl_Sleep (int ms)
Variables
static Tcl_ThreadDataKey dataKey
TclStubs tclStubs
Tcl_NotifierProcs tclOriginalNotifier
static int notifierCount = 0

Define Documentation
#define INTERVAL_TIMER  1

Definition at line 22 of file tclWinNotify.c.
Referenced by Tcl_FinalizeNotifier(), and Tcl_SetTimer().#define WM_WAKEUP  WM_USER

Definition at line 24 of file tclWinNotify.c.
Referenced by NotifierProc(), and Tcl_AlertNotifier().
Function Documentation
static LRESULT CALLBACK NotifierProc (HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam) [static]

Definition at line 380 of file tclWinNotify.c.
References ThreadSpecificData::crit, dataKey, ThreadSpecificData::pending, Tcl_ServiceAll(), TCL_TSD_INIT, and WM_WAKEUP.
Referenced by TCL_DECLARE_MUTEX().385 {
386     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
387 
388     if (message == WM_WAKEUP) {
389   EnterCriticalSection(&tsdPtr->crit);
390   tsdPtr->pending = 0;
391   LeaveCriticalSection(&tsdPtr->crit);
392     } else if (message != WM_TIMER) {
393   return DefWindowProc(hwnd, message, wParam, lParam);
394     }
395   
396     /*
397      * Process all of the runnable events.
398      */
399 
400     Tcl_ServiceAll();
401     return 0;
402 }
void Tcl_AlertNotifier (ClientData clientData)

Definition at line 215 of file tclWinNotify.c.
References ThreadSpecificData::crit, ThreadSpecificData::event, ThreadSpecificData::hwnd, ThreadSpecificData::pending, and WM_WAKEUP.217 {
218     ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
219 
220     /*
221      * Note that we do not need to lock around access to the hwnd
222      * because the race condition has no effect since any race condition
223      * implies that the notifier thread is already awake.
224      */
225 
226     if (tsdPtr->hwnd) {
227   /*
228    * We do need to lock around access to the pending flag.
229    */
230 
231   EnterCriticalSection(&tsdPtr->crit);
232   if (!tsdPtr->pending) {
233       PostMessage(tsdPtr->hwnd, WM_WAKEUP, 0, 0);
234   }
235   tsdPtr->pending = 1;
236   LeaveCriticalSection(&tsdPtr->crit);
237     } else {
238   SetEvent(tsdPtr->event);
239     }
240 }
TCL_DECLARE_MUTEX (notifierMutex)

Definition at line 59 of file tclWinNotify.c.
References ThreadSpecificData::crit, dataKey, ThreadSpecificData::event, FALSE, ThreadSpecificData::hwnd, notifierCount, NotifierProc(), NULL, panic, ThreadSpecificData::pending, Tcl_MutexLock, Tcl_MutexUnlock, TCL_TSD_INIT, ThreadSpecificData::thread, ThreadSpecificData::timerActive, and TRUE.76           :
77  *  Returns a handle to the notifier state for this thread..
78  *
79  * Side effects:
80  *  None.
81  *
82  *----------------------------------------------------------------------
83  */
84 
85 ClientData
86 Tcl_InitNotifier()
87 {
88     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
89     WNDCLASS class;
90 
91     /*
92      * Register Notifier window class if this is the first thread to
93      * use this module.
94      */
95 
96     Tcl_MutexLock(&notifierMutex);
97     if (notifierCount == 0) {
98   class.style = 0;
99   class.cbClsExtra = 0;
100   class.cbWndExtra = 0;
101   class.hInstance = TclWinGetTclInstance();
102   class.hbrBackground = NULL;
103   class.lpszMenuName = NULL;
104   class.lpszClassName = "TclNotifier";
105   class.lpfnWndProc = NotifierProc;
106   class.hIcon = NULL;
107   class.hCursor = NULL;
108 
109   if (!RegisterClassA(&class)) {
110       panic("Unable to register TclNotifier window class");
111   }
112     }
113     notifierCount++;
114     Tcl_MutexUnlock(&notifierMutex);
115 
116     tsdPtr->pending = 0;
117     tsdPtr->timerActive = 0;
118 
119     InitializeCriticalSection(&tsdPtr->crit);
120 
121     tsdPtr->hwnd = NULL;
122     tsdPtr->thread = GetCurrentThreadId();
123     tsdPtr->event = CreateEvent(NULL, TRUE /* manual */,
124       FALSE /* !signaled */, NULL);
125 
126     return (ClientData) tsdPtr;
127 }

void Tcl_FinalizeNotifier (ClientData clientData)

Definition at line 147 of file tclWinNotify.c.
References ThreadSpecificData::crit, ThreadSpecificData::event, ThreadSpecificData::hwnd, INTERVAL_TIMER, notifierCount, NULL, Tcl_MutexLock, and Tcl_MutexUnlock.149 {
150     ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
151 
152     /*
153      * Only finalize the notifier if a notifier was installed in the
154      * current thread; there is a route in which this is not
155      * guaranteed to be true (when tclWin32Dll.c:DllMain() is called
156      * with the flag DLL_PROCESS_DETACH by the OS, which could be
157      * doing so from a thread that's never previously been involved
158      * with Tcl, e.g. the task manager) so this check is important.
159      *
160      * Fixes Bug #217982 reported by Hugh Vu and Gene Leache.
161      */
162     if (tsdPtr == NULL) {
163   return;
164     }
165 
166     DeleteCriticalSection(&tsdPtr->crit);
167     CloseHandle(tsdPtr->event);
168 
169     /*
170      * Clean up the timer and messaging window for this thread.
171      */
172 
173     if (tsdPtr->hwnd) {
174   KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
175   DestroyWindow(tsdPtr->hwnd);
176     }
177 
178     /*
179      * If this is the last thread to use the notifier, unregister
180      * the notifier window class.
181      */
182 
183     Tcl_MutexLock(&notifierMutex);
184     notifierCount--;
185     if (notifierCount == 0) {
186   UnregisterClassA("TclNotifier", TclWinGetTclInstance());
187     }
188     Tcl_MutexUnlock(&notifierMutex);
189 }
void Tcl_ServiceModeHook (int mode)

Definition at line 330 of file tclWinNotify.c.
References dataKey, ThreadSpecificData::hwnd, NULL, Tcl_AlertNotifier(), TCL_SERVICE_ALL, and TCL_TSD_INIT.333 {
334     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
335 
336     /*
337      * If this is the first time that the notifier has been used from a
338      * modal loop, then create a communication window.  Note that after
339      * this point, the application needs to service events in a timely
340      * fashion or Windows will hang waiting for the window to respond
341      * to synchronous system messages.  At some point, we may want to
342      * consider destroying the window if we leave the modal loop, but
343      * for now we'll leave it around.
344      */
345 
346     if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) {
347   tsdPtr->hwnd = CreateWindowA("TclNotifier", "TclNotifier", WS_TILED,
348     0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL);
349   /*
350    * Send an initial message to the window to ensure that we wake up the
351    * notifier once we get into the modal loop.  This will force the
352    * notifier to recompute the timeout value and schedule a timer
353    * if one is needed.
354    */
355 
356   Tcl_AlertNotifier((ClientData)tsdPtr);
357     }
358 }
void Tcl_SetTimer (Tcl_Time * timePtr)

Definition at line 261 of file tclWinNotify.c.
References dataKey, ThreadSpecificData::hwnd, INTERVAL_TIMER, NULL, Tcl_Time::sec, SetTimer(), Tcl_NotifierProcs::setTimerProc, TCL_TSD_INIT, tclOriginalNotifier, tclStubs, ThreadSpecificData::timeout, ThreadSpecificData::timerActive, and Tcl_Time::usec.263 {
264     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
265     UINT timeout;
266 
267     /*
268      * Allow the notifier to be hooked.  This may not make sense
269      * on Windows, but mirrors the UNIX hook.
270      */
271 
272     if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) {
273   tclStubs.tcl_SetTimer(timePtr);
274   return;
275     }
276 
277     /*
278      * We only need to set up an interval timer if we're being called
279      * from an external event loop.  If we don't have a window handle
280      * then we just return immediately and let Tcl_WaitForEvent handle
281      * timeouts.
282      */
283 
284     if (!tsdPtr->hwnd) {
285   return;
286     }
287 
288     if (!timePtr) {
289   timeout = 0;
290     } else {
291   /*
292    * Make sure we pass a non-zero value into the timeout argument.
293    * Windows seems to get confused by zero length timers.
294    */
295 
296   timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
297   if (timeout == 0) {
298       timeout = 1;
299   }
300     }
301     tsdPtr->timeout = timeout;
302     if (timeout != 0) {
303   tsdPtr->timerActive = 1;
304   SetTimer(tsdPtr->hwnd, INTERVAL_TIMER,
305         (unsigned long) tsdPtr->timeout, NULL);
306     } else {
307   tsdPtr->timerActive = 0;
308   KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
309     }
310 }
void Tcl_Sleep (int ms)

Definition at line 523 of file tclWinNotify.c.
References DWORD(), Tcl_Time::sec, Tcl_GetTime(), and Tcl_Time::usec.525 {
526     /*
527      * Simply calling 'Sleep' for the requisite number of milliseconds
528      * can make the process appear to wake up early because it isn't
529      * synchronized with the CPU performance counter that is used in
530      * tclWinTime.c.  This behavior is probably benign, but messes
531      * up some of the corner cases in the test suite.  We get around
532      * this problem by repeating the 'Sleep' call as many times
533      * as necessary to make the clock advance by the requisite amount.
534      */
535 
536     Tcl_Time now;   /* Current wall clock time */
537     Tcl_Time desired;   /* Desired wakeup time */
538     DWORD sleepTime = ms; /* Time to sleep */
539 
540     Tcl_GetTime( &now );
541     desired.sec = now.sec + ( ms / 1000 );
542     desired.usec = now.usec + 1000 * ( ms % 1000 );
543     if ( desired.usec > 1000000 ) {
544   ++desired.sec;
545   desired.usec -= 1000000;
546     }
547   
548     for ( ; ; ) {
549   Sleep( sleepTime );
550   Tcl_GetTime( &now );
551   if ( now.sec > desired.sec ) {
552       break;
553   } else if ( ( now.sec == desired.sec )
554        && ( now.usec >= desired.usec ) ) {
555       break;
556   }
557   sleepTime = ( ( 1000 * ( desired.sec - now.sec ) )
558           + ( ( desired.usec - now.usec ) / 1000 ) );
559     }
560 
561 }
int Tcl_WaitForEvent (Tcl_Time * timePtr)

Definition at line 425 of file tclWinNotify.c.
References dataKey, DWORD(), ThreadSpecificData::event, FALSE, NULL, Tcl_Time::sec, status, TCL_TSD_INIT, tclOriginalNotifier, tclStubs, Tcl_Time::usec, and Tcl_NotifierProcs::waitForEventProc.427 {
428     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
429     MSG msg;
430     DWORD timeout, result;
431     int status;
432 
433     /*
434      * Allow the notifier to be hooked.  This may not make
435      * sense on windows, but mirrors the UNIX hook.
436      */
437 
438     if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) {
439   return tclStubs.tcl_WaitForEvent(timePtr);
440     }
441 
442     /*
443      * Compute the timeout in milliseconds.
444      */
445 
446     if (timePtr) {
447   timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
448     } else {
449   timeout = INFINITE;
450     }
451 
452     /*
453      * Check to see if there are any messages in the queue before waiting
454      * because MsgWaitForMultipleObjects will not wake up if there are events
455      * currently sitting in the queue.
456      */
457 
458     if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
459   /*
460    * Wait for something to happen (a signal from another thread, a
461    * message, or timeout).
462    */
463 
464   result = MsgWaitForMultipleObjects(1, &tsdPtr->event, FALSE, timeout,
465     QS_ALLINPUT);
466     }
467 
468     /*
469      * Check to see if there are any messages to process.
470      */
471 
472     if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
473   /*
474    * Retrieve and dispatch the first message.
475    */
476 
477   result = GetMessage(&msg, NULL, 0, 0);
478   if (result == 0) {
479       /*
480        * We received a request to exit this thread (WM_QUIT), so
481        * propagate the quit message and start unwinding.
482        */
483 
484       PostQuitMessage((int) msg.wParam);
485       status = -1;
486   } else if (result == -1) {
487       /*
488        * We got an error from the system.  I have no idea why this would
489        * happen, so we'll just unwind.
490        */
491 
492       status = -1;
493   } else {
494       TranslateMessage(&msg);
495       DispatchMessage(&msg);
496       status = 1;
497   }
498     } else {
499   status = 0;
500     }
501 
502     ResetEvent(tsdPtr->event);
503     return status;
504 }

Variable Documentation
Tcl_ThreadDataKey dataKey [static]

Definition at line 45 of file tclWinNotify.c.int notifierCount = 0 [static]

Definition at line 58 of file tclWinNotify.c.
Referenced by TCL_DECLARE_MUTEX(), Tcl_FinalizeNotifier(), and Tcl_InitNotifier().Tcl_NotifierProcs tclOriginalNotifier

Definition at line 46 of file tclStubInit.c.TclStubs tclStubs

Definition at line 411 of file tclStubInit.c.

win/tclWinPipe.c File Reference
#include "tclWinInt.h"
#include <fcntl.h>
#include <io.h>
#include <sys/stat.h>
Classes
struct ProcInfo
struct PipeInfo
struct ThreadSpecificData
struct PipeEvent
Defines
#define APPL_NONE  0
#define APPL_DOS  1
#define APPL_WIN3X  2
#define APPL_WIN32  3
#define WIN_FILE  3
#define PIPE_PENDING  (1<<0)
#define PIPE_ASYNC  (1<<1)
#define PIPE_EOF  (1<<2)
#define PIPE_EXTRABYTE  (1<<3)
Functions
TCL_DECLARE_MUTEX (pipeMutex)
static int ApplicationType (Tcl_Interp *interp, const char *fileName, char *fullName)
static void BuildCommandLine (const char *executable, int argc, CONST char **argv, Tcl_DString *linePtr)
static BOOL HasConsole (void)
static int PipeBlockModeProc (ClientData instanceData, int mode)
static void PipeCheckProc (ClientData clientData, int flags)
static int PipeClose2Proc (ClientData instanceData, Tcl_Interp *interp, int flags)
static int PipeEventProc (Tcl_Event *evPtr, int flags)
static int PipeGetHandleProc (ClientData instanceData, int direction, ClientData *handlePtr)
static void PipeInit (void)
static int PipeInputProc (ClientData instanceData, char *buf, int toRead, int *errorCode)
static int PipeOutputProc (ClientData instanceData, CONST char *buf, int toWrite, int *errorCode)
static DWORD WINAPI PipeReaderThread (LPVOID arg)
static void PipeSetupProc (ClientData clientData, int flags)
static void PipeWatchProc (ClientData instanceData, int mask)
static DWORD WINAPI PipeWriterThread (LPVOID arg)
static int TempFileName (WCHAR name[MAX_PATH])
static int WaitForRead (PipeInfo *infoPtr, int blocking)
static void PipeThreadActionProc _ANSI_ARGS_ ((ClientData instanceData, int action))
void TclpFinalizePipes ()
TclFile TclWinMakeFile (HANDLE handle)
static int TempFileName (name)
TclFile TclpMakeFile (Tcl_Channel channel, int direction)
TclFile TclpOpenFile (CONST char *path, int mode)
TclFile TclpCreateTempFile (CONST char *contents)
Tcl_Obj * TclpTempFileName ()
int TclpCreatePipe (TclFile *readPipe, TclFile *writePipe)
int TclpCloseFile (TclFile file)
unsigned long TclpGetPid (Tcl_Pid pid)
int TclpCreateProcess (Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr)
static int ApplicationType (Tcl_Interp *interp, const char *originalName, fullName)
static void BuildCommandLine (CONST char *executable, int argc, CONST char **argv, Tcl_DString *linePtr)
Tcl_Channel TclpCreateCommandChannel (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)
void TclGetAndDetachPids (Tcl_Interp *interp, Tcl_Channel chan)
Tcl_Pid Tcl_WaitPid (Tcl_Pid pid, int *statPtr, int options)
void TclWinAddProcess (HANDLE hProcess, DWORD id)
int Tcl_PidObjCmd (ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST *objv)
static void PipeThreadActionProc (ClientData instanceData, int action)
Variables
static int initialized = 0
WinFile
static ProcInfo * procList
static Tcl_ThreadDataKey dataKey
static Tcl_ChannelType pipeChannelType

Define Documentation
#define APPL_DOS  1

Referenced by ApplicationType(), and TclpCreateProcess().#define APPL_NONE  0

Referenced by ApplicationType(), and TclpCreateProcess().#define APPL_WIN32  3

Referenced by ApplicationType().#define APPL_WIN3X  2

Referenced by ApplicationType().#define PIPE_ASYNC  (1<<1)

Definition at line 81 of file tclWinPipe.c.
Referenced by PipeBlockModeProc(), PipeClose2Proc(), PipeInputProc(), and PipeOutputProc().#define PIPE_EOF  (1<<2)

Definition at line 87 of file tclWinPipe.c.
Referenced by PipeEventProc(), PipeInputProc(), PipeReaderThread(), and WaitForRead().#define PIPE_EXTRABYTE  (1<<3)

Definition at line 88 of file tclWinPipe.c.
Referenced by PipeInputProc(), PipeReaderThread(), and WaitForRead().#define PIPE_PENDING  (1<<0)

Definition at line 80 of file tclWinPipe.c.
Referenced by PipeCheckProc(), and PipeEventProc().#define WIN_FILE  3

Referenced by TclpCloseFile(), TclpCreateProcess(), and TclWinMakeFile().
Function Documentation
static void PipeThreadActionProc _ANSI_ARGS_ ((ClientData instanceData, int action)) [static]
static int ApplicationType (Tcl_Interp * interp, const char * originalName, fullName) [static]

Definition at line 1362 of file tclWinPipe.c.
References APPL_DOS, APPL_NONE, APPL_WIN32, APPL_WIN3X, CONST, DWORD(), NULL, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringSetLength(), Tcl_DStringValue, Tcl_PosixError(), Tcl_WinTCharToUtf(), Tcl_WinUtfToTChar(), TclWinConvertError(), and tclWinProcs.1367 {
1368     int applType, i, nameLen, found;
1369     HANDLE hFile;
1370     TCHAR *rest;
1371     char *ext;
1372     char buf[2];
1373     DWORD attr, read;
1374     IMAGE_DOS_HEADER header;
1375     Tcl_DString nameBuf, ds;
1376     CONST TCHAR *nativeName;
1377     WCHAR nativeFullPath[MAX_PATH];
1378     static char extensions[][5] = {"", ".com", ".exe", ".bat"};
1379 
1380     /* Look for the program as an external program.  First try the name
1381      * as it is, then try adding .com, .exe, and .bat, in that order, to
1382      * the name, looking for an executable.
1383      *
1384      * Using the raw SearchPath() procedure doesn't do quite what is 
1385      * necessary.  If the name of the executable already contains a '.' 
1386      * character, it will not try appending the specified extension when
1387      * searching (in other words, SearchPath will not find the program 
1388      * "a.b.exe" if the arguments specified "a.b" and ".exe").   
1389      * So, first look for the file as it is named.  Then manually append 
1390      * the extensions, looking for a match.  
1391      */
1392 
1393     applType = APPL_NONE;
1394     Tcl_DStringInit(&nameBuf);
1395     Tcl_DStringAppend(&nameBuf, originalName, -1);
1396     nameLen = Tcl_DStringLength(&nameBuf);
1397 
1398     for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) {
1399   Tcl_DStringSetLength(&nameBuf, nameLen);
1400   Tcl_DStringAppend(&nameBuf, extensions[i], -1);
1401         nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf), 
1402     Tcl_DStringLength(&nameBuf), &ds);
1403   found = (*tclWinProcs->searchPathProc)(NULL, nativeName, NULL, 
1404     MAX_PATH, nativeFullPath, &rest);
1405   Tcl_DStringFree(&ds);
1406   if (found == 0) {
1407       continue;
1408   }
1409 
1410   /*
1411    * Ignore matches on directories or data files, return if identified
1412    * a known type.
1413    */
1414 
1415   attr = (*tclWinProcs->getFileAttributesProc)((TCHAR *) nativeFullPath);
1416   if ((attr == 0xffffffff) || (attr & FILE_ATTRIBUTE_DIRECTORY)) {
1417       continue;
1418   }
1419   strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
1420   Tcl_DStringFree(&ds);
1421 
1422   ext = strrchr(fullName, '.');
1423   if ((ext != NULL) && (stricmp(ext, ".bat") == 0)) {
1424       applType = APPL_DOS;
1425       break;
1426   }
1427   
1428   hFile = (*tclWinProcs->createFileProc)((TCHAR *) nativeFullPath, 
1429     GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, 
1430     FILE_ATTRIBUTE_NORMAL, NULL);
1431   if (hFile == INVALID_HANDLE_VALUE) {
1432       continue;
1433   }
1434 
1435   header.e_magic = 0;
1436   ReadFile(hFile, (void *) &header, sizeof(header), &read, NULL);
1437   if (header.e_magic != IMAGE_DOS_SIGNATURE) {
1438       /* 
1439        * Doesn't have the magic number for relocatable executables.  If 
1440        * filename ends with .com, assume it's a DOS application anyhow.
1441        * Note that we didn't make this assumption at first, because some
1442        * supposed .com files are really 32-bit executables with all the
1443        * magic numbers and everything.  
1444        */
1445 
1446       CloseHandle(hFile);
1447       if ((ext != NULL) && (stricmp(ext, ".com") == 0)) {
1448     applType = APPL_DOS;
1449     break;
1450       }
1451       continue;
1452   }
1453   if (header.e_lfarlc != sizeof(header)) {
1454       /* 
1455        * All Windows 3.X and Win32 and some DOS programs have this value
1456        * set here.  If it doesn't, assume that since it already had the 
1457        * other magic number it was a DOS application.
1458        */
1459 
1460       CloseHandle(hFile);
1461       applType = APPL_DOS;
1462       break;
1463   }
1464 
1465   /* 
1466    * The DWORD at header.e_lfanew points to yet another magic number.
1467    */
1468 
1469   buf[0] = '\0';
1470   SetFilePointer(hFile, header.e_lfanew, NULL, FILE_BEGIN);
1471   ReadFile(hFile, (void *) buf, 2, &read, NULL);
1472   CloseHandle(hFile);
1473 
1474   if ((buf[0] == 'N') && (buf[1] == 'E')) {
1475       applType = APPL_WIN3X;
1476   } else if ((buf[0] == 'P') && (buf[1] == 'E')) {
1477       applType = APPL_WIN32;
1478   } else {
1479       /*
1480        * Strictly speaking, there should be a test that there
1481        * is an 'L' and 'E' at buf[0..1], to identify the type as 
1482        * DOS, but of course we ran into a DOS executable that 
1483        * _doesn't_ have the magic number -- specifically, one
1484        * compiled using the Lahey Fortran90 compiler.
1485        */
1486 
1487       applType = APPL_DOS;
1488   }
1489   break;
1490     }
1491     Tcl_DStringFree(&nameBuf);
1492 
1493     if (applType == APPL_NONE) {
1494   TclWinConvertError(GetLastError());
1495   Tcl_AppendResult(interp, "couldn't execute \"", originalName,
1496     "\": ", Tcl_PosixError(interp), (char *) NULL);
1497   return APPL_NONE;
1498     }
1499 
1500     if ((applType == APPL_DOS) || (applType == APPL_WIN3X)) {
1501   /* 
1502    * Replace long path name of executable with short path name for 
1503    * 16-bit applications.  Otherwise the application may not be able
1504    * to correctly parse its own command line to separate off the 
1505    * application name from the arguments.
1506    */
1507 
1508   (*tclWinProcs->getShortPathNameProc)((TCHAR *) nativeFullPath, 
1509     nativeFullPath, MAX_PATH);
1510   strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
1511   Tcl_DStringFree(&ds);
1512     }
1513     return applType;
1514 }
static int ApplicationType (Tcl_Interp * interp, const char * fileName, char * fullName) [static]

Referenced by TclpCreateProcess().static void BuildCommandLine (CONST char * executable, int argc, CONST char ** argv, Tcl_DString * linePtr) [static]

Definition at line 1536 of file tclWinPipe.c.
References CONST, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringValue, Tcl_UniCharIsSpace(), Tcl_UtfToUniChar(), and Tcl_WinUtfToTChar().1543 {
1544     CONST char *arg, *start, *special;
1545     int quote, i;
1546     Tcl_DString ds;
1547 
1548     Tcl_DStringInit(&ds);
1549 
1550     /*
1551      * Prime the path.  Add a space separator if we were primed with
1552      * something.
1553      */
1554 
1555     Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1);
1556     if (Tcl_DStringLength(&ds) > 0) Tcl_DStringAppend(&ds, " ", 1);
1557 
1558     for (i = 0; i < argc; i++) {
1559   if (i == 0) {
1560       arg = executable;
1561   } else {
1562       arg = argv[i];
1563       Tcl_DStringAppend(&ds, " ", 1);
1564   }
1565 
1566   quote = 0;
1567   if (arg[0] == '\0') {
1568       quote = 1;
1569   } else {
1570       int count;
1571       Tcl_UniChar ch;
1572       for (start = arg; *start != '\0'; start += count) {
1573           count = Tcl_UtfToUniChar(start, &ch);
1574     if (Tcl_UniCharIsSpace(ch)) { /* INTL: ISO space. */
1575         quote = 1;
1576         break;
1577     }
1578       }
1579   }
1580   if (quote) {
1581       Tcl_DStringAppend(&ds, "\"", 1);
1582   }
1583   start = arg;      
1584   for (special = arg; ; ) {
1585       if ((*special == '\\') && 
1586         (special[1] == '\\' || special[1] == '"' || (quote && special[1] == '\0'))) {
1587     Tcl_DStringAppend(&ds, start, (int) (special - start));
1588     start = special;
1589     while (1) {
1590         special++;
1591         if (*special == '"' || (quote && *special == '\0')) {
1592       /* 
1593        * N backslashes followed a quote -> insert 
1594        * N * 2 + 1 backslashes then a quote.
1595        */
1596 
1597       Tcl_DStringAppend(&ds, start,
1598         (int) (special - start));
1599       break;
1600         }
1601         if (*special != '\\') {
1602       break;
1603         }
1604     }
1605     Tcl_DStringAppend(&ds, start, (int) (special - start));
1606     start = special;
1607       }
1608       if (*special == '"') {
1609     Tcl_DStringAppend(&ds, start, (int) (special - start));
1610     Tcl_DStringAppend(&ds, "\\\"", 2);
1611     start = special + 1;
1612       }
1613       if (*special == '\0') {
1614     break;
1615       }
1616       special++;
1617   }
1618   Tcl_DStringAppend(&ds, start, (int) (special - start));
1619   if (quote) {
1620       Tcl_DStringAppend(&ds, "\"", 1);
1621   }
1622     }
1623     Tcl_DStringFree(linePtr);
1624     Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr);
1625     Tcl_DStringFree(&ds);
1626 }
static void BuildCommandLine (const char * executable, int argc, CONST char ** argv, Tcl_DString * linePtr) [static]

Referenced by TclpCreateProcess().static BOOL HasConsole (void) [static]

Definition at line 1310 of file tclWinPipe.c.
References FALSE, NULL, and TRUE.
Referenced by TclpCreateProcess().1311 {
1312     HANDLE handle;
1313     
1314     handle = CreateFileA("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE,
1315       NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
1316 
1317     if (handle != INVALID_HANDLE_VALUE) {
1318         CloseHandle(handle);
1319   return TRUE;
1320     } else {
1321         return FALSE;
1322     }
1323 }
static int PipeBlockModeProc (ClientData instanceData, int mode) [static]

Definition at line 1813 of file tclWinPipe.c.
References PipeInfo::flags, PIPE_ASYNC, and TCL_MODE_NONBLOCKING.1817 {
1818     PipeInfo *infoPtr = (PipeInfo *) instanceData;
1819     
1820     /*
1821      * Pipes on Windows can not be switched between blocking and nonblocking,
1822      * hence we have to emulate the behavior. This is done in the input
1823      * function by checking against a bit in the state. We set or unset the
1824      * bit here to cause the input function to emulate the correct behavior.
1825      */
1826 
1827     if (mode == TCL_MODE_NONBLOCKING) {
1828   infoPtr->flags |= PIPE_ASYNC;
1829     } else {
1830   infoPtr->flags &= ~(PIPE_ASYNC);
1831     }
1832     return 0;
1833 }
static void PipeCheckProc (ClientData clientData, int flags) [static]

Definition at line 378 of file tclWinPipe.c.
References ckalloc, ThreadSpecificData::firstPipePtr, PipeInfo::flags, PipeEvent::header, PipeEvent::infoPtr, PipeInfo::nextPtr, NULL, PIPE_PENDING, PipeEventProc(), Tcl_Event::proc, PipeInfo::readFile, TCL_FILE_EVENTS, TCL_QUEUE_TAIL, Tcl_QueueEvent(), TCL_READABLE, TCL_TSD_INIT, TCL_WRITABLE, WaitForRead(), PipeInfo::watchMask, WinFile, PipeInfo::writable, and PipeInfo::writeFile.
Referenced by PipeInit(), and TclpFinalizePipes().381 {
382     PipeInfo *infoPtr;
383     PipeEvent *evPtr;
384     WinFile *filePtr;
385     int needEvent;
386     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
387 
388     if (!(flags & TCL_FILE_EVENTS)) {
389   return;
390     }
391     
392     /*
393      * Queue events for any ready pipes that don't already have events
394      * queued.
395      */
396 
397     for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL; 
398       infoPtr = infoPtr->nextPtr) {
399   if (infoPtr->flags & PIPE_PENDING) {
400       continue;
401   }
402   
403   /*
404    * Queue an event if the pipe is signaled for reading or writing.
405    */
406 
407   needEvent = 0;
408   filePtr = (WinFile*) infoPtr->writeFile;
409   if ((infoPtr->watchMask & TCL_WRITABLE) &&
410     (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) {
411       needEvent = 1;
412   }
413   
414   filePtr = (WinFile*) infoPtr->readFile;
415   if ((infoPtr->watchMask & TCL_READABLE) &&
416     (WaitForRead(infoPtr, 0) >= 0)) {
417       needEvent = 1;
418   }
419 
420   if (needEvent) {
421       infoPtr->flags |= PIPE_PENDING;
422       evPtr = (PipeEvent *) ckalloc(sizeof(PipeEvent));
423       evPtr->header.proc = PipeEventProc;
424       evPtr->infoPtr = infoPtr;
425       Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
426   }
427     }
428 }
static int PipeClose2Proc (ClientData instanceData, Tcl_Interp * interp, int flags) [static]

Definition at line 1852 of file tclWinPipe.c.
References ckfree, DWORD(), errno, PipeInfo::errorFile, ThreadSpecificData::firstPipePtr, PipeInfo::flags, PipeInfo::nextPtr, NULL, PipeInfo::numPids, PipeInfo::pidPtr, PIPE_ASYNC, PipeInfo::readable, PipeInfo::readFile, PipeInfo::readThread, PipeInfo::startReader, PipeInfo::startWriter, PipeInfo::stopReader, PipeInfo::stopWriter, TCL_CLOSE_READ, TCL_CLOSE_WRITE, Tcl_DetachPids(), Tcl_MakeFileChannel(), Tcl_MutexLock, Tcl_MutexUnlock, TCL_READABLE, Tcl_ReapDetachedProcs(), TCL_TSD_INIT, TCL_WRITABLE, TclCleanupChildren(), TclInExit(), TclpCloseFile(), PipeInfo::validMask, PipeInfo::watchMask, WinFile, PipeInfo::writable, PipeInfo::writeBuf, PipeInfo::writeFile, and PipeInfo::writeThread.1856 {
1857     PipeInfo *pipePtr = (PipeInfo *) instanceData;
1858     Tcl_Channel errChan;
1859     int errorCode, result;
1860     PipeInfo *infoPtr, **nextPtrPtr;
1861     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1862     DWORD exitCode;
1863 
1864     errorCode = 0;
1865     if ((!flags || (flags == TCL_CLOSE_READ))
1866   && (pipePtr->readFile != NULL)) {
1867   /*
1868    * Clean up the background thread if necessary.  Note that this
1869    * must be done before we can close the file, since the 
1870    * thread may be blocking trying to read from the pipe.
1871    */
1872 
1873   if (pipePtr->readThread) {
1874       /*
1875        * The thread may already have closed on it's own.  Check it's
1876        * exit code.
1877        */
1878 
1879       GetExitCodeThread(pipePtr->readThread, &exitCode);
1880 
1881       if (exitCode == STILL_ACTIVE) {
1882     /*
1883      * Set the stop event so that if the reader thread is blocked
1884      * in PipeReaderThread on WaitForMultipleEvents, it will exit
1885      * cleanly.
1886      */
1887 
1888     SetEvent(pipePtr->stopReader);
1889 
1890     /*
1891      * Wait at most 20 milliseconds for the reader thread to close.
1892      */
1893 
1894     if (WaitForSingleObject(pipePtr->readThread, 20)
1895         == WAIT_TIMEOUT) {
1896         /*
1897          * The thread must be blocked waiting for the pipe to
1898          * become readable in ReadFile().  There isn't a clean way
1899          * to exit the thread from this condition.  We should
1900          * terminate the child process instead to get the reader
1901          * thread to fall out of ReadFile with a FALSE.  (below) is
1902          * not the correct way to do this, but will stay here until
1903          * a better solution is found.
1904          *
1905          * Note that we need to guard against terminating the
1906          * thread while it is in the middle of Tcl_ThreadAlert
1907          * because it won't be able to release the notifier lock.
1908          */
1909 
1910         Tcl_MutexLock(&pipeMutex);
1911 
1912         /* BUG: this leaks memory */
1913         TerminateThread(pipePtr->readThread, 0);
1914         Tcl_MutexUnlock(&pipeMutex);
1915     }
1916       }
1917 
1918       CloseHandle(pipePtr->readThread);
1919       CloseHandle(pipePtr->readable);
1920       CloseHandle(pipePtr->startReader);
1921       CloseHandle(pipePtr->stopReader);
1922       pipePtr->readThread = NULL;
1923   }
1924   if (TclpCloseFile(pipePtr->readFile) != 0) {
1925       errorCode = errno;
1926   }
1927   pipePtr->validMask &= ~TCL_READABLE;
1928   pipePtr->readFile = NULL;
1929     }
1930     if ((!flags || (flags & TCL_CLOSE_WRITE))
1931   && (pipePtr->writeFile != NULL)) {
1932 
1933   if (pipePtr->writeThread) {
1934       /*
1935        * Wait for the writer thread to finish the current buffer,
1936        * then terminate the thread and close the handles.  If the
1937        * channel is nonblocking, there should be no pending write
1938        * operations.
1939        */
1940 
1941       WaitForSingleObject(pipePtr->writable, INFINITE);
1942 
1943       /*
1944        * The thread may already have closed on it's own.  Check it's
1945        * exit code.
1946        */
1947 
1948       GetExitCodeThread(pipePtr->writeThread, &exitCode);
1949 
1950       if (exitCode == STILL_ACTIVE) {
1951     /*
1952      * Set the stop event so that if the reader thread is blocked
1953      * in PipeReaderThread on WaitForMultipleEvents, it will exit
1954      * cleanly.
1955      */
1956 
1957     SetEvent(pipePtr->stopWriter);
1958 
1959     /*
1960      * Wait at most 20 milliseconds for the reader thread to close.
1961      */
1962 
1963     if (WaitForSingleObject(pipePtr->writeThread, 20)
1964         == WAIT_TIMEOUT) {
1965         /*
1966          * The thread must be blocked waiting for the pipe to
1967          * consume input in WriteFile().  There isn't a clean way
1968          * to exit the thread from this condition.  We should
1969          * terminate the child process instead to get the writer
1970          * thread to fall out of WriteFile with a FALSE.  (below) is
1971          * not the correct way to do this, but will stay here until
1972          * a better solution is found.
1973          *
1974          * Note that we need to guard against terminating the
1975          * thread while it is in the middle of Tcl_ThreadAlert
1976          * because it won't be able to release the notifier lock.
1977          */
1978 
1979         Tcl_MutexLock(&pipeMutex);
1980 
1981         /* BUG: this leaks memory */
1982         TerminateThread(pipePtr->writeThread, 0);
1983         Tcl_MutexUnlock(&pipeMutex);
1984     }
1985       }
1986 
1987       CloseHandle(pipePtr->writeThread);
1988       CloseHandle(pipePtr->writable);
1989       CloseHandle(pipePtr->startWriter);
1990       CloseHandle(pipePtr->stopWriter);
1991       pipePtr->writeThread = NULL;
1992   }
1993   if (TclpCloseFile(pipePtr->writeFile) != 0) {
1994       if (errorCode == 0) {
1995     errorCode = errno;
1996       }
1997   }
1998   pipePtr->validMask &= ~TCL_WRITABLE;
1999   pipePtr->writeFile = NULL;
2000     }
2001 
2002     pipePtr->watchMask &= pipePtr->validMask;
2003 
2004     /*
2005      * Don't free the channel if any of the flags were set.
2006      */
2007 
2008     if (flags) {
2009   return errorCode;
2010     }
2011 
2012     /*
2013      * Remove the file from the list of watched files.
2014      */
2015 
2016     for (nextPtrPtr = &(tsdPtr->firstPipePtr), infoPtr = *nextPtrPtr;
2017    infoPtr != NULL;
2018    nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
2019   if (infoPtr == (PipeInfo *)pipePtr) {
2020       *nextPtrPtr = infoPtr->nextPtr;
2021       break;
2022   }
2023     }
2024 
2025     if ((pipePtr->flags & PIPE_ASYNC) || TclInExit()) {
2026   /*
2027    * If the channel is non-blocking or Tcl is being cleaned up,
2028    * just detach the children PIDs, reap them (important if we are
2029    * in a dynamic load module), and discard the errorFile.
2030    */
2031 
2032   Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr);
2033   Tcl_ReapDetachedProcs();
2034 
2035   if (pipePtr->errorFile) {
2036       if (TclpCloseFile(pipePtr->errorFile) != 0) {
2037     if ( errorCode == 0 ) {
2038         errorCode = errno;
2039     }
2040       }
2041   }
2042   result = 0;
2043     } else {
2044   /*
2045    * Wrap the error file into a channel and give it to the cleanup
2046    * routine.
2047    */
2048 
2049   if (pipePtr->errorFile) {
2050       WinFile *filePtr;
2051 
2052       filePtr = (WinFile*)pipePtr->errorFile;
2053       errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
2054             TCL_READABLE);
2055       ckfree((char *) filePtr);
2056   } else {
2057       errChan = NULL;
2058   }
2059 
2060   result = TclCleanupChildren(interp, pipePtr->numPids,
2061             pipePtr->pidPtr, errChan);
2062     }
2063 
2064     if (pipePtr->numPids > 0) {
2065         ckfree((char *) pipePtr->pidPtr);
2066     }
2067 
2068     if (pipePtr->writeBuf != NULL) {
2069   ckfree(pipePtr->writeBuf);
2070     }
2071 
2072     ckfree((char*) pipePtr);
2073 
2074     if (errorCode == 0) {
2075         return result;
2076     }
2077     return errorCode;
2078 }
static int PipeEventProc (Tcl_Event * evPtr, int flags) [static]

Definition at line 2289 of file tclWinPipe.c.
References PipeInfo::channel, ThreadSpecificData::firstPipePtr, PipeInfo::flags, PipeEvent::infoPtr, PipeInfo::nextPtr, NULL, PIPE_EOF, PIPE_PENDING, PipeInfo::readFlags, TCL_FILE_EVENTS, Tcl_NotifyChannel(), TCL_READABLE, TCL_TSD_INIT, TCL_WRITABLE, WaitForRead(), PipeInfo::watchMask, WinFile, and PipeInfo::writable.
Referenced by PipeCheckProc().2293 {
2294     PipeEvent *pipeEvPtr = (PipeEvent *)evPtr;
2295     PipeInfo *infoPtr;
2296     WinFile *filePtr;
2297     int mask;
2298     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2299 
2300     if (!(flags & TCL_FILE_EVENTS)) {
2301   return 0;
2302     }
2303 
2304     /*
2305      * Search through the list of watched pipes for the one whose handle
2306      * matches the event.  We do this rather than simply dereferencing
2307      * the handle in the event so that pipes can be deleted while the
2308      * event is in the queue.
2309      */
2310 
2311     for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;
2312       infoPtr = infoPtr->nextPtr) {
2313   if (pipeEvPtr->infoPtr == infoPtr) {
2314       infoPtr->flags &= ~(PIPE_PENDING);
2315       break;
2316   }
2317     }
2318 
2319     /*
2320      * Remove stale events.
2321      */
2322 
2323     if (!infoPtr) {
2324   return 1;
2325     }
2326 
2327     /*
2328      * Check to see if the pipe is readable.  Note
2329      * that we can't tell if a pipe is writable, so we always report it
2330      * as being writable unless we have detected EOF.
2331      */
2332 
2333     filePtr = (WinFile*) ((PipeInfo*)infoPtr)->writeFile;
2334     mask = 0;
2335     if ((infoPtr->watchMask & TCL_WRITABLE) &&
2336       (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) {
2337   mask = TCL_WRITABLE;
2338     }
2339 
2340     filePtr = (WinFile*) ((PipeInfo*)infoPtr)->readFile;
2341     if ((infoPtr->watchMask & TCL_READABLE) &&
2342       (WaitForRead(infoPtr, 0) >= 0)) {
2343   if (infoPtr->readFlags & PIPE_EOF) {
2344       mask = TCL_READABLE;
2345   } else {
2346       mask |= TCL_READABLE;
2347   }
2348     }
2349 
2350     /*
2351      * Inform the channel of the events.
2352      */
2353 
2354     Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask);
2355     return 1;
2356 }
static int PipeGetHandleProc (ClientData instanceData, int direction, ClientData * handlePtr) [static]

Definition at line 2438 of file tclWinPipe.c.
References PipeInfo::readFile, TCL_ERROR, TCL_OK, TCL_READABLE, TCL_WRITABLE, WinFile, and PipeInfo::writeFile.2442 {
2443     PipeInfo *infoPtr = (PipeInfo *) instanceData;
2444     WinFile *filePtr; 
2445 
2446     if (direction == TCL_READABLE && infoPtr->readFile) {
2447   filePtr = (WinFile*) infoPtr->readFile;
2448   *handlePtr = (ClientData) filePtr->handle;
2449   return TCL_OK;
2450     }
2451     if (direction == TCL_WRITABLE && infoPtr->writeFile) {
2452   filePtr = (WinFile*) infoPtr->writeFile;
2453   *handlePtr = (ClientData) filePtr->handle;
2454   return TCL_OK;
2455     }
2456     return TCL_ERROR;
2457 }
static void PipeInit (void) [static]

Definition at line 250 of file tclWinPipe.c.
References ThreadSpecificData::firstPipePtr, initialized, NULL, PipeCheckProc(), PipeSetupProc(), procList, Tcl_CreateEventSource(), Tcl_MutexLock, Tcl_MutexUnlock, TCL_TSD_INIT, and TclThreadDataKeyGet().
Referenced by PipeThreadActionProc(), Tcl_WaitPid(), TclpCreateCommandChannel(), TclpCreateProcess(), TclpGetPid(), and TclWinAddProcess().251 {
252     ThreadSpecificData *tsdPtr;
253 
254     /*
255      * Check the initialized flag first, then check again in the mutex.
256      * This is a speed enhancement.
257      */
258 
259     if (!initialized) {
260   Tcl_MutexLock(&pipeMutex);
261   if (!initialized) {
262       initialized = 1;
263       procList = NULL;
264   }
265   Tcl_MutexUnlock(&pipeMutex);
266     }
267 
268     tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
269     if (tsdPtr == NULL) {
270   tsdPtr = TCL_TSD_INIT(&dataKey);
271   tsdPtr->firstPipePtr = NULL;
272   Tcl_CreateEventSource(PipeSetupProc, PipeCheckProc, NULL);
273     }
274 }
static int PipeInputProc (ClientData instanceData, char * buf, int toRead, int * errorCode) [static]

Definition at line 2099 of file tclWinPipe.c.
References DWORD(), EPIPE, errno, PipeInfo::extraByte, PipeInfo::flags, NULL, PIPE_ASYNC, PIPE_EOF, PIPE_EXTRABYTE, PipeInfo::readFile, PipeInfo::readFlags, TclWinConvertError(), TRUE, WaitForRead(), and WinFile.2105 {
2106     PipeInfo *infoPtr = (PipeInfo *) instanceData;
2107     WinFile *filePtr = (WinFile*) infoPtr->readFile;
2108     DWORD count, bytesRead = 0;
2109     int result;
2110 
2111     *errorCode = 0;
2112     /*
2113      * Synchronize with the reader thread.
2114      */
2115 
2116     result = WaitForRead(infoPtr, (infoPtr->flags & PIPE_ASYNC) ? 0 : 1);
2117 
2118     /*
2119      * If an error occurred, return immediately.
2120      */
2121 
2122     if (result == -1) {
2123   *errorCode = errno;
2124   return -1;
2125     }
2126 
2127     if (infoPtr->readFlags & PIPE_EXTRABYTE) {
2128   /*
2129    * The reader thread consumed 1 byte as a side effect of
2130    * waiting so we need to move it into the buffer.
2131    */
2132 
2133   *buf = infoPtr->extraByte;
2134   infoPtr->readFlags &= ~PIPE_EXTRABYTE;
2135   buf++;
2136   bufSize--;
2137   bytesRead = 1;
2138 
2139   /*
2140    * If further read attempts would block, return what we have.
2141    */
2142 
2143   if (result == 0) {
2144       return bytesRead;
2145   }
2146     }
2147 
2148     /*
2149      * Attempt to read bufSize bytes.  The read will return immediately
2150      * if there is any data available.  Otherwise it will block until
2151      * at least one byte is available or an EOF occurs.
2152      */
2153 
2154     if (ReadFile(filePtr->handle, (LPVOID) buf, (DWORD) bufSize, &count,
2155       (LPOVERLAPPED) NULL) == TRUE) {
2156   return bytesRead + count;
2157     } else if (bytesRead) {
2158   /*
2159    * Ignore errors if we have data to return.
2160    */
2161 
2162   return bytesRead;
2163     }
2164 
2165     TclWinConvertError(GetLastError());
2166     if (errno == EPIPE) {
2167   infoPtr->readFlags |= PIPE_EOF;
2168   return 0;
2169     }
2170     *errorCode = errno;
2171     return -1;
2172 }
static int PipeOutputProc (ClientData instanceData, CONST char * buf, int toWrite, int * errorCode) [static]

Definition at line 2193 of file tclWinPipe.c.
References ckalloc, ckfree, DWORD(), EAGAIN, errno, FALSE, PipeInfo::flags, NULL, PIPE_ASYNC, size_t(), PipeInfo::startWriter, TclWinConvertError(), PipeInfo::toWrite, WinFile, PipeInfo::writable, PipeInfo::writeBuf, PipeInfo::writeBufLen, PipeInfo::writeError, and PipeInfo::writeFile.2198 {
2199     PipeInfo *infoPtr = (PipeInfo *) instanceData;
2200     WinFile *filePtr = (WinFile*) infoPtr->writeFile;
2201     DWORD bytesWritten, timeout;
2202     
2203     *errorCode = 0;
2204     timeout = (infoPtr->flags & PIPE_ASYNC) ? 0 : INFINITE;
2205     if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) {
2206   /*
2207    * The writer thread is blocked waiting for a write to complete
2208    * and the channel is in non-blocking mode.
2209    */
2210 
2211   errno = EAGAIN;
2212   goto error;
2213     }
2214     
2215     /*
2216      * Check for a background error on the last write.
2217      */
2218 
2219     if (infoPtr->writeError) {
2220   TclWinConvertError(infoPtr->writeError);
2221   infoPtr->writeError = 0;
2222   goto error;
2223     }
2224 
2225     if (infoPtr->flags & PIPE_ASYNC) {
2226   /*
2227    * The pipe is non-blocking, so copy the data into the output
2228    * buffer and restart the writer thread.
2229    */
2230 
2231   if (toWrite > infoPtr->writeBufLen) {
2232       /*
2233        * Reallocate the buffer to be large enough to hold the data.
2234        */
2235 
2236       if (infoPtr->writeBuf) {
2237     ckfree(infoPtr->writeBuf);
2238       }
2239       infoPtr->writeBufLen = toWrite;
2240       infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
2241   }
2242   memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
2243   infoPtr->toWrite = toWrite;
2244   ResetEvent(infoPtr->writable);
2245   SetEvent(infoPtr->startWriter);
2246   bytesWritten = toWrite;
2247     } else {
2248   /*
2249    * In the blocking case, just try to write the buffer directly.
2250    * This avoids an unnecessary copy.
2251    */
2252 
2253   if (WriteFile(filePtr->handle, (LPVOID) buf, (DWORD) toWrite,
2254     &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
2255       TclWinConvertError(GetLastError());
2256       goto error;
2257   }
2258     }
2259     return bytesWritten;
2260 
2261     error:
2262     *errorCode = errno;
2263     return -1;
2264 
2265 }
static DWORD WINAPI PipeReaderThread (LPVOID arg) [static]

Definition at line 2855 of file tclWinPipe.c.
References DWORD(), PipeInfo::extraByte, FALSE, NULL, PIPE_EOF, PIPE_EXTRABYTE, PipeInfo::readable, PipeInfo::readFile, PipeInfo::readFlags, PipeInfo::startReader, PipeInfo::stopReader, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_ThreadAlert(), PipeInfo::threadId, and WinFile.
Referenced by TclpCreateCommandChannel().2856 {
2857     PipeInfo *infoPtr = (PipeInfo *)arg;
2858     HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle;
2859     DWORD count, err;
2860     int done = 0;
2861     HANDLE wEvents[2];
2862     DWORD waitResult;
2863 
2864     wEvents[0] = infoPtr->stopReader;
2865     wEvents[1] = infoPtr->startReader;
2866 
2867     while (!done) {
2868   /*
2869    * Wait for the main thread to signal before attempting to wait
2870    * on the pipe becoming readable.
2871    */
2872 
2873   waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
2874 
2875   if (waitResult != (WAIT_OBJECT_0 + 1)) {
2876       /*
2877        * The start event was not signaled.  It might be the stop event
2878        * or an error, so exit.
2879        */
2880 
2881       break;
2882   }
2883 
2884   /*
2885    * Try waiting for 0 bytes.  This will block until some data is
2886    * available on NT, but will return immediately on Win 95.  So,
2887    * if no data is available after the first read, we block until
2888    * we can read a single byte off of the pipe.
2889    */
2890 
2891   if ((ReadFile(handle, NULL, 0, &count, NULL) == FALSE)
2892     || (PeekNamedPipe(handle, NULL, 0, NULL, &count,
2893       NULL) == FALSE)) {
2894       /*
2895        * The error is a result of an EOF condition, so set the
2896        * EOF bit before signalling the main thread.
2897        */
2898 
2899       err = GetLastError();
2900       if (err == ERROR_BROKEN_PIPE) {
2901     infoPtr->readFlags |= PIPE_EOF;
2902     done = 1;
2903       } else if (err == ERROR_INVALID_HANDLE) {
2904     break;
2905       }
2906   } else if (count == 0) {
2907       if (ReadFile(handle, &(infoPtr->extraByte), 1, &count, NULL)
2908         != FALSE) {
2909     /*
2910      * One byte was consumed as a side effect of waiting
2911      * for the pipe to become readable.
2912      */
2913 
2914     infoPtr->readFlags |= PIPE_EXTRABYTE;
2915       } else {
2916     err = GetLastError();
2917     if (err == ERROR_BROKEN_PIPE) {
2918         /*
2919          * The error is a result of an EOF condition, so set the
2920          * EOF bit before signalling the main thread.
2921          */
2922 
2923         infoPtr->readFlags |= PIPE_EOF;
2924         done = 1;
2925     } else if (err == ERROR_INVALID_HANDLE) {
2926         break;
2927     }
2928       }
2929   }
2930 
2931     
2932   /*
2933    * Signal the main thread by signalling the readable event and
2934    * then waking up the notifier thread.
2935    */
2936 
2937   SetEvent(infoPtr->readable);
2938   
2939   /*
2940    * Alert the foreground thread.  Note that we need to treat this like
2941    * a critical section so the foreground thread does not terminate
2942    * this thread while we are holding a mutex in the notifier code.
2943    */
2944 
2945   Tcl_MutexLock(&pipeMutex);
2946   if (infoPtr->threadId != NULL) {
2947       /* TIP #218. When in flight ignore the event, no one will receive it anyway */
2948       Tcl_ThreadAlert(infoPtr->threadId);
2949   }
2950   Tcl_MutexUnlock(&pipeMutex);
2951     }
2952 
2953     return 0;
2954 }
void PipeSetupProc (ClientData clientData, int flags) [static]

Definition at line 322 of file tclWinPipe.c.
References ThreadSpecificData::firstPipePtr, PipeInfo::nextPtr, NULL, PipeInfo::readFile, TCL_FILE_EVENTS, TCL_READABLE, Tcl_SetMaxBlockTime(), TCL_TSD_INIT, TCL_WRITABLE, WaitForRead(), PipeInfo::watchMask, WinFile, PipeInfo::writable, and PipeInfo::writeFile.
Referenced by PipeInit(), and TclpFinalizePipes().325 {
326     PipeInfo *infoPtr;
327     Tcl_Time blockTime = { 0, 0 };
328     int block = 1;
329     WinFile *filePtr;
330     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
331 
332     if (!(flags & TCL_FILE_EVENTS)) {
333   return;
334     }
335     
336     /*
337      * Look to see if any events are already pending.  If they are, poll.
338      */
339 
340     for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL; 
341       infoPtr = infoPtr->nextPtr) {
342   if (infoPtr->watchMask & TCL_WRITABLE) {
343       filePtr = (WinFile*) infoPtr->writeFile;
344       if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
345     block = 0;
346       }
347   }
348   if (infoPtr->watchMask & TCL_READABLE) {
349       filePtr = (WinFile*) infoPtr->readFile;
350       if (WaitForRead(infoPtr, 0) >= 0) {
351     block = 0;
352       }
353   }
354     }
355     if (!block) {
356   Tcl_SetMaxBlockTime(&blockTime);
357     }
358 }
static void PipeThreadActionProc (ClientData instanceData, int action) [static]

Definition at line 3064 of file tclWinPipe.c.
References PipeInfo::channel, NULL, PipeInit(), TCL_CHANNEL_THREAD_INSERT, Tcl_GetChannelThread(), Tcl_MutexLock, Tcl_MutexUnlock, and PipeInfo::threadId.3067 {
3068     PipeInfo *infoPtr = (PipeInfo *) instanceData;
3069 
3070     /* We do not access firstPipePtr in the thread structures. This is
3071      * not for all pipes managed by the thread, but only those we are
3072      * watching. Removal of the filevent handlers before transfer thus
3073      * takes care of this structure.
3074      */
3075 
3076     Tcl_MutexLock(&pipeMutex);
3077     if (action == TCL_CHANNEL_THREAD_INSERT) {
3078         /* We can't copy the thread information from the channel when
3079    * the channel is created. At this time the channel back
3080    * pointer has not been set yet. However in that case the
3081    * threadId has already been set by TclpCreateCommandChannel
3082    * itself, so the structure is still good.
3083    */
3084 
3085         PipeInit ();
3086         if (infoPtr->channel != NULL) {
3087       infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel);
3088   }
3089     } else {
3090   infoPtr->threadId = NULL;
3091     }
3092     Tcl_MutexUnlock(&pipeMutex);
3093 }
static void PipeWatchProc (ClientData instanceData, int mask) [static]

Definition at line 2376 of file tclWinPipe.c.
References ThreadSpecificData::firstPipePtr, PipeInfo::nextPtr, NULL, Tcl_SetMaxBlockTime(), TCL_TSD_INIT, PipeInfo::validMask, and PipeInfo::watchMask.2381 {
2382     PipeInfo **nextPtrPtr, *ptr;
2383     PipeInfo *infoPtr = (PipeInfo *) instanceData;
2384     int oldMask = infoPtr->watchMask;
2385     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2386 
2387     /*
2388      * Since most of the work is handled by the background threads,
2389      * we just need to update the watchMask and then force the notifier
2390      * to poll once. 
2391      */
2392 
2393     infoPtr->watchMask = mask & infoPtr->validMask;
2394     if (infoPtr->watchMask) {
2395   Tcl_Time blockTime = { 0, 0 };
2396   if (!oldMask) {
2397       infoPtr->nextPtr = tsdPtr->firstPipePtr;
2398       tsdPtr->firstPipePtr = infoPtr;
2399   }
2400   Tcl_SetMaxBlockTime(&blockTime);
2401     } else {
2402   if (oldMask) {
2403       /*
2404        * Remove the pipe from the list of watched pipes.
2405        */
2406 
2407       for (nextPtrPtr = &(tsdPtr->firstPipePtr), ptr = *nextPtrPtr;
2408      ptr != NULL;
2409      nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
2410     if (infoPtr == ptr) {
2411         *nextPtrPtr = ptr->nextPtr;
2412         break;
2413     }
2414       }
2415   }
2416     }
2417 }
static DWORD WINAPI PipeWriterThread (LPVOID arg) [static]

Definition at line 2975 of file tclWinPipe.c.
References DWORD(), FALSE, NULL, PipeInfo::startWriter, PipeInfo::stopWriter, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_ThreadAlert(), PipeInfo::threadId, PipeInfo::toWrite, WinFile, PipeInfo::writable, PipeInfo::writeBuf, PipeInfo::writeError, and PipeInfo::writeFile.
Referenced by TclpCreateCommandChannel().2976 {
2977 
2978     PipeInfo *infoPtr = (PipeInfo *)arg;
2979     HANDLE *handle = ((WinFile *) infoPtr->writeFile)->handle;
2980     DWORD count, toWrite;
2981     char *buf;
2982     int done = 0;
2983     HANDLE wEvents[2];
2984     DWORD waitResult;
2985 
2986     wEvents[0] = infoPtr->stopWriter;
2987     wEvents[1] = infoPtr->startWriter;
2988 
2989     while (!done) {
2990   /*
2991    * Wait for the main thread to signal before attempting to write.
2992    */
2993 
2994   waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
2995 
2996   if (waitResult != (WAIT_OBJECT_0 + 1)) {
2997       /*
2998        * The start event was not signaled.  It might be the stop event
2999        * or an error, so exit.
3000        */
3001 
3002       break;
3003   }
3004 
3005   buf = infoPtr->writeBuf;
3006   toWrite = infoPtr->toWrite;
3007 
3008   /*
3009    * Loop until all of the bytes are written or an error occurs.
3010    */
3011 
3012   while (toWrite > 0) {
3013       if (WriteFile(handle, buf, toWrite, &count, NULL) == FALSE) {
3014     infoPtr->writeError = GetLastError();
3015     done = 1; 
3016     break;
3017       } else {
3018     toWrite -= count;
3019     buf += count;
3020       }
3021   }
3022   
3023   /*
3024    * Signal the main thread by signalling the writable event and
3025    * then waking up the notifier thread.
3026    */
3027 
3028   SetEvent(infoPtr->writable);
3029 
3030   /*
3031    * Alert the foreground thread.  Note that we need to treat this like
3032    * a critical section so the foreground thread does not terminate
3033    * this thread while we are holding a mutex in the notifier code.
3034    */
3035 
3036   Tcl_MutexLock(&pipeMutex);
3037   if (infoPtr->threadId != NULL) {
3038       /* TIP #218. When in flight ignore the event, no one will receive it anyway */
3039       Tcl_ThreadAlert(infoPtr->threadId);
3040   }
3041   Tcl_MutexUnlock(&pipeMutex);
3042     }
3043 
3044     return 0;
3045 }
TCL_DECLARE_MUTEX (pipeMutex)

Definition at line 34 of file tclWinPipe.c.59                        {
60     int type;     /* One of the file types defined above. */
61     HANDLE handle;    /* Open file handle. */
62 } WinFile;
int Tcl_PidObjCmd (ClientData dummy, Tcl_Interp * interp, int objc, Tcl_Obj *CONST * objv)

Definition at line 2674 of file tclWinPipe.c.
References getpid, NULL, PipeInfo::numPids, PipeInfo::pidPtr, pipeChannelType, TCL_ERROR, Tcl_GetChannel(), Tcl_GetChannelInstanceData(), Tcl_GetChannelType(), Tcl_GetObjResult(), Tcl_GetStringFromObj(), TCL_INTEGER_SPACE, Tcl_ListObjAppendElement(), Tcl_NewStringObj(), TCL_OK, Tcl_SetStringObj(), Tcl_WrongNumArgs(), and TclpGetPid.2679 {
2680     Tcl_Channel chan;
2681     Tcl_ChannelType *chanTypePtr;
2682     PipeInfo *pipePtr;
2683     int i;
2684     Tcl_Obj *resultPtr;
2685     char buf[TCL_INTEGER_SPACE];
2686 
2687     if (objc > 2) {
2688   Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
2689   return TCL_ERROR;
2690     }
2691     if (objc == 1) {
2692   resultPtr = Tcl_GetObjResult(interp);
2693   wsprintfA(buf, "%lu", (unsigned long) getpid());
2694   Tcl_SetStringObj(resultPtr, buf, -1);
2695     } else {
2696         chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
2697     NULL);
2698         if (chan == (Tcl_Channel) NULL) {
2699       return TCL_ERROR;
2700   }
2701   chanTypePtr = Tcl_GetChannelType(chan);
2702   if (chanTypePtr != &pipeChannelType) {
2703       return TCL_OK;
2704   }
2705 
2706         pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
2707   resultPtr = Tcl_GetObjResult(interp);
2708         for (i = 0; i < pipePtr->numPids; i++) {
2709       wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
2710       Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr,
2711         Tcl_NewStringObj(buf, -1));
2712   }
2713     }
2714     return TCL_OK;
2715 }
Tcl_Pid Tcl_WaitPid (Tcl_Pid pid, int * statPtr, int options)

Definition at line 2479 of file tclWinPipe.c.
References DWORD(), ProcInfo::hProcess, ProcInfo::nextPtr, NULL, PipeInit(), procList, and Tcl_MutexLock.2483 {
2484     ProcInfo *infoPtr = NULL, **prevPtrPtr;
2485     DWORD flags;
2486     Tcl_Pid result;
2487     DWORD ret, exitCode;
2488 
2489     PipeInit();
2490 
2491     /*
2492      * If no pid is specified, do nothing.
2493      */
2494     
2495     if (pid == 0) {
2496   *statPtr = 0;
2497   return 0;
2498     }
2499 
2500     /*
2501      * Find the process and cut it from the process list.
2502      * SF Tcl Bug  859820, Backport of its fix.
2503      * SF Tcl Bug 1381436, asking for the backport.
2504      *     
2505      * [x] Cutting the infoPtr after the closehandle allows the
2506      * pointer to become stale. We do it here, and compensate if the
2507      * process was not done yet.
2508      */
2509 
2510     Tcl_MutexLock(&pipeMutex);
2511     prevPtrPtr = &procList;
2512     for (infoPtr = procList; infoPtr != NULL;
2513       prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) {
2514    if (infoPtr->hProcess == (HANDLE) pid) {
2515       *prevPtrPtr = infoPtr->nextPtr;
2516       break;
2517   }
2518     }
2519     Tcl_MutexUnlock(&pipeMutex);
2520 
2521     /*
2522      * If the pid is not one of the processes we know about (we started it)
2523      * then do nothing.
2524      */
2525              
2526     if (infoPtr == NULL) {
2527         *statPtr = 0;
2528   return 0;
2529     }
2530 
2531     /*
2532      * Officially "wait" for it to finish. We either poll (WNOHANG) or
2533      * wait for an infinite amount of time.
2534      */
2535     
2536     if (options & WNOHANG) {
2537   flags = 0;
2538     } else {
2539   flags = INFINITE;
2540     }
2541     ret = WaitForSingleObject(infoPtr->hProcess, flags);
2542     if (ret == WAIT_TIMEOUT) {
2543   *statPtr = 0;
2544   if (options & WNOHANG) {
2545       /*
2546        * Re-insert the cut infoPtr back on the list.
2547        * See [x] for explanation.
2548        */
2549       Tcl_MutexLock(&pipeMutex);
2550       infoPtr->nextPtr = procList;
2551       procList = infoPtr;
2552       Tcl_MutexUnlock(&pipeMutex);
2553       return 0;
2554   } else {
2555       result = 0;
2556   }
2557     } else if (ret == WAIT_OBJECT_0) {
2558   GetExitCodeProcess(infoPtr->hProcess, &exitCode);
2559   if (exitCode & 0xC0000000) {
2560       /*
2561        * A fatal exception occured.
2562        */
2563       switch (exitCode) {
2564     case EXCEPTION_FLT_DENORMAL_OPERAND:
2565     case EXCEPTION_FLT_DIVIDE_BY_ZERO:
2566     case EXCEPTION_FLT_INEXACT_RESULT:
2567     case EXCEPTION_FLT_INVALID_OPERATION:
2568     case EXCEPTION_FLT_OVERFLOW:
2569     case EXCEPTION_FLT_STACK_CHECK:
2570     case EXCEPTION_FLT_UNDERFLOW:
2571     case EXCEPTION_INT_DIVIDE_BY_ZERO:
2572     case EXCEPTION_INT_OVERFLOW:
2573         *statPtr = 0xC0000000 | SIGFPE;
2574         break;
2575 
2576     case EXCEPTION_PRIV_INSTRUCTION:
2577     case EXCEPTION_ILLEGAL_INSTRUCTION:
2578         *statPtr = 0xC0000000 | SIGILL;
2579         break;
2580 
2581     case EXCEPTION_ACCESS_VIOLATION:
2582     case EXCEPTION_DATATYPE_MISALIGNMENT:
2583     case EXCEPTION_ARRAY_BOUNDS_EXCEEDED:
2584     case EXCEPTION_STACK_OVERFLOW:
2585     case EXCEPTION_NONCONTINUABLE_EXCEPTION:
2586     case EXCEPTION_INVALID_DISPOSITION:
2587     case EXCEPTION_GUARD_PAGE:
2588     case EXCEPTION_INVALID_HANDLE:
2589         *statPtr = 0xC0000000 | SIGSEGV;
2590         break;
2591 
2592     case CONTROL_C_EXIT:
2593         *statPtr = 0xC0000000 | SIGINT;
2594         break;
2595 
2596     default:
2597         *statPtr = 0xC0000000 | SIGABRT;
2598         break;
2599       }
2600   } else {
2601       *statPtr = exitCode;
2602   }
2603   result = pid;
2604     } else {
2605   errno = ECHILD;
2606         *statPtr = 0xC0000000 | ECHILD;
2607   result = (Tcl_Pid) -1;
2608     }
2609 
2610     /*
2611      * Officially close the process handle.
2612      */
2613 
2614     CloseHandle(infoPtr->hProcess);
2615     ckfree((char*)infoPtr);
2616 
2617     return result;
2618 }
void TclGetAndDetachPids (Tcl_Interp * interp, Tcl_Channel chan)

Definition at line 1766 of file tclWinPipe.c.
References ckfree, PipeInfo::numPids, PipeInfo::pidPtr, pipeChannelType, Tcl_AppendElement(), Tcl_DetachPids(), Tcl_GetChannelInstanceData(), Tcl_GetChannelType(), TCL_INTEGER_SPACE, and TclpGetPid.1769 {
1770     PipeInfo *pipePtr;
1771     Tcl_ChannelType *chanTypePtr;
1772     int i;
1773     char buf[TCL_INTEGER_SPACE];
1774 
1775     /*
1776      * Punt if the channel is not a command channel.
1777      */
1778 
1779     chanTypePtr = Tcl_GetChannelType(chan);
1780     if (chanTypePtr != &pipeChannelType) {
1781         return;
1782     }
1783 
1784     pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
1785     for (i = 0; i < pipePtr->numPids; i++) {
1786         wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
1787         Tcl_AppendElement(interp, buf);
1788         Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
1789     }
1790     if (pipePtr->numPids > 0) {
1791         ckfree((char *) pipePtr->pidPtr);
1792         pipePtr->numPids = 0;
1793     }
1794 }
int TclpCloseFile (TclFile file)

Definition at line 829 of file tclWinPipe.c.
References ckfree, FALSE, NULL, panic, TclInThreadExit(), TclWinConvertError(), WIN_FILE, and WinFile.831 {
832     WinFile *filePtr = (WinFile *) file;
833 
834     switch (filePtr->type) {
835   case WIN_FILE:
836       /*
837        * Don't close the Win32 handle if the handle is a standard channel
838        * during the thread exit process.  Otherwise, one thread may kill
839        * the stdio of another.
840        */
841 
842       if (!TclInThreadExit() 
843         || ((GetStdHandle(STD_INPUT_HANDLE) != filePtr->handle)
844           && (GetStdHandle(STD_OUTPUT_HANDLE) != filePtr->handle)
845           && (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) {
846     if (filePtr->handle != NULL &&
847       CloseHandle(filePtr->handle) == FALSE) {
848         TclWinConvertError(GetLastError());
849         ckfree((char *) filePtr);
850         return -1;
851     }
852       }
853       break;
854 
855   default:
856       panic("TclpCloseFile: unexpected file type");
857     }
858 
859     ckfree((char *) filePtr);
860     return 0;
861 }
Tcl_Channel TclpCreateCommandChannel (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid * pidPtr)

Definition at line 1647 of file tclWinPipe.c.
References PipeInfo::channel, ckalloc, DWORD(), PipeInfo::errorFile, FALSE, PipeInfo::flags, NULL, PipeInfo::numPids, PipeInfo::pidPtr, pipeChannelType, PipeInit(), PipeReaderThread(), PipeWriterThread(), PipeInfo::readable, PipeInfo::readFile, PipeInfo::readFlags, PipeInfo::readThread, PipeInfo::startReader, PipeInfo::startWriter, PipeInfo::stopReader, PipeInfo::stopWriter, Tcl_CreateChannel(), Tcl_GetCurrentThread(), TCL_INTEGER_SPACE, TCL_READABLE, Tcl_SetChannelOption(), TCL_WRITABLE, PipeInfo::threadId, TRUE, PipeInfo::validMask, PipeInfo::watchMask, WinFile, PipeInfo::writable, PipeInfo::writeBuf, PipeInfo::writeBufLen, PipeInfo::writeError, PipeInfo::writeFile, and PipeInfo::writeThread.1654 {
1655     char channelName[16 + TCL_INTEGER_SPACE];
1656     int channelId;
1657     DWORD id;
1658     PipeInfo *infoPtr = (PipeInfo *) ckalloc((unsigned) sizeof(PipeInfo));
1659 
1660     PipeInit();
1661 
1662     infoPtr->watchMask = 0;
1663     infoPtr->flags = 0;
1664     infoPtr->readFlags = 0;
1665     infoPtr->readFile = readFile;
1666     infoPtr->writeFile = writeFile;
1667     infoPtr->errorFile = errorFile;
1668     infoPtr->numPids = numPids;
1669     infoPtr->pidPtr = pidPtr;
1670     infoPtr->writeBuf = 0;
1671     infoPtr->writeBufLen = 0;
1672     infoPtr->writeError = 0;
1673     infoPtr->channel = (Tcl_Channel) NULL;
1674 
1675     /*
1676      * Use one of the fds associated with the channel as the
1677      * channel id.
1678      */
1679 
1680     if (readFile) {
1681   channelId = (int) ((WinFile*)readFile)->handle;
1682     } else if (writeFile) {
1683   channelId = (int) ((WinFile*)writeFile)->handle;
1684     } else if (errorFile) {
1685   channelId = (int) ((WinFile*)errorFile)->handle;
1686     } else {
1687   channelId = 0;
1688     }
1689 
1690     infoPtr->validMask = 0;
1691 
1692     infoPtr->threadId = Tcl_GetCurrentThread();
1693 
1694     if (readFile != NULL) {
1695   /*
1696    * Start the background reader thread.
1697    */
1698 
1699   infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL);
1700   infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL);
1701   infoPtr->stopReader = CreateEvent(NULL, TRUE, FALSE, NULL);
1702   infoPtr->readThread = CreateThread(NULL, 256, PipeReaderThread,
1703     infoPtr, 0, &id);
1704   SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST); 
1705         infoPtr->validMask |= TCL_READABLE;
1706     } else {
1707   infoPtr->readThread = 0;
1708     }
1709     if (writeFile != NULL) {
1710   /*
1711    * Start the background writer thread.
1712    */
1713 
1714   infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL);
1715   infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
1716   infoPtr->stopWriter = CreateEvent(NULL, TRUE, FALSE, NULL);
1717   infoPtr->writeThread = CreateThread(NULL, 256, PipeWriterThread,
1718     infoPtr, 0, &id);
1719   SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST); 
1720         infoPtr->validMask |= TCL_WRITABLE;
1721     }
1722 
1723     /*
1724      * For backward compatibility with previous versions of Tcl, we
1725      * use "file%d" as the base name for pipes even though it would
1726      * be more natural to use "pipe%d".
1727      * Use the pointer to keep the channel names unique, in case
1728      * channels share handles (stdin/stdout).
1729      */
1730 
1731     wsprintfA(channelName, "file%lx", infoPtr);
1732     infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
1733             (ClientData) infoPtr, infoPtr->validMask);
1734 
1735     /*
1736      * Pipes have AUTO translation mode on Windows and ^Z eof char, which
1737      * means that a ^Z will be appended to them at close. This is needed
1738      * for Windows programs that expect a ^Z at EOF.
1739      */
1740 
1741     Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
1742       "-translation", "auto");
1743     Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
1744       "-eofchar", "\032 {}");
1745     return infoPtr->channel;
1746 }
int TclpCreatePipe (TclFile * readPipe, TclFile * writePipe)

Definition at line 793 of file tclWinPipe.c.
References NULL, TclWinConvertError(), and TclWinMakeFile().798 {
799     HANDLE readHandle, writeHandle;
800 
801     if (CreatePipe(&readHandle, &writeHandle, NULL, 0) != 0) {
802   *readPipe = TclWinMakeFile(readHandle);
803   *writePipe = TclWinMakeFile(writeHandle);
804   return 1;
805     }
806 
807     TclWinConvertError(GetLastError());
808     return 0;
809 }
int TclpCreateProcess (Tcl_Interp * interp, int argc, CONST char ** argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid * pidPtr)

Definition at line 929 of file tclWinPipe.c.
References APPL_DOS, APPL_NONE, ApplicationType(), BuildCommandLine(), DWORD(), F_OK, FALSE, HasConsole(), NULL, panic, PipeInit(), Tcl_AppendToObj(), Tcl_DecrRefCount, Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringValue, TCL_ERROR, Tcl_FSAccess(), Tcl_FSConvertToPathType(), Tcl_GetStringFromObj(), Tcl_IncrRefCount, Tcl_NewStringObj(), TCL_OK, Tcl_PosixError(), TCL_UTF_MAX, TclpFindExecutable(), TclWinAddProcess(), TclWinConvertError(), TclWinGetPlatformId(), tclWinProcs, TRUE, VER_PLATFORM_WIN32_WINDOWS, WIN_FILE, and WinFile.957 {
958     int result, applType, createFlags;
959     Tcl_DString cmdLine;  /* Complete command line (TCHAR). */
960     STARTUPINFOA startInfo;
961     PROCESS_INFORMATION procInfo;
962     SECURITY_ATTRIBUTES secAtts;
963     HANDLE hProcess, h, inputHandle, outputHandle, errorHandle;
964     char execPath[MAX_PATH * TCL_UTF_MAX];
965     WinFile *filePtr;
966 
967     PipeInit();
968 
969     applType = ApplicationType(interp, argv[0], execPath);
970     if (applType == APPL_NONE) {
971   return TCL_ERROR;
972     }
973 
974     result = TCL_ERROR;
975     Tcl_DStringInit(&cmdLine);
976     hProcess = GetCurrentProcess();
977 
978     /*
979      * STARTF_USESTDHANDLES must be used to pass handles to child process.
980      * Using SetStdHandle() and/or dup2() only works when a console mode 
981      * parent process is spawning an attached console mode child process.
982      */
983 
984     ZeroMemory(&startInfo, sizeof(startInfo));
985     startInfo.cb = sizeof(startInfo);
986     startInfo.dwFlags   = STARTF_USESTDHANDLES;
987     startInfo.hStdInput = INVALID_HANDLE_VALUE;
988     startInfo.hStdOutput= INVALID_HANDLE_VALUE;
989     startInfo.hStdError = INVALID_HANDLE_VALUE;
990 
991     secAtts.nLength = sizeof(SECURITY_ATTRIBUTES);
992     secAtts.lpSecurityDescriptor = NULL;
993     secAtts.bInheritHandle = TRUE;
994 
995     /*
996      * We have to check the type of each file, since we cannot duplicate 
997      * some file types.  
998      */
999 
1000     inputHandle = INVALID_HANDLE_VALUE;
1001     if (inputFile != NULL) {
1002   filePtr = (WinFile *)inputFile;
1003   if (filePtr->type == WIN_FILE) {
1004       inputHandle = filePtr->handle;
1005   }
1006     }
1007     outputHandle = INVALID_HANDLE_VALUE;
1008     if (outputFile != NULL) {
1009   filePtr = (WinFile *)outputFile;
1010   if (filePtr->type == WIN_FILE) {
1011       outputHandle = filePtr->handle;
1012   }
1013     }
1014     errorHandle = INVALID_HANDLE_VALUE;
1015     if (errorFile != NULL) {
1016   filePtr = (WinFile *)errorFile;
1017   if (filePtr->type == WIN_FILE) {
1018       errorHandle = filePtr->handle;
1019   }
1020     }
1021 
1022     /*
1023      * Duplicate all the handles which will be passed off as stdin, stdout
1024      * and stderr of the child process. The duplicate handles are set to
1025      * be inheritable, so the child process can use them.
1026      */
1027 
1028     if (inputHandle == INVALID_HANDLE_VALUE) {
1029   /* 
1030    * If handle was not set, stdin should return immediate EOF.
1031    * Under Windows95, some applications (both 16 and 32 bit!) 
1032    * cannot read from the NUL device; they read from console
1033    * instead.  When running tk, this is fatal because the child 
1034    * process would hang forever waiting for EOF from the unmapped 
1035    * console window used by the helper application.
1036    *
1037    * Fortunately, the helper application detects a closed pipe 
1038    * as an immediate EOF and can pass that information to the 
1039    * child process.
1040    */
1041 
1042   if (CreatePipe(&startInfo.hStdInput, &h, &secAtts, 0) != FALSE) {
1043       CloseHandle(h);
1044   }
1045     } else {
1046   DuplicateHandle(hProcess, inputHandle, hProcess, &startInfo.hStdInput,
1047     0, TRUE, DUPLICATE_SAME_ACCESS);
1048     }
1049     if (startInfo.hStdInput == INVALID_HANDLE_VALUE) {
1050   TclWinConvertError(GetLastError());
1051   Tcl_AppendResult(interp, "couldn't duplicate input handle: ",
1052     Tcl_PosixError(interp), (char *) NULL);
1053   goto end;
1054     }
1055 
1056     if (outputHandle == INVALID_HANDLE_VALUE) {
1057   /*
1058    * If handle was not set, output should be sent to an infinitely 
1059    * deep sink.  Under Windows 95, some 16 bit applications cannot
1060    * have stdout redirected to NUL; they send their output to
1061    * the console instead.  Some applications, like "more" or "dir /p", 
1062    * when outputting multiple pages to the console, also then try and
1063    * read from the console to go the next page.  When running tk, this
1064    * is fatal because the child process would hang forever waiting
1065    * for input from the unmapped console window used by the helper
1066    * application.
1067    *
1068    * Fortunately, the helper application will detect a closed pipe
1069    * as a sink.
1070    */
1071 
1072   if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) 
1073     && (applType == APPL_DOS)) {
1074       if (CreatePipe(&h, &startInfo.hStdOutput, &secAtts, 0) != FALSE) {
1075     CloseHandle(h);
1076       }
1077   } else {
1078       startInfo.hStdOutput = CreateFileA("NUL:", GENERIC_WRITE, 0,
1079         &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
1080   }
1081     } else {
1082   DuplicateHandle(hProcess, outputHandle, hProcess, &startInfo.hStdOutput, 
1083     0, TRUE, DUPLICATE_SAME_ACCESS);
1084     }
1085     if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) {
1086   TclWinConvertError(GetLastError());
1087   Tcl_AppendResult(interp, "couldn't duplicate output handle: ",
1088     Tcl_PosixError(interp), (char *) NULL);
1089   goto end;
1090     }
1091 
1092     if (errorHandle == INVALID_HANDLE_VALUE) {
1093   /*
1094    * If handle was not set, errors should be sent to an infinitely
1095    * deep sink.
1096    */
1097 
1098   startInfo.hStdError = CreateFileA("NUL:", GENERIC_WRITE, 0,
1099     &secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
1100     } else {
1101   DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError, 
1102     0, TRUE, DUPLICATE_SAME_ACCESS);
1103     } 
1104     if (startInfo.hStdError == INVALID_HANDLE_VALUE) {
1105   TclWinConvertError(GetLastError());
1106   Tcl_AppendResult(interp, "couldn't duplicate error handle: ",
1107     Tcl_PosixError(interp), (char *) NULL);
1108   goto end;
1109     }
1110     /* 
1111      * If we do not have a console window, then we must run DOS and
1112      * WIN32 console mode applications as detached processes. This tells
1113      * the loader that the child application should not inherit the
1114      * console, and that it should not create a new console window for
1115      * the child application.  The child application should get its stdio 
1116      * from the redirection handles provided by this application, and run
1117      * in the background.
1118      *
1119      * If we are starting a GUI process, they don't automatically get a 
1120      * console, so it doesn't matter if they are started as foreground or
1121      * detached processes.  The GUI window will still pop up to the
1122      * foreground.
1123      */
1124 
1125     if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
1126   if (HasConsole()) {
1127       createFlags = 0;
1128   } else if (applType == APPL_DOS) {
1129       /*
1130        * Under NT, 16-bit DOS applications will not run unless they
1131        * can be attached to a console.  If we are running without a
1132        * console, run the 16-bit program as an normal process inside
1133        * of a hidden console application, and then run that hidden
1134        * console as a detached process.
1135        */
1136 
1137       startInfo.wShowWindow = SW_HIDE;
1138       startInfo.dwFlags |= STARTF_USESHOWWINDOW;
1139       createFlags = CREATE_NEW_CONSOLE;
1140       Tcl_DStringAppend(&cmdLine, "cmd.exe /c", -1);
1141   } else {
1142       createFlags = DETACHED_PROCESS;
1143   } 
1144     } else {
1145   if (HasConsole()) {
1146       createFlags = 0;
1147   } else {
1148       createFlags = DETACHED_PROCESS;
1149   }
1150   
1151   if (applType == APPL_DOS) {
1152       /*
1153        * Under Windows 95, 16-bit DOS applications do not work well 
1154        * with pipes:
1155        *
1156        * 1. EOF on a pipe between a detached 16-bit DOS application 
1157        * and another application is not seen at the other
1158        * end of the pipe, so the listening process blocks forever on 
1159        * reads.  This inablity to detect EOF happens when either a 
1160        * 16-bit app or the 32-bit app is the listener.  
1161        *
1162        * 2. If a 16-bit DOS application (detached or not) blocks when 
1163        * writing to a pipe, it will never wake up again, and it
1164        * eventually brings the whole system down around it.
1165        *
1166        * The 16-bit application is run as a normal process inside
1167        * of a hidden helper console app, and this helper may be run
1168        * as a detached process.  If any of the stdio handles is
1169        * a pipe, the helper application accumulates information 
1170        * into temp files and forwards it to or from the DOS 
1171        * application as appropriate.  This means that DOS apps 
1172        * must receive EOF from a stdin pipe before they will actually
1173        * begin, and must finish generating stdout or stderr before 
1174        * the data will be sent to the next stage of the pipe.
1175        *
1176        * The helper app should be located in the same directory as
1177        * the tcl dll.
1178        */
1179 
1180       if (createFlags != 0) {
1181     startInfo.wShowWindow = SW_HIDE;
1182     startInfo.dwFlags |= STARTF_USESHOWWINDOW;
1183     createFlags = CREATE_NEW_CONSOLE;
1184       }
1185 
1186       {
1187     Tcl_Obj *tclExePtr, *pipeDllPtr;
1188     int i, fileExists;
1189     char *start,*end;
1190     Tcl_DString pipeDll;
1191     Tcl_DStringInit(&pipeDll);
1192     Tcl_DStringAppend(&pipeDll, TCL_PIPE_DLL, -1);
1193     tclExePtr = Tcl_NewStringObj(TclpFindExecutable(""), -1);
1194     start = Tcl_GetStringFromObj(tclExePtr, &i);
1195     for (end = start + (i-1); end > start; end--) {
1196         if (*end == '/')
1197             break;
1198     }
1199     if (*end != '/')
1200         panic("no / in executable path name");
1201     i = (end - start) + 1;
1202     pipeDllPtr = Tcl_NewStringObj(start, i);
1203     Tcl_AppendToObj(pipeDllPtr, Tcl_DStringValue(&pipeDll), -1);
1204     Tcl_IncrRefCount(pipeDllPtr);
1205     if (Tcl_FSConvertToPathType(interp, pipeDllPtr) != TCL_OK)
1206         panic("Tcl_FSConvertToPathType failed");
1207     fileExists = (Tcl_FSAccess(pipeDllPtr, F_OK) == 0);
1208     if (!fileExists) {
1209         panic("Tcl pipe dll \"%s\" not found",
1210             Tcl_DStringValue(&pipeDll));
1211     }
1212     Tcl_DStringAppend(&cmdLine, Tcl_DStringValue(&pipeDll), -1);
1213     Tcl_DecrRefCount(tclExePtr);
1214     Tcl_DecrRefCount(pipeDllPtr);
1215     Tcl_DStringFree(&pipeDll);
1216       }
1217   }
1218     }
1219     
1220     /*
1221      * cmdLine gets the full command line used to invoke the executable,
1222      * including the name of the executable itself.  The command line
1223      * arguments in argv[] are stored in cmdLine separated by spaces. 
1224      * Special characters in individual arguments from argv[] must be 
1225      * quoted when being stored in cmdLine.
1226      *
1227      * When calling any application, bear in mind that arguments that 
1228      * specify a path name are not converted.  If an argument contains 
1229      * forward slashes as path separators, it may or may not be 
1230      * recognized as a path name, depending on the program.  In general,
1231      * most applications accept forward slashes only as option 
1232      * delimiters and backslashes only as paths.
1233      *
1234      * Additionally, when calling a 16-bit dos or windows application, 
1235      * all path names must use the short, cryptic, path format (e.g., 
1236      * using ab~1.def instead of "a b.default").  
1237      */
1238 
1239     BuildCommandLine(execPath, argc, argv, &cmdLine);
1240 
1241     if ((*tclWinProcs->createProcessProc)(NULL, 
1242       (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE, 
1243       (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) {
1244   TclWinConvertError(GetLastError());
1245   Tcl_AppendResult(interp, "couldn't execute \"", argv[0],
1246     "\": ", Tcl_PosixError(interp), (char *) NULL);
1247   goto end;
1248     }
1249 
1250     /*
1251      * This wait is used to force the OS to give some time to the DOS
1252      * process.
1253      */
1254 
1255     if (applType == APPL_DOS) {
1256   WaitForSingleObject(procInfo.hProcess, 50);
1257     }
1258 
1259     /* 
1260      * "When an application spawns a process repeatedly, a new thread 
1261      * instance will be created for each process but the previous 
1262      * instances may not be cleaned up.  This results in a significant 
1263      * virtual memory loss each time the process is spawned.  If there 
1264      * is a WaitForInputIdle() call between CreateProcess() and
1265      * CloseHandle(), the problem does not occur." PSS ID Number: Q124121
1266      */
1267 
1268     WaitForInputIdle(procInfo.hProcess, 5000);
1269     CloseHandle(procInfo.hThread);
1270 
1271     *pidPtr = (Tcl_Pid) procInfo.hProcess;
1272     if (*pidPtr != 0) {
1273   TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId);
1274     }
1275     result = TCL_OK;
1276 
1277     end:
1278     Tcl_DStringFree(&cmdLine);
1279     if (startInfo.hStdInput != INVALID_HANDLE_VALUE) {
1280         CloseHandle(startInfo.hStdInput);
1281     }
1282     if (startInfo.hStdOutput != INVALID_HANDLE_VALUE) {
1283         CloseHandle(startInfo.hStdOutput);
1284     }
1285     if (startInfo.hStdError != INVALID_HANDLE_VALUE) {
1286   CloseHandle(startInfo.hStdError);
1287     }
1288     return result;
1289 }
TclFile TclpCreateTempFile (CONST char * contents)

Definition at line 676 of file tclWinPipe.c.
References CONST, dstring, DWORD(), NULL, Tcl_DStringFree(), Tcl_UtfToExternalDString(), TclWinConvertError(), TclWinMakeFile(), tclWinProcs, and TempFileName().678 {
679     WCHAR name[MAX_PATH];
680     CONST char *native;
681     Tcl_DString dstring;
682     HANDLE handle;
683 
684     if (TempFileName(name) == 0) {
685   return NULL;
686     }
687 
688     handle = (*tclWinProcs->createFileProc)((TCHAR *) name, 
689       GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS, 
690       FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE, NULL);
691     if (handle == INVALID_HANDLE_VALUE) {
692   goto error;
693     }
694 
695     /*
696      * Write the file out, doing line translations on the way.
697      */
698 
699     if (contents != NULL) {
700   DWORD result, length;
701   CONST char *p;
702 
703   /*
704    * Convert the contents from UTF to native encoding
705    */
706   native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring);
707   
708   for (p = native; *p != '\0'; p++) {
709       if (*p == '\n') {
710     length = p - native;
711     if (length > 0) {
712         if (!WriteFile(handle, native, length, &result, NULL)) {
713       goto error;
714         }
715     }
716     if (!WriteFile(handle, "\r\n", 2, &result, NULL)) {
717         goto error;
718     }
719     native = p+1;
720       }
721   }
722   length = p - native;
723   if (length > 0) {
724       if (!WriteFile(handle, native, length, &result, NULL)) {
725     goto error;
726       }
727   }
728   Tcl_DStringFree(&dstring);
729   if (SetFilePointer(handle, 0, NULL, FILE_BEGIN) == 0xFFFFFFFF) {
730       goto error;
731   }
732     }
733 
734     return TclWinMakeFile(handle);
735 
736   error:
737     /* Free the native representation of the contents if necessary */
738     if (contents != NULL) {
739   Tcl_DStringFree(&dstring);
740     }
741 
742     TclWinConvertError(GetLastError());
743     CloseHandle(handle);
744     (*tclWinProcs->deleteFileProc)((TCHAR *) name);
745     return NULL;
746 }
void TclpFinalizePipes ()

Definition at line 294 of file tclWinPipe.c.
References NULL, PipeCheckProc(), PipeSetupProc(), Tcl_DeleteEventSource(), and TclThreadDataKeyGet().295 {    
296     ThreadSpecificData *tsdPtr;
297 
298     tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
299     if (tsdPtr != NULL) {
300   Tcl_DeleteEventSource(PipeSetupProc, PipeCheckProc, NULL);
301     }
302 }
unsigned long TclpGetPid (Tcl_Pid pid)

Definition at line 883 of file tclWinPipe.c.
References ProcInfo::dwProcessId, ProcInfo::hProcess, ProcInfo::nextPtr, NULL, PipeInit(), procList, Tcl_MutexLock, and Tcl_MutexUnlock.885 {
886     ProcInfo *infoPtr;
887 
888     PipeInit();
889 
890     Tcl_MutexLock(&pipeMutex);
891     for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
892   if (infoPtr->hProcess == (HANDLE) pid) {
893       Tcl_MutexUnlock(&pipeMutex);
894       return infoPtr->dwProcessId;
895   }
896     }
897     Tcl_MutexUnlock(&pipeMutex);
898     return (unsigned long) -1;
899 }
TclFile TclpMakeFile (Tcl_Channel channel, int direction)

Definition at line 523 of file tclWinPipe.c.
References NULL, Tcl_GetChannelHandle(), TCL_OK, and TclWinMakeFile().526 {
527     HANDLE handle;
528 
529     if (Tcl_GetChannelHandle(channel, direction, 
530       (ClientData *) &handle) == TCL_OK) {
531   return TclWinMakeFile(handle);
532     } else {
533   return (TclFile) NULL;
534     }
535 }
TclFile TclpOpenFile (CONST char * path, int mode)

Definition at line 555 of file tclWinPipe.c.
References CONST, DWORD(), NULL, Tcl_DStringFree(), Tcl_WinUtfToTChar(), TclWinConvertError(), TclWinMakeFile(), and tclWinProcs.558 {
559     HANDLE handle;
560     DWORD accessMode, createMode, shareMode, flags;
561     Tcl_DString ds;
562     CONST TCHAR *nativePath;
563     
564     /*
565      * Map the access bits to the NT access mode.
566      */
567 
568     switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
569   case O_RDONLY:
570       accessMode = GENERIC_READ;
571       break;
572   case O_WRONLY:
573       accessMode = GENERIC_WRITE;
574       break;
575   case O_RDWR:
576       accessMode = (GENERIC_READ | GENERIC_WRITE);
577       break;
578   default:
579       TclWinConvertError(ERROR_INVALID_FUNCTION);
580       return NULL;
581     }
582 
583     /*
584      * Map the creation flags to the NT create mode.
585      */
586 
587     switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
588   case (O_CREAT | O_EXCL):
589   case (O_CREAT | O_EXCL | O_TRUNC):
590       createMode = CREATE_NEW;
591       break;
592   case (O_CREAT | O_TRUNC):
593       createMode = CREATE_ALWAYS;
594       break;
595   case O_CREAT:
596       createMode = OPEN_ALWAYS;
597       break;
598   case O_TRUNC:
599   case (O_TRUNC | O_EXCL):
600       createMode = TRUNCATE_EXISTING;
601       break;
602   default:
603       createMode = OPEN_EXISTING;
604       break;
605     }
606 
607     nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
608 
609     /*
610      * If the file is not being created, use the existing file attributes.
611      */
612 
613     flags = 0;
614     if (!(mode & O_CREAT)) {
615   flags = (*tclWinProcs->getFileAttributesProc)(nativePath);
616   if (flags == 0xFFFFFFFF) {
617       flags = 0;
618   }
619     }
620 
621     /*
622      * Set up the file sharing mode.  We want to allow simultaneous access.
623      */
624 
625     shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
626 
627     /*
628      * Now we get to create the file.
629      */
630 
631     handle = (*tclWinProcs->createFileProc)(nativePath, accessMode, 
632       shareMode, NULL, createMode, flags, NULL);
633     Tcl_DStringFree(&ds);
634 
635     if (handle == INVALID_HANDLE_VALUE) {
636   DWORD err;
637   
638   err = GetLastError();
639   if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
640       err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
641   }
642         TclWinConvertError(err);
643         return NULL;
644     }
645 
646     /*
647      * Seek to the end of file if we are writing.
648      */
649 
650     if (mode & (O_WRONLY|O_APPEND)) {
651   SetFilePointer(handle, 0, NULL, FILE_END);
652     }
653 
654     return TclWinMakeFile(handle);
655 }
Tcl_Obj* TclpTempFileName ()

Definition at line 765 of file tclWinPipe.c.
References NULL, TclpNativeToNormalized(), and TempFileName().766 {
767     WCHAR fileName[MAX_PATH];
768 
769     if (TempFileName(fileName) == 0) {
770   return NULL;
771     }
772 
773     return TclpNativeToNormalized((ClientData) fileName);
774 }
void TclWinAddProcess (HANDLE hProcess, DWORD id)

Definition at line 2639 of file tclWinPipe.c.
References ckalloc, ProcInfo::dwProcessId, ProcInfo::hProcess, ProcInfo::nextPtr, PipeInit(), procList, Tcl_MutexLock, and Tcl_MutexUnlock.
Referenced by TclpCreateProcess().2642 {
2643     ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo));
2644 
2645     PipeInit();
2646     
2647     procPtr->hProcess = hProcess;
2648     procPtr->dwProcessId = id;
2649     Tcl_MutexLock(&pipeMutex);
2650     procPtr->nextPtr = procList;
2651     procList = procPtr;
2652     Tcl_MutexUnlock(&pipeMutex);
2653 }
TclFile TclWinMakeFile (HANDLE handle)

Definition at line 448 of file tclWinPipe.c.
References ckalloc, WIN_FILE, and WinFile.
Referenced by Tcl_MakeFileChannel(), TclpCreatePipe(), TclpCreateTempFile(), TclpMakeFile(), TclpOpenFile(), and TclpOpenFileChannel().450 {
451     WinFile *filePtr;
452 
453     filePtr = (WinFile *) ckalloc(sizeof(WinFile));
454     filePtr->type = WIN_FILE;
455     filePtr->handle = handle;
456 
457     return (TclFile)filePtr;
458 }
static int TempFileName (name) [static]

Definition at line 482 of file tclWinPipe.c.
References tclWinProcs, and TclWinProcs::useWide.485 {
486     TCHAR *prefix;
487 
488     prefix = (tclWinProcs->useWide) ? (TCHAR *) L"TCL" : (TCHAR *) "TCL";
489     if ((*tclWinProcs->getTempPathProc)(MAX_PATH, name) != 0) {
490   if ((*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0, 
491     name) != 0) {
492       return 1;
493   }
494     }
495     if (tclWinProcs->useWide) {
496   ((WCHAR *) name)[0] = '.';
497   ((WCHAR *) name)[1] = '\0';
498     } else {
499   ((char *) name)[0] = '.';
500   ((char *) name)[1] = '\0';
501     }
502     return (*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0, 
503       name);
504 }
static int TempFileName (WCHAR name[MAX_PATH]) [static]

Referenced by TclpCreateTempFile(), and TclpTempFileName().static int WaitForRead (PipeInfo * infoPtr, int blocking) [static]

Definition at line 2741 of file tclWinPipe.c.
References DWORD(), EAGAIN, EPIPE, errno, NULL, PIPE_EOF, PIPE_EXTRABYTE, PipeInfo::readable, PipeInfo::readFile, PipeInfo::readFlags, PipeInfo::startReader, TclWinConvertError(), TRUE, and WinFile.2745 {
2746     DWORD timeout, count;
2747     HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle;
2748 
2749     while (1) {
2750   /*
2751    * Synchronize with the reader thread.
2752    */
2753        
2754   timeout = blocking ? INFINITE : 0;
2755   if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) {
2756       /*
2757        * The reader thread is blocked waiting for data and the channel
2758        * is in non-blocking mode.
2759        */
2760 
2761       errno = EAGAIN;
2762       return -1;
2763   }
2764 
2765   /*
2766    * At this point, the two threads are synchronized, so it is safe
2767    * to access shared state.
2768    */
2769 
2770 
2771   /*
2772    * If the pipe has hit EOF, it is always readable.
2773    */
2774 
2775   if (infoPtr->readFlags & PIPE_EOF) {
2776       return 1;
2777   }
2778     
2779   /*
2780    * Check to see if there is any data sitting in the pipe.
2781    */
2782 
2783   if (PeekNamedPipe(handle, (LPVOID) NULL, (DWORD) 0,
2784     (LPDWORD) NULL, &count, (LPDWORD) NULL) != TRUE) {
2785       TclWinConvertError(GetLastError());
2786       /*
2787        * Check to see if the peek failed because of EOF.
2788        */
2789 
2790       if (errno == EPIPE) {
2791     infoPtr->readFlags |= PIPE_EOF;
2792     return 1;
2793       }
2794 
2795       /*
2796        * Ignore errors if there is data in the buffer.
2797        */
2798 
2799       if (infoPtr->readFlags & PIPE_EXTRABYTE) {
2800     return 0;
2801       } else {
2802     return -1;
2803       }
2804   }
2805 
2806   /*
2807    * We found some data in the pipe, so it must be readable.
2808    */
2809 
2810   if (count > 0) {
2811       return 1;
2812   }
2813 
2814   /*
2815    * The pipe isn't readable, but there is some data sitting
2816    * in the buffer, so return immediately.
2817    */
2818 
2819   if (infoPtr->readFlags & PIPE_EXTRABYTE) {
2820       return 0;
2821   }
2822 
2823   /*
2824    * There wasn't any data available, so reset the thread and
2825    * try again.
2826    */
2827     
2828   ResetEvent(infoPtr->readable);
2829   SetEvent(infoPtr->startReader);
2830     }
2831 }

Variable Documentation
Tcl_ThreadDataKey dataKey [static]

Definition at line 162 of file tclWinPipe.c.int initialized = 0 [static]

Definition at line 26 of file tclWinPipe.c.Tcl_ChannelType pipeChannelType [static]
Initial value: {
    "pipe",     
    TCL_CHANNEL_VERSION_4,  
    TCL_CLOSE2PROC,   
    PipeInputProc,    
    PipeOutputProc,   
    NULL,     
    NULL,     
    NULL,     
    PipeWatchProc,    
    PipeGetHandleProc,    
    PipeClose2Proc,   
    PipeBlockModeProc,    
    NULL,     
    NULL,     
    NULL,                       
    PipeThreadActionProc,       
}
Definition at line 214 of file tclWinPipe.c.ProcInfo* procList [static]

Definition at line 74 of file tclWinPipe.c.
Referenced by PipeInit(), Tcl_WaitPid(), TclpGetPid(), and TclWinAddProcess().WinFile

Definition at line 62 of file tclWinPipe.c.
Referenced by PipeCheckProc(), PipeClose2Proc(), PipeEventProc(), PipeGetHandleProc(), PipeInputProc(), PipeOutputProc(), PipeReaderThread(), PipeSetupProc(), PipeWriterThread(), TclpCloseFile(), TclpCreateCommandChannel(), TclpCreateProcess(), TclWinMakeFile(), and WaitForRead().

win/tclWinPort.h File Reference
#include "tclInt.h"
#include <stdio.h>
#include <stdlib.h>
#include <errno.h>
#include <fcntl.h>
#include <float.h>
#include <io.h>
#include <malloc.h>
#include <process.h>
#include <signal.h>
#include <string.h>
#include <sys/stat.h>
#include <sys/timeb.h>
#include <sys/utime.h>
#include <time.h>
#include <windows.h>
#include <winsock2.h>
#include "tclPlatDecls.h"
#include "tclIntPlatDecls.h"
Defines
#define WIN32_LEAN_AND_MEAN
#define INCL_WINSOCK_API_TYPEDEFS  1
#define EINPROGRESS  WSAEINPROGRESS
#define ENOTSUP  -1030507
#define EWOULDBLOCK  EAGAIN
#define EALREADY  149
#define ENOTSOCK  95
#define EDESTADDRREQ  96
#define EMSGSIZE  97
#define EPROTOTYPE  98
#define ENOPROTOOPT  99
#define EPROTONOSUPPORT  120
#define ESOCKTNOSUPPORT  121
#define EOPNOTSUPP  122
#define EPFNOSUPPORT  123
#define EAFNOSUPPORT  124
#define EADDRINUSE  125
#define EADDRNOTAVAIL  126
#define ENETDOWN  127
#define ENETUNREACH  128
#define ENETRESET  129
#define ECONNABORTED  130
#define ECONNRESET  131
#define ENOBUFS  132
#define EISCONN  133
#define ENOTCONN  134
#define ESHUTDOWN  143
#define ETOOMANYREFS  144
#define ETIMEDOUT  145
#define ECONNREFUSED  146
#define ELOOP  90
#define EHOSTDOWN  147
#define EHOSTUNREACH  148
#define ENOTEMPTY  93
#define EUSERS  94
#define EDQUOT  69
#define ESTALE  151
#define EREMOTE  66
#define EOVERFLOW  EINVAL
#define WAIT_STATUS_TYPE  int
#define WIFEXITED(stat)  (((*((int *) &(stat))) & 0xC0000000) == 0)
#define WEXITSTATUS(stat)  (*((int *) &(stat)))
#define WIFSIGNALED(stat)  ((*((int *) &(stat))) & 0xC0000000)
#define WTERMSIG(stat)  ((*((int *) &(stat))) & 0x7f)
#define WIFSTOPPED(stat)  0
#define WSTOPSIG(stat)  (((*((int *) &(stat))) >> 8) & 0xff)
#define WNOHANG  1
#define WUNTRACED  2
#define F_OK  00
#define X_OK  01
#define W_OK  02
#define R_OK  04
#define S_IFLNK  0120000
#define S_ISREG(m)  0
#define S_ISDIR(m)  0
#define S_ISCHR(m)  0
#define S_ISBLK(m)  0
#define S_ISFIFO(m)  0
#define S_ISLNK(m)  (((m) & S_IFMT) == S_IFLNK)
#define MAXPATH  MAX_PATH
#define MAXPATHLEN  MAXPATH
#define pid_t  int
#define uid_t  int
#define TclpPanic  ((Tcl_PanicProc *) NULL)
#define TCL_PLATFORM_TRANSLATION  TCL_TRANSLATE_CRLF
#define TCL_SHLIB_EXT  ".dll"
#define USE_PUTENV  1
#define USE_PUTENV_FOR_UNSET  1
#define TclpSysAlloc(size, isBin)
#define TclpSysFree(ptr)
#define TclpSysRealloc(ptr, size)
#define getservbyname  TclWinGetServByName
#define getsockopt  TclWinGetSockOpt
#define ntohs  TclWinNToHS
#define setsockopt  TclWinSetSockOpt
#define socklen_t  int
#define TclpReleaseFile(file)  ckfree((char *) file)
#define TclpExit  exit
#define TclpMutexInit(a)
#define TclpMutexLock(a)
#define TclpMutexUnlock(a)
#define INVALID_SET_FILE_POINTER  0xFFFFFFFF
#define TCL_STORAGE_CLASS  DLLIMPORT
Typedefs
typedef int TclpMutex
Functions
EXTERN HANDLE TclWinSerialReopen _ANSI_ARGS_ ((HANDLE handle, CONST TCHAR *name, DWORD access))
EXTERN Tcl_Channel TclWinOpenSerialChannel _ANSI_ARGS_ ((HANDLE handle, char *channelName, int permissions))
EXTERN Tcl_Channel TclWinOpenFileChannel _ANSI_ARGS_ ((HANDLE handle, char *channelName, int permissions, int appendMode))
EXTERN TclFile TclWinMakeFile _ANSI_ARGS_ ((HANDLE handle))

Define Documentation
#define EADDRINUSE  125

Definition at line 141 of file tclWinPort.h.#define EADDRNOTAVAIL  126

Definition at line 144 of file tclWinPort.h.#define EAFNOSUPPORT  124

Definition at line 138 of file tclWinPort.h.#define EALREADY  149

Definition at line 108 of file tclWinPort.h.#define ECONNABORTED  130

Definition at line 156 of file tclWinPort.h.#define ECONNREFUSED  146

Definition at line 180 of file tclWinPort.h.#define ECONNRESET  131

Definition at line 159 of file tclWinPort.h.#define EDESTADDRREQ  96

Definition at line 114 of file tclWinPort.h.#define EDQUOT  69

Definition at line 198 of file tclWinPort.h.#define EHOSTDOWN  147

Definition at line 186 of file tclWinPort.h.#define EHOSTUNREACH  148

Definition at line 189 of file tclWinPort.h.#define EINPROGRESS  WSAEINPROGRESS

Definition at line 88 of file tclWinPort.h.#define EISCONN  133

Definition at line 165 of file tclWinPort.h.#define ELOOP  90

Definition at line 183 of file tclWinPort.h.#define EMSGSIZE  97

Definition at line 117 of file tclWinPort.h.#define ENETDOWN  127

Definition at line 147 of file tclWinPort.h.#define ENETRESET  129

Definition at line 153 of file tclWinPort.h.#define ENETUNREACH  128

Definition at line 150 of file tclWinPort.h.#define ENOBUFS  132

Definition at line 162 of file tclWinPort.h.#define ENOPROTOOPT  99

Definition at line 123 of file tclWinPort.h.#define ENOTCONN  134

Definition at line 168 of file tclWinPort.h.#define ENOTEMPTY  93

Definition at line 192 of file tclWinPort.h.#define ENOTSOCK  95

Definition at line 111 of file tclWinPort.h.#define ENOTSUP  -1030507

Definition at line 96 of file tclWinPort.h.
Referenced by Tcl_ErrnoId(), and Tcl_ErrnoMsg().#define EOPNOTSUPP  122

Definition at line 132 of file tclWinPort.h.#define EOVERFLOW  EINVAL

Definition at line 217 of file tclWinPort.h.#define EPFNOSUPPORT  123

Definition at line 135 of file tclWinPort.h.#define EPROTONOSUPPORT  120

Definition at line 126 of file tclWinPort.h.#define EPROTOTYPE  98

Definition at line 120 of file tclWinPort.h.#define EREMOTE  66

Definition at line 204 of file tclWinPort.h.#define ESHUTDOWN  143

Definition at line 171 of file tclWinPort.h.#define ESOCKTNOSUPPORT  121

Definition at line 129 of file tclWinPort.h.#define ESTALE  151

Definition at line 201 of file tclWinPort.h.#define ETIMEDOUT  145

Definition at line 177 of file tclWinPort.h.#define ETOOMANYREFS  144

Definition at line 174 of file tclWinPort.h.#define EUSERS  94

Definition at line 195 of file tclWinPort.h.#define EWOULDBLOCK  EAGAIN

Definition at line 105 of file tclWinPort.h.#define F_OK  00

Definition at line 273 of file tclWinPort.h.#define getservbyname  TclWinGetServByName

Definition at line 461 of file tclWinPort.h.
Referenced by TclSockGetPort().#define getsockopt  TclWinGetSockOpt

Definition at line 462 of file tclWinPort.h.
Referenced by TclSockMinimumBuffers(), and TcpGetOptionProc().#define INCL_WINSOCK_API_TYPEDEFS  1

Definition at line 75 of file tclWinPort.h.#define INVALID_SET_FILE_POINTER  0xFFFFFFFF

Definition at line 528 of file tclWinPort.h.
Referenced by FileSeekProc(), and FileWideSeekProc().#define MAXPATH  MAX_PATH

Definition at line 343 of file tclWinPort.h.#define MAXPATHLEN  MAXPATH

Definition at line 347 of file tclWinPort.h.#define ntohs  TclWinNToHS

Definition at line 463 of file tclWinPort.h.
Referenced by TclSockGetPort(), TcpAccept(), and TcpGetOptionProc().#define pid_t  int

Definition at line 355 of file tclWinPort.h.#define R_OK  04

Definition at line 282 of file tclWinPort.h.#define S_IFLNK  0120000

Definition at line 291 of file tclWinPort.h.
Referenced by DoCopyFile(), NativeStatMode(), TCL_DECLARE_MUTEX(), and TclpObjStatAlias().#define S_ISBLK(m)  0

Definition at line 319 of file tclWinPort.h.#define S_ISCHR(m)  0

Definition at line 312 of file tclWinPort.h.#define S_ISDIR(m)  0

Definition at line 305 of file tclWinPort.h.#define S_ISFIFO(m)  0

Definition at line 326 of file tclWinPort.h.#define S_ISLNK(m)  (((m) & S_IFMT) == S_IFLNK)

Definition at line 331 of file tclWinPort.h.#define S_ISREG(m)  0

Definition at line 298 of file tclWinPort.h.#define setsockopt  TclWinSetSockOpt

Definition at line 464 of file tclWinPort.h.
Referenced by CreateSocket(), and TclSockMinimumBuffers().#define socklen_t  int

Definition at line 466 of file tclWinPort.h.
Referenced by Tcl_MakeFileChannel(), TclSockMinimumBuffers(), TcpAccept(), and TcpGetOptionProc().#define TCL_PLATFORM_TRANSLATION  TCL_TRANSLATE_CRLF

Definition at line 412 of file tclWinPort.h.#define TCL_SHLIB_EXT  ".dll"

Definition at line 418 of file tclWinPort.h.#define TCL_STORAGE_CLASS  DLLIMPORT

Definition at line 535 of file tclWinPort.h.#define TclpExit  exit

Definition at line 481 of file tclWinPort.h.#define TclpMutexInit(a)

Definition at line 515 of file tclWinPort.h.#define TclpMutexLock(a)

Definition at line 516 of file tclWinPort.h.#define TclpMutexUnlock(a)

Definition at line 517 of file tclWinPort.h.#define TclpPanic  ((Tcl_PanicProc *) NULL)

Definition at line 398 of file tclWinPort.h.#define TclpReleaseFile(file)  ckfree((char *) file)

Definition at line 474 of file tclWinPort.h.#define TclpSysAlloc(size, isBin)
Value:((void*)HeapAlloc(GetProcessHeap(), \
              (DWORD)0, (DWORD)size))
Definition at line 447 of file tclWinPort.h.
Referenced by TclpSysRealloc().#define TclpSysFree(ptr)
Value:(HeapFree(GetProcessHeap(), \
              (DWORD)0, (HGLOBAL)ptr))
Definition at line 449 of file tclWinPort.h.
Referenced by TclpSysRealloc().#define TclpSysRealloc(ptr, size)
Value:((void*)HeapReAlloc(GetProcessHeap(), \
              (DWORD)0, (LPVOID)ptr, (DWORD)size))
Definition at line 451 of file tclWinPort.h.#define uid_t  int

Definition at line 358 of file tclWinPort.h.
Referenced by SetGroupAttribute(), and SetOwnerAttribute().#define USE_PUTENV  1

Definition at line 426 of file tclWinPort.h.#define USE_PUTENV_FOR_UNSET  1

Definition at line 427 of file tclWinPort.h.#define W_OK  02

Definition at line 279 of file tclWinPort.h.#define WAIT_STATUS_TYPE  int

Definition at line 229 of file tclWinPort.h.#define WEXITSTATUS(stat)  (*((int *) &(stat)))

Definition at line 237 of file tclWinPort.h.#define WIFEXITED(stat)  (((*((int *) &(stat))) & 0xC0000000) == 0)

Definition at line 233 of file tclWinPort.h.#define WIFSIGNALED(stat)  ((*((int *) &(stat))) & 0xC0000000)

Definition at line 241 of file tclWinPort.h.#define WIFSTOPPED(stat)  0

Definition at line 249 of file tclWinPort.h.#define WIN32_LEAN_AND_MEAN

Definition at line 68 of file tclWinPort.h.#define WNOHANG  1

Definition at line 262 of file tclWinPort.h.#define WSTOPSIG(stat)  (((*((int *) &(stat))) >> 8) & 0xff)

Definition at line 253 of file tclWinPort.h.#define WTERMSIG(stat)  ((*((int *) &(stat))) & 0x7f)

Definition at line 245 of file tclWinPort.h.#define WUNTRACED  2

Definition at line 265 of file tclWinPort.h.#define X_OK  01

Definition at line 276 of file tclWinPort.h.
Typedef Documentation
typedef int TclpMutex

Definition at line 514 of file tclWinPort.h.
Function Documentation
EXTERN TclFile TclWinMakeFile _ANSI_ARGS_ ((HANDLE handle))
EXTERN Tcl_Channel TclWinOpenFileChannel _ANSI_ARGS_ ((HANDLE handle, char *channelName, int permissions, int appendMode))
EXTERN Tcl_Channel TclWinOpenSerialChannel _ANSI_ARGS_ ((HANDLE handle, char *channelName, int permissions))
EXTERN HANDLE TclWinSerialReopen _ANSI_ARGS_ ((HANDLE handle, CONST TCHAR *name, DWORD access))

win/tclWinReg.c File Reference
#include <tclPort.h>
#include <stdlib.h>
Classes
struct RegWinProcs
Defines
#define TCL_STORAGE_CLASS  DLLEXPORT
#define SWAPWORD(x)  MAKEWORD(HIBYTE(x), LOBYTE(x))
#define SWAPLONG(x)  MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x)))
#define REG_CREATE  1
Functions
static void AppendSystemError (Tcl_Interp *interp, DWORD error)
static int BroadcastValue (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
static DWORD ConvertDWORD (DWORD type, DWORD value)
static int DeleteKey (Tcl_Interp *interp, Tcl_Obj *keyNameObj)
static int DeleteValue (Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj)
static int GetKeyNames (Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *patternObj)
static int GetType (Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj)
static int GetValue (Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj)
static int GetValueNames (Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *patternObj)
static int OpenKey (Tcl_Interp *interp, Tcl_Obj *keyNameObj, REGSAM mode, int flags, HKEY *keyPtr)
static DWORD OpenSubKey (char *hostName, HKEY rootKey, char *keyName, REGSAM mode, int flags, HKEY *keyPtr)
static int ParseKeyName (Tcl_Interp *interp, char *name, char **hostNamePtr, HKEY *rootKeyPtr, char **keyNamePtr)
static DWORD RecursiveDeleteKey (HKEY hStartKey, CONST TCHAR *pKeyName)
static int RegistryObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
static int SetValue (Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, Tcl_Obj *typeObj)
EXTERN int Registry_Init (Tcl_Interp *interp)
static DWORD RecursiveDeleteKey (HKEY startKey, CONST char *keyName)
Variables
static CONST char * rootKeyNames []
static HKEY rootKeys []
static CONST char * typeNames []
static DWORD lastType = REG_RESOURCE_LIST
static RegWinProcs * regWinProcs
static RegWinProcs asciiProcs
static RegWinProcs unicodeProcs

Define Documentation
#define REG_CREATE  1

Definition at line 41 of file tclWinReg.c.
Referenced by OpenSubKey().#define SWAPLONG(x)  MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x)))

Definition at line 34 of file tclWinReg.c.
Referenced by ConvertDWORD().#define SWAPWORD(x)  MAKEWORD(HIBYTE(x), LOBYTE(x))

Definition at line 33 of file tclWinReg.c.#define TCL_STORAGE_CLASS  DLLEXPORT

Definition at line 27 of file tclWinReg.c.
Function Documentation
static void AppendSystemError (Tcl_Interp * interp, DWORD error) [static]

Definition at line 1390 of file tclWinReg.c.
References NULL, Tcl_AppendToObj(), Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, Tcl_ExternalToUtfDString(), Tcl_FreeEncoding(), Tcl_GetEncoding(), Tcl_GetObjResult(), and TCL_INTEGER_SPACE.
Referenced by DeleteKey(), DeleteValue(), GetType(), GetValue(), GetValueNames(), OpenKey(), and SetValue().1393 {
1394     int length;
1395     WCHAR *wMsgPtr;
1396     char *msg;
1397     char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE];
1398     Tcl_DString ds;
1399     Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
1400 
1401     length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM
1402       | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
1403       MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) &wMsgPtr,
1404       0, NULL);
1405     if (length == 0) {
1406   char *msgPtr;
1407 
1408   length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM
1409     | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
1410     MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr,
1411     0, NULL);
1412   if (length > 0) {
1413       wMsgPtr = (WCHAR *) LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR));
1414       MultiByteToWideChar(CP_ACP, 0, msgPtr, length + 1, wMsgPtr,
1415         length + 1);
1416       LocalFree(msgPtr);
1417   }
1418     }
1419     if (length == 0) {
1420   if (error == ERROR_CALL_NOT_IMPLEMENTED) {
1421       msg = "function not supported under Win32s";
1422   } else {
1423       sprintf(msgBuf, "unknown error: %ld", error);
1424       msg = msgBuf;
1425   }
1426     } else {
1427   Tcl_Encoding encoding;
1428 
1429   encoding = Tcl_GetEncoding(NULL, "unicode");
1430   Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds);
1431   Tcl_FreeEncoding(encoding);
1432   LocalFree(wMsgPtr);
1433 
1434   msg = Tcl_DStringValue(&ds);
1435   length = Tcl_DStringLength(&ds);
1436 
1437   /*
1438    * Trim the trailing CR/LF from the system message.
1439    */
1440   if (msg[length-1] == '\n') {
1441       msg[--length] = 0;
1442   }
1443   if (msg[length-1] == '\r') {
1444       msg[--length] = 0;
1445   }
1446     }
1447 
1448     sprintf(id, "%ld", error);
1449     Tcl_SetErrorCode(interp, "WINDOWS", id, msg, (char *) NULL);
1450     Tcl_AppendToObj(resultPtr, msg, length);
1451 
1452     if (length != 0) {
1453   Tcl_DStringFree(&ds);
1454     }
1455 }
static int BroadcastValue (Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[]) [static]

Definition at line 1326 of file tclWinReg.c.
References NULL, size_t(), TCL_ERROR, Tcl_GetIntFromObj(), Tcl_GetStringFromObj(), Tcl_ListObjAppendElement(), Tcl_NewLongObj(), Tcl_NewObj(), TCL_OK, Tcl_SetObjResult(), and Tcl_WrongNumArgs().
Referenced by RegistryObjCmd().1330 {
1331     LRESULT result, sendResult;
1332     UINT timeout = 3000;
1333     int len;
1334     char *str;
1335     Tcl_Obj *objPtr;
1336 
1337     if ((objc != 3) && (objc != 5)) {
1338   Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?");
1339   return TCL_ERROR;
1340     }
1341 
1342     if (objc > 3) {
1343   str = Tcl_GetStringFromObj(objv[3], &len);
1344   if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", (size_t) len)) {
1345       Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?");
1346       return TCL_ERROR;
1347   }
1348   if (Tcl_GetIntFromObj(interp, objv[4], (int *) &timeout) != TCL_OK) {
1349       return TCL_ERROR;
1350   }
1351     }
1352 
1353     str = Tcl_GetStringFromObj(objv[2], &len);
1354     if (len == 0) {
1355   str = NULL;
1356     }
1357 
1358     /*
1359      * Use the ignore the result.
1360      */
1361     result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE,
1362       (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult);
1363 
1364     objPtr = Tcl_NewObj();
1365     Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) result));
1366     Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) sendResult));
1367     Tcl_SetObjResult(interp, objPtr);
1368 
1369     return TCL_OK;
1370 }
static DWORD ConvertDWORD (DWORD type, DWORD value) [static]

Definition at line 1475 of file tclWinReg.c.
References DWORD(), and SWAPLONG.
Referenced by GetValue(), and SetValue().1478 {
1479     DWORD order = 1;
1480     DWORD localType;
1481 
1482     /*
1483      * Check to see if the low bit is in the first byte.
1484      */
1485 
1486     localType = (*((char*)(&order)) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
1487     return (type != localType) ? SWAPLONG(value) : value;
1488 }
static int DeleteKey (Tcl_Interp * interp, Tcl_Obj * keyNameObj) [static]

Definition at line 360 of file tclWinReg.c.
References AppendSystemError(), ckalloc, ckfree, CONST, DWORD(), NULL, OpenSubKey(), ParseKeyName(), RecursiveDeleteKey(), Tcl_AppendToObj(), Tcl_DStringFree(), TCL_ERROR, Tcl_GetObjResult(), Tcl_GetStringFromObj(), TCL_OK, and Tcl_WinUtfToTChar().
Referenced by RegistryObjCmd().363 {
364     char *tail, *buffer, *hostName, *keyName;
365     CONST char *nativeTail;
366     HKEY rootKey, subkey;
367     DWORD result;
368     int length;
369     Tcl_Obj *resultPtr;
370     Tcl_DString buf;
371 
372     /*
373      * Find the parent of the key being deleted and open it.
374      */
375 
376     keyName = Tcl_GetStringFromObj(keyNameObj, &length);
377     buffer = ckalloc((unsigned int) length + 1);
378     strcpy(buffer, keyName);
379 
380     if (ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName)
381       != TCL_OK) {
382   ckfree(buffer);
383   return TCL_ERROR;
384     }
385 
386     resultPtr = Tcl_GetObjResult(interp);
387     if (*keyName == '\0') {
388   Tcl_AppendToObj(resultPtr, "bad key: cannot delete root keys", -1);
389   ckfree(buffer);
390   return TCL_ERROR;
391     }
392 
393     tail = strrchr(keyName, '\\');
394     if (tail) {
395   *tail++ = '\0';
396     } else {
397   tail = keyName;
398   keyName = NULL;
399     }
400 
401     result = OpenSubKey(hostName, rootKey, keyName,
402       KEY_ENUMERATE_SUB_KEYS | DELETE, 0, &subkey);
403     if (result != ERROR_SUCCESS) {
404   ckfree(buffer);
405   if (result == ERROR_FILE_NOT_FOUND) {
406       return TCL_OK;
407   } else {
408       Tcl_AppendToObj(resultPtr, "unable to delete key: ", -1);
409       AppendSystemError(interp, result);
410       return TCL_ERROR;
411   }
412     }
413 
414     /*
415      * Now we recursively delete the key and everything below it.
416      */
417 
418     nativeTail = Tcl_WinUtfToTChar(tail, -1, &buf);
419     result = RecursiveDeleteKey(subkey, nativeTail);
420     Tcl_DStringFree(&buf);
421 
422     if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) {
423   Tcl_AppendToObj(resultPtr, "unable to delete key: ", -1);
424   AppendSystemError(interp, result);
425   result = TCL_ERROR;
426     } else {
427   result = TCL_OK;
428     }
429 
430     RegCloseKey(subkey);
431     ckfree(buffer);
432     return result;
433 }
static int DeleteValue (Tcl_Interp * interp, Tcl_Obj * keyNameObj, Tcl_Obj * valueNameObj) [static]

Definition at line 452 of file tclWinReg.c.
References AppendSystemError(), DWORD(), NULL, OpenKey(), regWinProcs, Tcl_DStringFree(), Tcl_DStringValue, TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), TCL_OK, and Tcl_WinUtfToTChar().
Referenced by RegistryObjCmd().456 {
457     HKEY key;
458     char *valueName;
459     int length;
460     DWORD result;
461     Tcl_Obj *resultPtr;
462     Tcl_DString ds;
463 
464     /*
465      * Attempt to open the key for deletion.
466      */
467 
468     if (OpenKey(interp, keyNameObj, KEY_SET_VALUE, 0, &key)
469       != TCL_OK) {
470   return TCL_ERROR;
471     }
472 
473     resultPtr = Tcl_GetObjResult(interp);
474     valueName = Tcl_GetStringFromObj(valueNameObj, &length);
475     Tcl_WinUtfToTChar(valueName, length, &ds);
476     result = (*regWinProcs->regDeleteValueProc)(key, Tcl_DStringValue(&ds));
477     Tcl_DStringFree(&ds);
478     if (result != ERROR_SUCCESS) {
479   Tcl_AppendStringsToObj(resultPtr, "unable to delete value \"",
480     Tcl_GetString(valueNameObj), "\" from key \"",
481     Tcl_GetString(keyNameObj), "\": ", NULL);
482   AppendSystemError(interp, result);
483   result = TCL_ERROR;
484     } else {
485   result = TCL_OK;
486     }
487     RegCloseKey(key);
488     return result;
489 }
static int GetKeyNames (Tcl_Interp * interp, Tcl_Obj * keyNameObj, Tcl_Obj * patternObj) [static]

Definition at line 511 of file tclWinReg.c.
References DWORD(), NULL, OpenKey(), regWinProcs, Tcl_DStringFree(), Tcl_DStringLength, Tcl_DStringValue, TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), Tcl_ListObjAppendElement(), Tcl_NewStringObj(), TCL_OK, Tcl_StringMatch(), and Tcl_WinTCharToUtf().
Referenced by RegistryObjCmd().515 {
516     HKEY key;
517     DWORD index;
518     char buffer[MAX_PATH+1], *pattern, *name;
519     Tcl_Obj *resultPtr;
520     int result = TCL_OK;
521     Tcl_DString ds;
522 
523     /*
524      * Attempt to open the key for enumeration.
525      */
526 
527     if (OpenKey(interp, keyNameObj, KEY_ENUMERATE_SUB_KEYS, 0, &key)
528       != TCL_OK) {
529   return TCL_ERROR;
530     }
531 
532     if (patternObj) {
533   pattern = Tcl_GetString(patternObj);
534     } else {
535   pattern = NULL;
536     }
537 
538     /*
539      * Enumerate over the subkeys until we get an error, indicating the
540      * end of the list.
541      */
542 
543     resultPtr = Tcl_GetObjResult(interp);
544     for (index = 0; (*regWinProcs->regEnumKeyProc)(key, index, buffer,
545       MAX_PATH+1) == ERROR_SUCCESS; index++) {
546   Tcl_WinTCharToUtf((TCHAR *) buffer, -1, &ds);
547   name = Tcl_DStringValue(&ds);
548   if (pattern && !Tcl_StringMatch(name, pattern)) {
549       Tcl_DStringFree(&ds);
550       continue;
551   }
552   result = Tcl_ListObjAppendElement(interp, resultPtr,
553     Tcl_NewStringObj(name, Tcl_DStringLength(&ds)));
554   Tcl_DStringFree(&ds);
555   if (result != TCL_OK) {
556       break;
557   }
558     }
559 
560     RegCloseKey(key);
561     return result;
562 }
static int GetType (Tcl_Interp * interp, Tcl_Obj * keyNameObj, Tcl_Obj * valueNameObj) [static]

Definition at line 582 of file tclWinReg.c.
References AppendSystemError(), CONST, DWORD(), lastType, NULL, OpenKey(), regWinProcs, Tcl_DStringFree(), TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), TCL_OK, Tcl_SetIntObj(), Tcl_SetStringObj(), Tcl_WinUtfToTChar(), and typeNames.
Referenced by RegistryObjCmd().586 {
587     HKEY key;
588     Tcl_Obj *resultPtr;
589     DWORD result;
590     DWORD type;
591     Tcl_DString ds;
592     char *valueName;
593     CONST char *nativeValue;
594     int length;
595 
596     /*
597      * Attempt to open the key for reading.
598      */
599 
600     if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
601       != TCL_OK) {
602   return TCL_ERROR;
603     }
604 
605     /*
606      * Get the type of the value.
607      */
608 
609     resultPtr = Tcl_GetObjResult(interp);
610 
611     valueName = Tcl_GetStringFromObj(valueNameObj, &length);
612     nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds);
613     result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type,
614       NULL, NULL);
615     Tcl_DStringFree(&ds);
616     RegCloseKey(key);
617 
618     if (result != ERROR_SUCCESS) {
619   Tcl_AppendStringsToObj(resultPtr, "unable to get type of value \"",
620     Tcl_GetString(valueNameObj), "\" from key \"",
621     Tcl_GetString(keyNameObj), "\": ", NULL);
622   AppendSystemError(interp, result);
623   return TCL_ERROR;
624     }
625 
626     /*
627      * Set the type into the result.  Watch out for unknown types.
628      * If we don't know about the type, just use the numeric value.
629      */
630 
631     if (type > lastType || type < 0) {
632   Tcl_SetIntObj(resultPtr, (int) type);
633     } else {
634   Tcl_SetStringObj(resultPtr, typeNames[type], -1);
635     }
636     return TCL_OK;
637 }
static int GetValue (Tcl_Interp * interp, Tcl_Obj * keyNameObj, Tcl_Obj * valueNameObj) [static]

Definition at line 658 of file tclWinReg.c.
References AppendSystemError(), CONST, ConvertDWORD(), DWORD(), NULL, OpenKey(), regWinProcs, TCL_DSTRING_STATIC_SIZE, Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringSetLength(), Tcl_DStringValue, TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_ListObjAppendElement(), Tcl_NewStringObj(), TCL_OK, Tcl_SetByteArrayObj(), Tcl_SetIntObj(), Tcl_SetStringObj(), Tcl_WinTCharToUtf(), Tcl_WinUtfToTChar(), and RegWinProcs::useWide.
Referenced by RegistryObjCmd().662 {
663     HKEY key;
664     char *valueName;
665     CONST char *nativeValue;
666     DWORD result, length, type;
667     Tcl_Obj *resultPtr;
668     Tcl_DString data, buf;
669     int nameLen;
670 
671     /*
672      * Attempt to open the key for reading.
673      */
674 
675     if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
676       != TCL_OK) {
677   return TCL_ERROR;
678     }
679 
680     /*
681      * Initialize a Dstring to maximum statically allocated size
682      * we could get one more byte by avoiding Tcl_DStringSetLength()
683      * and just setting length to TCL_DSTRING_STATIC_SIZE, but this
684      * should be safer if the implementation of Dstrings changes.
685      *
686      * This allows short values to be read from the registy in one call.
687      * Longer values need a second call with an expanded DString.
688      */
689 
690     Tcl_DStringInit(&data);
691     length = TCL_DSTRING_STATIC_SIZE - 1;
692     Tcl_DStringSetLength(&data, (int) length);
693 
694     resultPtr = Tcl_GetObjResult(interp);
695 
696     valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen);
697     nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
698 
699     result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type,
700       (BYTE *) Tcl_DStringValue(&data), &length);
701     while (result == ERROR_MORE_DATA) {
702   /*
703    * The Windows docs say that in this error case, we just need
704    * to expand our buffer and request more data.
705    * Required for HKEY_PERFORMANCE_DATA
706    */
707   length *= 2;
708         Tcl_DStringSetLength(&data, (int) length);
709         result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue,
710     NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length);
711     }
712     Tcl_DStringFree(&buf);
713     RegCloseKey(key);
714     if (result != ERROR_SUCCESS) {
715   Tcl_AppendStringsToObj(resultPtr, "unable to get value \"",
716     Tcl_GetString(valueNameObj), "\" from key \"",
717     Tcl_GetString(keyNameObj), "\": ", NULL);
718   AppendSystemError(interp, result);
719   Tcl_DStringFree(&data);
720   return TCL_ERROR;
721     }
722 
723     /*
724      * If the data is a 32-bit quantity, store it as an integer object.  If it
725      * is a multi-string, store it as a list of strings.  For null-terminated
726      * strings, append up the to first null.  Otherwise, store it as a binary
727      * string.
728      */
729 
730     if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
731   Tcl_SetIntObj(resultPtr, (int) ConvertDWORD(type,
732     *((DWORD*) Tcl_DStringValue(&data))));
733     } else if (type == REG_MULTI_SZ) {
734   char *p = Tcl_DStringValue(&data);
735   char *end = Tcl_DStringValue(&data) + length;
736 
737   /*
738    * Multistrings are stored as an array of null-terminated strings,
739    * terminated by two null characters.  Also do a bounds check in
740    * case we get bogus data.
741    */
742  
743   while (p < end  && ((regWinProcs->useWide) 
744     ? *((Tcl_UniChar *)p) : *p) != 0) {
745       Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf);
746       Tcl_ListObjAppendElement(interp, resultPtr,
747         Tcl_NewStringObj(Tcl_DStringValue(&buf),
748           Tcl_DStringLength(&buf)));
749       if (regWinProcs->useWide) {
750     while (*((Tcl_UniChar *)p)++ != 0) {}
751       } else {
752     while (*p++ != '\0') {}
753       }
754       Tcl_DStringFree(&buf);
755   }
756     } else if ((type == REG_SZ) || (type == REG_EXPAND_SZ)) {
757   Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&data), -1, &buf);
758   Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&buf),
759     Tcl_DStringLength(&buf));
760   Tcl_DStringFree(&buf);
761     } else {
762   /*
763    * Save binary data as a byte array.
764    */
765 
766   Tcl_SetByteArrayObj(resultPtr, Tcl_DStringValue(&data), (int) length);
767     }
768     Tcl_DStringFree(&data);
769     return result;
770 }
static int GetValueNames (Tcl_Interp * interp, Tcl_Obj * keyNameObj, Tcl_Obj * patternObj) [static]

Definition at line 792 of file tclWinReg.c.
References AppendSystemError(), DWORD(), NULL, OpenKey(), regWinProcs, Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringSetLength(), Tcl_DStringValue, TCL_ERROR, Tcl_GetObjResult(), Tcl_GetString(), Tcl_ListObjAppendElement(), Tcl_NewStringObj(), TCL_OK, Tcl_StringMatch(), Tcl_WinTCharToUtf(), and RegWinProcs::useWide.
Referenced by RegistryObjCmd().796 {
797     HKEY key;
798     Tcl_Obj *resultPtr;
799     DWORD index, size, maxSize, result;
800     Tcl_DString buffer, ds;
801     char *pattern, *name;
802 
803     /*
804      * Attempt to open the key for enumeration.
805      */
806 
807     if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
808       != TCL_OK) {
809   return TCL_ERROR;
810     }
811 
812     resultPtr = Tcl_GetObjResult(interp);
813 
814     /*
815      * Query the key to determine the appropriate buffer size to hold the
816      * largest value name plus the terminating null.
817      */
818 
819     result = (*regWinProcs->regQueryInfoKeyProc)(key, NULL, NULL, NULL, NULL,
820       NULL, NULL, &index, &maxSize, NULL, NULL, NULL);
821     if (result != ERROR_SUCCESS) {
822   Tcl_AppendStringsToObj(resultPtr, "unable to query key \"",
823     Tcl_GetString(keyNameObj), "\": ", NULL);
824   AppendSystemError(interp, result);
825   RegCloseKey(key);
826   result = TCL_ERROR;
827   goto done;
828     }
829     maxSize++;
830 
831 
832     Tcl_DStringInit(&buffer);
833     Tcl_DStringSetLength(&buffer,
834       (int) ((regWinProcs->useWide) ? maxSize*2 : maxSize));
835     index = 0;
836     result = TCL_OK;
837 
838     if (patternObj) {
839   pattern = Tcl_GetString(patternObj);
840     } else {
841   pattern = NULL;
842     }
843 
844     /*
845      * Enumerate the values under the given subkey until we get an error,
846      * indicating the end of the list.  Note that we need to reset size
847      * after each iteration because RegEnumValue smashes the old value.
848      */
849 
850     size = maxSize;
851     while ((*regWinProcs->regEnumValueProc)(key, index,
852       Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL)
853       == ERROR_SUCCESS) {
854 
855   if (regWinProcs->useWide) {
856       size *= 2;
857   }
858 
859   Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size, &ds);
860   name = Tcl_DStringValue(&ds);
861   if (!pattern || Tcl_StringMatch(name, pattern)) {
862       result = Tcl_ListObjAppendElement(interp, resultPtr,
863         Tcl_NewStringObj(name, Tcl_DStringLength(&ds)));
864       if (result != TCL_OK) {
865     Tcl_DStringFree(&ds);
866     break;
867       }
868   }
869   Tcl_DStringFree(&ds);
870 
871   index++;
872   size = maxSize;
873     }
874     Tcl_DStringFree(&buffer);
875 
876     done:
877     RegCloseKey(key);
878     return result;
879 }
static int OpenKey (Tcl_Interp * interp, Tcl_Obj * keyNameObj, REGSAM mode, int flags, HKEY * keyPtr) [static]

Definition at line 900 of file tclWinReg.c.
References AppendSystemError(), ckalloc, ckfree, DWORD(), OpenSubKey(), ParseKeyName(), Tcl_AppendToObj(), TCL_ERROR, Tcl_GetObjResult(), Tcl_GetStringFromObj(), and TCL_OK.
Referenced by DeleteValue(), GetKeyNames(), GetType(), GetValue(), GetValueNames(), RegistryObjCmd(), and SetValue().906 {
907     char *keyName, *buffer, *hostName;
908     int length;
909     HKEY rootKey;
910     DWORD result;
911 
912     keyName = Tcl_GetStringFromObj(keyNameObj, &length);
913     buffer = ckalloc((unsigned int) length + 1);
914     strcpy(buffer, keyName);
915 
916     result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
917     if (result == TCL_OK) {
918   result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr);
919   if (result != ERROR_SUCCESS) {
920       Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
921       Tcl_AppendToObj(resultPtr, "unable to open key: ", -1);
922       AppendSystemError(interp, result);
923       result = TCL_ERROR;
924   } else {
925       result = TCL_OK;
926   }
927     }
928 
929     ckfree(buffer);
930     return result;
931 }
static DWORD OpenSubKey (char * hostName, HKEY rootKey, char * keyName, REGSAM mode, int flags, HKEY * keyPtr) [static]

Definition at line 952 of file tclWinReg.c.
References DWORD(), NULL, REG_CREATE, regWinProcs, Tcl_DStringFree(), and Tcl_WinUtfToTChar().
Referenced by DeleteKey(), and OpenKey().959 {
960     DWORD result;
961     Tcl_DString buf;
962 
963     /*
964      * Attempt to open the root key on a remote host if necessary.
965      */
966 
967     if (hostName) {
968   hostName = (char *) Tcl_WinUtfToTChar(hostName, -1, &buf);
969   result = (*regWinProcs->regConnectRegistryProc)(hostName, rootKey,
970     &rootKey);
971   Tcl_DStringFree(&buf);
972   if (result != ERROR_SUCCESS) {
973       return result;
974   }
975     }
976 
977     /*
978      * Now open the specified key with the requested permissions.  Note
979      * that this key must be closed by the caller.
980      */
981 
982     keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
983     if (flags & REG_CREATE) {
984   DWORD create;
985   result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, NULL,
986     REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create);
987     } else {
988   if (rootKey == HKEY_PERFORMANCE_DATA) {
989       /*
990        * Here we fudge it for this special root key.
991        * See MSDN for more info on HKEY_PERFORMANCE_DATA and
992        * the peculiarities surrounding it
993        */
994       *keyPtr = HKEY_PERFORMANCE_DATA;
995       result = ERROR_SUCCESS;
996   } else {
997       result = (*regWinProcs->regOpenKeyExProc)(rootKey, keyName, 0,
998         mode, keyPtr);
999   }
1000     }
1001     Tcl_DStringFree(&buf);
1002 
1003     /*
1004      * Be sure to close the root key since we are done with it now.
1005      */
1006 
1007     if (hostName) {
1008   RegCloseKey(rootKey);
1009     }
1010     return result;
1011 }
static int ParseKeyName (Tcl_Interp * interp, char * name, char ** hostNamePtr, HKEY * rootKeyPtr, char ** keyNamePtr) [static]

Definition at line 1035 of file tclWinReg.c.
References NULL, rootKeyNames, rootKeys, Tcl_DecrRefCount, TCL_ERROR, TCL_EXACT, Tcl_GetIndexFromObj(), Tcl_GetObjResult(), Tcl_NewStringObj(), and TCL_OK.
Referenced by DeleteKey(), and OpenKey().1041 {
1042     char *rootName;
1043     int result, index;
1044     Tcl_Obj *rootObj, *resultPtr = Tcl_GetObjResult(interp);
1045 
1046     /*
1047      * Split the key into host and root portions.
1048      */
1049 
1050     *hostNamePtr = *keyNamePtr = rootName = NULL;
1051     if (name[0] == '\\') {
1052   if (name[1] == '\\') {
1053       *hostNamePtr = name;
1054       for (rootName = name+2; *rootName != '\0'; rootName++) {
1055     if (*rootName == '\\') {
1056         *rootName++ = '\0';
1057         break;
1058     }
1059       }
1060   }
1061     } else {
1062   rootName = name;
1063     }
1064     if (!rootName) {
1065   Tcl_AppendStringsToObj(resultPtr, "bad key \"", name,
1066     "\": must start with a valid root", NULL);
1067   return TCL_ERROR;
1068     }
1069 
1070     /*
1071      * Split the root into root and subkey portions.
1072      */
1073 
1074     for (*keyNamePtr = rootName; **keyNamePtr != '\0'; (*keyNamePtr)++) {
1075   if (**keyNamePtr == '\\') {
1076       **keyNamePtr = '\0';
1077       (*keyNamePtr)++;
1078       break;
1079   }
1080     }
1081 
1082     /*
1083      * Look for a matching root name.
1084      */
1085 
1086     rootObj = Tcl_NewStringObj(rootName, -1);
1087     result = Tcl_GetIndexFromObj(interp, rootObj, rootKeyNames, "root name",
1088       TCL_EXACT, &index);
1089     Tcl_DecrRefCount(rootObj);
1090     if (result != TCL_OK) {
1091   return TCL_ERROR;
1092     }
1093     *rootKeyPtr = rootKeys[index];
1094     return TCL_OK;
1095 }
static DWORD RecursiveDeleteKey (HKEY startKey, CONST char * keyName) [static]

Definition at line 1116 of file tclWinReg.c.
References DWORD(), NULL, RecursiveDeleteKey(), regWinProcs, Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringSetLength(), Tcl_DStringValue, and RegWinProcs::useWide.1120 {
1121     DWORD result, size, maxSize;
1122     Tcl_DString subkey;
1123     HKEY hKey;
1124 
1125     /*
1126      * Do not allow NULL or empty key name.
1127      */
1128 
1129     if (!keyName || *keyName == '\0') {
1130   return ERROR_BADKEY;
1131     }
1132 
1133     result = (*regWinProcs->regOpenKeyExProc)(startKey, keyName, 0,
1134       KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE, &hKey);
1135     if (result != ERROR_SUCCESS) {
1136   return result;
1137     }
1138     result = (*regWinProcs->regQueryInfoKeyProc)(hKey, NULL, NULL, NULL, NULL,
1139       &maxSize, NULL, NULL, NULL, NULL, NULL, NULL);
1140     maxSize++;
1141     if (result != ERROR_SUCCESS) {
1142   return result;
1143     }
1144 
1145     Tcl_DStringInit(&subkey);
1146     Tcl_DStringSetLength(&subkey,
1147       (int) ((regWinProcs->useWide) ? maxSize * 2 : maxSize));
1148 
1149     while (result == ERROR_SUCCESS) {
1150   /*
1151    * Always get index 0 because key deletion changes ordering.
1152    */
1153 
1154   size = maxSize;
1155   result=(*regWinProcs->regEnumKeyExProc)(hKey, 0,
1156     Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL);
1157   if (result == ERROR_NO_MORE_ITEMS) {
1158       result = (*regWinProcs->regDeleteKeyProc)(startKey, keyName);
1159       break;
1160   } else if (result == ERROR_SUCCESS) {
1161       result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey));
1162   }
1163     }
1164     Tcl_DStringFree(&subkey);
1165     RegCloseKey(hKey);
1166     return result;
1167 }
static DWORD RecursiveDeleteKey (HKEY hStartKey, CONST TCHAR * pKeyName) [static]

Referenced by DeleteKey(), and RecursiveDeleteKey().int Registry_Init (Tcl_Interp * interp)

Definition at line 212 of file tclWinReg.c.
References asciiProcs, NULL, RegistryObjCmd(), regWinProcs, Tcl_CreateObjCommand(), TCL_ERROR, Tcl_InitStubs, Tcl_PkgProvide(), TclWinGetPlatformId(), and unicodeProcs.
Referenced by Tcl_AppInit().214 {
215     if (!Tcl_InitStubs(interp, "8.0", 0)) {
216   return TCL_ERROR;
217     }
218 
219     /*
220      * Determine if the unicode interfaces are available and select the
221      * appropriate registry function table.
222      */
223 
224     if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
225   regWinProcs = &unicodeProcs;
226     } else {
227   regWinProcs = &asciiProcs;
228     }
229 
230     Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, NULL, NULL);
231     return Tcl_PkgProvide(interp, "registry", "1.1.4");
232 }
static int RegistryObjCmd (ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[]) [static]

Definition at line 251 of file tclWinReg.c.
References BroadcastValue(), CONST, DeleteKey(), DeleteValue(), GetKeyNames(), GetType(), GetValue(), GetValueNames(), NULL, OpenKey(), SetValue(), TCL_ERROR, Tcl_GetIndexFromObj(), TCL_OK, and Tcl_WrongNumArgs().
Referenced by Registry_Init().256 {
257     int index;
258     char *errString;
259 
260     static CONST char *subcommands[] = {
261   "broadcast", "delete", "get", "keys", "set", "type", "values",
262   (char *) NULL
263     };
264     enum SubCmdIdx {
265   BroadcastIdx, DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx
266     };
267 
268     if (objc < 2) {
269   Tcl_WrongNumArgs(interp, objc, objv, "option ?arg arg ...?");
270   return TCL_ERROR;
271     }
272 
273     if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "option", 0, &index)
274       != TCL_OK) {
275   return TCL_ERROR;
276     }
277 
278     switch (index) {
279   case BroadcastIdx:    /* broadcast */
280       return BroadcastValue(interp, objc, objv);
281       break;
282   case DeleteIdx:     /* delete */
283       if (objc == 3) {
284     return DeleteKey(interp, objv[2]);
285       } else if (objc == 4) {
286     return DeleteValue(interp, objv[2], objv[3]);
287       }
288       errString = "keyName ?valueName?";
289       break;
290   case GetIdx:      /* get */
291       if (objc == 4) {
292     return GetValue(interp, objv[2], objv[3]);
293       }
294       errString = "keyName valueName";
295       break;
296   case KeysIdx:     /* keys */
297       if (objc == 3) {
298     return GetKeyNames(interp, objv[2], NULL);
299       } else if (objc == 4) {
300     return GetKeyNames(interp, objv[2], objv[3]);
301       }
302       errString = "keyName ?pattern?";
303       break;
304   case SetIdx:      /* set */
305       if (objc == 3) {
306     HKEY key;
307 
308     /*
309      * Create the key and then close it immediately.
310      */
311 
312     if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 1, &key)
313       != TCL_OK) {
314         return TCL_ERROR;
315     }
316     RegCloseKey(key);
317     return TCL_OK;
318       } else if (objc == 5 || objc == 6) {
319     Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5];
320     return SetValue(interp, objv[2], objv[3], objv[4], typeObj);
321       }
322       errString = "keyName ?valueName data ?type??";
323       break;
324   case TypeIdx:     /* type */
325       if (objc == 4) {
326     return GetType(interp, objv[2], objv[3]);
327       }
328       errString = "keyName valueName";
329       break;
330   case ValuesIdx:     /* values */
331       if (objc == 3) {
332     return GetValueNames(interp, objv[2], NULL);
333       } else if (objc == 4) {
334     return GetValueNames(interp, objv[2], objv[3]);
335       }
336       errString = "keyName ?pattern?";
337       break;
338     }
339     Tcl_WrongNumArgs(interp, 2, objv, errString);
340     return TCL_ERROR;
341 }
static int SetValue (Tcl_Interp * interp, Tcl_Obj * keyNameObj, Tcl_Obj * valueNameObj, Tcl_Obj * dataObj, Tcl_Obj * typeObj) [static]

Definition at line 1188 of file tclWinReg.c.
References AppendSystemError(), ConvertDWORD(), DWORD(), NULL, OpenKey(), regWinProcs, Tcl_AppendToObj(), Tcl_DStringAppend(), Tcl_DStringFree(), Tcl_DStringInit(), Tcl_DStringLength, Tcl_DStringSetLength(), Tcl_DStringValue, TCL_ERROR, Tcl_GetByteArrayFromObj(), Tcl_GetIndexFromObj(), Tcl_GetIntFromObj(), Tcl_GetObjResult(), Tcl_GetString(), Tcl_GetStringFromObj(), Tcl_ListObjGetElements(), TCL_OK, Tcl_ResetResult(), Tcl_WinUtfToTChar(), typeNames, and RegWinProcs::useWide.
Referenced by RegistryObjCmd().1194 {
1195     DWORD type, result;
1196     HKEY key;
1197     int length;
1198     char *valueName;
1199     Tcl_Obj *resultPtr;
1200     Tcl_DString nameBuf;
1201 
1202     if (typeObj == NULL) {
1203   type = REG_SZ;
1204     } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type",
1205       0, (int *) &type) != TCL_OK) {
1206   if (Tcl_GetIntFromObj(NULL, typeObj, (int*) &type) != TCL_OK) {
1207       return TCL_ERROR;
1208   }
1209   Tcl_ResetResult(interp);
1210     }
1211     if (OpenKey(interp, keyNameObj, KEY_ALL_ACCESS, 1, &key) != TCL_OK) {
1212   return TCL_ERROR;
1213     }
1214 
1215     valueName = Tcl_GetStringFromObj(valueNameObj, &length);
1216     valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf);
1217     resultPtr = Tcl_GetObjResult(interp);
1218 
1219     if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
1220   DWORD value;
1221   if (Tcl_GetIntFromObj(interp, dataObj, (int*) &value) != TCL_OK) {
1222       RegCloseKey(key);
1223       Tcl_DStringFree(&nameBuf);
1224       return TCL_ERROR;
1225   }
1226 
1227   value = ConvertDWORD(type, value);
1228   result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
1229     (BYTE*) &value, sizeof(DWORD));
1230     } else if (type == REG_MULTI_SZ) {
1231   Tcl_DString data, buf;
1232   int objc, i;
1233   Tcl_Obj **objv;
1234 
1235   if (Tcl_ListObjGetElements(interp, dataObj, &objc, &objv) != TCL_OK) {
1236       RegCloseKey(key);
1237       Tcl_DStringFree(&nameBuf);
1238       return TCL_ERROR;
1239   }
1240 
1241   /*
1242    * Append the elements as null terminated strings.  Note that
1243    * we must not assume the length of the string in case there are
1244    * embedded nulls, which aren't allowed in REG_MULTI_SZ values.
1245    */
1246 
1247   Tcl_DStringInit(&data);
1248   for (i = 0; i < objc; i++) {
1249       Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1);
1250 
1251       /*
1252        * Add a null character to separate this value from the next.
1253        * We accomplish this by growing the string by one byte.  Since the
1254        * DString always tacks on an extra null byte, the new byte will
1255        * already be set to null.
1256        */
1257 
1258       Tcl_DStringSetLength(&data, Tcl_DStringLength(&data)+1);
1259   }
1260 
1261   Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
1262     &buf);
1263   result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
1264     (BYTE *) Tcl_DStringValue(&buf),
1265     (DWORD) Tcl_DStringLength(&buf));
1266   Tcl_DStringFree(&data);
1267   Tcl_DStringFree(&buf);
1268     } else if (type == REG_SZ || type == REG_EXPAND_SZ) {
1269   Tcl_DString buf;
1270   char *data = Tcl_GetStringFromObj(dataObj, &length);
1271 
1272   data = (char *) Tcl_WinUtfToTChar(data, length, &buf);
1273 
1274   /*
1275    * Include the null in the length, padding if needed for Unicode.
1276    */
1277 
1278   if (regWinProcs->useWide) {
1279       Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
1280   }
1281   length = Tcl_DStringLength(&buf) + 1;
1282 
1283   result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
1284     (BYTE*)data, (DWORD) length);
1285   Tcl_DStringFree(&buf);
1286     } else {
1287   char *data;
1288 
1289   /*
1290    * Store binary data in the registry.
1291    */
1292 
1293   data = Tcl_GetByteArrayFromObj(dataObj, &length);
1294   result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
1295     (BYTE *)data, (DWORD) length);
1296     }
1297     Tcl_DStringFree(&nameBuf);
1298     RegCloseKey(key);
1299     if (result != ERROR_SUCCESS) {
1300   Tcl_AppendToObj(resultPtr, "unable to set value: ", -1);
1301   AppendSystemError(interp, result);
1302   return TCL_ERROR;
1303     }
1304     return TCL_OK;
1305 }

Variable Documentation
RegWinProcs asciiProcs [static]
Initial value: {
    0,

    (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryA,
    (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
      DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
      DWORD *)) RegCreateKeyExA, 
    (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyA,
    (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueA,
    (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyA,
    (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
      TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExA,
    (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
      DWORD *, BYTE *, DWORD *)) RegEnumValueA,
    (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM,
      HKEY *)) RegOpenKeyExA,
    (LONG (WINAPI *)(HKEY, TCHAR *, DWORD *, DWORD *,
      DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *,
      FILETIME *)) RegQueryInfoKeyA,
    (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
      BYTE *, DWORD *)) RegQueryValueExA,
    (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD,
      CONST BYTE*, DWORD)) RegSetValueExA,
}
Definition at line 106 of file tclWinReg.c.DWORD lastType = REG_RESOURCE_LIST [static]

Definition at line 71 of file tclWinReg.c.
Referenced by GetType().RegWinProcs* regWinProcs [static]

Definition at line 104 of file tclWinReg.c.
Referenced by DeleteValue(), GetKeyNames(), GetType(), GetValue(), GetValueNames(), OpenSubKey(), RecursiveDeleteKey(), Registry_Init(), and SetValue().CONST char* rootKeyNames[] [static]
Initial value: {
    "HKEY_LOCAL_MACHINE", "HKEY_USERS", "HKEY_CLASSES_ROOT",
    "HKEY_CURRENT_USER", "HKEY_CURRENT_CONFIG",
    "HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL
}
Definition at line 48 of file tclWinReg.c.
Referenced by ParseKeyName().HKEY rootKeys[] [static]
Initial value: {
    HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
    HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA
}
Definition at line 54 of file tclWinReg.c.
Referenced by ParseKeyName().CONST char* typeNames[] [static]
Initial value: {
    "none", "sz", "expand_sz", "binary", "dword",
    "dword_big_endian", "link", "multi_sz", "resource_list", NULL
}
Definition at line 66 of file tclWinReg.c.
Referenced by GetType(), and SetValue().RegWinProcs unicodeProcs [static]
Initial value: {
    1,

    (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryW,
    (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
      DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
      DWORD *)) RegCreateKeyExW, 
    (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyW,
    (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueW,
    (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyW,
    (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
      TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExW,
    (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
      DWORD *, BYTE *, DWORD *)) RegEnumValueW,
    (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM,
      HKEY *)) RegOpenKeyExW,
    (LONG (WINAPI *)(HKEY, TCHAR *, DWORD *, DWORD *,
      DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *,
      FILETIME *)) RegQueryInfoKeyW,
    (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
      BYTE *, DWORD *)) RegQueryValueExW,
    (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD,
      CONST BYTE*, DWORD)) RegSetValueExW,
}
Definition at line 131 of file tclWinReg.c.

win/tclWinSerial.c File Reference
#include "tclWinInt.h"
#include <fcntl.h>
#include <io.h>
#include <sys/stat.h>
Classes
struct ThreadSpecificData
struct SerialEvent
Defines
#define SERIAL_PENDING  (1<<0)
#define SERIAL_ASYNC  (1<<1)
#define SERIAL_EOF  (1<<2)
#define SERIAL_ERROR  (1<<4)
#define SERIAL_DEFAULT_BLOCKTIME  10
#define SERIAL_READ_ERRORS
#define SERIAL_WRITE_ERRORS  ( CE_TXFULL | CE_PTO )
Functions
TCL_DECLARE_MUTEX (serialMutex)
static int SerialBlockProc (ClientData instanceData, int mode)
static void SerialCheckProc (ClientData clientData, int flags)
static int SerialCloseProc (ClientData instanceData, Tcl_Interp *interp)
static int SerialEventProc (Tcl_Event *evPtr, int flags)
static void SerialExitHandler (ClientData clientData)
static int SerialGetHandleProc (ClientData instanceData, int direction, ClientData *handlePtr)
static ThreadSpecificData * SerialInit (void)
static int SerialInputProc (ClientData instanceData, char *buf, int toRead, int *errorCode)
static int SerialOutputProc (ClientData instanceData, CONST char *buf, int toWrite, int *errorCode)
static void SerialSetupProc (ClientData clientData, int flags)
static void SerialWatchProc (ClientData instanceData, int mask)
static void ProcExitHandler (ClientData clientData)
static int SerialGetOptionProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, Tcl_DString *dsPtr))
static int SerialSetOptionProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, CONST char *value))
static DWORD WINAPI SerialWriterThread (LPVOID arg)
static void SerialThreadActionProc _ANSI_ARGS_ ((ClientData instanceData, int action))
static void SerialBlockTime (int msec)
static unsigned int SerialGetMilliseconds (void)
static int blockingRead (SerialInfo *infoPtr, LPVOID buf, DWORD bufSize, LPDWORD lpRead, LPOVERLAPPED osPtr)
static int blockingWrite (SerialInfo *infoPtr, LPVOID buf, DWORD bufSize, LPDWORD lpWritten, LPOVERLAPPED osPtr)
HANDLE TclWinSerialReopen (HANDLE handle, CONST TCHAR *name, DWORD access)
Tcl_Channel TclWinOpenSerialChannel (HANDLE handle, char *channelName, int permissions)
static void SerialErrorStr (DWORD error, Tcl_DString *dsPtr)
static void SerialModemStatusStr (DWORD status, Tcl_DString *dsPtr)
static int SerialSetOptionProc (ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, CONST char *value)
static int SerialGetOptionProc (ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, Tcl_DString *dsPtr)
static void SerialThreadActionProc (ClientData instanceData, int action)
Variables
static int initialized = 0
SerialInfo
static Tcl_ThreadDataKey dataKey
static COMMTIMEOUTS no_timeout
static Tcl_ChannelType serialChannelType

Define Documentation
#define SERIAL_ASYNC  (1<<1)

Referenced by SerialBlockProc(), SerialInputProc(), and SerialOutputProc().#define SERIAL_DEFAULT_BLOCKTIME  10

Referenced by TclWinOpenSerialChannel().#define SERIAL_EOF  (1<<2)
#define SERIAL_ERROR  (1<<4)
#define SERIAL_PENDING  (1<<0)

Referenced by SerialCheckProc(), and SerialEventProc().#define SERIAL_READ_ERRORS
Value:( CE_RXOVER | CE_OVERRUN | CE_RXPARITY \
                                | CE_FRAME  | CE_BREAK )
Referenced by SerialCheckProc(), SerialErrorStr(), and SerialInputProc().#define SERIAL_WRITE_ERRORS  ( CE_TXFULL | CE_PTO )

Referenced by SerialErrorStr(), and SerialOutputProc().
Function Documentation
static void SerialThreadActionProc _ANSI_ARGS_ ((ClientData instanceData, int action)) [static]
static int SerialSetOptionProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, CONST char *value)) [static]
static int SerialGetOptionProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, Tcl_DString *dsPtr)) [static]
static int blockingRead (SerialInfo * infoPtr, LPVOID buf, DWORD bufSize, LPDWORD lpRead, LPOVERLAPPED osPtr) [static]

Definition at line 731 of file tclWinSerial.c.
References FALSE, and TRUE.
Referenced by SerialInputProc().737 {
738     /*
739      *  Perform overlapped blocking read. 
740      *  1. Reset the overlapped event
741      *  2. Start overlapped read operation
742      *  3. Wait for completion
743      */
744 
745     /* 
746      * Set Offset to ZERO, otherwise NT4.0 may report an error.
747      */
748     osPtr->Offset = osPtr->OffsetHigh = 0;
749     ResetEvent(osPtr->hEvent);
750     if (! ReadFile(infoPtr->handle, buf, bufSize, lpRead, osPtr) ) {
751         if (GetLastError() != ERROR_IO_PENDING) {
752             /* ReadFile failed, but it isn't delayed. Report error. */
753             return FALSE;
754         } else {   
755             /* Read is pending, wait for completion, timeout ? */
756             if (! GetOverlappedResult(infoPtr->handle, osPtr, lpRead, TRUE) ) {
757                 return FALSE;
758             }
759         }
760     } else {
761         /* ReadFile completed immediately. */
762     }
763     return TRUE;
764 }
static int blockingWrite (SerialInfo * infoPtr, LPVOID buf, DWORD bufSize, LPDWORD lpWritten, LPOVERLAPPED osPtr) [static]

Definition at line 784 of file tclWinSerial.c.
References FALSE, and TRUE.
Referenced by SerialOutputProc(), and SerialWriterThread().790 {
791     int result;
792     /*
793     *  Perform overlapped blocking write. 
794     *  1. Reset the overlapped event
795     *  2. Remove these bytes from the output queue counter
796     *  3. Start overlapped write operation
797     *  3. Remove these bytes from the output queue counter
798     *  4. Wait for completion
799     *  5. Adjust the output queue counter
800     */
801     ResetEvent(osPtr->hEvent);
802 
803     EnterCriticalSection(&infoPtr->csWrite);
804     infoPtr->writeQueue -= bufSize;
805   /* 
806   * Set Offset to ZERO, otherwise NT4.0 may report an error 
807   */
808   osPtr->Offset = osPtr->OffsetHigh = 0;
809     result = WriteFile(infoPtr->handle, buf, bufSize, lpWritten, osPtr);
810     LeaveCriticalSection(&infoPtr->csWrite);
811 
812     if (result == FALSE ) {
813         int err = GetLastError();
814         switch (err) {
815         case ERROR_IO_PENDING:
816             /* Write is pending, wait for completion */
817             if (! GetOverlappedResult(infoPtr->handle, osPtr, lpWritten, TRUE) ) {
818                 return FALSE;
819             }
820             break;
821         case ERROR_COUNTER_TIMEOUT:
822             /* Write timeout handled in SerialOutputProc */
823             break;
824         default:
825             /* WriteFile failed, but it isn't delayed. Report error */
826             return FALSE;
827         }
828     } else {
829         /* WriteFile completed immediately. */
830     }
831 
832     EnterCriticalSection(&infoPtr->csWrite);
833     infoPtr->writeQueue += (*lpWritten - bufSize);
834     LeaveCriticalSection(&infoPtr->csWrite);
835 
836     return TRUE;
837 }
static void ProcExitHandler (ClientData clientData) [static]

Definition at line 322 of file tclWinSerial.c.
References initialized, Tcl_MutexLock, and Tcl_MutexUnlock.324 {
325     Tcl_MutexLock(&serialMutex);
326     initialized = 0;
327     Tcl_MutexUnlock(&serialMutex);
328 }
static int SerialBlockProc (ClientData instanceData, int mode) [static]

Definition at line 548 of file tclWinSerial.c.
References SERIAL_ASYNC, SerialInfo, and TCL_MODE_NONBLOCKING.552 {
553     int errorCode = 0;
554 
555     SerialInfo *infoPtr = (SerialInfo *) instanceData;
556 
557     /*
558      * Only serial READ can be switched between blocking & nonblocking
559      * using COMMTIMEOUTS.
560      * Serial write emulates blocking & nonblocking by the SerialWriterThread.
561      */
562 
563     if (mode == TCL_MODE_NONBLOCKING) {
564         infoPtr->flags |= SERIAL_ASYNC;
565     } else {
566         infoPtr->flags &= ~(SERIAL_ASYNC);
567     }
568     return errorCode;
569 }
static void SerialBlockTime (int msec) [static]

Definition at line 343 of file tclWinSerial.c.
References Tcl_Time::sec, Tcl_SetMaxBlockTime(), and Tcl_Time::usec.
Referenced by SerialSetupProc(), and SerialWatchProc().345 {
346     Tcl_Time blockTime;
347 
348     blockTime.sec  =  msec / 1000;
349     blockTime.usec = (msec % 1000) * 1000;
350     Tcl_SetMaxBlockTime(&blockTime);
351 }
static void SerialCheckProc (ClientData clientData, int flags) [static]

Definition at line 448 of file tclWinSerial.c.
References ckalloc, ThreadSpecificData::firstSerialPtr, SerialEvent::header, SerialEvent::infoPtr, NULL, Tcl_Event::proc, SERIAL_PENDING, SERIAL_READ_ERRORS, SerialEventProc(), SerialGetMilliseconds(), SerialInfo, TCL_FILE_EVENTS, TCL_QUEUE_TAIL, Tcl_QueueEvent(), TCL_READABLE, TCL_TSD_INIT, and TCL_WRITABLE.
Referenced by SerialExitHandler(), and SerialInit().451 {
452     SerialInfo *infoPtr;
453     SerialEvent *evPtr;
454     int needEvent;
455     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
456     COMSTAT cStat;
457     unsigned int time;
458 
459     if (!(flags & TCL_FILE_EVENTS)) {
460         return;
461     }
462 
463     /*
464      * Queue events for any ready serials that don't already have events
465      * queued.
466      */
467 
468     for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
469             infoPtr = infoPtr->nextPtr) {
470         if (infoPtr->flags & SERIAL_PENDING) {
471             continue;
472         }
473 
474         needEvent = 0;
475 
476         /*
477          * If WRITABLE watch mask is set
478          * look for infoPtr->evWritable object
479          */
480         if (infoPtr->watchMask & TCL_WRITABLE) {
481             if (WaitForSingleObject(infoPtr->evWritable, 0) != WAIT_TIMEOUT) {
482                 infoPtr->writable = 1;
483                 needEvent = 1;
484             }
485         }
486         
487         /*
488          * If READABLE watch mask is set
489          * call ClearCommError to poll cbInQue
490          * Window errors are ignored here
491          */
492 
493         if( infoPtr->watchMask & TCL_READABLE ) {
494             if( ClearCommError( infoPtr->handle, &infoPtr->error, &cStat ) ) {
495                 /*
496                  * Look for characters already pending in windows queue.
497                  * If they are, poll.
498                  */
499 
500                 if( infoPtr->watchMask & TCL_READABLE ) {
501                     /*
502                      * force fileevent after serial read error
503                      */
504                     if( (cStat.cbInQue > 0) ||
505                             (infoPtr->error & SERIAL_READ_ERRORS) ) {
506                         infoPtr->readable = 1;
507       time = SerialGetMilliseconds();
508       if ((unsigned int) (time - infoPtr->lastEventTime)
509         >= (unsigned int) infoPtr->blockTime) {
510           needEvent = 1;
511           infoPtr->lastEventTime = time;
512       }
513                     }
514                 }
515             }
516         }
517 
518         /*
519          * Queue an event if the serial is signaled for reading or writing.
520          */
521         if (needEvent) {
522             infoPtr->flags |= SERIAL_PENDING;
523             evPtr = (SerialEvent *) ckalloc(sizeof(SerialEvent));
524             evPtr->header.proc = SerialEventProc;
525             evPtr->infoPtr = infoPtr;
526             Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
527         }
528     }
529 }
static int SerialCloseProc (ClientData instanceData, Tcl_Interp * interp) [static]

Definition at line 588 of file tclWinSerial.c.
References ckfree, DWORD(), errno, FALSE, ThreadSpecificData::firstSerialPtr, NULL, SerialInfo, Tcl_MutexLock, Tcl_MutexUnlock, TCL_READABLE, TCL_TSD_INIT, TCL_WRITABLE, TclInThreadExit(), and TclWinConvertError().591 {
592     SerialInfo *serialPtr = (SerialInfo *) instanceData;
593     int errorCode, result = 0;
594     SerialInfo *infoPtr, **nextPtrPtr;
595     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
596     DWORD exitCode;
597 
598     errorCode = 0;
599 
600     if (serialPtr->validMask & TCL_READABLE) {
601         PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR);
602         CloseHandle(serialPtr->osRead.hEvent);
603     }
604     serialPtr->validMask &= ~TCL_READABLE;
605  
606     if (serialPtr->validMask & TCL_WRITABLE) {
607 
608         /*
609          * Generally we cannot wait for a pending write operation
610          * because it may hang due to handshake
611          *    WaitForSingleObject(serialPtr->evWritable, INFINITE);
612          */
613 
614   /*
615    * The thread may have already closed on it's own.  Check it's
616    * exit code.
617    */
618 
619   GetExitCodeThread(serialPtr->writeThread, &exitCode);
620 
621   if (exitCode == STILL_ACTIVE) {
622       /*
623        * Set the stop event so that if the writer thread is
624        * blocked in SerialWriterThread on WaitForMultipleEvents, it
625        * will exit cleanly.
626        */
627 
628       SetEvent(serialPtr->evStopWriter);
629 
630       /*
631        * Wait at most 20 milliseconds for the writer thread to
632        * close.
633        */
634 
635       if (WaitForSingleObject(serialPtr->writeThread, 20)
636         == WAIT_TIMEOUT) {
637     /*
638      * Forcibly terminate the background thread as a last
639      * resort.  Note that we need to guard against
640      * terminating the thread while it is in the middle of
641      * Tcl_ThreadAlert because it won't be able to release
642      * the notifier lock.
643      */
644 
645     Tcl_MutexLock(&serialMutex);
646 
647     /* BUG: this leaks memory */
648     TerminateThread(serialPtr->writeThread, 0);
649 
650     Tcl_MutexUnlock(&serialMutex);
651       }
652   }
653 
654         CloseHandle(serialPtr->writeThread);
655   CloseHandle(serialPtr->osWrite.hEvent);
656   DeleteCriticalSection(&serialPtr->csWrite);
657         CloseHandle(serialPtr->evWritable);
658         CloseHandle(serialPtr->evStartWriter);
659         CloseHandle(serialPtr->evStopWriter);
660         serialPtr->writeThread = NULL;
661 
662         PurgeComm(serialPtr->handle, PURGE_TXABORT | PURGE_TXCLEAR);
663     }
664     serialPtr->validMask &= ~TCL_WRITABLE;
665 
666     /*
667      * Don't close the Win32 handle if the handle is a standard channel
668      * during the thread exit process.  Otherwise, one thread may kill
669      * the stdio of another.
670      */
671 
672     if (!TclInThreadExit()
673   || ((GetStdHandle(STD_INPUT_HANDLE) != serialPtr->handle)
674   && (GetStdHandle(STD_OUTPUT_HANDLE) != serialPtr->handle)
675   && (GetStdHandle(STD_ERROR_HANDLE) != serialPtr->handle))) {
676       if (CloseHandle(serialPtr->handle) == FALSE) {
677     TclWinConvertError(GetLastError());
678     errorCode = errno;
679       }
680     }
681 
682     serialPtr->watchMask &= serialPtr->validMask;
683 
684     /*
685      * Remove the file from the list of watched files.
686      */
687 
688     for (nextPtrPtr = &(tsdPtr->firstSerialPtr), infoPtr = *nextPtrPtr;
689       infoPtr != NULL;
690       nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
691         if (infoPtr == (SerialInfo *)serialPtr) {
692             *nextPtrPtr = infoPtr->nextPtr;
693             break;
694         }
695     }
696 
697     /*
698      * Wrap the error file into a channel and give it to the cleanup
699      * routine.
700      */
701     if (serialPtr->writeBuf != NULL) {
702         ckfree(serialPtr->writeBuf);
703         serialPtr->writeBuf = NULL;
704     }
705     ckfree((char*) serialPtr);
706 
707     if (errorCode == 0) {
708         return result;
709     }
710     return errorCode;
711 }
static void SerialErrorStr (DWORD error, Tcl_DString * dsPtr) [static]

Definition at line 1509 of file tclWinSerial.c.
References DWORD(), SERIAL_READ_ERRORS, SERIAL_WRITE_ERRORS, Tcl_DStringAppendElement(), and TCL_INTEGER_SPACE.
Referenced by SerialGetOptionProc().1512 {
1513     if( (error & CE_RXOVER) != 0) {
1514                 Tcl_DStringAppendElement(dsPtr, "RXOVER");
1515     }
1516     if( (error & CE_OVERRUN) != 0) {
1517                 Tcl_DStringAppendElement(dsPtr, "OVERRUN");
1518     }
1519     if( (error & CE_RXPARITY) != 0) {
1520                 Tcl_DStringAppendElement(dsPtr, "RXPARITY");
1521     }
1522     if( (error & CE_FRAME) != 0) {
1523                 Tcl_DStringAppendElement(dsPtr, "FRAME");
1524     }
1525     if( (error & CE_BREAK) != 0) {
1526                 Tcl_DStringAppendElement(dsPtr, "BREAK");
1527     }
1528     if( (error & CE_TXFULL) != 0) {
1529                 Tcl_DStringAppendElement(dsPtr, "TXFULL");
1530     }
1531     if( (error & CE_PTO) != 0) {    /* PTO used to signal WRITE-TIMEOUT */
1532                 Tcl_DStringAppendElement(dsPtr, "TIMEOUT");
1533     }
1534     if( (error & ~((DWORD) (SERIAL_READ_ERRORS | SERIAL_WRITE_ERRORS))) != 0) {
1535                 char buf[TCL_INTEGER_SPACE + 1];
1536                 wsprintfA(buf, "%d", error);
1537                 Tcl_DStringAppendElement(dsPtr, buf);
1538     }
1539 }
static int SerialEventProc (Tcl_Event * evPtr, int flags) [static]

Definition at line 1104 of file tclWinSerial.c.
References ThreadSpecificData::firstSerialPtr, SerialEvent::infoPtr, NULL, SERIAL_PENDING, SerialInfo, TCL_FILE_EVENTS, Tcl_NotifyChannel(), TCL_READABLE, TCL_TSD_INIT, and TCL_WRITABLE.
Referenced by SerialCheckProc().1108 {
1109     SerialEvent *serialEvPtr = (SerialEvent *)evPtr;
1110     SerialInfo *infoPtr;
1111     int mask;
1112     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1113 
1114     if (!(flags & TCL_FILE_EVENTS)) {
1115         return 0;
1116     }
1117 
1118     /*
1119      * Search through the list of watched serials for the one whose handle
1120      * matches the event.  We do this rather than simply dereferencing
1121      * the handle in the event so that serials can be deleted while the
1122      * event is in the queue.
1123      */
1124 
1125     for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
1126             infoPtr = infoPtr->nextPtr) {
1127         if (serialEvPtr->infoPtr == infoPtr) {
1128             infoPtr->flags &= ~(SERIAL_PENDING);
1129             break;
1130         }
1131     }
1132 
1133     /*
1134      * Remove stale events.
1135      */
1136 
1137     if (!infoPtr) {
1138         return 1;
1139     }
1140 
1141     /*
1142      * Check to see if the serial is readable.  Note
1143      * that we can't tell if a serial is writable, so we always report it
1144      * as being writable unless we have detected EOF.
1145      */
1146 
1147     mask = 0;
1148     if( infoPtr->watchMask & TCL_WRITABLE ) {
1149         if( infoPtr->writable ) {
1150             mask |= TCL_WRITABLE;
1151             infoPtr->writable = 0;
1152         }
1153     }
1154 
1155     if( infoPtr->watchMask & TCL_READABLE ) {
1156         if( infoPtr->readable ) {
1157             mask |= TCL_READABLE;
1158             infoPtr->readable = 0;
1159         }
1160     }
1161 
1162     /*
1163      * Inform the channel of the events.
1164      */
1165 
1166     Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask);
1167     return 1;
1168 }
static void SerialExitHandler (ClientData clientData) [static]

Definition at line 283 of file tclWinSerial.c.
References ThreadSpecificData::firstSerialPtr, NULL, SerialCheckProc(), SerialInfo, SerialSetupProc(), Tcl_DeleteEventSource(), and TCL_TSD_INIT.
Referenced by SerialInit().285 {
286     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
287     SerialInfo *infoPtr;
288 
289     /*
290      * Clear all eventually pending output.
291      * Otherwise Tcl's exit could totally block,
292      * because it performs a blocking flush on all open channels.
293      * Note that serial write operations may be blocked due to handshake.
294      */
295     for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
296             infoPtr = infoPtr->nextPtr) {
297         PurgeComm(infoPtr->handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR 
298             | PURGE_RXCLEAR);
299 
300     }
301     Tcl_DeleteEventSource(SerialSetupProc, SerialCheckProc, NULL);
302 }
static int SerialGetHandleProc (ClientData instanceData, int direction, ClientData * handlePtr) [static]

Definition at line 1248 of file tclWinSerial.c.
References SerialInfo, and TCL_OK.1252 {
1253     SerialInfo *infoPtr = (SerialInfo *) instanceData;
1254 
1255     *handlePtr = (ClientData) infoPtr->handle;
1256     return TCL_OK;
1257 }
static unsigned int SerialGetMilliseconds (void) [static]

Definition at line 366 of file tclWinSerial.c.
References Tcl_Time::sec, TclpGetTime(), and Tcl_Time::usec.
Referenced by SerialCheckProc().368 {
369     Tcl_Time time;
370 
371     TclpGetTime(&time);
372 
373     return (time.sec * 1000 + time.usec / 1000);
374 }
static int SerialGetOptionProc (ClientData instanceData, Tcl_Interp * interp, CONST char * optionName, Tcl_DString * dsPtr) [static]

Definition at line 1927 of file tclWinSerial.c.
References DWORD(), NULL, SerialErrorStr(), SerialInfo, SerialModemStatusStr(), size_t(), status, Tcl_BadChannelOption(), Tcl_DStringAppendElement(), Tcl_DStringEndSublist(), Tcl_DStringStartSublist(), TCL_ERROR, Tcl_InputBuffered(), TCL_INTEGER_SPACE, TCL_OK, and Tcl_OutputBuffered().1932 {
1933     SerialInfo *infoPtr;
1934     DCB dcb;
1935     size_t len;
1936     int valid = 0;  /* flag if valid option parsed */
1937 
1938     infoPtr = (SerialInfo *) instanceData;
1939 
1940     if (optionName == NULL) {
1941   len = 0;
1942     } else {
1943   len = strlen(optionName);
1944     }
1945 
1946     /*
1947      * get option -mode
1948      */
1949 
1950     if (len == 0) {
1951   Tcl_DStringAppendElement(dsPtr, "-mode");
1952     }
1953     if ((len == 0) ||
1954       ((len > 2) && (strncmp(optionName, "-mode", len) == 0))) {
1955 
1956   char parity;
1957   char *stop;
1958   char buf[2 * TCL_INTEGER_SPACE + 16];
1959 
1960   if (! GetCommState(infoPtr->handle, &dcb)) {
1961       if (interp) {
1962     Tcl_AppendResult(interp, 
1963       "can't get comm state", (char *) NULL);
1964       }
1965       return TCL_ERROR;
1966   }
1967 
1968   valid = 1;
1969   parity = 'n';
1970   if (dcb.Parity <= 4) {
1971       parity = "noems"[dcb.Parity];
1972   }
1973   stop = (dcb.StopBits == ONESTOPBIT) ? "1" :
1974       (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2";
1975 
1976   wsprintfA(buf, "%d,%c,%d,%s", dcb.BaudRate, parity,
1977     dcb.ByteSize, stop);
1978   Tcl_DStringAppendElement(dsPtr, buf);
1979     }
1980 
1981     /*
1982      * get option -pollinterval
1983      */
1984 
1985     if (len == 0) {
1986   Tcl_DStringAppendElement(dsPtr, "-pollinterval");
1987     }
1988     if ((len == 0) ||
1989       ((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0))) {
1990   char buf[TCL_INTEGER_SPACE + 1];
1991 
1992   valid = 1;
1993   wsprintfA(buf, "%d", infoPtr->blockTime);
1994   Tcl_DStringAppendElement(dsPtr, buf);
1995     }
1996 
1997     /*
1998      * get option -sysbuffer
1999      */
2000 
2001     if (len == 0) {
2002   Tcl_DStringAppendElement(dsPtr, "-sysbuffer");
2003   Tcl_DStringStartSublist(dsPtr);
2004     }
2005     if ((len == 0) ||
2006       ((len > 1) && (strncmp(optionName, "-sysbuffer", len) == 0))) {
2007 
2008   char buf[TCL_INTEGER_SPACE + 1];
2009   valid = 1;
2010 
2011   wsprintfA(buf, "%d", infoPtr->sysBufRead);
2012   Tcl_DStringAppendElement(dsPtr, buf);
2013   wsprintfA(buf, "%d", infoPtr->sysBufWrite);
2014   Tcl_DStringAppendElement(dsPtr, buf);
2015     }
2016     if (len == 0) {
2017   Tcl_DStringEndSublist(dsPtr);
2018     }
2019 
2020     /*
2021      * get option -xchar
2022      */
2023 
2024     if (len == 0) {
2025   Tcl_DStringAppendElement(dsPtr, "-xchar");
2026   Tcl_DStringStartSublist(dsPtr);
2027     }
2028     if ((len == 0) ||
2029       ((len > 1) && (strncmp(optionName, "-xchar", len) == 0))) {
2030 
2031   char buf[4];
2032   valid = 1;
2033 
2034   if (! GetCommState(infoPtr->handle, &dcb)) {
2035       if (interp) {
2036     Tcl_AppendResult(interp, 
2037       "can't get comm state", (char *) NULL);
2038       }
2039       return TCL_ERROR;
2040   }
2041   sprintf(buf, "%c", dcb.XonChar);
2042   Tcl_DStringAppendElement(dsPtr, buf);
2043   sprintf(buf, "%c", dcb.XoffChar);
2044   Tcl_DStringAppendElement(dsPtr, buf);
2045     }
2046     if (len == 0) {
2047   Tcl_DStringEndSublist(dsPtr);
2048     }
2049 
2050     /*
2051      * get option -lasterror
2052      * option is readonly and returned by [fconfigure chan -lasterror]
2053      * but not returned by unnamed [fconfigure chan]
2054      */
2055 
2056     if ( (len > 1) && (strncmp(optionName, "-lasterror", len) == 0) ) {
2057   valid = 1;
2058   SerialErrorStr(infoPtr->lastError, dsPtr);
2059     }
2060 
2061     /*
2062      * get option -queue
2063      * option is readonly and returned by [fconfigure chan -queue]
2064      */
2065 
2066     if ((len > 1) && (strncmp(optionName, "-queue", len) == 0)) {
2067   char buf[TCL_INTEGER_SPACE + 1];
2068   COMSTAT cStat;
2069   DWORD error;
2070   int inBuffered, outBuffered, count;
2071 
2072   valid = 1;
2073 
2074   /* 
2075    * Query the pending data in Tcl's internal queues
2076    */
2077   inBuffered  = Tcl_InputBuffered(infoPtr->channel);
2078   outBuffered = Tcl_OutputBuffered(infoPtr->channel);
2079 
2080   /*
2081    * Query the number of bytes in our output queue:
2082    *     1. The bytes pending in the output thread
2083    *     2. The bytes in the system drivers buffer
2084    * The writer thread should not interfere this action.
2085    */
2086   EnterCriticalSection(&infoPtr->csWrite);
2087   ClearCommError( infoPtr->handle, &error, &cStat );
2088   count = (int)cStat.cbOutQue + infoPtr->writeQueue;
2089   LeaveCriticalSection(&infoPtr->csWrite);
2090 
2091   wsprintfA(buf, "%d", inBuffered + cStat.cbInQue); 
2092   Tcl_DStringAppendElement(dsPtr, buf);
2093   wsprintfA(buf, "%d", outBuffered + count); 
2094   Tcl_DStringAppendElement(dsPtr, buf);
2095     }
2096 
2097     /*
2098      * get option -ttystatus
2099      * option is readonly and returned by [fconfigure chan -ttystatus]
2100      * but not returned by unnamed [fconfigure chan]
2101      */
2102     if ((len > 4) && (strncmp(optionName, "-ttystatus", len) == 0)) {
2103 
2104   DWORD status;
2105 
2106   if (! GetCommModemStatus(infoPtr->handle, &status)) {
2107       if (interp) {
2108     Tcl_AppendResult(interp, 
2109       "can't get tty status", (char *) NULL);
2110       }
2111       return TCL_ERROR;
2112   }
2113   valid = 1;
2114   SerialModemStatusStr(status, dsPtr);
2115     }
2116 
2117     if (valid) {
2118   return TCL_OK;
2119     } else {
2120   return Tcl_BadChannelOption(interp, optionName,
2121     "mode pollinterval lasterror queue sysbuffer ttystatus xchar");
2122     }
2123 }
static ThreadSpecificData * SerialInit (void) [static]

Definition at line 237 of file tclWinSerial.c.
References ThreadSpecificData::firstSerialPtr, initialized, NULL, ProcExitHandler(), SerialCheckProc(), SerialExitHandler(), SerialSetupProc(), Tcl_CreateEventSource(), Tcl_CreateExitHandler(), Tcl_CreateThreadExitHandler(), Tcl_MutexLock, Tcl_MutexUnlock, TCL_TSD_INIT, and TclThreadDataKeyGet().
Referenced by SerialThreadActionProc(), TclWinOpenSerialChannel(), and TclWinSerialReopen().238 {
239     ThreadSpecificData *tsdPtr;
240 
241     /*
242      * Check the initialized flag first, then check it again in the mutex.
243      * This is a speed enhancement.
244      */
245 
246     if (!initialized) {
247         Tcl_MutexLock(&serialMutex);
248         if (!initialized) {
249             initialized = 1;
250             Tcl_CreateExitHandler(ProcExitHandler, NULL);
251         }
252         Tcl_MutexUnlock(&serialMutex);
253     }
254 
255     tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
256     if (tsdPtr == NULL) {
257         tsdPtr = TCL_TSD_INIT(&dataKey);
258         tsdPtr->firstSerialPtr = NULL;
259         Tcl_CreateEventSource(SerialSetupProc, SerialCheckProc, NULL);
260         Tcl_CreateThreadExitHandler(SerialExitHandler, NULL);
261     }
262     return tsdPtr;
263 }
static int SerialInputProc (ClientData instanceData, char * buf, int toRead, int * errorCode) [static]

Definition at line 857 of file tclWinSerial.c.
References blockingRead(), DWORD(), EAGAIN, EIO, errno, FALSE, SERIAL_ASYNC, SERIAL_READ_ERRORS, SerialInfo, and TclWinConvertError().863 {
864     SerialInfo *infoPtr = (SerialInfo *) instanceData;
865     DWORD bytesRead = 0;
866     COMSTAT cStat;
867 
868     *errorCode = 0;
869 
870     /*
871      * Check if there is a CommError pending from SerialCheckProc
872      */
873     if( infoPtr->error & SERIAL_READ_ERRORS ){
874         goto commError;
875     }
876 
877     /*
878      * Look for characters already pending in windows queue.
879      * This is the mainly restored good old code from Tcl8.0
880      */
881 
882     if( ClearCommError( infoPtr->handle, &infoPtr->error, &cStat ) ) {
883         /*
884          * Check for errors here, but not in the evSetup/Check procedures
885          */
886 
887         if( infoPtr->error & SERIAL_READ_ERRORS ) {
888             goto commError;
889         }
890         if( infoPtr->flags & SERIAL_ASYNC ) {
891             /*
892              * NON_BLOCKING mode:
893              * Avoid blocking by reading more bytes than available
894              * in input buffer
895              */
896 
897             if( cStat.cbInQue > 0 ) {
898                 if( (DWORD) bufSize > cStat.cbInQue ) {
899                     bufSize = cStat.cbInQue;
900                 }
901             } else {
902                 errno = *errorCode = EAGAIN;
903                 return -1;
904             }
905         } else {
906             /*
907              * BLOCKING mode:
908              * Tcl trys to read a full buffer of 4 kBytes here
909              */
910 
911             if( cStat.cbInQue > 0 ) {
912                 if( (DWORD) bufSize > cStat.cbInQue ) {
913                     bufSize = cStat.cbInQue;
914                 }
915             } else {
916                 bufSize = 1;
917             }
918         }
919     }
920 
921     if( bufSize == 0 ) {
922         return bytesRead = 0;
923     }
924 
925     /*
926     *  Perform blocking read. Doesn't block in non-blocking mode, 
927     *  because we checked the number of available bytes.
928     */
929     if (blockingRead(infoPtr, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
930             &infoPtr->osRead) == FALSE) {
931         goto error;
932     }
933     return bytesRead;
934 
935 error:
936     TclWinConvertError(GetLastError());
937     *errorCode = errno;
938     return -1;
939 
940 commError:
941     infoPtr->lastError = infoPtr->error;  /* save last error code */
942     infoPtr->error = 0;                   /* reset error code */
943     *errorCode = EIO;                     /* to return read-error only once */
944     return -1;
945 }
static void SerialModemStatusStr (DWORD status, Tcl_DString * dsPtr) [static]

Definition at line 1550 of file tclWinSerial.c.
References Tcl_DStringAppendElement().
Referenced by SerialGetOptionProc().1553 {
1554     Tcl_DStringAppendElement(dsPtr, "CTS");
1555     Tcl_DStringAppendElement(dsPtr, (status & MS_CTS_ON)  ?  "1" : "0");
1556     Tcl_DStringAppendElement(dsPtr, "DSR");
1557     Tcl_DStringAppendElement(dsPtr, (status & MS_DSR_ON)   ? "1" : "0");
1558     Tcl_DStringAppendElement(dsPtr, "RING");
1559     Tcl_DStringAppendElement(dsPtr, (status & MS_RING_ON)  ? "1" : "0");
1560     Tcl_DStringAppendElement(dsPtr, "DCD");
1561     Tcl_DStringAppendElement(dsPtr, (status & MS_RLSD_ON)  ? "1" : "0");
1562 }
static int SerialOutputProc (ClientData instanceData, CONST char * buf, int toWrite, int * errorCode) [static]

Definition at line 966 of file tclWinSerial.c.
References blockingWrite(), ckalloc, ckfree, DWORD(), EIO, errno, EWOULDBLOCK, initialized, SERIAL_ASYNC, SERIAL_WRITE_ERRORS, SerialInfo, size_t(), TclInExit(), and TclWinConvertError().971 {
972     SerialInfo *infoPtr = (SerialInfo *) instanceData;
973     DWORD bytesWritten, timeout;
974 
975     *errorCode = 0;
976 
977     /*
978      * At EXIT Tcl trys to flush all open channels in blocking mode.
979      * We avoid blocking output after ExitProc or CloseHandler(chan)
980      * has been called by checking the corrresponding variables.
981      */
982     if( ! initialized || TclInExit() ) {
983         return toWrite;
984     }
985 
986     /*
987      * Check if there is a CommError pending from SerialCheckProc
988      */
989     if( infoPtr->error & SERIAL_WRITE_ERRORS ){
990         infoPtr->lastError = infoPtr->error;  /* save last error code */
991         infoPtr->error = 0;                   /* reset error code */
992         errno = EIO;            
993         goto error;
994     }
995 
996     timeout = (infoPtr->flags & SERIAL_ASYNC) ? 0 : INFINITE;
997     if (WaitForSingleObject(infoPtr->evWritable, timeout) == WAIT_TIMEOUT) {
998         /*
999          * The writer thread is blocked waiting for a write to complete
1000          * and the channel is in non-blocking mode.
1001          */
1002 
1003         errno = EWOULDBLOCK;
1004         goto error1;
1005     }
1006     /*
1007      * Check for a background error on the last write.
1008      */
1009 
1010     if (infoPtr->writeError) {
1011         TclWinConvertError(infoPtr->writeError);
1012         infoPtr->writeError = 0;
1013         goto error1;
1014     }
1015 
1016     /*
1017      * Remember the number of bytes in output queue
1018      */
1019     EnterCriticalSection(&infoPtr->csWrite);
1020     infoPtr->writeQueue += toWrite;
1021     LeaveCriticalSection(&infoPtr->csWrite);
1022 
1023     if (infoPtr->flags & SERIAL_ASYNC) {
1024         /*
1025          * The serial is non-blocking, so copy the data into the output
1026          * buffer and restart the writer thread.
1027          */
1028 
1029         if (toWrite > infoPtr->writeBufLen) {
1030             /*
1031              * Reallocate the buffer to be large enough to hold the data.
1032              */
1033 
1034             if (infoPtr->writeBuf) {
1035                 ckfree(infoPtr->writeBuf);
1036             }
1037             infoPtr->writeBufLen = toWrite;
1038             infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
1039         }
1040         memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
1041         infoPtr->toWrite = toWrite;
1042         ResetEvent(infoPtr->evWritable);
1043         SetEvent(infoPtr->evStartWriter);
1044         bytesWritten = (DWORD) toWrite;
1045 
1046     } else {
1047         /*
1048         * In the blocking case, just try to write the buffer directly.
1049         * This avoids an unnecessary copy.
1050         */
1051         if (! blockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite,
1052                 &bytesWritten, &infoPtr->osWrite) ) {
1053             goto writeError;
1054         }
1055         if (bytesWritten != (DWORD) toWrite) {
1056             /* Write timeout */
1057             infoPtr->lastError |= CE_PTO;
1058             errno = EIO;
1059             goto error;
1060         }
1061     }
1062 
1063     return (int) bytesWritten;
1064 
1065 writeError:
1066     TclWinConvertError(GetLastError());
1067 
1068 error:
1069     /* 
1070      * Reset the output queue counter on error during blocking output 
1071      */
1072 /*
1073     EnterCriticalSection(&infoPtr->csWrite);
1074     infoPtr->writeQueue = 0;
1075     LeaveCriticalSection(&infoPtr->csWrite);
1076 */
1077   error1: 
1078     *errorCode = errno;
1079     return -1;
1080 }
static int SerialSetOptionProc (ClientData instanceData, Tcl_Interp * interp, CONST char * optionName, CONST char * value) [static]

Definition at line 1581 of file tclWinSerial.c.
References BOOL(), ckfree, CONST, DWORD(), FALSE, NULL, SerialInfo, size_t(), Tcl_DStringFree(), TCL_ERROR, Tcl_GetBoolean(), TCL_OK, Tcl_SplitList(), Tcl_WinUtfToTChar(), tclWinProcs, and TRUE.1586 {
1587     SerialInfo *infoPtr;
1588     DCB dcb;
1589     BOOL result, flag;
1590     size_t len, vlen;
1591     Tcl_DString ds;
1592     CONST TCHAR *native;
1593     int argc;
1594     CONST char **argv;
1595 
1596     infoPtr = (SerialInfo *) instanceData;
1597 
1598     /*
1599      * Parse options
1600      */
1601     len = strlen(optionName);
1602     vlen = strlen(value);
1603 
1604     /*
1605      * Option -mode baud,parity,databits,stopbits
1606      */
1607     if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) {
1608   if (! GetCommState(infoPtr->handle, &dcb)) {
1609       if (interp) {
1610     Tcl_AppendResult(interp, 
1611       "can't get comm state", (char *) NULL);
1612       }
1613       return TCL_ERROR;
1614   }
1615   native = Tcl_WinUtfToTChar(value, -1, &ds);
1616   result = (*tclWinProcs->buildCommDCBProc)(native, &dcb);
1617   Tcl_DStringFree(&ds);
1618 
1619   if (result == FALSE) {
1620       if (interp) {
1621     Tcl_AppendResult(interp,
1622       "bad value for -mode: should be baud,parity,data,stop",
1623       (char *) NULL);
1624       }
1625       return TCL_ERROR;
1626   }
1627 
1628   /* Default settings for serial communications */ 
1629   dcb.fBinary = TRUE;
1630   dcb.fErrorChar = FALSE;
1631   dcb.fNull = FALSE;
1632   dcb.fAbortOnError = FALSE;
1633 
1634   if (! SetCommState(infoPtr->handle, &dcb) ) {
1635       if (interp) {
1636     Tcl_AppendResult(interp, 
1637       "can't set comm state", (char *) NULL);
1638       }
1639       return TCL_ERROR;
1640   }
1641   return TCL_OK;
1642     }
1643 
1644     /*
1645      * Option -handshake none|xonxoff|rtscts|dtrdsr
1646      */
1647     if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
1648   if (! GetCommState(infoPtr->handle, &dcb)) {
1649       if (interp) {
1650     Tcl_AppendResult(interp, 
1651       "can't get comm state", (char *) NULL);
1652       }
1653       return TCL_ERROR;
1654   }
1655   /*
1656    * Reset all handshake options
1657    * DTR and RTS are ON by default
1658    */
1659   dcb.fOutX = dcb.fInX = FALSE;
1660   dcb.fOutxCtsFlow = dcb.fOutxDsrFlow = dcb.fDsrSensitivity = FALSE;
1661   dcb.fDtrControl = DTR_CONTROL_ENABLE;
1662   dcb.fRtsControl = RTS_CONTROL_ENABLE;
1663   dcb.fTXContinueOnXoff = FALSE;
1664 
1665   /*
1666    * Adjust the handshake limits.
1667    * Yes, the XonXoff limits seem to influence even hardware handshake
1668    */
1669   dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2);
1670   dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4);
1671 
1672   if (strnicmp(value, "NONE", vlen) == 0) {
1673       /* leave all handshake options disabled */
1674   } else if (strnicmp(value, "XONXOFF", vlen) == 0) {
1675       dcb.fOutX = dcb.fInX = TRUE;
1676   } else if (strnicmp(value, "RTSCTS", vlen) == 0) {
1677       dcb.fOutxCtsFlow = TRUE;
1678       dcb.fRtsControl = RTS_CONTROL_HANDSHAKE;
1679   } else if (strnicmp(value, "DTRDSR", vlen) == 0) {
1680       dcb.fOutxDsrFlow = TRUE;
1681       dcb.fDtrControl = DTR_CONTROL_HANDSHAKE;
1682   } else {
1683       if (interp) {
1684     Tcl_AppendResult(interp, "bad value for -handshake: ",
1685       "must be one of xonxoff, rtscts, dtrdsr or none",
1686       (char *) NULL);
1687     return TCL_ERROR;
1688       }
1689   }
1690 
1691   if (! SetCommState(infoPtr->handle, &dcb)) {
1692       if (interp) {
1693     Tcl_AppendResult(interp, 
1694       "can't set comm state", (char *) NULL);
1695       }
1696       return TCL_ERROR;
1697   }
1698   return TCL_OK;
1699     }
1700 
1701     /*
1702      * Option -xchar {\x11 \x13}
1703      */
1704     if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
1705   if (! GetCommState(infoPtr->handle, &dcb)) {
1706       if (interp) {
1707     Tcl_AppendResult(interp, 
1708       "can't get comm state", (char *) NULL);
1709       }
1710       return TCL_ERROR;
1711   }
1712 
1713   if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
1714       return TCL_ERROR;
1715   }
1716   if (argc == 2) {
1717       dcb.XonChar  = argv[0][0];
1718       dcb.XoffChar = argv[1][0];
1719       ckfree((char *) argv);
1720   } else {
1721       if (interp) {
1722     Tcl_AppendResult(interp,
1723       "bad value for -xchar: should be a list of two elements",
1724       (char *) NULL);
1725       }
1726       ckfree((char *) argv);
1727       return TCL_ERROR;
1728   }
1729 
1730   if (! SetCommState(infoPtr->handle, &dcb)) {
1731       if (interp) {
1732     Tcl_AppendResult(interp,
1733       "can't set comm state", (char *) NULL);
1734       }
1735       return TCL_ERROR;
1736   }
1737   return TCL_OK;
1738     }
1739 
1740     /*
1741      * Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
1742      */
1743     if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
1744   int i, result = TCL_OK;
1745 
1746   if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
1747       return TCL_ERROR;
1748   }
1749   if ((argc % 2) == 1) {
1750       if (interp) {
1751     Tcl_AppendResult(interp,
1752       "bad value for -ttycontrol: should be a list of signal,value pairs",
1753       (char *) NULL);
1754       }
1755       ckfree((char *) argv);
1756       return TCL_ERROR;
1757   }
1758   for (i = 0; i < argc - 1; i += 2) {
1759       if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) {
1760     result = TCL_ERROR;
1761     break;
1762       }
1763       if (strnicmp(argv[i], "DTR", strlen(argv[i])) == 0) {
1764     if (!EscapeCommFunction(infoPtr->handle, flag ?
1765           (DWORD) SETDTR : (DWORD) CLRDTR)) {
1766         if (interp) {
1767       Tcl_AppendResult(interp,
1768         "can't set DTR signal", (char *) NULL);
1769         }
1770         result = TCL_ERROR;
1771         break;
1772     }
1773       } else if (strnicmp(argv[i], "RTS", strlen(argv[i])) == 0) {
1774     if (!EscapeCommFunction(infoPtr->handle, flag ?
1775           (DWORD) SETRTS : (DWORD) CLRRTS)) {
1776         if (interp) {
1777       Tcl_AppendResult(interp,
1778         "can't set RTS signal", (char *) NULL);
1779         }
1780         result = TCL_ERROR;
1781         break;
1782     }
1783       } else if (strnicmp(argv[i], "BREAK", strlen(argv[i])) == 0) {
1784     if (!EscapeCommFunction(infoPtr->handle, flag ?
1785           (DWORD) SETBREAK : (DWORD) CLRBREAK)) {
1786         if (interp) {
1787       Tcl_AppendResult(interp,
1788         "can't set BREAK signal", (char *) NULL);
1789         }
1790         result = TCL_ERROR;
1791         break;
1792     }
1793       } else {
1794     if (interp) {
1795         Tcl_AppendResult(interp, "bad signal for -ttycontrol: ",
1796           "must be DTR, RTS or BREAK", (char *) NULL);
1797     }
1798     result = TCL_ERROR;
1799     break;
1800       }
1801   }
1802 
1803   ckfree((char *) argv);
1804   return result;
1805     }
1806 
1807     /*
1808      * Option -sysbuffer {read_size write_size}
1809      * Option -sysbuffer read_size 
1810      */
1811     if ((len > 1) && (strncmp(optionName, "-sysbuffer", len) == 0)) {
1812   /*
1813    * -sysbuffer 4096 or -sysbuffer {64536 4096}
1814    */
1815   size_t inSize = (size_t) -1, outSize = (size_t) -1;
1816 
1817   if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
1818       return TCL_ERROR;
1819   }
1820   if (argc == 1) {
1821       inSize = atoi(argv[0]);
1822       outSize = infoPtr->sysBufWrite;
1823   } else if (argc == 2) {
1824       inSize  = atoi(argv[0]);
1825       outSize = atoi(argv[1]);
1826   }
1827   ckfree((char *) argv);
1828   if ((inSize <= 0) || (outSize <= 0)) {
1829       if (interp) {
1830     Tcl_AppendResult(interp,
1831       "bad value for -sysbuffer: should be a list of one or two integers > 0",
1832       (char *) NULL);
1833       }
1834       return TCL_ERROR;
1835   }
1836   if (! SetupComm(infoPtr->handle, inSize, outSize)) {
1837       if (interp) {
1838     Tcl_AppendResult(interp, 
1839       "can't setup comm buffers", (char *) NULL);
1840       }
1841       return TCL_ERROR;
1842   }
1843   infoPtr->sysBufRead  = inSize;
1844   infoPtr->sysBufWrite = outSize;
1845 
1846   /*
1847    * Adjust the handshake limits.
1848    * Yes, the XonXoff limits seem to influence even hardware handshake
1849    */
1850   if (! GetCommState(infoPtr->handle, &dcb)) {
1851       if (interp) {
1852     Tcl_AppendResult(interp, 
1853       "can't get comm state", (char *) NULL);
1854       }
1855       return TCL_ERROR;
1856   }
1857   dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2);
1858   dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4);
1859   if (! SetCommState(infoPtr->handle, &dcb)) {
1860       if (interp) {
1861     Tcl_AppendResult(interp, 
1862       "can't set comm state", (char *) NULL);
1863       }
1864       return TCL_ERROR;
1865   }
1866   return TCL_OK;
1867     }
1868 
1869     /*
1870      * Option -pollinterval msec
1871      */
1872     if ((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0)) {
1873 
1874   if ( Tcl_GetInt(interp, value, &(infoPtr->blockTime)) != TCL_OK ) {
1875       return TCL_ERROR;
1876   }
1877   return TCL_OK;
1878     }
1879 
1880     /*
1881      * Option -timeout msec
1882      */
1883     if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) {
1884   int msec;
1885   COMMTIMEOUTS tout = {0,0,0,0,0};
1886 
1887   if ( Tcl_GetInt(interp, value, &msec) != TCL_OK ) {
1888       return TCL_ERROR;
1889   }
1890   tout.ReadTotalTimeoutConstant = msec;
1891   if (! SetCommTimeouts(infoPtr->handle, &tout)) {
1892       if (interp) {
1893     Tcl_AppendResult(interp, 
1894       "can't set comm timeouts", (char *) NULL);
1895       }
1896       return TCL_ERROR;
1897   }
1898 
1899   return TCL_OK;
1900     }
1901 
1902     return Tcl_BadChannelOption(interp, optionName,
1903       "mode handshake pollinterval sysbuffer timeout ttycontrol xchar");
1904 }
void SerialSetupProc (ClientData clientData, int flags) [static]

Definition at line 393 of file tclWinSerial.c.
References ThreadSpecificData::firstSerialPtr, INT_MAX, NULL, SerialBlockTime(), SerialInfo, TCL_FILE_EVENTS, TCL_READABLE, TCL_TSD_INIT, and TCL_WRITABLE.
Referenced by SerialExitHandler(), and SerialInit().396 {
397     SerialInfo *infoPtr;
398     int block = 1;
399     int msec = INT_MAX; /* min. found block time */
400     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
401 
402     if (!(flags & TCL_FILE_EVENTS)) {
403         return;
404     }
405 
406     /*
407      * Look to see if any events handlers installed. If they are, do not block.
408      */
409 
410     for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
411             infoPtr = infoPtr->nextPtr) {
412 
413         if (infoPtr->watchMask & TCL_WRITABLE) {
414             if (WaitForSingleObject(infoPtr->evWritable, 0) != WAIT_TIMEOUT) {
415                 block = 0;
416                 msec = min( msec, infoPtr->blockTime );
417             }
418         }
419         if( infoPtr->watchMask & TCL_READABLE ) {
420             block = 0;
421             msec = min( msec, infoPtr->blockTime );
422         }
423     }
424 
425     if (!block) {
426         SerialBlockTime(msec);
427     }
428 }
static void SerialThreadActionProc (ClientData instanceData, int action) [static]

Definition at line 2142 of file tclWinSerial.c.
References NULL, SerialInfo, SerialInit(), TCL_CHANNEL_THREAD_INSERT, Tcl_GetChannelThread(), Tcl_MutexLock, and Tcl_MutexUnlock.2145 {
2146     SerialInfo *infoPtr = (SerialInfo *) instanceData;
2147 
2148     /* We do not access firstSerialPtr in the thread structures. This is
2149      * not for all serials managed by the thread, but only those we are
2150      * watching. Removal of the filevent handlers before transfer thus
2151      * takes care of this structure.
2152      */
2153 
2154     Tcl_MutexLock(&serialMutex);
2155     if (action == TCL_CHANNEL_THREAD_INSERT) {
2156         /* We can't copy the thread information from the channel when
2157    * the channel is created. At this time the channel back
2158    * pointer has not been set yet. However in that case the
2159    * threadId has already been set by TclpCreateCommandChannel
2160    * itself, so the structure is still good.
2161    */
2162 
2163         SerialInit ();
2164         if (infoPtr->channel != NULL) {
2165       infoPtr->threadId = Tcl_GetChannelThread (infoPtr->channel);
2166   }
2167     } else {
2168   infoPtr->threadId = NULL;
2169     }
2170     Tcl_MutexUnlock(&serialMutex);
2171 }
static void SerialWatchProc (ClientData instanceData, int mask) [static]

Definition at line 1188 of file tclWinSerial.c.
References ThreadSpecificData::firstSerialPtr, NULL, SerialBlockTime(), SerialInfo, and TCL_TSD_INIT.1193 {
1194     SerialInfo **nextPtrPtr, *ptr;
1195     SerialInfo *infoPtr = (SerialInfo *) instanceData;
1196     int oldMask = infoPtr->watchMask;
1197     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1198 
1199     /*
1200      * Since the file is always ready for events, we set the block time
1201      * so we will poll.
1202      */
1203 
1204     infoPtr->watchMask = mask & infoPtr->validMask;
1205     if (infoPtr->watchMask) {
1206         if (!oldMask) {
1207             infoPtr->nextPtr = tsdPtr->firstSerialPtr;
1208             tsdPtr->firstSerialPtr = infoPtr;
1209         }
1210         SerialBlockTime(infoPtr->blockTime);
1211     } else {
1212         if (oldMask) {
1213             /*
1214              * Remove the serial port from the list of watched serial ports.
1215              */
1216 
1217             for (nextPtrPtr = &(tsdPtr->firstSerialPtr), ptr = *nextPtrPtr;
1218                     ptr != NULL;
1219                     nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
1220                 if (infoPtr == ptr) {
1221                     *nextPtrPtr = ptr->nextPtr;
1222                     break;
1223                 }
1224             }
1225         }
1226     }
1227 }
static DWORD WINAPI SerialWriterThread (LPVOID arg) [static]

Definition at line 1278 of file tclWinSerial.c.
References blockingWrite(), DWORD(), FALSE, NULL, SerialInfo, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_ThreadAlert(), and TRUE.
Referenced by TclWinOpenSerialChannel().1279 {
1280 
1281     SerialInfo *infoPtr = (SerialInfo *)arg;
1282     DWORD bytesWritten, toWrite, waitResult;
1283     char *buf;
1284     OVERLAPPED myWrite; /* have an own OVERLAPPED in this thread */
1285     HANDLE wEvents[2];
1286 
1287     /*
1288      * The stop event takes precedence by being first in the list.
1289      */
1290     wEvents[0] = infoPtr->evStopWriter;
1291     wEvents[1] = infoPtr->evStartWriter;
1292 
1293     for (;;) {
1294         /*
1295          * Wait for the main thread to signal before attempting to write.
1296          */
1297 
1298   waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
1299 
1300   if (waitResult != (WAIT_OBJECT_0 + 1)) {
1301       /*
1302        * The start event was not signaled.  It might be the stop event
1303        * or an error, so exit.
1304        */
1305 
1306       break;
1307   }
1308 
1309         buf = infoPtr->writeBuf;
1310         toWrite = infoPtr->toWrite;
1311 
1312         myWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);
1313 
1314         /*
1315          * Loop until all of the bytes are written or an error occurs.
1316          */
1317 
1318         while (toWrite > 0) {
1319             /*
1320             *  Check for pending writeError
1321             *  Ignore all write operations until the user has been notified
1322             */
1323             if (infoPtr->writeError) {
1324                 break;
1325             }
1326             if (blockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite, 
1327                     &bytesWritten, &myWrite) == FALSE) {
1328                 infoPtr->writeError = GetLastError();
1329                 break;
1330             }
1331             if (bytesWritten != toWrite) {
1332                 /* Write timeout */
1333                 infoPtr->writeError = ERROR_WRITE_FAULT;
1334                 break;
1335             }
1336             toWrite -= bytesWritten;
1337             buf += bytesWritten;
1338         }
1339 
1340         CloseHandle(myWrite.hEvent);
1341         /*
1342          * Signal the main thread by signalling the evWritable event and
1343          * then waking up the notifier thread.
1344          */
1345         SetEvent(infoPtr->evWritable);
1346 
1347         /*
1348          * Alert the foreground thread.  Note that we need to treat this like
1349          * a critical section so the foreground thread does not terminate
1350          * this thread while we are holding a mutex in the notifier code.
1351          */
1352 
1353         Tcl_MutexLock(&serialMutex);
1354   if (infoPtr->threadId != NULL) {
1355       /* TIP #218. When in flight ignore the event, no one will receive it anyway */
1356       Tcl_ThreadAlert(infoPtr->threadId);
1357   }
1358         Tcl_MutexUnlock(&serialMutex);
1359     }
1360 
1361     return 0;
1362 }
TCL_DECLARE_MUTEX (serialMutex)

Definition at line 36 of file tclWinSerial.c.
References DWORD(), and SerialInfo.68                           {
69     HANDLE handle;
70     struct SerialInfo *nextPtr; /* Pointer to next registered serial. */
71     Tcl_Channel channel;        /* Pointer to channel structure. */
72     int validMask;              /* OR'ed combination of TCL_READABLE,
73                                  * TCL_WRITABLE, or TCL_EXCEPTION: indicates
74                                  * which operations are valid on the file. */
75     int watchMask;              /* OR'ed combination of TCL_READABLE,
76                                  * TCL_WRITABLE, or TCL_EXCEPTION: indicates
77                                  * which events should be reported. */
78     int flags;                  /* State flags, see above for a list. */
79     int readable;               /* flag that the channel is readable */
80     int writable;               /* flag that the channel is writable */
81     int blockTime;              /* max. blocktime in msec */
82     unsigned int lastEventTime; /* Time in milliseconds since last readable event */
83         /* Next readable event only after blockTime */
84     DWORD error;                /* pending error code returned by
85                                  * ClearCommError() */
86     DWORD lastError;            /* last error code, can be fetched with
87                                  * fconfigure chan -lasterror */
88     DWORD sysBufRead;           /* Win32 system buffer size for read ops, 
89                                  * default=4096 */
90     DWORD sysBufWrite;          /* Win32 system buffer size for write ops, 
91                                  * default=4096 */
92 
93     Tcl_ThreadId threadId;      /* Thread to which events should be reported.
94                                  * This value is used by the reader/writer
95                                  * threads. */
96     OVERLAPPED osRead;          /* OVERLAPPED structure for read operations */
97     OVERLAPPED osWrite;         /* OVERLAPPED structure for write operations */
98     HANDLE writeThread;         /* Handle to writer thread. */
99     CRITICAL_SECTION csWrite;   /* Writer thread synchronisation */
100     HANDLE evWritable;          /* Manual-reset event to signal when the
101                                  * writer thread has finished waiting for
102                                  * the current buffer to be written. */
103     HANDLE evStartWriter;       /* Auto-reset event used by the main thread to
104                                  * signal when the writer thread should attempt
105                                  * to write to the serial. */
106     HANDLE evStopWriter;  /* Auto-reset event used by the main thread to
107                                  * signal when the writer thread should close.
108          */
109     DWORD writeError;           /* An error caused by the last background
110                                  * write.  Set to 0 if no error has been
111                                  * detected.  This word is shared with the
112                                  * writer thread so access must be
113                                  * synchronized with the evWritable object.
114                                  */
115     char *writeBuf;             /* Current background output buffer.
116                                  * Access is synchronized with the evWritable
117                                  * object. */
118     int writeBufLen;            /* Size of write buffer.  Access is
119                                  * synchronized with the evWritable
120                                  * object. */
121     int toWrite;                /* Current amount to be written.  Access is
122                                  * synchronized with the evWritable object. */
123     int writeQueue;             /* Number of bytes pending in output queue.
124                                  * Offset to DCB.cbInQue.
125                                  * Used to query [fconfigure -queue] */
126 } SerialInfo;
Tcl_Channel TclWinOpenSerialChannel (HANDLE handle, char * channelName, int permissions)

Definition at line 1424 of file tclWinSerial.c.
References ckalloc, DWORD(), FALSE, NULL, SERIAL_DEFAULT_BLOCKTIME, serialChannelType, SerialInfo, SerialInit(), SerialWriterThread(), Tcl_CreateChannel(), Tcl_GetCurrentThread(), TCL_READABLE, Tcl_SetChannelOption(), TCL_WRITABLE, and TRUE.
Referenced by Tcl_MakeFileChannel(), and TclpOpenFileChannel().1428 {
1429     SerialInfo *infoPtr;
1430     DWORD id;
1431 
1432     SerialInit();
1433 
1434     infoPtr = (SerialInfo *) ckalloc((unsigned) sizeof(SerialInfo));
1435     memset(infoPtr, 0, sizeof(SerialInfo));
1436 
1437     infoPtr->validMask     = permissions;
1438     infoPtr->handle        = handle;
1439     infoPtr->channel       = (Tcl_Channel) NULL;
1440     infoPtr->readable      = 0; 
1441     infoPtr->writable      = 1;
1442     infoPtr->toWrite       = infoPtr->writeQueue = 0;
1443     infoPtr->blockTime     = SERIAL_DEFAULT_BLOCKTIME;
1444     infoPtr->lastEventTime = 0;
1445     infoPtr->lastError     = infoPtr->error = 0;
1446     infoPtr->threadId      = Tcl_GetCurrentThread();
1447     infoPtr->sysBufRead    = 4096;
1448     infoPtr->sysBufWrite   = 4096;
1449 
1450     /*
1451      * Use the pointer to keep the channel names unique, in case
1452      * the handles are shared between multiple channels (stdin/stdout).
1453      */
1454 
1455     wsprintfA(channelName, "file%lx", (int) infoPtr);
1456 
1457     infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
1458             (ClientData) infoPtr, permissions);
1459 
1460 
1461     SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite);
1462     PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR 
1463             | PURGE_RXCLEAR);
1464 
1465     /*
1466      * default is blocking
1467      */
1468     SetCommTimeouts(handle, &no_timeout);
1469 
1470 
1471     if (permissions & TCL_READABLE) {
1472         infoPtr->osRead.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);
1473     }
1474     if (permissions & TCL_WRITABLE) {
1475         /* 
1476         * Initially the channel is writable
1477         * and the writeThread is idle.
1478         */ 
1479         infoPtr->osWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);
1480         infoPtr->evWritable = CreateEvent(NULL, TRUE, TRUE, NULL);
1481         infoPtr->evStartWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
1482   infoPtr->evStopWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
1483         InitializeCriticalSection(&infoPtr->csWrite);
1484         infoPtr->writeThread = CreateThread(NULL, 256, SerialWriterThread,
1485             infoPtr, 0, &id);
1486     }
1487 
1488     /*
1489      * Files have default translation of AUTO and ^Z eof char, which
1490      * means that a ^Z will be accepted as EOF when reading.
1491      */
1492 
1493     Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
1494     Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
1495 
1496     return infoPtr->channel;
1497 }
HANDLE TclWinSerialReopen (HANDLE handle, CONST TCHAR * name, DWORD access)

Definition at line 1384 of file tclWinSerial.c.
References FALSE, SerialInit(), and tclWinProcs.
Referenced by TclpOpenFileChannel().1388 {
1389     ThreadSpecificData *tsdPtr;
1390 
1391     tsdPtr = SerialInit();
1392 
1393     /* 
1394     * Multithreaded I/O needs the overlapped flag set
1395     * otherwise ClearCommError blocks under Windows NT/2000 until serial
1396     * output is finished
1397     */
1398     if (CloseHandle(handle) == FALSE) {
1399         return INVALID_HANDLE_VALUE;
1400     }
1401     handle = (*tclWinProcs->createFileProc)(name, access, 
1402                 0, 0, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
1403     return handle;
1404 }

Variable Documentation
Tcl_ThreadDataKey dataKey [static]

Definition at line 137 of file tclWinSerial.c.int initialized = 0 [static]

Definition at line 28 of file tclWinSerial.c.COMMTIMEOUTS no_timeout [static]
Initial value: {
    0,               
    0,               
    0,               
    0,               
    0,               
}
Definition at line 157 of file tclWinSerial.c.Tcl_ChannelType serialChannelType [static]
Initial value: {
    "serial",                   
    TCL_CHANNEL_VERSION_4,      
    SerialCloseProc,            
    SerialInputProc,            
    SerialOutputProc,           
    NULL,                       
    SerialSetOptionProc,        
    SerialGetOptionProc,        
    SerialWatchProc,            
    SerialGetHandleProc,        
    NULL,                       
    SerialBlockProc,            
    NULL,                       
    NULL,                       
    NULL,                       
    SerialThreadActionProc,     
}
Definition at line 201 of file tclWinSerial.c.
Referenced by TclWinOpenSerialChannel().SerialInfo

Definition at line 126 of file tclWinSerial.c.
Referenced by SerialBlockProc(), SerialCheckProc(), SerialCloseProc(), SerialEventProc(), SerialExitHandler(), SerialGetHandleProc(), SerialGetOptionProc(), SerialInputProc(), SerialOutputProc(), SerialSetOptionProc(), SerialSetupProc(), SerialThreadActionProc(), SerialWatchProc(), SerialWriterThread(), TCL_DECLARE_MUTEX(), and TclWinOpenSerialChannel().

win/tclWinSock.c File Reference
#include "tclWinInt.h"
Classes
struct SocketInfo
struct SocketEvent
struct ThreadSpecificData
Defines
#define SOCKET_MESSAGE  WM_USER+1
#define SOCKET_SELECT  WM_USER+2
#define SOCKET_TERMINATE  WM_USER+3
#define SELECT  TRUE
#define UNSELECT  FALSE
#define TCP_BUFFER_SIZE  4096
#define SOCKET_ASYNC  (1<<0)
#define SOCKET_EOF  (1<<1)
#define SOCKET_ASYNC_CONNECT  (1<<2)
#define SOCKET_PENDING  (1<<3)
#define WSA_VERSION_MAJOR  1
#define WSA_VERSION_MINOR  1
#define WSA_VERSION_REQD  MAKEWORD(WSA_VERSION_MAJOR, WSA_VERSION_MINOR)
Functions
TCL_DECLARE_MUTEX (socketMutex)
static SocketInfo *CreateSocket _ANSI_ARGS_ ((Tcl_Interp *interp, int port, CONST char *host, int server, CONST char *myaddr, int myport, int async))
static int CreateSocketAddress _ANSI_ARGS_ ((LPSOCKADDR_IN sockaddrPtr, CONST char *host, int port))
static void InitSockets _ANSI_ARGS_ ((void))
static SocketInfo *NewSocketInfo _ANSI_ARGS_ ((SOCKET socket))
static void SocketExitHandler _ANSI_ARGS_ ((ClientData clientData))
static LRESULT CALLBACK SocketProc _ANSI_ARGS_ ((HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam))
static void TcpAccept _ANSI_ARGS_ ((SocketInfo *infoPtr))
static int WaitForSocketEvent _ANSI_ARGS_ ((SocketInfo *infoPtr, int events, int *errorCodePtr))
static DWORD WINAPI SocketThread _ANSI_ARGS_ ((LPVOID arg))
static void TcpThreadActionProc _ANSI_ARGS_ ((ClientData instanceData, int action))
static void InitSockets ()
static int SocketsEnabled ()
static void SocketExitHandler (ClientData clientData)
void TclpFinalizeSockets ()
int TclpHasSockets (Tcl_Interp *interp)
void SocketSetupProc (ClientData data, int flags)
static void SocketCheckProc (ClientData data, int flags)
static int SocketEventProc (Tcl_Event *evPtr, int flags)
static int TcpBlockProc (ClientData instanceData, int mode)
static int TcpCloseProc (ClientData instanceData, Tcl_Interp *interp)
static SocketInfo * NewSocketInfo (SOCKET socket)
static SocketInfo * CreateSocket (Tcl_Interp *interp, int port, CONST char *host, int server, CONST char *myaddr, int myport, int async)
static int CreateSocketAddress (LPSOCKADDR_IN sockaddrPtr, CONST char *host, int port)
static int WaitForSocketEvent (SocketInfo *infoPtr, int events, int *errorCodePtr)
Tcl_Channel Tcl_OpenTcpClient (Tcl_Interp *interp, int port, CONST char *host, CONST char *myaddr, int myport, int async)
Tcl_Channel Tcl_MakeTcpClientChannel (ClientData sock)
Tcl_Channel Tcl_OpenTcpServer (Tcl_Interp *interp, int port, CONST char *host, Tcl_TcpAcceptProc *acceptProc, ClientData acceptProcData)
static void TcpAccept (SocketInfo *infoPtr)
static int TcpInputProc (ClientData instanceData, char *buf, int toRead, int *errorCodePtr)
static int TcpOutputProc (ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr)
static int TcpSetOptionProc (ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, CONST char *value)
static int TcpGetOptionProc (ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, Tcl_DString *dsPtr)
static void TcpWatchProc (ClientData instanceData, int mask)
static int TcpGetHandleProc (ClientData instanceData, int direction, ClientData *handlePtr)
static DWORD WINAPI SocketThread (LPVOID arg)
static LRESULT CALLBACK SocketProc (HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam)
CONST char * Tcl_GetHostName ()
int TclWinGetSockOpt (SOCKET s, int level, int optname, char *optval, int FAR *optlen)
int TclWinSetSockOpt (SOCKET s, int level, int optname, const char *optval, int optlen)
u_short TclWinNToHS (u_short netshort)
servent * TclWinGetServByName (const char *name, const char *proto)
static void TcpThreadActionProc (ClientData instanceData, int action)
Variables
static int initialized = 0
static int hostnameInitialized = 0
static char hostname [255]
winSock
static Tcl_ThreadDataKey dataKey
static WNDCLASS windowClass
static Tcl_EventCheckProc SocketCheckProc
static Tcl_EventProc SocketEventProc
static Tcl_EventSetupProc SocketSetupProc
static Tcl_DriverBlockModeProc TcpBlockProc
static Tcl_DriverCloseProc TcpCloseProc
static Tcl_DriverSetOptionProc TcpSetOptionProc
static Tcl_DriverGetOptionProc TcpGetOptionProc
static Tcl_DriverInputProc TcpInputProc
static Tcl_DriverOutputProc TcpOutputProc
static Tcl_DriverWatchProc TcpWatchProc
static Tcl_DriverGetHandleProc TcpGetHandleProc
static Tcl_ChannelType tcpChannelType

Define Documentation
#define SELECT  TRUE

Definition at line 143 of file tclWinSock.c.
Referenced by CreateSocket(), SocketEventProc(), SocketProc(), Tcl_MakeTcpClientChannel(), TcpAccept(), TcpInputProc(), TcpOutputProc(), TcpThreadActionProc(), and WaitForSocketEvent().#define SOCKET_ASYNC  (1<<0)

Definition at line 206 of file tclWinSock.c.
Referenced by TcpBlockProc(), TcpInputProc(), TcpOutputProc(), and WaitForSocketEvent().#define SOCKET_ASYNC_CONNECT  (1<<2)

Definition at line 210 of file tclWinSock.c.
Referenced by CreateSocket(), SocketProc(), TcpInputProc(), and TcpOutputProc().#define SOCKET_EOF  (1<<1)

Definition at line 208 of file tclWinSock.c.
Referenced by TcpInputProc().#define SOCKET_MESSAGE  WM_USER+1

Definition at line 140 of file tclWinSock.c.
Referenced by SocketProc().#define SOCKET_PENDING  (1<<3)

Definition at line 212 of file tclWinSock.c.
Referenced by SocketCheckProc(), and SocketEventProc().#define SOCKET_SELECT  WM_USER+2

Definition at line 141 of file tclWinSock.c.
Referenced by CreateSocket(), SocketEventProc(), SocketProc(), Tcl_MakeTcpClientChannel(), TcpAccept(), TcpInputProc(), TcpOutputProc(), TcpThreadActionProc(), and WaitForSocketEvent().#define SOCKET_TERMINATE  WM_USER+3

Definition at line 142 of file tclWinSock.c.
Referenced by SocketProc(), and TclpFinalizeSockets().#define TCP_BUFFER_SIZE  4096

Definition at line 199 of file tclWinSock.c.
Referenced by CreateSocket(), and Tcl_MakeTcpClientChannel().#define UNSELECT  FALSE

Definition at line 144 of file tclWinSock.c.
Referenced by SocketEventProc(), TcpInputProc(), TcpOutputProc(), TcpThreadActionProc(), and WaitForSocketEvent().#define WSA_VERSION_MAJOR  1

Referenced by InitSockets().#define WSA_VERSION_MINOR  1

Referenced by InitSockets().#define WSA_VERSION_REQD  MAKEWORD(WSA_VERSION_MAJOR, WSA_VERSION_MINOR)

Referenced by InitSockets().
Function Documentation
static void TcpThreadActionProc _ANSI_ARGS_ ((ClientData instanceData, int action)) [static]
static DWORD WINAPI SocketThread _ANSI_ARGS_ ((LPVOID arg)) [static]
static int WaitForSocketEvent _ANSI_ARGS_ ((SocketInfo *infoPtr, int events, int *errorCodePtr)) [static]
static void TcpAccept _ANSI_ARGS_ ((SocketInfo *infoPtr)) [static]
static LRESULT CALLBACK SocketProc _ANSI_ARGS_ ((HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam)) [static]
static void SocketExitHandler _ANSI_ARGS_ ((ClientData clientData)) [static]
static SocketInfo* NewSocketInfo _ANSI_ARGS_ ((SOCKET socket)) [static]
static void InitSockets _ANSI_ARGS_ ((void)) [static]
static int CreateSocketAddress _ANSI_ARGS_ ((LPSOCKADDR_IN sockaddrPtr, CONST char *host, int port)) [static]
static SocketInfo* CreateSocket _ANSI_ARGS_ ((Tcl_Interp *interp, int port, CONST char *host, int server, CONST char *myaddr, int myport, int async)) [static]
static SocketInfo* CreateSocket (Tcl_Interp * interp, int port, CONST char * host, int server, CONST char * myaddr, int myport, int async) [static]

Definition at line 1070 of file tclWinSock.c.
References CreateSocketAddress(), DWORD(), EWOULDBLOCK, SocketInfo::flags, ThreadSpecificData::hwnd, NewSocketInfo(), NULL, SELECT, SocketInfo::selectEvents, SOCKET_ASYNC_CONNECT, SOCKET_SELECT, SocketsEnabled(), SOMAXCONN, Tcl_GetErrno(), Tcl_PosixError(), TclSockMinimumBuffers(), TclThreadDataKeyGet(), TclWinConvertWSAError(), TCP_BUFFER_SIZE, SocketInfo::watchEvents, and winSock.1080 {
1081     u_long flag = 1;    /* Indicates nonblocking mode. */
1082     int asyncConnect = 0; /* Will be 1 if async connect is
1083          * in progress. */
1084     SOCKADDR_IN sockaddr; /* Socket address */
1085     SOCKADDR_IN mysockaddr; /* Socket address for client */
1086     SOCKET sock = INVALID_SOCKET;
1087     SocketInfo *infoPtr;  /* The returned value. */
1088     ThreadSpecificData *tsdPtr = 
1089   (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
1090 
1091     /*
1092      * Check that WinSock is initialized; do not call it if not, to
1093      * prevent system crashes. This can happen at exit time if the exit
1094      * handler for WinSock ran before other exit handlers that want to
1095      * use sockets.
1096      */
1097 
1098     if (!SocketsEnabled()) {
1099         return NULL;
1100     }
1101 
1102     if (! CreateSocketAddress(&sockaddr, host, port)) {
1103   goto error;
1104     }
1105     if ((myaddr != NULL || myport != 0) &&
1106       ! CreateSocketAddress(&mysockaddr, myaddr, myport)) {
1107   goto error;
1108     }
1109 
1110     sock = winSock.socket(AF_INET, SOCK_STREAM, 0);
1111     if (sock == INVALID_SOCKET) {
1112   goto error;
1113     }
1114 
1115     /*
1116      * Win-NT has a misfeature that sockets are inherited in child
1117      * processes by default.  Turn off the inherit bit.
1118      */
1119 
1120     SetHandleInformation( (HANDLE) sock, HANDLE_FLAG_INHERIT, 0 );
1121   
1122     /*
1123      * Set kernel space buffering
1124      */
1125 
1126     TclSockMinimumBuffers((int) sock, TCP_BUFFER_SIZE);
1127 
1128     if (server) {
1129   /*
1130    * Bind to the specified port.  Note that we must not call setsockopt
1131    * with SO_REUSEADDR because Microsoft allows addresses to be reused
1132    * even if they are still in use.
1133          *
1134          * Bind should not be affected by the socket having already been
1135          * set into nonblocking mode. If there is trouble, this is one place
1136          * to look for bugs.
1137    */
1138     
1139   if (winSock.bind(sock, (SOCKADDR *) &sockaddr,
1140     sizeof(SOCKADDR_IN)) == SOCKET_ERROR) {
1141             goto error;
1142         }
1143 
1144         /*
1145          * Set the maximum number of pending connect requests to the
1146          * max value allowed on each platform (Win32 and Win32s may be
1147          * different, and there may be differences between TCP/IP stacks).
1148          */
1149         
1150   if (winSock.listen(sock, SOMAXCONN) == SOCKET_ERROR) {
1151       goto error;
1152   }
1153 
1154   /*
1155    * Add this socket to the global list of sockets.
1156    */
1157 
1158   infoPtr = NewSocketInfo(sock);
1159 
1160   /*
1161    * Set up the select mask for connection request events.
1162    */
1163 
1164   infoPtr->selectEvents = FD_ACCEPT;
1165   infoPtr->watchEvents |= FD_ACCEPT;
1166 
1167     } else {
1168 
1169         /*
1170          * Try to bind to a local port, if specified.
1171          */
1172         
1173   if (myaddr != NULL || myport != 0) { 
1174       if (winSock.bind(sock, (SOCKADDR *) &mysockaddr,
1175         sizeof(SOCKADDR_IN)) == SOCKET_ERROR) {
1176     goto error;
1177       }
1178   }            
1179     
1180   /*
1181    * Set the socket into nonblocking mode if the connect should be
1182    * done in the background.
1183    */
1184     
1185   if (async) {
1186       if (winSock.ioctlsocket(sock, (long) FIONBIO, &flag) == SOCKET_ERROR) {
1187     goto error;
1188       }
1189   }
1190 
1191   /*
1192    * Attempt to connect to the remote socket.
1193    */
1194 
1195   if (winSock.connect(sock, (SOCKADDR *) &sockaddr,
1196     sizeof(SOCKADDR_IN)) == SOCKET_ERROR) {
1197             TclWinConvertWSAError((DWORD) winSock.WSAGetLastError());
1198       if (Tcl_GetErrno() != EWOULDBLOCK) {
1199     goto error;
1200       }
1201 
1202       /*
1203        * The connection is progressing in the background.
1204        */
1205 
1206       asyncConnect = 1;
1207         }
1208 
1209   /*
1210    * Add this socket to the global list of sockets.
1211    */
1212 
1213   infoPtr = NewSocketInfo(sock);
1214 
1215   /*
1216    * Set up the select mask for read/write events.  If the connect
1217    * attempt has not completed, include connect events.
1218    */
1219 
1220   infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
1221   if (asyncConnect) {
1222       infoPtr->flags |= SOCKET_ASYNC_CONNECT;
1223       infoPtr->selectEvents |= FD_CONNECT;
1224   }
1225     }
1226 
1227     /*
1228      * Register for interest in events in the select mask.  Note that this
1229      * automatically places the socket into non-blocking mode.
1230      */
1231 
1232     winSock.ioctlsocket(sock, (long) FIONBIO, &flag);
1233     SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
1234       (WPARAM) SELECT, (LPARAM) infoPtr);
1235 
1236     return infoPtr;
1237 
1238 error:
1239     TclWinConvertWSAError((DWORD) winSock.WSAGetLastError());
1240     if (interp != NULL) {
1241   Tcl_AppendResult(interp, "couldn't open socket: ",
1242     Tcl_PosixError(interp), (char *) NULL);
1243     }
1244     if (sock != INVALID_SOCKET) {
1245   winSock.closesocket(sock);
1246     }
1247     return NULL;
1248 }
static int CreateSocketAddress (LPSOCKADDR_IN sockaddrPtr, CONST char * host, int port) [static]

Definition at line 1268 of file tclWinSock.c.
References EFAULT, EHOSTUNREACH, ENXIO, NULL, size_t(), SocketsEnabled(), Tcl_SetErrno(), and winSock.1272 {
1273     struct hostent *hostent;    /* Host database entry */
1274     struct in_addr addr;    /* For 64/32 bit madness */
1275 
1276     /*
1277      * Check that WinSock is initialized; do not call it if not, to
1278      * prevent system crashes. This can happen at exit time if the exit
1279      * handler for WinSock ran before other exit handlers that want to
1280      * use sockets.
1281      */
1282 
1283     if (!SocketsEnabled()) {
1284         Tcl_SetErrno(EFAULT);
1285         return 0;
1286     }
1287 
1288     ZeroMemory(sockaddrPtr, sizeof(SOCKADDR_IN));
1289     sockaddrPtr->sin_family = AF_INET;
1290     sockaddrPtr->sin_port = winSock.htons((u_short) (port & 0xFFFF));
1291     if (host == NULL) {
1292   addr.s_addr = INADDR_ANY;
1293     } else {
1294         addr.s_addr = winSock.inet_addr(host);
1295         if (addr.s_addr == INADDR_NONE) {
1296             hostent = winSock.gethostbyname(host);
1297             if (hostent != NULL) {
1298                 memcpy(&addr, hostent->h_addr, (size_t) hostent->h_length);
1299             } else {
1300 #ifdef  EHOSTUNREACH
1301                 Tcl_SetErrno(EHOSTUNREACH);
1302 #else
1303 #ifdef ENXIO
1304                 Tcl_SetErrno(ENXIO);
1305 #endif
1306 #endif
1307     return 0; /* Error. */
1308       }
1309   }
1310     }
1311 
1312     /*
1313      * NOTE: On 64 bit machines the assignment below is rumored to not
1314      * do the right thing. Please report errors related to this if you
1315      * observe incorrect behavior on 64 bit machines such as DEC Alphas.
1316      * Should we modify this code to do an explicit memcpy?
1317      */
1318 
1319     sockaddrPtr->sin_addr.s_addr = addr.s_addr;
1320     return 1; /* Success. */
1321 }
static void InitSockets () [static]

Definition at line 319 of file tclWinSock.c.
References DWORD(), FALSE, ThreadSpecificData::hwnd, initialized, NULL, ThreadSpecificData::readyEvent, SocketExitHandler(), ThreadSpecificData::socketList, ThreadSpecificData::socketListLock, SocketProc(), SocketThread(), ThreadSpecificData::socketThread, Tcl_CreateEventSource(), Tcl_CreateExitHandler(), Tcl_GetCurrentThread(), TCL_TSD_INIT, TclpFinalizeSockets(), TclThreadDataKeyGet(), TclWinConvertError(), TclWinConvertWSAError(), ThreadSpecificData::threadId, TRUE, winSock, WSA_VERSION_MAJOR, WSA_VERSION_MINOR, and WSA_VERSION_REQD.320 {
321     DWORD id;
322     WSADATA wsaData;
323     DWORD err;
324     ThreadSpecificData *tsdPtr = 
325   (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
326 
327     if (!initialized) {
328   initialized = 1;
329   Tcl_CreateExitHandler(SocketExitHandler, (ClientData) NULL);
330 
331   winSock.hModule = LoadLibraryA("wsock32.dll");
332 
333   if (winSock.hModule == NULL) {
334       return;
335   }
336     
337   /*
338    * Initialize the function table.
339    */
340 
341   winSock.accept = (LPFN_ACCEPT)
342     GetProcAddress(winSock.hModule, "accept");
343   winSock.bind = (LPFN_BIND)
344     GetProcAddress(winSock.hModule, "bind");
345   winSock.closesocket = (LPFN_CLOSESOCKET)
346     GetProcAddress(winSock.hModule, "closesocket");
347   winSock.connect = (LPFN_CONNECT)
348     GetProcAddress(winSock.hModule, "connect");
349   winSock.gethostbyaddr = (LPFN_GETHOSTBYADDR)
350     GetProcAddress(winSock.hModule, "gethostbyaddr");
351   winSock.gethostbyname = (LPFN_GETHOSTBYNAME)
352     GetProcAddress(winSock.hModule, "gethostbyname");
353   winSock.gethostname = (LPFN_GETHOSTNAME)
354     GetProcAddress(winSock.hModule, "gethostname");
355   winSock.getpeername = (LPFN_GETPEERNAME)
356     GetProcAddress(winSock.hModule, "getpeername");
357   winSock.getservbyname = (LPFN_GETSERVBYNAME)
358     GetProcAddress(winSock.hModule, "getservbyname");
359   winSock.getsockname = (LPFN_GETSOCKNAME)
360     GetProcAddress(winSock.hModule, "getsockname");
361   winSock.getsockopt = (LPFN_GETSOCKOPT)
362     GetProcAddress(winSock.hModule, "getsockopt");
363   winSock.htons = (LPFN_HTONS)
364     GetProcAddress(winSock.hModule, "htons");
365   winSock.inet_addr = (LPFN_INET_ADDR)
366     GetProcAddress(winSock.hModule, "inet_addr");
367   winSock.inet_ntoa = (LPFN_INET_NTOA)
368     GetProcAddress(winSock.hModule, "inet_ntoa");
369   winSock.ioctlsocket = (LPFN_IOCTLSOCKET)
370     GetProcAddress(winSock.hModule, "ioctlsocket");
371   winSock.listen = (LPFN_LISTEN)
372     GetProcAddress(winSock.hModule, "listen");
373   winSock.ntohs = (LPFN_NTOHS)
374     GetProcAddress(winSock.hModule, "ntohs");
375   winSock.recv = (LPFN_RECV)
376     GetProcAddress(winSock.hModule, "recv");
377   winSock.select = (LPFN_SELECT)
378     GetProcAddress(winSock.hModule, "select");
379   winSock.send = (LPFN_SEND)
380     GetProcAddress(winSock.hModule, "send");
381   winSock.setsockopt = (LPFN_SETSOCKOPT)
382     GetProcAddress(winSock.hModule, "setsockopt");
383   winSock.socket = (LPFN_SOCKET)
384     GetProcAddress(winSock.hModule, "socket");
385   winSock.WSAAsyncSelect = (LPFN_WSAASYNCSELECT)
386     GetProcAddress(winSock.hModule, "WSAAsyncSelect");
387   winSock.WSACleanup = (LPFN_WSACLEANUP)
388     GetProcAddress(winSock.hModule, "WSACleanup");
389   winSock.WSAGetLastError = (LPFN_WSAGETLASTERROR)
390     GetProcAddress(winSock.hModule, "WSAGetLastError");
391   winSock.WSAStartup = (LPFN_WSASTARTUP)
392     GetProcAddress(winSock.hModule, "WSAStartup");
393     
394   /*
395    * Now check that all fields are properly initialized. If not,
396    * return zero to indicate that we failed to initialize
397    * properly.
398    */
399     
400   if ((winSock.accept == NULL) ||
401     (winSock.bind == NULL) ||
402     (winSock.closesocket == NULL) ||
403     (winSock.connect == NULL) ||
404     (winSock.gethostbyname == NULL) ||
405     (winSock.gethostbyaddr == NULL) ||
406     (winSock.gethostname == NULL) ||
407     (winSock.getpeername == NULL) ||
408     (winSock.getservbyname == NULL) ||
409     (winSock.getsockname == NULL) ||
410     (winSock.getsockopt == NULL) ||
411     (winSock.htons == NULL) ||
412     (winSock.inet_addr == NULL) ||
413     (winSock.inet_ntoa == NULL) ||
414     (winSock.ioctlsocket == NULL) ||
415     (winSock.listen == NULL) ||
416     (winSock.ntohs == NULL) ||
417     (winSock.recv == NULL) ||
418     (winSock.select == NULL) ||
419     (winSock.send == NULL) ||
420     (winSock.setsockopt == NULL) ||
421     (winSock.socket == NULL) ||
422     (winSock.WSAAsyncSelect == NULL) ||
423     (winSock.WSACleanup == NULL) ||
424     (winSock.WSAGetLastError == NULL) ||
425     (winSock.WSAStartup == NULL))
426   {
427       goto unloadLibrary;
428   }
429   
430   /*
431    * Create the async notification window with a new class.  We
432    * must create a new class to avoid a Windows 95 bug that causes
433    * us to get the wrong message number for socket events if the
434    * message window is a subclass of a static control.
435    */
436     
437   windowClass.style = 0;
438   windowClass.cbClsExtra = 0;
439   windowClass.cbWndExtra = 0;
440   windowClass.hInstance = TclWinGetTclInstance();
441   windowClass.hbrBackground = NULL;
442   windowClass.lpszMenuName = NULL;
443   windowClass.lpszClassName = "TclSocket";
444   windowClass.lpfnWndProc = SocketProc;
445   windowClass.hIcon = NULL;
446   windowClass.hCursor = NULL;
447 
448   if (!RegisterClassA(&windowClass)) {
449       TclWinConvertError(GetLastError());
450       goto unloadLibrary;
451   }
452 
453   /*
454    * Initialize the winsock library and check the interface
455    * version actually loaded. We only ask for the 1.1 interface
456    * and do require that it not be less than 1.1.
457    */
458 
459 #define WSA_VERSION_MAJOR   1
460 #define WSA_VERSION_MINOR   1
461 #define WSA_VERSION_REQD    MAKEWORD(WSA_VERSION_MAJOR, WSA_VERSION_MINOR)
462 
463   if ((err = winSock.WSAStartup(WSA_VERSION_REQD, &wsaData)) != 0) {
464       TclWinConvertWSAError(err);
465       goto unloadLibrary;
466   }
467 
468   /*
469    * Note the byte positions are swapped for the comparison, so
470    * that 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101
471    * (1.1).  We want the comparison to be 0x0200 < 0x0101.
472    */
473 
474   if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion))
475     < MAKEWORD(WSA_VERSION_MINOR, WSA_VERSION_MAJOR)) {
476       TclWinConvertWSAError(WSAVERNOTSUPPORTED);
477       winSock.WSACleanup();
478       goto unloadLibrary;
479   }
480 
481 #undef WSA_VERSION_REQD
482 #undef WSA_VERSION_MAJOR
483 #undef WSA_VERSION_MINOR
484     }
485 
486     /*
487      * Check for per-thread initialization.
488      */
489 
490     if (tsdPtr == NULL) {
491   tsdPtr = TCL_TSD_INIT(&dataKey);
492   tsdPtr->socketList = NULL;
493   tsdPtr->hwnd       = NULL;
494   tsdPtr->threadId   = Tcl_GetCurrentThread();
495   tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
496   if (tsdPtr->readyEvent == NULL) {
497       goto unloadLibrary;
498   }
499   tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL);
500   if (tsdPtr->socketListLock == NULL) {
501       goto unloadLibrary;
502   }
503   tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread,
504     tsdPtr, 0, &id);
505   if (tsdPtr->socketThread == NULL) {
506       goto unloadLibrary;
507   }
508 
509   SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST);
510 
511   /*
512    * Wait for the thread to signal when the window has
513    * been created and if it is ready to go.
514    */
515 
516   WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
517 
518   if (tsdPtr->hwnd == NULL) {
519       goto unloadLibrary; /* Trouble creating the window */
520   }
521 
522   Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
523     }
524     return;
525 
526 unloadLibrary:
527     TclpFinalizeSockets();
528     FreeLibrary(winSock.hModule);
529     winSock.hModule = NULL;
530     return;
531 }
static SocketInfo* NewSocketInfo (SOCKET socket) [static]

Definition at line 1028 of file tclWinSock.c.
References SocketInfo::acceptEventCount, SocketInfo::acceptProc, ckalloc, SocketInfo::flags, SocketInfo::lastError, SocketInfo::nextPtr, NULL, SocketInfo::readyEvents, SocketInfo::selectEvents, SocketInfo::socket, and SocketInfo::watchEvents.1030 {
1031     SocketInfo *infoPtr;
1032 
1033     infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo));
1034     infoPtr->socket = socket;
1035     infoPtr->flags = 0;
1036     infoPtr->watchEvents = 0;
1037     infoPtr->readyEvents = 0;
1038     infoPtr->selectEvents = 0;
1039     infoPtr->acceptEventCount = 0;
1040     infoPtr->acceptProc = NULL;
1041     infoPtr->lastError = 0;
1042 
1043     /* TIP #218. Removed the code inserting the new structure
1044      * into the global list. This is now handled in the thread
1045      * action callbacks, and only there.
1046      */
1047     infoPtr->nextPtr = NULL;
1048     
1049     return infoPtr;
1050 }
static void SocketCheckProc (ClientData data, int flags) [static]

Definition at line 753 of file tclWinSock.c.
References ckalloc, SocketInfo::flags, SocketEvent::header, SocketInfo::nextPtr, NULL, Tcl_Event::proc, SocketInfo::readyEvents, SocketInfo::socket, SocketEvent::socket, SOCKET_PENDING, ThreadSpecificData::socketList, ThreadSpecificData::socketListLock, TCL_FILE_EVENTS, TCL_QUEUE_TAIL, Tcl_QueueEvent(), TCL_TSD_INIT, and SocketInfo::watchEvents.756 {
757     SocketInfo *infoPtr;
758     SocketEvent *evPtr;
759     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
760 
761     if (!(flags & TCL_FILE_EVENTS)) {
762   return;
763     }
764     
765     /*
766      * Queue events for any ready sockets that don't already have events
767      * queued (caused by persistent states that won't generate WinSock
768      * events).
769      */
770 
771     WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
772     for (infoPtr = tsdPtr->socketList; infoPtr != NULL; 
773       infoPtr = infoPtr->nextPtr) {
774   if ((infoPtr->readyEvents & infoPtr->watchEvents)
775     && !(infoPtr->flags & SOCKET_PENDING)) {
776       infoPtr->flags |= SOCKET_PENDING;
777       evPtr = (SocketEvent *) ckalloc(sizeof(SocketEvent));
778       evPtr->header.proc = SocketEventProc;
779       evPtr->socket = infoPtr->socket;
780       Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
781   }
782     }
783     SetEvent(tsdPtr->socketListLock);
784 }
static int SocketEventProc (Tcl_Event * evPtr, int flags) [static]

Definition at line 808 of file tclWinSock.c.
References SocketInfo::channel, SocketInfo::flags, ThreadSpecificData::hwnd, SocketInfo::lastError, SocketInfo::nextPtr, NULL, SocketInfo::readyEvents, SELECT, SocketEvent::socket, SocketInfo::socket, SOCKET_PENDING, SOCKET_SELECT, ThreadSpecificData::socketList, ThreadSpecificData::socketListLock, TCL_FILE_EVENTS, Tcl_NotifyChannel(), TCL_READABLE, Tcl_SetMaxBlockTime(), TCL_TSD_INIT, TCL_WRITABLE, TcpAccept(), UNSELECT, SocketInfo::watchEvents, and winSock.812 {
813     SocketInfo *infoPtr;
814     SocketEvent *eventPtr = (SocketEvent *) evPtr;
815     int mask = 0;
816     int events;
817     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
818 
819     if (!(flags & TCL_FILE_EVENTS)) {
820   return 0;
821     }
822 
823     /*
824      * Find the specified socket on the socket list.
825      */
826 
827     WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
828     for (infoPtr = tsdPtr->socketList; infoPtr != NULL; 
829       infoPtr = infoPtr->nextPtr) {
830   if (infoPtr->socket == eventPtr->socket) {
831       break;
832   }
833     }
834     SetEvent(tsdPtr->socketListLock);
835 
836     /*
837      * Discard events that have gone stale.
838      */
839 
840     if (!infoPtr) {
841   return 1;
842     }
843 
844     infoPtr->flags &= ~SOCKET_PENDING;
845 
846     /*
847      * Handle connection requests directly.
848      */
849 
850     if (infoPtr->readyEvents & FD_ACCEPT) {
851   TcpAccept(infoPtr);
852   return 1;
853     }
854 
855     /*
856      * Mask off unwanted events and compute the read/write mask so 
857      * we can notify the channel.
858      */
859 
860     events = infoPtr->readyEvents & infoPtr->watchEvents;
861 
862     if (events & FD_CLOSE) {
863   /*
864    * If the socket was closed and the channel is still interested
865    * in read events, then we need to ensure that we keep polling
866    * for this event until someone does something with the channel.
867    * Note that we do this before calling Tcl_NotifyChannel so we don't
868    * have to watch out for the channel being deleted out from under
869    * us.  This may cause a redundant trip through the event loop, but
870    * it's simpler than trying to do unwind protection.
871    */
872 
873   Tcl_Time blockTime = { 0, 0 };
874   Tcl_SetMaxBlockTime(&blockTime);
875   mask |= TCL_READABLE|TCL_WRITABLE;
876     } else if (events & FD_READ) {
877   fd_set readFds;
878   struct timeval timeout;
879 
880   /*
881    * We must check to see if data is really available, since someone
882    * could have consumed the data in the meantime.  Turn off async
883    * notification so select will work correctly.  If the socket is
884    * still readable, notify the channel driver, otherwise reset the
885    * async select handler and keep waiting.
886    */
887 
888   SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
889     (WPARAM) UNSELECT, (LPARAM) infoPtr);
890 
891   FD_ZERO(&readFds);
892   FD_SET(infoPtr->socket, &readFds);
893   timeout.tv_usec = 0;
894   timeout.tv_sec = 0;
895  
896   if (winSock.select(0, &readFds, NULL, NULL, &timeout) != 0) {
897       mask |= TCL_READABLE;
898   } else {
899       infoPtr->readyEvents &= ~(FD_READ);
900       SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
901         (WPARAM) SELECT, (LPARAM) infoPtr);
902   }
903     }
904     if (events & (FD_WRITE | FD_CONNECT)) {
905   mask |= TCL_WRITABLE;
906   if (events & FD_CONNECT && infoPtr->lastError != NO_ERROR) {
907       /* connect errors should also fire the readable handler. */
908       mask |= TCL_READABLE;
909   }
910     }
911 
912     if (mask) {
913   Tcl_NotifyChannel(infoPtr->channel, mask);
914     }
915     return 1;
916 }
static void SocketExitHandler (ClientData clientData) [static]

Definition at line 580 of file tclWinSock.c.
References hostnameInitialized, initialized, NULL, Tcl_MutexLock, Tcl_MutexUnlock, TclpFinalizeSockets(), and winSock.
Referenced by InitSockets().582 {
583     Tcl_MutexLock(&socketMutex);
584     if (winSock.hModule) {
585   /*
586    * Make sure the socket event handling window is cleaned-up
587    * for, at most, this thread.
588    */
589   TclpFinalizeSockets();
590   UnregisterClass("TclSocket", TclWinGetTclInstance());
591   winSock.WSACleanup();
592   FreeLibrary(winSock.hModule);
593   winSock.hModule = NULL;
594     }
595     initialized = 0;
596     hostnameInitialized = 0;
597     Tcl_MutexUnlock(&socketMutex);
598 }
static LRESULT CALLBACK SocketProc (HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam) [static]

Definition at line 2383 of file tclWinSock.c.
References SocketInfo::acceptEventCount, DWORD(), SocketInfo::flags, SocketInfo::lastError, SocketInfo::nextPtr, NULL, ThreadSpecificData::readyEvent, SocketInfo::readyEvents, SELECT, SocketInfo::selectEvents, SocketInfo::socket, SOCKET_ASYNC_CONNECT, SOCKET_MESSAGE, SOCKET_SELECT, SOCKET_TERMINATE, ThreadSpecificData::socketList, ThreadSpecificData::socketListLock, Tcl_GetErrno(), Tcl_ThreadAlert(), TclWinConvertWSAError(), ThreadSpecificData::threadId, and winSock.
Referenced by InitSockets().2388 {
2389     int event, error;
2390     SOCKET socket;
2391     SocketInfo *infoPtr;
2392     ThreadSpecificData *tsdPtr =
2393 #ifdef _WIN64
2394   (ThreadSpecificData *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
2395 #else
2396   (ThreadSpecificData *) GetWindowLong(hwnd, GWL_USERDATA);
2397 #endif
2398 
2399     switch (message) {
2400 
2401   default:
2402       return DefWindowProc(hwnd, message, wParam, lParam);
2403       break;
2404 
2405   case WM_CREATE:
2406       /*
2407        * store the initial tsdPtr, it's from a different thread, so it's
2408        * not directly accessible, but needed.
2409        */
2410 
2411 #ifdef _WIN64
2412       SetWindowLongPtr(hwnd, GWLP_USERDATA,
2413         (LONG_PTR) ((LPCREATESTRUCT)lParam)->lpCreateParams);
2414 #else
2415       SetWindowLong(hwnd, GWL_USERDATA,
2416         (LONG) ((LPCREATESTRUCT)lParam)->lpCreateParams);
2417 #endif
2418       break;
2419 
2420   case WM_DESTROY:
2421       PostQuitMessage(0);
2422       break;
2423 
2424   case SOCKET_MESSAGE:
2425       event = WSAGETSELECTEVENT(lParam);
2426       error = WSAGETSELECTERROR(lParam);
2427       socket = (SOCKET) wParam;
2428 
2429       /*
2430        * Find the specified socket on the socket list and update its
2431        * eventState flag.
2432        */
2433 
2434       WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
2435       for (infoPtr = tsdPtr->socketList; infoPtr != NULL; 
2436      infoPtr = infoPtr->nextPtr) {
2437     if (infoPtr->socket == socket) {
2438         /*
2439          * Update the socket state.
2440          */
2441 
2442         /*
2443          * A count of FD_ACCEPTS is stored, so if an FD_CLOSE
2444          * event happens, then clear the FD_ACCEPT count.
2445          * Otherwise, increment the count if the current
2446          * event is an FD_ACCEPT.
2447          */
2448 
2449         if (event & FD_CLOSE) {
2450       infoPtr->acceptEventCount = 0;
2451       infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
2452         } else if (event & FD_ACCEPT) {
2453       infoPtr->acceptEventCount++;
2454         }
2455 
2456         if (event & FD_CONNECT) {
2457       /*
2458        * The socket is now connected,
2459        * clear the async connect flag.
2460        */
2461 
2462       infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
2463 
2464       /*
2465        * Remember any error that occurred so we can report
2466        * connection failures.
2467        */
2468 
2469       if (error != ERROR_SUCCESS) {
2470           TclWinConvertWSAError((DWORD) error);
2471           infoPtr->lastError = Tcl_GetErrno();
2472       }
2473 
2474         } 
2475         if(infoPtr->flags & SOCKET_ASYNC_CONNECT) {
2476       infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
2477       if (error != ERROR_SUCCESS) {
2478           TclWinConvertWSAError((DWORD) error);
2479           infoPtr->lastError = Tcl_GetErrno();
2480       }
2481       infoPtr->readyEvents |= FD_WRITE;
2482         }
2483         infoPtr->readyEvents |= event;
2484 
2485         /*
2486          * Wake up the Main Thread.
2487          */
2488         SetEvent(tsdPtr->readyEvent);
2489         Tcl_ThreadAlert(tsdPtr->threadId);
2490         break;
2491     }
2492       }
2493       SetEvent(tsdPtr->socketListLock);
2494       break;
2495 
2496   case SOCKET_SELECT:
2497       infoPtr = (SocketInfo *) lParam;
2498       if (wParam == SELECT) {
2499 
2500     winSock.WSAAsyncSelect(infoPtr->socket, hwnd,
2501       SOCKET_MESSAGE, infoPtr->selectEvents);
2502       } else {
2503     /*
2504      * Clear the selection mask
2505      */
2506 
2507     winSock.WSAAsyncSelect(infoPtr->socket, hwnd, 0, 0);
2508       }
2509       break;
2510 
2511   case SOCKET_TERMINATE:
2512       DestroyWindow(hwnd);
2513       break;
2514     }
2515 
2516     return 0;
2517 }
static int SocketsEnabled () [static]

Definition at line 551 of file tclWinSock.c.
References NULL, Tcl_MutexLock, Tcl_MutexUnlock, and winSock.
Referenced by CreateSocket(), CreateSocketAddress(), TclpHasSockets(), TclWinGetServByName(), TclWinGetSockOpt(), TclWinNToHS(), TclWinSetSockOpt(), TcpCloseProc(), TcpGetOptionProc(), TcpInputProc(), TcpOutputProc(), and TcpSetOptionProc().552 {
553     int enabled;
554     Tcl_MutexLock(&socketMutex);
555     enabled = (winSock.hModule != NULL);
556     Tcl_MutexUnlock(&socketMutex);
557     return enabled;
558 }
void SocketSetupProc (ClientData data, int flags)

Definition at line 708 of file tclWinSock.c.
References SocketInfo::nextPtr, NULL, SocketInfo::readyEvents, ThreadSpecificData::socketList, ThreadSpecificData::socketListLock, TCL_FILE_EVENTS, Tcl_SetMaxBlockTime(), TCL_TSD_INIT, and SocketInfo::watchEvents.711 {
712     SocketInfo *infoPtr;
713     Tcl_Time blockTime = { 0, 0 };
714     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
715 
716     if (!(flags & TCL_FILE_EVENTS)) {
717   return;
718     }
719     
720     /*
721      * Check to see if there is a ready socket.  If so, poll.
722      */
723 
724     WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
725     for (infoPtr = tsdPtr->socketList; infoPtr != NULL; 
726       infoPtr = infoPtr->nextPtr) {
727   if (infoPtr->readyEvents & infoPtr->watchEvents) {
728       Tcl_SetMaxBlockTime(&blockTime);
729       break;
730   }
731     }
732     SetEvent(tsdPtr->socketListLock);
733 }
static DWORD WINAPI SocketThread (LPVOID arg) [static]

Definition at line 2317 of file tclWinSock.c.
References DWORD(), ThreadSpecificData::hwnd, NULL, and ThreadSpecificData::readyEvent.
Referenced by InitSockets().2318 {
2319     MSG msg;
2320     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)(arg);
2321 
2322     /*
2323      * Create a dummy window receiving socket events.
2324      */
2325 
2326     tsdPtr->hwnd = CreateWindow("TclSocket", "TclSocket", 
2327       WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg);
2328 
2329     /*
2330      * Signalize thread creator that we are done creating the window.
2331      */
2332 
2333     SetEvent(tsdPtr->readyEvent);
2334 
2335     /*
2336      * If unable to create the window, exit this thread immediately.
2337      */
2338 
2339     if (tsdPtr->hwnd == NULL) {
2340   return 1;
2341     }
2342 
2343     /*
2344      * Process all messages on the socket window until WM_QUIT.
2345      * This threads exits only when instructed to do so by the
2346      * call to PostMessage(SOCKET_TERMINATE) in TclpFinalizeSockets().
2347      */
2348 
2349     while (GetMessage(&msg, NULL, 0, 0) > 0) {
2350   DispatchMessage(&msg);
2351     }
2352 
2353     /*
2354      * This releases waiters on thread exit in TclpFinalizeSockets()
2355      */
2356 
2357     SetEvent(tsdPtr->readyEvent);
2358 
2359     return (DWORD)msg.wParam;
2360 }
TCL_DECLARE_MUTEX (socketMutex)

Definition at line 36 of file tclWinSock.c.103               {
104     HMODULE       hModule;  /* Handle to WinSock library. */
105 
106     /* Winsock 1.1 functions */
107     LPFN_ACCEPT       accept;
108     LPFN_BIND       bind;
109     LPFN_CLOSESOCKET      closesocket;
110     LPFN_CONNECT      connect;
111     LPFN_GETHOSTBYADDR      gethostbyaddr;
112     LPFN_GETHOSTBYNAME      gethostbyname;
113     LPFN_GETHOSTNAME      gethostname;
114     LPFN_GETPEERNAME      getpeername;
115     LPFN_GETSERVBYNAME      getservbyname;
116     LPFN_GETSOCKNAME      getsockname;
117     LPFN_GETSOCKOPT     getsockopt;
118     LPFN_HTONS        htons;
119     LPFN_INET_ADDR      inet_addr;
120     LPFN_INET_NTOA      inet_ntoa;
121     LPFN_IOCTLSOCKET      ioctlsocket;
122     LPFN_LISTEN       listen;
123     LPFN_NTOHS        ntohs;
124     LPFN_RECV       recv;
125     LPFN_SELECT       select;
126     LPFN_SEND       send;
127     LPFN_SETSOCKOPT     setsockopt;
128     LPFN_SOCKET       socket;
129     LPFN_WSAASYNCSELECT     WSAAsyncSelect;
130     LPFN_WSACLEANUP     WSACleanup;
131     LPFN_WSAGETLASTERROR    WSAGetLastError;
132     LPFN_WSASTARTUP     WSAStartup;
133 
134 } winSock;
CONST char* Tcl_GetHostName ()

Definition at line 2538 of file tclWinSock.c.
References DWORD(), hostname, hostnameInitialized, InitSockets(), NULL, Tcl_DStringFree(), Tcl_MutexLock, Tcl_MutexUnlock, TCL_OK, Tcl_UtfToLower(), Tcl_WinTCharToUtf(), TclpHasSockets(), tclWinProcs, and winSock.2539 {
2540     DWORD length;
2541     WCHAR wbuf[MAX_COMPUTERNAME_LENGTH + 1];
2542 
2543     Tcl_MutexLock(&socketMutex);
2544     InitSockets();
2545 
2546     if (hostnameInitialized) {
2547   Tcl_MutexUnlock(&socketMutex);
2548         return hostname;
2549     }
2550     Tcl_MutexUnlock(&socketMutex);
2551   
2552     if (TclpHasSockets(NULL) == TCL_OK) {
2553   /*
2554    * INTL: bug
2555    */
2556 
2557   if (winSock.gethostname(hostname, sizeof(hostname)) == 0) {
2558       Tcl_MutexLock(&socketMutex);
2559       hostnameInitialized = 1;
2560       Tcl_MutexUnlock(&socketMutex);
2561       return hostname;
2562   }
2563     }
2564     Tcl_MutexLock(&socketMutex);
2565     length = sizeof(hostname);
2566     if ((*tclWinProcs->getComputerNameProc)(wbuf, &length) != 0) {
2567   /*
2568    * Convert string from native to UTF then change to lowercase.
2569    */
2570 
2571   Tcl_DString ds;
2572 
2573   lstrcpynA(hostname, Tcl_WinTCharToUtf((TCHAR *) wbuf, -1, &ds),
2574     sizeof(hostname));
2575   Tcl_DStringFree(&ds);
2576   Tcl_UtfToLower(hostname);
2577     } else {
2578   hostname[0] = '\0';
2579     }
2580     hostnameInitialized = 1;
2581     Tcl_MutexUnlock(&socketMutex);
2582     return hostname;
2583 }
Tcl_Channel Tcl_MakeTcpClientChannel (ClientData sock)

Definition at line 1470 of file tclWinSock.c.
References ThreadSpecificData::hwnd, NewSocketInfo(), NULL, SELECT, SocketInfo::selectEvents, SOCKET_SELECT, Tcl_CreateChannel(), TCL_INTEGER_SPACE, TCL_OK, TCL_READABLE, Tcl_SetChannelOption(), TCL_WRITABLE, TclpHasSockets(), TclSockMinimumBuffers(), TclThreadDataKeyGet(), TCP_BUFFER_SIZE, and tcpChannelType.1472 {
1473     SocketInfo *infoPtr;
1474     char channelName[16 + TCL_INTEGER_SPACE];
1475     ThreadSpecificData *tsdPtr;
1476 
1477     if (TclpHasSockets(NULL) != TCL_OK) {
1478   return NULL;
1479     }
1480 
1481     tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
1482 
1483     /*
1484      * Set kernel space buffering and non-blocking.
1485      */
1486 
1487     TclSockMinimumBuffers((int) sock, TCP_BUFFER_SIZE);
1488 
1489     infoPtr = NewSocketInfo((SOCKET) sock);
1490 
1491     /*
1492      * Start watching for read/write events on the socket.
1493      */
1494 
1495     infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
1496     SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
1497       (WPARAM) SELECT, (LPARAM) infoPtr);
1498 
1499     wsprintfA(channelName, "sock%d", infoPtr->socket);
1500     infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
1501       (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
1502     Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
1503     return infoPtr->channel;
1504 }
Tcl_Channel Tcl_OpenTcpClient (Tcl_Interp * interp, int port, CONST char * host, CONST char * myaddr, int myport, int async)

Definition at line 1409 of file tclWinSock.c.
References SocketInfo::channel, CreateSocket(), NULL, SocketInfo::socket, Tcl_Close(), Tcl_CreateChannel(), TCL_ERROR, TCL_INTEGER_SPACE, TCL_OK, TCL_READABLE, Tcl_SetChannelOption(), TCL_WRITABLE, TclpHasSockets(), and tcpChannelType.1417 {
1418     SocketInfo *infoPtr;
1419     char channelName[16 + TCL_INTEGER_SPACE];
1420 
1421     if (TclpHasSockets(interp) != TCL_OK) {
1422   return NULL;
1423     }
1424 
1425     /*
1426      * Create a new client socket and wrap it in a channel.
1427      */
1428 
1429     infoPtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
1430     if (infoPtr == NULL) {
1431   return NULL;
1432     }
1433 
1434     wsprintfA(channelName, "sock%d", infoPtr->socket);
1435 
1436     infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
1437       (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
1438     if (Tcl_SetChannelOption(interp, infoPtr->channel, "-translation",
1439       "auto crlf") == TCL_ERROR) {
1440         Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
1441         return (Tcl_Channel) NULL;
1442     }
1443     if (Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "")
1444       == TCL_ERROR) {
1445         Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
1446         return (Tcl_Channel) NULL;
1447     }
1448     return infoPtr->channel;
1449 }
Tcl_Channel Tcl_OpenTcpServer (Tcl_Interp * interp, int port, CONST char * host, Tcl_TcpAcceptProc * acceptProc, ClientData acceptProcData)

Definition at line 1524 of file tclWinSock.c.
References SocketInfo::acceptProc, SocketInfo::acceptProcData, SocketInfo::channel, CreateSocket(), NULL, SocketInfo::socket, Tcl_Close(), Tcl_CreateChannel(), TCL_ERROR, TCL_INTEGER_SPACE, TCL_OK, Tcl_SetChannelOption(), TclpHasSockets(), and tcpChannelType.1532 {
1533     SocketInfo *infoPtr;
1534     char channelName[16 + TCL_INTEGER_SPACE];
1535 
1536     if (TclpHasSockets(interp) != TCL_OK) {
1537   return NULL;
1538     }
1539 
1540     /*
1541      * Create a new client socket and wrap it in a channel.
1542      */
1543 
1544     infoPtr = CreateSocket(interp, port, host, 1, NULL, 0, 0);
1545     if (infoPtr == NULL) {
1546   return NULL;
1547     }
1548 
1549     infoPtr->acceptProc = acceptProc;
1550     infoPtr->acceptProcData = acceptProcData;
1551 
1552     wsprintfA(channelName, "sock%d", infoPtr->socket);
1553 
1554     infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
1555       (ClientData) infoPtr, 0);
1556     if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
1557       == TCL_ERROR) {
1558         Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
1559         return (Tcl_Channel) NULL;
1560     }
1561 
1562     return infoPtr->channel;
1563 }
void TclpFinalizeSockets ()

Definition at line 620 of file tclWinSock.c.
References ThreadSpecificData::hwnd, NULL, ThreadSpecificData::readyEvent, SOCKET_TERMINATE, ThreadSpecificData::socketListLock, ThreadSpecificData::socketThread, Tcl_DeleteEventSource(), and TclThreadDataKeyGet().621 {
622     ThreadSpecificData *tsdPtr;
623 
624     tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
625     if (tsdPtr != NULL) {
626   if (tsdPtr->socketThread != NULL) {
627       if (tsdPtr->hwnd != NULL) {
628     PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0);
629     /*
630      * Wait for the thread to exit. This ensures that we are
631      * completely cleaned up before we leave this function.
632      */
633     WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
634     tsdPtr->hwnd = NULL;
635       }
636       CloseHandle(tsdPtr->socketThread);
637       tsdPtr->socketThread = NULL;
638   }
639   if (tsdPtr->readyEvent != NULL) {
640       CloseHandle(tsdPtr->readyEvent);
641       tsdPtr->readyEvent = NULL;
642   }
643   if (tsdPtr->socketListLock != NULL) {
644       CloseHandle(tsdPtr->socketListLock);
645       tsdPtr->socketListLock = NULL;
646   }
647   Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
648     }
649 }
int TclpHasSockets (Tcl_Interp * interp)

Definition at line 673 of file tclWinSock.c.
References InitSockets(), NULL, SocketsEnabled(), TCL_ERROR, Tcl_MutexLock, Tcl_MutexUnlock, and TCL_OK.675 {
676     Tcl_MutexLock(&socketMutex);
677     InitSockets();
678     Tcl_MutexUnlock(&socketMutex);
679 
680     if (SocketsEnabled()) {
681   return TCL_OK;
682     }
683     if (interp != NULL) {
684   Tcl_AppendResult(interp, "sockets are not available on this system",
685     NULL);
686     }
687     return TCL_ERROR;
688 }
struct servent* TclWinGetServByName (const char * name, const char * proto)

Definition at line 2657 of file tclWinSock.c.
References NULL, SocketsEnabled(), and winSock.2658 {
2659     /*
2660      * Check that WinSock is initialized; do not call it if not, to
2661      * prevent system crashes. This can happen at exit time if the exit
2662      * handler for WinSock ran before other exit handlers that want to
2663      * use sockets.
2664      */
2665     if (!SocketsEnabled()) {
2666         return (struct servent *) NULL;
2667     }
2668 
2669     return winSock.getservbyname(name, proto);
2670 }
int TclWinGetSockOpt (SOCKET s, int level, int optname, char * optval, int FAR * optlen)

Definition at line 2605 of file tclWinSock.c.
References SocketsEnabled(), and winSock.
Referenced by TcpGetOptionProc().2607 {
2608     /*
2609      * Check that WinSock is initialized; do not call it if not, to
2610      * prevent system crashes. This can happen at exit time if the exit
2611      * handler for WinSock ran before other exit handlers that want to
2612      * use sockets.
2613      */
2614 
2615     if (!SocketsEnabled()) {
2616         return SOCKET_ERROR;
2617     }
2618     
2619     return winSock.getsockopt(s, level, optname, optval, optlen);
2620 }
u_short TclWinNToHS (u_short netshort)

Definition at line 2640 of file tclWinSock.c.
References SocketsEnabled(), and winSock.2641 {
2642     /*
2643      * Check that WinSock is initialized; do not call it if not, to
2644      * prevent system crashes. This can happen at exit time if the exit
2645      * handler for WinSock ran before other exit handlers that want to
2646      * use sockets.
2647      */
2648 
2649     if (!SocketsEnabled()) {
2650         return (u_short) -1;
2651     }
2652 
2653     return winSock.ntohs(netshort);
2654 }
int TclWinSetSockOpt (SOCKET s, int level, int optname, const char * optval, int optlen)

Definition at line 2623 of file tclWinSock.c.
References SocketsEnabled(), and winSock.2625 {
2626     /*
2627      * Check that WinSock is initialized; do not call it if not, to
2628      * prevent system crashes. This can happen at exit time if the exit
2629      * handler for WinSock ran before other exit handlers that want to
2630      * use sockets.
2631      */
2632     if (!SocketsEnabled()) {
2633         return SOCKET_ERROR;
2634     }
2635 
2636     return winSock.setsockopt(s, level, optname, optval, optlen);
2637 }
static void TcpAccept (SocketInfo * infoPtr) [static]

Definition at line 1583 of file tclWinSock.c.
References ThreadSpecificData::hwnd, NewSocketInfo(), NULL, SELECT, SocketInfo::selectEvents, SOCKET_SELECT, Tcl_Close(), Tcl_CreateChannel(), TCL_ERROR, TCL_INTEGER_SPACE, TCL_READABLE, Tcl_SetChannelOption(), TCL_WRITABLE, TclThreadDataKeyGet(), tcpChannelType, and winSock.1585 {
1586     SOCKET newSocket;
1587     SocketInfo *newInfoPtr;
1588     SOCKADDR_IN addr;
1589     int len;
1590     char channelName[16 + TCL_INTEGER_SPACE];
1591     ThreadSpecificData *tsdPtr = 
1592   (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
1593 
1594     /*
1595      * Accept the incoming connection request.
1596      */
1597 
1598     len = sizeof(SOCKADDR_IN);
1599 
1600     newSocket = winSock.accept(infoPtr->socket, (SOCKADDR *)&addr,
1601       &len);
1602 
1603     /*
1604      * Clear the ready mask so we can detect the next connection request.
1605      * Note that connection requests are level triggered, so if there is
1606      * a request already pending, a new event will be generated.
1607      */
1608 
1609     if (newSocket == INVALID_SOCKET) {
1610   infoPtr->acceptEventCount = 0;
1611   infoPtr->readyEvents &= ~(FD_ACCEPT);
1612   return;
1613     }
1614 
1615     /*
1616      * It is possible that more than one FD_ACCEPT has been sent, so an extra
1617      * count must be kept.  Decrement the count, and reset the readyEvent bit
1618      * if the count is no longer > 0.
1619      */
1620 
1621     infoPtr->acceptEventCount--;
1622 
1623     if (infoPtr->acceptEventCount <= 0) {
1624   infoPtr->readyEvents &= ~(FD_ACCEPT);
1625     }
1626 
1627     /*
1628      * Win-NT has a misfeature that sockets are inherited in child
1629      * processes by default.  Turn off the inherit bit.
1630      */
1631 
1632     SetHandleInformation( (HANDLE) newSocket, HANDLE_FLAG_INHERIT, 0 );
1633 
1634     /*
1635      * Add this socket to the global list of sockets.
1636      */
1637 
1638     newInfoPtr = NewSocketInfo(newSocket);
1639 
1640     /*
1641      * Select on read/write events and create the channel.
1642      */
1643 
1644     newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
1645     SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
1646       (WPARAM) SELECT, (LPARAM) newInfoPtr);
1647 
1648     wsprintfA(channelName, "sock%d", newInfoPtr->socket);
1649     newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
1650       (ClientData) newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
1651     if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
1652       "auto crlf") == TCL_ERROR) {
1653   Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
1654   return;
1655     }
1656     if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "")
1657       == TCL_ERROR) {
1658   Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
1659   return;
1660     }
1661 
1662     /*
1663      * Invoke the accept callback procedure.
1664      */
1665 
1666     if (infoPtr->acceptProc != NULL) {
1667   (infoPtr->acceptProc) (infoPtr->acceptProcData,
1668     newInfoPtr->channel,
1669     winSock.inet_ntoa(addr.sin_addr),
1670     winSock.ntohs(addr.sin_port));
1671     }
1672 }
static int TcpBlockProc (ClientData instanceData, int mode) [static]

Definition at line 935 of file tclWinSock.c.
References SocketInfo::flags, SOCKET_ASYNC, and TCL_MODE_NONBLOCKING.939 {
940     SocketInfo *infoPtr = (SocketInfo *) instanceData;
941 
942     if (mode == TCL_MODE_NONBLOCKING) {
943   infoPtr->flags |= SOCKET_ASYNC;
944     } else {
945   infoPtr->flags &= ~(SOCKET_ASYNC);
946     }
947     return 0;
948 }
static int TcpCloseProc (ClientData instanceData, Tcl_Interp * interp) [static]

Definition at line 970 of file tclWinSock.c.
References ckfree, DWORD(), SocketInfo::socket, SocketsEnabled(), Tcl_GetErrno(), TCL_TSD_INIT, TclWinConvertWSAError(), and winSock.973 {
974     SocketInfo *infoPtr = (SocketInfo *) instanceData;
975     /* TIP #218 */
976     int errorCode = 0;
977     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
978 
979     /*
980      * Check that WinSock is initialized; do not call it if not, to
981      * prevent system crashes. This can happen at exit time if the exit
982      * handler for WinSock ran before other exit handlers that want to
983      * use sockets.
984      */
985 
986     if (SocketsEnabled()) {
987         
988   /*
989          * Clean up the OS socket handle.  The default Windows setting
990    * for a socket is SO_DONTLINGER, which does a graceful shutdown
991    * in the background.
992          */
993     
994         if (winSock.closesocket(infoPtr->socket) == SOCKET_ERROR) {
995             TclWinConvertWSAError((DWORD) winSock.WSAGetLastError());
996             errorCode = Tcl_GetErrno();
997         }
998     }
999 
1000     /* TIP #218. Removed the code removing the structure
1001      * from the global socket list. This is now done by
1002      * the thread action callbacks, and only there. This
1003      * happens before this code is called. We can free
1004      * without fear of damanging the list.
1005      */
1006     ckfree((char *) infoPtr);
1007     return errorCode;
1008 }
static int TcpGetHandleProc (ClientData instanceData, int direction, ClientData * handlePtr) [static]

Definition at line 2289 of file tclWinSock.c.
References TCL_OK.2293 {
2294     SocketInfo *statePtr = (SocketInfo *) instanceData;
2295 
2296     *handlePtr = (ClientData) statePtr->socket;
2297     return TCL_OK;
2298 }
static int TcpGetOptionProc (ClientData instanceData, Tcl_Interp * interp, CONST char * optionName, Tcl_DString * dsPtr) [static]

Definition at line 2021 of file tclWinSock.c.
References DWORD(), NULL, size_t(), SocketInfo::socket, SocketsEnabled(), Tcl_BadChannelOption(), Tcl_DStringAppend(), Tcl_DStringAppendElement(), Tcl_DStringEndSublist(), Tcl_DStringStartSublist(), Tcl_ErrnoMsg(), TCL_ERROR, Tcl_GetErrno(), TCL_INTEGER_SPACE, TCL_OK, Tcl_PosixError(), TclFormatInt(), TclWinConvertWSAError(), TclWinGetSockOpt(), and winSock.2030 {
2031     SocketInfo *infoPtr;
2032     SOCKADDR_IN sockname;
2033     SOCKADDR_IN peername;
2034     struct hostent *hostEntPtr;
2035     SOCKET sock;
2036     int size = sizeof(SOCKADDR_IN);
2037     size_t len = 0;
2038     char buf[TCL_INTEGER_SPACE];
2039 
2040     /*
2041      * Check that WinSock is initialized; do not call it if not, to
2042      * prevent system crashes. This can happen at exit time if the exit
2043      * handler for WinSock ran before other exit handlers that want to
2044      * use sockets.
2045      */
2046 
2047     if (!SocketsEnabled()) {
2048   if (interp) {
2049       Tcl_AppendResult(interp, "winsock is not initialized", NULL);
2050   }
2051         return TCL_ERROR;
2052     }
2053     
2054     infoPtr = (SocketInfo *) instanceData;
2055     sock = (int) infoPtr->socket;
2056     if (optionName != (char *) NULL) {
2057         len = strlen(optionName);
2058     }
2059 
2060     if ((len > 1) && (optionName[1] == 'e') &&
2061       (strncmp(optionName, "-error", len) == 0)) {
2062   int optlen;
2063   DWORD err;
2064   int ret;
2065     
2066   optlen = sizeof(int);
2067   ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR,
2068     (char *)&err, &optlen);
2069   if (ret == SOCKET_ERROR) {
2070       err = winSock.WSAGetLastError();
2071   }
2072   if (err) {
2073       TclWinConvertWSAError(err);
2074       Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
2075   }
2076   return TCL_OK;
2077     }
2078 
2079     if ((len == 0) ||
2080             ((len > 1) && (optionName[1] == 'p') &&
2081                     (strncmp(optionName, "-peername", len) == 0))) {
2082         if (winSock.getpeername(sock, (LPSOCKADDR) &peername, &size)
2083                 == 0) {
2084             if (len == 0) {
2085                 Tcl_DStringAppendElement(dsPtr, "-peername");
2086                 Tcl_DStringStartSublist(dsPtr);
2087             }
2088             Tcl_DStringAppendElement(dsPtr,
2089                     winSock.inet_ntoa(peername.sin_addr));
2090 
2091       if (peername.sin_addr.s_addr == 0) {
2092           hostEntPtr = (struct hostent *) NULL;
2093       } else {
2094           hostEntPtr = winSock.gethostbyaddr(
2095                     (char *) &(peername.sin_addr), sizeof(peername.sin_addr),
2096         AF_INET);
2097       }
2098             if (hostEntPtr != (struct hostent *) NULL) {
2099                 Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
2100             } else {
2101                 Tcl_DStringAppendElement(dsPtr,
2102                         winSock.inet_ntoa(peername.sin_addr));
2103             }
2104       TclFormatInt(buf, winSock.ntohs(peername.sin_port));
2105             Tcl_DStringAppendElement(dsPtr, buf);
2106             if (len == 0) {
2107                 Tcl_DStringEndSublist(dsPtr);
2108             } else {
2109                 return TCL_OK;
2110             }
2111         } else {
2112             /*
2113              * getpeername failed - but if we were asked for all the options
2114              * (len==0), don't flag an error at that point because it could
2115              * be an fconfigure request on a server socket. (which have
2116              * no peer). {copied from unix/tclUnixChan.c}
2117              */
2118             if (len) {
2119     TclWinConvertWSAError((DWORD) winSock.WSAGetLastError());
2120                 if (interp) {
2121                     Tcl_AppendResult(interp, "can't get peername: ",
2122                                      Tcl_PosixError(interp),
2123                                      (char *) NULL);
2124                 }
2125                 return TCL_ERROR;
2126             }
2127         }
2128     }
2129 
2130     if ((len == 0) ||
2131             ((len > 1) && (optionName[1] == 's') &&
2132                     (strncmp(optionName, "-sockname", len) == 0))) {
2133         if (winSock.getsockname(sock, (LPSOCKADDR) &sockname, &size)
2134                 == 0) {
2135             if (len == 0) {
2136                 Tcl_DStringAppendElement(dsPtr, "-sockname");
2137                 Tcl_DStringStartSublist(dsPtr);
2138             }
2139             Tcl_DStringAppendElement(dsPtr,
2140                     winSock.inet_ntoa(sockname.sin_addr));
2141       if (sockname.sin_addr.s_addr == 0) {
2142           hostEntPtr = (struct hostent *) NULL;
2143       } else {
2144           hostEntPtr = winSock.gethostbyaddr(
2145                     (char *) &(sockname.sin_addr), sizeof(peername.sin_addr),
2146         AF_INET);
2147       }
2148             if (hostEntPtr != (struct hostent *) NULL) {
2149                 Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
2150             } else {
2151                 Tcl_DStringAppendElement(dsPtr,
2152                         winSock.inet_ntoa(sockname.sin_addr));
2153             }
2154             TclFormatInt(buf, winSock.ntohs(sockname.sin_port));
2155             Tcl_DStringAppendElement(dsPtr, buf);
2156             if (len == 0) {
2157                 Tcl_DStringEndSublist(dsPtr);
2158             } else {
2159                 return TCL_OK;
2160             }
2161         } else {
2162       if (interp) {
2163     TclWinConvertWSAError((DWORD) winSock.WSAGetLastError());
2164     Tcl_AppendResult(interp, "can't get sockname: ",
2165          Tcl_PosixError(interp),
2166          (char *) NULL);
2167       }
2168       return TCL_ERROR;
2169   }
2170     }
2171 
2172 /*
2173     if (len == 0 || !strncmp(optionName, "-keepalive", len)) {
2174   int optlen;
2175   BOOL opt = FALSE;
2176     
2177         if (len == 0) {
2178             Tcl_DStringAppendElement(dsPtr, "-keepalive");
2179         }
2180   optlen = sizeof(BOOL);
2181   winSock.getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt,
2182     &optlen);
2183   if (opt) {
2184       Tcl_DStringAppendElement(dsPtr, "1");
2185   } else {
2186       Tcl_DStringAppendElement(dsPtr, "0");
2187   }
2188   if (len > 0) return TCL_OK;
2189     }
2190 
2191     if (len == 0 || !strncmp(optionName, "-nagle", len)) {
2192   int optlen;
2193   BOOL opt = FALSE;
2194     
2195         if (len == 0) {
2196             Tcl_DStringAppendElement(dsPtr, "-nagle");
2197         }
2198   optlen = sizeof(BOOL);
2199   winSock.getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt,
2200     &optlen);
2201   if (opt) {
2202       Tcl_DStringAppendElement(dsPtr, "0");
2203   } else {
2204       Tcl_DStringAppendElement(dsPtr, "1");
2205   }
2206   if (len > 0) return TCL_OK;
2207     }
2208 */
2209 
2210     if (len > 0) {
2211         /*return Tcl_BadChannelOption(interp, optionName, "peername sockname keepalive nagle");*/
2212         return Tcl_BadChannelOption(interp, optionName, "peername sockname");
2213     }
2214 
2215     return TCL_OK;
2216 }
static int TcpInputProc (ClientData instanceData, char * buf, int toRead, int * errorCodePtr) [static]

Definition at line 1692 of file tclWinSock.c.
References DWORD(), EFAULT, SocketInfo::flags, ThreadSpecificData::hwnd, SELECT, SOCKET_ASYNC, SOCKET_ASYNC_CONNECT, SOCKET_EOF, SOCKET_SELECT, SocketsEnabled(), Tcl_GetErrno(), TclThreadDataKeyGet(), TclWinConvertWSAError(), UNSELECT, WaitForSocketEvent(), and winSock.1697 {
1698     SocketInfo *infoPtr = (SocketInfo *) instanceData;
1699     int bytesRead;
1700     DWORD error;
1701     ThreadSpecificData *tsdPtr = 
1702   (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
1703     
1704     *errorCodePtr = 0;
1705 
1706     /*
1707      * Check that WinSock is initialized; do not call it if not, to
1708      * prevent system crashes. This can happen at exit time if the exit
1709      * handler for WinSock ran before other exit handlers that want to
1710      * use sockets.
1711      */
1712 
1713     if (!SocketsEnabled()) {
1714         *errorCodePtr = EFAULT;
1715         return -1;
1716     }
1717 
1718     /*
1719      * First check to see if EOF was already detected, to prevent
1720      * calling the socket stack after the first time EOF is detected.
1721      */
1722 
1723     if (infoPtr->flags & SOCKET_EOF) {
1724   return 0;
1725     }
1726 
1727     /*
1728      * Check to see if the socket is connected before trying to read.
1729      */
1730 
1731     if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
1732       && ! WaitForSocketEvent(infoPtr,  FD_CONNECT, errorCodePtr)) {
1733   return -1;
1734     }
1735     
1736     /*
1737      * No EOF, and it is connected, so try to read more from the socket.
1738      * Note that we clear the FD_READ bit because read events are level
1739      * triggered so a new event will be generated if there is still data
1740      * available to be read.  We have to simulate blocking behavior here
1741      * since we are always using non-blocking sockets.
1742      */
1743 
1744     while (1) {
1745   SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
1746     (WPARAM) UNSELECT, (LPARAM) infoPtr);
1747   bytesRead = winSock.recv(infoPtr->socket, buf, toRead, 0);
1748   infoPtr->readyEvents &= ~(FD_READ);
1749   
1750   /*
1751    * Check for end-of-file condition or successful read.
1752    */
1753   
1754   if (bytesRead == 0) {
1755       infoPtr->flags |= SOCKET_EOF;
1756   }
1757   if (bytesRead != SOCKET_ERROR) {
1758       break;
1759   }
1760   
1761   /*
1762    * If an error occurs after the FD_CLOSE has arrived,
1763    * then ignore the error and report an EOF.
1764    */
1765   
1766   if (infoPtr->readyEvents & FD_CLOSE) {
1767       infoPtr->flags |= SOCKET_EOF;
1768       bytesRead = 0;
1769       break;
1770   }
1771   
1772   /*
1773    * Check for error condition or underflow in non-blocking case.
1774    */
1775   
1776   error = winSock.WSAGetLastError();
1777   if ((infoPtr->flags & SOCKET_ASYNC) || (error != WSAEWOULDBLOCK)) {
1778       TclWinConvertWSAError(error);
1779       *errorCodePtr = Tcl_GetErrno();
1780       bytesRead = -1;
1781       break;
1782   }
1783 
1784   /*
1785    * In the blocking case, wait until the file becomes readable
1786    * or closed and try again.
1787    */
1788 
1789   if (!WaitForSocketEvent(infoPtr, FD_READ|FD_CLOSE, errorCodePtr)) {
1790       bytesRead = -1;
1791       break;
1792     }
1793     }
1794     
1795     SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
1796       (WPARAM) SELECT, (LPARAM) infoPtr);
1797     
1798     return bytesRead;
1799 }
static int TcpOutputProc (ClientData instanceData, CONST char * buf, int toWrite, int * errorCodePtr) [static]

Definition at line 1819 of file tclWinSock.c.
References DWORD(), EFAULT, EWOULDBLOCK, SocketInfo::flags, ThreadSpecificData::hwnd, SELECT, SOCKET_ASYNC, SOCKET_ASYNC_CONNECT, SOCKET_SELECT, SocketsEnabled(), Tcl_GetErrno(), Tcl_SetMaxBlockTime(), TclThreadDataKeyGet(), TclWinConvertWSAError(), UNSELECT, WaitForSocketEvent(), and winSock.1824 {
1825     SocketInfo *infoPtr = (SocketInfo *) instanceData;
1826     int bytesWritten;
1827     DWORD error;
1828     ThreadSpecificData *tsdPtr = 
1829   (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
1830 
1831     *errorCodePtr = 0;
1832 
1833     /*
1834      * Check that WinSock is initialized; do not call it if not, to
1835      * prevent system crashes. This can happen at exit time if the exit
1836      * handler for WinSock ran before other exit handlers that want to
1837      * use sockets.
1838      */
1839 
1840     if (!SocketsEnabled()) {
1841         *errorCodePtr = EFAULT;
1842         return -1;
1843     }
1844 
1845     /*
1846      * Check to see if the socket is connected before trying to write.
1847      */
1848     
1849     if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
1850       && ! WaitForSocketEvent(infoPtr,  FD_CONNECT, errorCodePtr)) {
1851   return -1;
1852     }
1853 
1854     while (1) {
1855   SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
1856     (WPARAM) UNSELECT, (LPARAM) infoPtr);
1857 
1858   bytesWritten = winSock.send(infoPtr->socket, buf, toWrite, 0);
1859   if (bytesWritten != SOCKET_ERROR) {
1860       /*
1861        * Since Windows won't generate a new write event until we hit
1862        * an overflow condition, we need to force the event loop to
1863        * poll until the condition changes.
1864        */
1865 
1866       if (infoPtr->watchEvents & FD_WRITE) {
1867     Tcl_Time blockTime = { 0, 0 };
1868     Tcl_SetMaxBlockTime(&blockTime);
1869       }   
1870       break;
1871   }
1872   
1873   /*
1874    * Check for error condition or overflow.  In the event of overflow, we
1875    * need to clear the FD_WRITE flag so we can detect the next writable
1876    * event.  Note that Windows only sends a new writable event after a
1877    * send fails with WSAEWOULDBLOCK.
1878    */
1879 
1880   error = winSock.WSAGetLastError();
1881   if (error == WSAEWOULDBLOCK) {
1882       infoPtr->readyEvents &= ~(FD_WRITE);
1883       if (infoPtr->flags & SOCKET_ASYNC) {
1884     *errorCodePtr = EWOULDBLOCK;
1885     bytesWritten = -1;
1886     break;
1887       } 
1888   } else {
1889       TclWinConvertWSAError(error);
1890       *errorCodePtr = Tcl_GetErrno();
1891       bytesWritten = -1;
1892       break;
1893   }
1894 
1895   /*
1896    * In the blocking case, wait until the file becomes writable
1897    * or closed and try again.
1898    */
1899 
1900   if (!WaitForSocketEvent(infoPtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
1901       bytesWritten = -1;
1902       break;
1903   }
1904     }
1905 
1906     SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
1907       (WPARAM) SELECT, (LPARAM) infoPtr);
1908     
1909     return bytesWritten;
1910 }
static int TcpSetOptionProc (ClientData instanceData, Tcl_Interp * interp, CONST char * optionName, CONST char * value) [static]

Definition at line 1929 of file tclWinSock.c.
References NULL, SocketInfo::socket, SocketsEnabled(), Tcl_BadChannelOption(), and TCL_ERROR.1934 {
1935     SocketInfo *infoPtr;
1936     SOCKET sock;
1937 /*
1938     BOOL val = FALSE;
1939     int boolVar, rtn;
1940 */
1941     /*
1942      * Check that WinSock is initialized; do not call it if not, to
1943      * prevent system crashes. This can happen at exit time if the exit
1944      * handler for WinSock ran before other exit handlers that want to
1945      * use sockets.
1946      */
1947 
1948     if (!SocketsEnabled()) {
1949   if (interp) {
1950       Tcl_AppendResult(interp, "winsock is not initialized", NULL);
1951   }
1952         return TCL_ERROR;
1953     }
1954 
1955     infoPtr = (SocketInfo *) instanceData;
1956     sock = infoPtr->socket;
1957 
1958 /*
1959     if (!stricmp(optionName, "-keepalive")) {
1960   if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
1961       return TCL_ERROR;
1962   }
1963   if (boolVar) val = TRUE;
1964   rtn = winSock.setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
1965     (const char *) &val, sizeof(BOOL));
1966   if (rtn != 0) {
1967       TclWinConvertWSAError(winSock.WSAGetLastError());
1968       if (interp) {
1969     Tcl_AppendResult(interp, "couldn't set socket option: ",
1970       Tcl_PosixError(interp), NULL);
1971       }
1972       return TCL_ERROR;
1973   }
1974   return TCL_OK;
1975 
1976     } else if (!stricmp(optionName, "-nagle")) {
1977   if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
1978       return TCL_ERROR;
1979   }
1980   if (!boolVar) val = TRUE;
1981   rtn = winSock.setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
1982     (const char *) &val, sizeof(BOOL));
1983   if (rtn != 0) {
1984       TclWinConvertWSAError(winSock.WSAGetLastError());
1985       if (interp) {
1986     Tcl_AppendResult(interp, "couldn't set socket option: ",
1987       Tcl_PosixError(interp), NULL);
1988       }
1989       return TCL_ERROR;
1990   }
1991   return TCL_OK;
1992     }
1993 
1994     return Tcl_BadChannelOption(interp, optionName, "keepalive nagle");
1995 */
1996     return Tcl_BadChannelOption(interp, optionName, "");
1997 }
static void TcpThreadActionProc (ClientData instanceData, int action) [static]

Definition at line 2689 of file tclWinSock.c.
References ThreadSpecificData::hwnd, InitSockets(), SocketInfo::nextPtr, NULL, SELECT, SOCKET_SELECT, ThreadSpecificData::socketList, ThreadSpecificData::socketListLock, TCL_CHANNEL_THREAD_INSERT, Tcl_MutexLock, Tcl_MutexUnlock, TCL_TSD_INIT, and UNSELECT.2692 {
2693     ThreadSpecificData *tsdPtr;
2694     SocketInfo *infoPtr = (SocketInfo *) instanceData;
2695     int      notifyCmd;
2696 
2697     if (action == TCL_CHANNEL_THREAD_INSERT) {
2698         /*
2699    * Ensure that socket subsystem is initialized in this thread, or
2700    * else sockets will not work.
2701    */
2702 
2703         Tcl_MutexLock(&socketMutex);
2704   InitSockets();
2705   Tcl_MutexUnlock(&socketMutex);
2706 
2707   tsdPtr = TCL_TSD_INIT(&dataKey);
2708 
2709   WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
2710   infoPtr->nextPtr = tsdPtr->socketList;
2711   tsdPtr->socketList = infoPtr;
2712   SetEvent(tsdPtr->socketListLock);
2713 
2714   notifyCmd = SELECT;
2715     } else {
2716   SocketInfo **nextPtrPtr;
2717   int removed = 0;
2718 
2719   tsdPtr  = TCL_TSD_INIT(&dataKey);
2720 
2721   /* TIP #218, Bugfix: All access to socketList has to be protected by the lock */
2722   WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
2723   for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
2724        nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
2725       if ((*nextPtrPtr) == infoPtr) {
2726           (*nextPtrPtr) = infoPtr->nextPtr;
2727     removed = 1;
2728     break;
2729       }
2730   }
2731   SetEvent(tsdPtr->socketListLock);
2732 
2733   /*
2734    * This could happen if the channel was created in one thread
2735    * and then moved to another without updating the thread
2736    * local data in each thread.
2737    */
2738 
2739   if (!removed) {
2740       Tcl_Panic("file info ptr not on thread channel list");
2741   }
2742 
2743   notifyCmd = UNSELECT;
2744     }
2745 
2746     /*
2747      * Ensure that, or stop, notifications for the socket occur in this thread.
2748      */
2749 
2750     SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
2751     (WPARAM) notifyCmd, (LPARAM) infoPtr);
2752 }
static void TcpWatchProc (ClientData instanceData, int mask) [static]

Definition at line 2237 of file tclWinSock.c.
References SocketInfo::acceptProc, SocketInfo::readyEvents, TCL_READABLE, Tcl_SetMaxBlockTime(), TCL_WRITABLE, and SocketInfo::watchEvents.2242 {
2243     SocketInfo *infoPtr = (SocketInfo *) instanceData;
2244     
2245     /*
2246      * Update the watch events mask. Only if the socket is not a
2247      * server socket. Fix for SF Tcl Bug #557878.
2248      */
2249 
2250     if (!infoPtr->acceptProc) {    
2251         infoPtr->watchEvents = 0;
2252   if (mask & TCL_READABLE) {
2253       infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT);
2254   }
2255   if (mask & TCL_WRITABLE) {
2256       infoPtr->watchEvents |= (FD_WRITE|FD_CLOSE|FD_CONNECT);
2257   }
2258       
2259   /*
2260    * If there are any conditions already set, then tell the notifier to poll
2261    * rather than block.
2262    */
2263 
2264   if (infoPtr->readyEvents & infoPtr->watchEvents) {
2265       Tcl_Time blockTime = { 0, 0 };
2266       Tcl_SetMaxBlockTime(&blockTime);
2267   }
2268     }
2269 }
static int WaitForSocketEvent (SocketInfo * infoPtr, int events, int * errorCodePtr) [static]

Definition at line 1341 of file tclWinSock.c.
References EWOULDBLOCK, ThreadSpecificData::hwnd, ThreadSpecificData::readyEvent, SELECT, SOCKET_ASYNC, SOCKET_SELECT, TCL_SERVICE_NONE, Tcl_SetServiceMode(), TclThreadDataKeyGet(), UNSELECT, and void().1345 {
1346     int result = 1;
1347     int oldMode;
1348     ThreadSpecificData *tsdPtr = 
1349   (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
1350 
1351     /*
1352      * Be sure to disable event servicing so we are truly modal.
1353      */
1354 
1355     oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
1356     
1357     /*
1358      * Reset WSAAsyncSelect so we have a fresh set of events pending.
1359      */
1360 
1361     SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
1362       (WPARAM) UNSELECT, (LPARAM) infoPtr);
1363 
1364     SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
1365       (WPARAM) SELECT, (LPARAM) infoPtr);
1366 
1367     while (1) {
1368 
1369   if (infoPtr->lastError) {
1370       *errorCodePtr = infoPtr->lastError;
1371       result = 0;
1372       break;
1373   } else if (infoPtr->readyEvents & events) {
1374       break;
1375   } else if (infoPtr->flags & SOCKET_ASYNC) {
1376       *errorCodePtr = EWOULDBLOCK;
1377       result = 0;
1378       break;
1379   }
1380 
1381   /*
1382    * Wait until something happens.
1383    */
1384   WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
1385     }
1386     
1387     (void) Tcl_SetServiceMode(oldMode);
1388     return result;
1389 }

Variable Documentation
Tcl_ThreadDataKey dataKey [static]

Definition at line 228 of file tclWinSock.c.char hostname[255] [static]

Definition at line 33 of file tclWinSock.c.int hostnameInitialized = 0 [static]

Definition at line 32 of file tclWinSock.c.
Referenced by SocketExitHandler(), and Tcl_GetHostName().int initialized = 0 [static]

Definition at line 30 of file tclWinSock.c.Tcl_EventCheckProc SocketCheckProc [static]

Definition at line 244 of file tclWinSock.c.
Referenced by InitSockets(), and TclpFinalizeSockets().Tcl_EventProc SocketEventProc [static]

Definition at line 245 of file tclWinSock.c.
Referenced by SocketCheckProc().Tcl_EventSetupProc SocketSetupProc [static]

Definition at line 251 of file tclWinSock.c.
Referenced by InitSockets(), and TclpFinalizeSockets().Tcl_DriverBlockModeProc TcpBlockProc [static]

Definition at line 254 of file tclWinSock.c.Tcl_ChannelType tcpChannelType [static]
Initial value: {
    "tcp",        
    TCL_CHANNEL_VERSION_4,  
    TcpCloseProc,     
    TcpInputProc,     
    TcpOutputProc,      
    NULL,       
    TcpSetOptionProc,     
    TcpGetOptionProc,     
    TcpWatchProc,     
    TcpGetHandleProc,     
    NULL,       
    TcpBlockProc,     
    NULL,       
    NULL,       
    NULL,                   
    TcpThreadActionProc,    
}
Definition at line 276 of file tclWinSock.c.Tcl_DriverCloseProc TcpCloseProc [static]

Definition at line 255 of file tclWinSock.c.Tcl_DriverGetHandleProc TcpGetHandleProc [static]

Definition at line 261 of file tclWinSock.c.Tcl_DriverGetOptionProc TcpGetOptionProc [static]

Definition at line 257 of file tclWinSock.c.Tcl_DriverInputProc TcpInputProc [static]

Definition at line 258 of file tclWinSock.c.Tcl_DriverOutputProc TcpOutputProc [static]

Definition at line 259 of file tclWinSock.c.Tcl_DriverSetOptionProc TcpSetOptionProc [static]

Definition at line 256 of file tclWinSock.c.Tcl_DriverWatchProc TcpWatchProc [static]

Definition at line 260 of file tclWinSock.c.WNDCLASS windowClass [static]

Definition at line 229 of file tclWinSock.c.winSock

Definition at line 134 of file tclWinSock.c.
Referenced by CreateSocket(), CreateSocketAddress(), InitSockets(), SocketEventProc(), SocketExitHandler(), SocketProc(), SocketsEnabled(), Tcl_GetHostName(), TclWinGetServByName(), TclWinGetSockOpt(), TclWinNToHS(), TclWinSetSockOpt(), TcpAccept(), TcpCloseProc(), TcpGetOptionProc(), TcpInputProc(), and TcpOutputProc().

win/tclWinTest.c File Reference
#include "tclWinInt.h"
Defines
#define USE_COMPAT_CONST
#define INHERITED_ACE  (0x10)
#define VOL_BUF_SIZE  32
Functions
int TclplatformtestInit _ANSI_ARGS_ ((Tcl_Interp *interp))
static int TesteventloopCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int argc, CONST84 char **argv))
static int TestvolumetypeCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
static int TestwinclockCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
static int TestplatformChmod _ANSI_ARGS_ ((CONST char *nativePath, int pmode))
static int TestchmodCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int argc, CONST84 char **argv))
int TclplatformtestInit (Tcl_Interp *interp)
static int TesteventloopCmd (ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv)
static int TestvolumetypeCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static int TestwinclockCmd (ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
static int TestwincpuidCmd (ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST *objv)
static int TestwinsleepCmd (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST *objv)
static int TestExceptionCmd (ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
static int TestplatformChmod (CONST char *nativePath, int pmode)
static int TestchmodCmd (ClientData dummy, Tcl_Interp *interp, int argc, CONST84 char **argv)
Variables
static Tcl_ObjCmdProc TestExceptionCmd

Define Documentation
#define INHERITED_ACE  (0x10)

Definition at line 28 of file tclWinTest.c.
Referenced by TestplatformChmod().#define USE_COMPAT_CONST

Definition at line 14 of file tclWinTest.c.#define VOL_BUF_SIZE  32

Function Documentation
static int TestchmodCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int argc, CONST84 char **argv)) [static]
static int TestplatformChmod _ANSI_ARGS_ ((CONST char *nativePath, int pmode)) [static]
static int TestwinclockCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])) [static]
static int TestvolumetypeCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])) [static]
static int TesteventloopCmd _ANSI_ARGS_ ((ClientData dummy, Tcl_Interp *interp, int argc, CONST84 char **argv)) [static]
int TclplatformtestInit _ANSI_ARGS_ ((Tcl_Interp *interp))
int TclplatformtestInit (Tcl_Interp * interp)

Definition at line 77 of file tclWinTest.c.
References NULL, Tcl_CreateCommand(), Tcl_CreateObjCommand(), TCL_OK, TestchmodCmd(), TesteventloopCmd(), TestvolumetypeCmd(), TestwinclockCmd(), TestwincpuidCmd(), and TestwinsleepCmd().79 {
80     /*
81      * Add commands for platform specific tests for Windows here.
82      */
83 
84     Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
85           (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
86     Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
87           (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
88     Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd,
89        (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
90     Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd,
91        (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
92     Tcl_CreateObjCommand(interp, "testwincpuid", TestwincpuidCmd,
93        (ClientData) 0, (Tcl_CmdDeleteProc*) NULL );
94     Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd,
95        (ClientData) 0, (Tcl_CmdDeleteProc *) NULL );
96     Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd,
97        (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
98     return TCL_OK;
99 }
static int TestchmodCmd (ClientData dummy, Tcl_Interp * interp, int argc, CONST84 char ** argv) [static]

Definition at line 795 of file tclWinTest.c.
References CONST, NULL, strtol(), Tcl_DStringFree(), TCL_ERROR, TCL_OK, Tcl_PosixError(), Tcl_TranslateFileName(), and TestplatformChmod().800 {
801     int i, mode;
802     char *rest;
803 
804     if (argc < 2) {
805   usage:
806   Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
807     " mode file ?file ...?", NULL);
808   return TCL_ERROR;
809     }
810 
811     mode = (int) strtol(argv[1], &rest, 8);
812     if ((rest == argv[1]) || (*rest != '\0')) {
813   goto usage;
814     }
815 
816     for (i = 2; i < argc; i++) {
817   Tcl_DString buffer;
818   CONST char *translated;
819 
820   translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
821   if (translated == NULL) {
822       return TCL_ERROR;
823   }
824   if (TestplatformChmod(translated, mode) != 0) {
825       Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
826         NULL);
827       return TCL_ERROR;
828   }
829   Tcl_DStringFree(&buffer);
830     }
831     return TCL_OK;
832 }
static int TesteventloopCmd (ClientData clientData, Tcl_Interp * interp, int argc, CONST84 char ** argv) [static]

Definition at line 120 of file tclWinTest.c.
References NULL, TCL_ERROR, TCL_OK, TCL_SERVICE_ALL, Tcl_SetServiceMode(), and void().125 {
126     static int *framePtr = NULL; /* Pointer to integer on stack frame of
127           * innermost invocation of the "wait"
128           * subcommand. */
129 
130    if (argc < 2) {
131   Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
132                 " option ... \"", (char *) NULL);
133         return TCL_ERROR;
134     }
135     if (strcmp(argv[1], "done") == 0) {
136   *framePtr = 1;
137     } else if (strcmp(argv[1], "wait") == 0) {
138   int *oldFramePtr;
139   int done;
140   MSG msg;
141   int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
142 
143   /*
144    * Save the old stack frame pointer and set up the current frame.
145    */
146 
147   oldFramePtr = framePtr;
148   framePtr = &done;
149 
150   /*
151    * Enter a standard Windows event loop until the flag changes.
152    * Note that we do not explicitly call Tcl_ServiceEvent().
153    */
154 
155   done = 0;
156   while (!done) {
157       if (!GetMessage(&msg, NULL, 0, 0)) {
158     /*
159      * The application is exiting, so repost the quit message
160      * and start unwinding.
161      */
162 
163     PostQuitMessage((int)msg.wParam);
164     break;
165       }
166       TranslateMessage(&msg);
167       DispatchMessage(&msg);
168   }
169   (void) Tcl_SetServiceMode(oldMode);
170   framePtr = oldFramePtr;
171     } else {
172   Tcl_AppendResult(interp, "bad option \"", argv[1],
173     "\": must be done or wait", (char *) NULL);
174   return TCL_ERROR;
175     }
176     return TCL_OK;
177 }
static int TestExceptionCmd (ClientData dummy, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[]) [static]

Definition at line 439 of file tclWinTest.c.
References DWORD(), NULL, TCL_ERROR, Tcl_GetIndexFromObj(), TCL_OK, and Tcl_WrongNumArgs().444 {
445     static char *cmds[] = {
446       "access_violation",
447       "datatype_misalignment",
448       "array_bounds",
449       "float_denormal",
450       "float_divbyzero",
451       "float_inexact",
452       "float_invalidop",
453       "float_overflow",
454       "float_stack",
455       "float_underflow",
456       "int_divbyzero",
457       "int_overflow",
458       "private_instruction",
459       "inpageerror",
460       "illegal_instruction",
461       "noncontinue",
462       "stack_overflow",
463       "invalid_disp",
464       "guard_page",
465       "invalid_handle",
466       "ctrl+c",
467       NULL
468     };
469     static DWORD exceptions[] = {
470       EXCEPTION_ACCESS_VIOLATION,
471       EXCEPTION_DATATYPE_MISALIGNMENT,
472       EXCEPTION_ARRAY_BOUNDS_EXCEEDED,
473       EXCEPTION_FLT_DENORMAL_OPERAND,
474       EXCEPTION_FLT_DIVIDE_BY_ZERO,
475       EXCEPTION_FLT_INEXACT_RESULT,
476       EXCEPTION_FLT_INVALID_OPERATION,
477       EXCEPTION_FLT_OVERFLOW,
478       EXCEPTION_FLT_STACK_CHECK,
479       EXCEPTION_FLT_UNDERFLOW,
480       EXCEPTION_INT_DIVIDE_BY_ZERO,
481       EXCEPTION_INT_OVERFLOW,
482       EXCEPTION_PRIV_INSTRUCTION,
483       EXCEPTION_IN_PAGE_ERROR,
484       EXCEPTION_ILLEGAL_INSTRUCTION,
485       EXCEPTION_NONCONTINUABLE_EXCEPTION,
486       EXCEPTION_STACK_OVERFLOW,
487       EXCEPTION_INVALID_DISPOSITION,
488       EXCEPTION_GUARD_PAGE,
489       EXCEPTION_INVALID_HANDLE,
490       CONTROL_C_EXIT
491     };
492     int cmd;
493 
494     if ( objc != 2 ) {
495   Tcl_WrongNumArgs(interp, 0, objv, "<type-of-exception>");
496   return TCL_ERROR;
497     }
498     if (Tcl_GetIndexFromObj(interp, objv[1], cmds, "command", 0,
499       &cmd) != TCL_OK) {
500   return TCL_ERROR;
501     }
502 
503     /*
504      * Make sure the GPF dialog doesn't popup.
505      */
506 
507     SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOGPFAULTERRORBOX);
508 
509     /*
510      * As Tcl does not handle structured exceptions, this falls all the way
511      * back up the instruction stack to the C run-time portion that called
512      * main() where the process will now be terminated with this exception
513      * code by the default handler the C run-time provides.
514      */
515 
516     /* SMASH! */
517     RaiseException(exceptions[cmd], EXCEPTION_NONCONTINUABLE, 0, NULL);
518 
519     /* NOTREACHED */
520     return TCL_OK;
521 }
static int TestplatformChmod (CONST char * nativePath, int pmode) [static]

Definition at line 524 of file tclWinTest.c.
References BOOL(), ckalloc, ckfree, DWORD(), FALSE, hInstance, INHERITED_ACE, initialized, NULL, TCL_DECLARE_MUTEX, Tcl_MutexLock, Tcl_MutexUnlock, TRUE, and UCHAR.
Referenced by TestchmodCmd().525 {
526     SID_IDENTIFIER_AUTHORITY userSidAuthority =
527     { SECURITY_WORLD_SID_AUTHORITY };
528 
529     typedef DWORD (WINAPI *getSidLengthRequiredDef) ( UCHAR );
530     typedef BOOL (WINAPI *initializeSidDef) ( PSID,
531     PSID_IDENTIFIER_AUTHORITY, BYTE );
532     typedef PDWORD (WINAPI *getSidSubAuthorityDef) ( PSID, DWORD );
533 
534     static getSidLengthRequiredDef getSidLengthRequiredProc;
535     static initializeSidDef initializeSidProc;
536     static getSidSubAuthorityDef getSidSubAuthorityProc;
537     static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION 
538       | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION;
539     static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE 
540       | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA |  FILE_APPEND_DATA 
541       | FILE_WRITE_DATA | DELETE;
542 
543     BYTE *secDesc = 0;
544     DWORD secDescLen;
545 
546     const BOOL set_readOnly = !(pmode & 0222);
547     BOOL acl_readOnly_found = FALSE;
548 
549     ACL_SIZE_INFORMATION ACLSize;
550     BOOL curAclPresent, curAclDefaulted;
551     PACL curAcl; 
552     PACL newAcl = 0;
553     DWORD newAclSize;
554 
555     WORD j;
556   
557     SID *userSid = 0;
558     TCHAR *userDomain = NULL;
559 
560     DWORD attr;
561 
562     int res = 0;
563 
564     /*
565      * One time initialization, dynamically load Windows NT features
566      */
567     typedef DWORD (WINAPI *setNamedSecurityInfoADef)( IN LPSTR,
568       IN SE_OBJECT_TYPE, IN SECURITY_INFORMATION, IN PSID, IN PSID,
569       IN PACL, IN PACL );
570     typedef BOOL (WINAPI *getAceDef) (PACL, DWORD, LPVOID *);
571     typedef BOOL (WINAPI *addAceDef) ( PACL, DWORD, DWORD, LPVOID, DWORD );
572     typedef BOOL (WINAPI *equalSidDef) ( PSID, PSID );
573     typedef BOOL (WINAPI *addAccessDeniedAceDef) ( PACL, DWORD, DWORD, PSID );
574     typedef BOOL (WINAPI *initializeAclDef) ( PACL, DWORD, DWORD );
575     typedef DWORD (WINAPI *getLengthSidDef) ( PSID );
576     typedef BOOL (WINAPI *getAclInformationDef) (PACL, LPVOID, DWORD, 
577       ACL_INFORMATION_CLASS );
578     typedef BOOL (WINAPI *getSecurityDescriptorDaclDef) (PSECURITY_DESCRIPTOR,
579       LPBOOL, PACL *, LPBOOL );
580     typedef BOOL (WINAPI *lookupAccountNameADef) ( LPCSTR, LPCSTR, PSID, 
581       PDWORD, LPSTR, LPDWORD, PSID_NAME_USE );
582     typedef BOOL (WINAPI *getFileSecurityADef) ( LPCSTR, SECURITY_INFORMATION,
583       PSECURITY_DESCRIPTOR, DWORD, LPDWORD );
584 
585     static setNamedSecurityInfoADef setNamedSecurityInfoProc;
586     static getAceDef getAceProc;
587     static addAceDef addAceProc;
588     static equalSidDef equalSidProc;
589     static addAccessDeniedAceDef addAccessDeniedAceProc;
590     static initializeAclDef initializeAclProc;
591     static getLengthSidDef getLengthSidProc;
592     static getAclInformationDef getAclInformationProc;
593     static getSecurityDescriptorDaclDef getSecurityDescriptorDaclProc;
594     static lookupAccountNameADef lookupAccountNameProc; 
595     static getFileSecurityADef getFileSecurityProc;
596 
597     static int initialized = 0;
598     if (!initialized) {
599   TCL_DECLARE_MUTEX(initializeMutex)
600   Tcl_MutexLock(&initializeMutex);
601   if (!initialized) {
602       HINSTANCE hInstance = LoadLibrary("Advapi32");
603       if (hInstance != NULL) {
604     setNamedSecurityInfoProc = (setNamedSecurityInfoADef)
605       GetProcAddress(hInstance, "SetNamedSecurityInfoA");
606     getFileSecurityProc = (getFileSecurityADef)
607       GetProcAddress(hInstance, "GetFileSecurityA");
608     getAceProc = (getAceDef)
609       GetProcAddress(hInstance, "GetAce");
610     addAceProc = (addAceDef)
611       GetProcAddress(hInstance, "AddAce");
612     equalSidProc = (equalSidDef)
613       GetProcAddress(hInstance, "EqualSid");
614     addAccessDeniedAceProc = (addAccessDeniedAceDef)
615       GetProcAddress(hInstance, "AddAccessDeniedAce");
616     initializeAclProc = (initializeAclDef)
617       GetProcAddress(hInstance, "InitializeAcl");
618     getLengthSidProc = (getLengthSidDef)
619       GetProcAddress(hInstance, "GetLengthSid");
620     getAclInformationProc = (getAclInformationDef)
621       GetProcAddress(hInstance, "GetAclInformation");
622     getSecurityDescriptorDaclProc = (getSecurityDescriptorDaclDef)
623       GetProcAddress(hInstance, "GetSecurityDescriptorDacl");
624     lookupAccountNameProc = (lookupAccountNameADef)
625       GetProcAddress(hInstance, "LookupAccountNameA");
626     getSidLengthRequiredProc = (getSidLengthRequiredDef)
627       GetProcAddress(hInstance, "GetSidLengthRequired");
628     initializeSidProc = (initializeSidDef)
629       GetProcAddress(hInstance, "InitializeSid");
630     getSidSubAuthorityProc = (getSidSubAuthorityDef)
631       GetProcAddress(hInstance, "GetSidSubAuthority");
632     if (setNamedSecurityInfoProc && getAceProc
633       && addAceProc && equalSidProc && addAccessDeniedAceProc
634       && initializeAclProc && getLengthSidProc
635       && getAclInformationProc && getSecurityDescriptorDaclProc
636       && lookupAccountNameProc && getFileSecurityProc
637       && getSidLengthRequiredProc && initializeSidProc
638       && getSidSubAuthorityProc)
639         initialized = 1;
640       }
641       if (!initialized)
642     initialized = -1;
643   }
644   Tcl_MutexUnlock(&initializeMutex);
645     }
646 
647     /* Process the chmod request */
648     attr = GetFileAttributes(nativePath);
649 
650     /* nativePath not found */
651     if (attr == 0xffffffff) {
652   res = -1;
653   goto done;
654     }
655 
656     /* If no ACL API is present or nativePath is not a directory, 
657      * there is no special handling 
658      */
659     if (initialized < 0 || !(attr & FILE_ATTRIBUTE_DIRECTORY)) {
660   goto done;
661     }
662     
663     /* Set the result to error, if the ACL change is successful it will 
664      *  be reset to 0 
665      */
666     res = -1;
667 
668     /*
669      * Read the security descriptor for the directory. Note the
670      * first call obtains the size of the security descriptor.
671      */
672     if (!getFileSecurityProc(nativePath, infoBits, NULL, 0, &secDescLen)) {
673   if (GetLastError() == ERROR_INSUFFICIENT_BUFFER) {
674       DWORD secDescLen2 = 0;
675       secDesc = (BYTE *) ckalloc(secDescLen);
676       if (!getFileSecurityProc(nativePath, infoBits,
677              (PSECURITY_DESCRIPTOR)secDesc, 
678              secDescLen, &secDescLen2) 
679     || (secDescLen < secDescLen2)) {
680     goto done;
681       }
682   } else {
683       goto done;
684   }
685     }
686 
687     /* Get the World SID */
688     userSid = (SID*) ckalloc(getSidLengthRequiredProc((UCHAR)1));
689     initializeSidProc( userSid, &userSidAuthority, (BYTE)1);
690     *(getSidSubAuthorityProc( userSid, 0)) = SECURITY_WORLD_RID;
691 
692     /* If curAclPresent == false then curAcl and curAclDefaulted not valid */
693     if (!getSecurityDescriptorDaclProc(secDesc, &curAclPresent, 
694                &curAcl, &curAclDefaulted))
695   goto done;
696 
697     if (!curAclPresent || !curAcl) {
698   ACLSize.AclBytesInUse = 0;
699   ACLSize.AceCount = 0;
700     } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize), 
701       AclSizeInformation))
702   goto done;
703 
704     /* Allocate memory for the new ACL */
705     newAclSize = ACLSize.AclBytesInUse + sizeof (ACCESS_DENIED_ACE) 
706       + getLengthSidProc(userSid) - sizeof (DWORD);
707     newAcl = (ACL *) ckalloc (newAclSize);
708   
709     /* Initialize the new ACL */
710     if(!initializeAclProc(newAcl, newAclSize, ACL_REVISION)) {
711   goto done;
712     }
713     
714     /* Add denied to make readonly, this will be known as a "read-only tag" */
715     if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION, 
716       readOnlyMask, userSid)) {
717   goto done;
718     }
719       
720     acl_readOnly_found = FALSE;
721     for (j = 0; j < ACLSize.AceCount; j++) {
722   PACL *pACE2;
723   ACE_HEADER *phACE2;
724   if (! getAceProc (curAcl, j, (LPVOID*) &pACE2)) {
725       goto done;
726   }
727   
728   phACE2 = ((ACE_HEADER *) pACE2);
729 
730   /* Do NOT propagate inherited ACEs */
731   if (phACE2->AceFlags & INHERITED_ACE) {
732       continue;
733   }
734   
735   /* Skip the "read-only tag" restriction (either added above, or it
736    * is being removed) 
737    */
738   if (phACE2->AceType == ACCESS_DENIED_ACE_TYPE) {
739       ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *)phACE2;
740       if (pACEd->Mask == readOnlyMask && equalSidProc(userSid, 
741         (PSID)&(pACEd->SidStart))) {
742     acl_readOnly_found = TRUE;
743     continue;
744       }
745   }
746 
747   /* Copy the current ACE from the old to the new ACL */
748   if(! addAceProc (newAcl, ACL_REVISION, MAXDWORD, pACE2, 
749     ((PACE_HEADER) pACE2)->AceSize)) {
750       goto done;
751   }
752     }
753 
754     /* Apply the new ACL */
755     if (set_readOnly == acl_readOnly_found
756   || setNamedSecurityInfoProc((LPSTR)nativePath, SE_FILE_OBJECT, 
757        DACL_SECURITY_INFORMATION, NULL, NULL, newAcl, NULL)
758      == ERROR_SUCCESS ) {
759   res = 0;
760     }
761 
762  done:
763     if (secDesc) ckfree(secDesc);
764     if (newAcl) ckfree((char *)newAcl);
765     if (userSid) ckfree((char *)userSid);
766     if (userDomain) ckfree(userDomain);
767 
768     if (res != 0)
769   return res;
770     
771     /* Run normal chmod command */
772     return chmod(nativePath, pmode);
773 }
static int TestvolumetypeCmd (ClientData clientData, Tcl_Interp * interp, int objc, objv) [static]

Definition at line 197 of file tclWinTest.c.
References NULL, TCL_ERROR, Tcl_GetString(), TCL_OK, Tcl_SetResult(), TCL_VOLATILE, Tcl_WrongNumArgs(), TclWinConvertError(), and VOL_BUF_SIZE.
Referenced by TclplatformtestInit().202 {
203 #define VOL_BUF_SIZE 32
204     int found;
205     char volType[VOL_BUF_SIZE];
206     char *path;
207 
208     if (objc > 2) {
209   Tcl_WrongNumArgs(interp, 1, objv, "?name?");
210         return TCL_ERROR;
211     }
212     if (objc == 2) {
213   /*
214    * path has to be really a proper volume, but we don't
215    * get query APIs for that until NT5
216    */
217   path = Tcl_GetString(objv[1]);
218     } else {
219   path = NULL;
220     }
221     found = GetVolumeInformationA(path, NULL, 0, NULL, NULL, 
222       NULL, volType, VOL_BUF_SIZE);
223 
224     if (found == 0) {
225   Tcl_AppendResult(interp, "could not get volume type for \"",
226     (path?path:""), "\"", (char *) NULL);
227   TclWinConvertError(GetLastError());
228   return TCL_ERROR;
229     }
230     Tcl_SetResult(interp, volType, TCL_VOLATILE);
231     return TCL_OK;
232 #undef VOL_BUF_SIZE
233 }
static int TestwinclockCmd (ClientData dummy, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[]) [static]

Definition at line 262 of file tclWinTest.c.
References CONST, posixEpoch, Tcl_Time::sec, TCL_ERROR, Tcl_GetTime(), Tcl_ListObjAppendElement(), Tcl_NewIntObj(), Tcl_NewObj(), Tcl_NewWideIntObj(), TCL_OK, Tcl_SetObjResult(), Tcl_WrongNumArgs(), and Tcl_Time::usec.
Referenced by TclplatformtestInit().270 {
271     CONST static FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE };
272         /* The Posix epoch, expressed as a
273          * Windows FILETIME */
274     Tcl_Time tclTime;   /* Tcl clock */
275     FILETIME sysTime;   /* System clock */
276     Tcl_Obj* result;    /* Result of the command */
277     LARGE_INTEGER t1, t2;
278     LARGE_INTEGER p1, p2;
279 
280     if ( objc != 1 ) {
281   Tcl_WrongNumArgs( interp, 1, objv, "" );
282   return TCL_ERROR;
283     }
284 
285     QueryPerformanceCounter( &p1 );
286 
287     Tcl_GetTime( &tclTime );
288     GetSystemTimeAsFileTime( &sysTime );
289     t1.LowPart = posixEpoch.dwLowDateTime;
290     t1.HighPart = posixEpoch.dwHighDateTime;
291     t2.LowPart = sysTime.dwLowDateTime;
292     t2.HighPart = sysTime.dwHighDateTime;
293     t2.QuadPart -= t1.QuadPart;
294 
295     QueryPerformanceCounter( &p2 );
296 
297     result = Tcl_NewObj();
298     Tcl_ListObjAppendElement
299   ( interp, result, Tcl_NewIntObj( (int) (t2.QuadPart / 10000000 ) ) );
300     Tcl_ListObjAppendElement
301   ( interp, result,
302     Tcl_NewIntObj( (int) ( (t2.QuadPart / 10 ) % 1000000 ) ) );
303     Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.sec ) );
304     Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.usec ) );
305 
306     Tcl_ListObjAppendElement( interp, result, Tcl_NewWideIntObj( p1.QuadPart ) );
307     Tcl_ListObjAppendElement( interp, result, Tcl_NewWideIntObj( p2.QuadPart ) );
308 
309     Tcl_SetObjResult( interp, result );
310 
311     return TCL_OK;
312 }
static int TestwincpuidCmd (ClientData dummy, Tcl_Interp * interp, int objc, Tcl_Obj *CONST * objv) [static]

Definition at line 338 of file tclWinTest.c.
References status, TCL_ERROR, Tcl_GetIntFromObj(), Tcl_NewIntObj(), Tcl_NewListObj(), Tcl_NewStringObj(), TCL_OK, Tcl_SetObjResult(), Tcl_WrongNumArgs(), and TclWinCPUID().
Referenced by TclplatformtestInit().342 {
343     int status;
344     int index;
345     unsigned int regs[4];
346     Tcl_Obj * regsObjs[4];
347     int i;
348 
349     if ( objc != 2 ) {
350   Tcl_WrongNumArgs( interp, 1, objv, "eax" );
351   return TCL_ERROR;
352     }
353     if ( Tcl_GetIntFromObj( interp, objv[1], &index ) != TCL_OK ) {
354   return TCL_ERROR;
355     }
356     status = TclWinCPUID( (unsigned int) index, regs );
357     if ( status != TCL_OK ) {
358   Tcl_SetObjResult( interp, Tcl_NewStringObj( "operation not available", 
359                 -1 ) );
360   return status;
361     }
362     for ( i = 0; i < 4; ++i ) {
363   regsObjs[i] = Tcl_NewIntObj( (int) regs[i] );
364     }
365     Tcl_SetObjResult( interp, Tcl_NewListObj( 4, regsObjs ) );
366     return TCL_OK;
367        
368 }
static int TestwinsleepCmd (ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST * objv) [static]

Definition at line 394 of file tclWinTest.c.
References DWORD(), TCL_ERROR, Tcl_GetIntFromObj(), TCL_OK, and Tcl_WrongNumArgs().
Referenced by TclplatformtestInit().402 {
403     int ms;
404     if ( objc != 2 ) {
405   Tcl_WrongNumArgs( interp, 1, objv, "ms" );
406   return TCL_ERROR;
407     }
408     if ( Tcl_GetIntFromObj( interp, objv[1], &ms ) != TCL_OK ) {
409   return TCL_ERROR;
410     }
411     Sleep( (DWORD) ms );
412     return TCL_OK;
413 }

Variable Documentation
Tcl_ObjCmdProc TestExceptionCmd [static]

Definition at line 48 of file tclWinTest.c.

win/tclWinThrd.c File Reference
#include "tclWinInt.h"
#include <fcntl.h>
#include <io.h>
#include <sys/stat.h>
Classes
struct WinCondition
Defines
#define MASTER_LOCK  TclpMasterLock()
#define MASTER_UNLOCK  TclpMasterUnlock()
#define WIN_THREAD_UNINIT  0x0
#define WIN_THREAD_RUNNING  0x1
#define WIN_THREAD_BLOCKED  0x2
#define WIN_THREAD_DEAD  0x4
Functions
int TclpThreadCreate (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags)
int Tcl_JoinThread (Tcl_ThreadId threadId, int *result)
void TclpThreadExit (int status)
Tcl_ThreadId Tcl_GetCurrentThread ()
void TclpInitLock ()
void TclpInitUnlock ()
void TclpMasterLock ()
void TclpMasterUnlock ()
Tcl_Mutex * Tcl_GetAllocMutex ()
void TclFinalizeLock ()
Variables
static CRITICAL_SECTION masterLock
static int init = 0
static CRITICAL_SECTION initLock
static CRITICAL_SECTION joinLock

Define Documentation
#define MASTER_LOCK  TclpMasterLock()

Definition at line 28 of file tclWinThrd.c.
Referenced by TclFinalizeLock().#define MASTER_UNLOCK  TclpMasterUnlock()

Definition at line 29 of file tclWinThrd.c.#define WIN_THREAD_BLOCKED  0x2

Definition at line 115 of file tclWinThrd.c.#define WIN_THREAD_DEAD  0x4

Definition at line 116 of file tclWinThrd.c.#define WIN_THREAD_RUNNING  0x1

Definition at line 114 of file tclWinThrd.c.#define WIN_THREAD_UNINIT  0x0

Definition at line 113 of file tclWinThrd.c.
Function Documentation
Tcl_Mutex* Tcl_GetAllocMutex ()

Definition at line 409 of file tclWinThrd.c.
References NULL.410 {
411 #ifdef TCL_THREADS
412     if (!allocOnce) {
413   InitializeCriticalSection(&allocLock);
414   allocOnce = 1;
415     }
416     return &allocLockPtr;
417 #else
418     return NULL;
419 #endif
420 }
Tcl_ThreadId Tcl_GetCurrentThread ()

Definition at line 263 of file tclWinThrd.c.264 {
265     return (Tcl_ThreadId)GetCurrentThreadId();
266 }
int Tcl_JoinThread (Tcl_ThreadId threadId, int* result)

Definition at line 206 of file tclWinThrd.c.211 {
212     return TclJoinThread (threadId, result);
213 }
void TclFinalizeLock ()

Definition at line 441 of file tclWinThrd.c.
References init, initLock, joinLock, MASTER_LOCK, and masterLock.442 {
443     MASTER_LOCK;
444     DeleteCriticalSection(&joinLock);
445     /* Destroy the critical section that we are holding! */
446     DeleteCriticalSection(&masterLock);
447     init = 0;
448 #ifdef TCL_THREADS
449     DeleteCriticalSection(&allocLock);
450     allocOnce = 0;
451 #endif
452     /* Destroy the critical section that we are holding! */
453     DeleteCriticalSection(&initLock);
454 }
void TclpInitLock ()

Definition at line 288 of file tclWinThrd.c.
References init, initLock, joinLock, and masterLock.289 {
290     if (!init) {
291   /*
292    * There is a fundamental race here that is solved by creating
293    * the first Tcl interpreter in a single threaded environment.
294    * Once the interpreter has been created, it is safe to create
295    * more threads that create interpreters in parallel.
296    */
297   init = 1;
298   InitializeCriticalSection(&joinLock);
299   InitializeCriticalSection(&initLock);
300   InitializeCriticalSection(&masterLock);
301     }
302     EnterCriticalSection(&initLock);
303 }
void TclpInitUnlock ()

Definition at line 323 of file tclWinThrd.c.
References initLock.324 {
325     LeaveCriticalSection(&initLock);
326 }
void TclpMasterLock ()

Definition at line 349 of file tclWinThrd.c.
References init, initLock, joinLock, and masterLock.350 {
351     if (!init) {
352   /*
353    * There is a fundamental race here that is solved by creating
354    * the first Tcl interpreter in a single threaded environment.
355    * Once the interpreter has been created, it is safe to create
356    * more threads that create interpreters in parallel.
357    */
358   init = 1;
359   InitializeCriticalSection(&joinLock);
360   InitializeCriticalSection(&initLock);
361   InitializeCriticalSection(&masterLock);
362     }
363     EnterCriticalSection(&masterLock);
364 }
void TclpMasterUnlock ()

Definition at line 384 of file tclWinThrd.c.
References masterLock.385 {
386     LeaveCriticalSection(&masterLock);
387 }
int TclpThreadCreate (Tcl_ThreadId * idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags)

Definition at line 148 of file tclWinThrd.c.
References DWORD(), joinLock, NULL, TCL_ERROR, TCL_OK, and TCL_THREAD_JOINABLE.155 {
156     HANDLE tHandle;
157 
158     EnterCriticalSection(&joinLock);
159 
160 #if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
161     tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize, proc,
162   clientData, 0, (unsigned *)idPtr);
163 #else
164     tHandle = CreateThread(NULL, (DWORD) stackSize,
165       (LPTHREAD_START_ROUTINE) proc, (LPVOID) clientData,
166       (DWORD) 0, (LPDWORD)idPtr);
167 #endif
168 
169     if (tHandle == NULL) {
170         LeaveCriticalSection(&joinLock);
171   return TCL_ERROR;
172     } else {
173         if (flags & TCL_THREAD_JOINABLE) {
174       TclRememberJoinableThread (*idPtr);
175   }
176 
177   /*
178    * The only purpose of this is to decrement the reference count so the
179    * OS resources will be reaquired when the thread closes.
180    */
181 
182   CloseHandle(tHandle);
183   LeaveCriticalSection(&joinLock);
184   return TCL_OK;
185     }
186 }
void TclpThreadExit (int status)

Definition at line 232 of file tclWinThrd.c.
References DWORD(), joinLock, and Tcl_GetCurrentThread().234 {
235     EnterCriticalSection(&joinLock);
236     TclSignalExitThread (Tcl_GetCurrentThread (), status);
237     LeaveCriticalSection(&joinLock);
238 
239 #if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
240     _endthreadex((unsigned) status);
241 #else
242     ExitThread((DWORD) status);
243 #endif
244 }

Variable Documentation
int init = 0 [static]

Definition at line 27 of file tclWinThrd.c.
Referenced by LoadEscapeEncoding(), parse(), TclFinalizeLock(), TclpInitLock(), and TclpMasterLock().CRITICAL_SECTION initLock [static]

Definition at line 37 of file tclWinThrd.c.
Referenced by TclFinalizeLock(), TclpInitLock(), TclpInitUnlock(), and TclpMasterLock().CRITICAL_SECTION joinLock [static]

Definition at line 59 of file tclWinThrd.c.
Referenced by TclFinalizeLock(), TclpInitLock(), TclpMasterLock(), TclpThreadCreate(), and TclpThreadExit().CRITICAL_SECTION masterLock [static]

Definition at line 26 of file tclWinThrd.c.
Referenced by TclFinalizeLock(), TclpInitLock(), TclpMasterLock(), and TclpMasterUnlock().

win/tclWinThrd.h File Reference

win/tclWinTime.c File Reference
#include "tclWinInt.h"
Classes
struct ThreadSpecificData
struct TimeInfo
Defines
#define SECSPERDAY  (60L * 60L * 24L)
#define SECSPERYEAR  (SECSPERDAY * 365L)
#define SECSPER4YEAR  (SECSPERYEAR * 4L + SECSPERDAY)
#define SAMPLES  64
Functions
static struct tm *ComputeGMT _ANSI_ARGS_ ((const time_t *tp))
static void StopCalibration _ANSI_ARGS_ ((ClientData))
static DWORD WINAPI CalibrationThread _ANSI_ARGS_ ((LPVOID arg))
static void UpdateTimeEachSecond _ANSI_ARGS_ ((void))
static void ResetCounterSamples _ANSI_ARGS_ ((Tcl_WideUInt fileTime, Tcl_WideInt perfCounter, Tcl_WideInt perfFreq))
static Tcl_WideInt AccumulateSample _ANSI_ARGS_ ((Tcl_WideInt perfCounter, Tcl_WideUInt fileTime))
unsigned long TclpGetSeconds ()
unsigned long TclpGetClicks ()
int TclpGetTimeZone (Tcl_WideInt currentTime)
void Tcl_GetTime (Tcl_Time *timePtr)
static void StopCalibration (ClientData unused)
char * TclpGetTZName (int dst)
tm * TclpGetDate (TclpTime_t t, int useGMT)
static struct tm * ComputeGMT (time_t *tp) const
static DWORD WINAPI CalibrationThread (LPVOID arg)
static void UpdateTimeEachSecond ()
static void ResetCounterSamples (Tcl_WideUInt fileTime, Tcl_WideInt perfCounter, Tcl_WideInt perfFreq)
static Tcl_WideInt AccumulateSample (Tcl_WideInt perfCounter, Tcl_WideUInt fileTime)
tm * TclpGmtime (CONST TclpTime_t tt)
tm * TclpLocaltime (CONST TclpTime_t tt)
Variables
static int normalDays []
static int leapDays []
static Tcl_ThreadDataKey dataKey
static TimeInfo timeInfo
static CONST FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE }

Define Documentation
#define SAMPLES  64

Definition at line 24 of file tclWinTime.c.
Referenced by AccumulateSample(), and ResetCounterSamples().#define SECSPER4YEAR  (SECSPERYEAR * 4L + SECSPERDAY)

Definition at line 19 of file tclWinTime.c.
Referenced by ComputeGMT().#define SECSPERDAY  (60L * 60L * 24L)

Definition at line 17 of file tclWinTime.c.#define SECSPERYEAR  (SECSPERDAY * 365L)

Definition at line 18 of file tclWinTime.c.
Referenced by ComputeGMT().
Function Documentation
static Tcl_WideInt AccumulateSample _ANSI_ARGS_ ((Tcl_WideInt perfCounter, Tcl_WideUInt fileTime)) [static]
static void ResetCounterSamples _ANSI_ARGS_ ((Tcl_WideUInt fileTime, Tcl_WideInt perfCounter, Tcl_WideInt perfFreq)) [static]
static void UpdateTimeEachSecond _ANSI_ARGS_ ((void)) [static]
static DWORD WINAPI CalibrationThread _ANSI_ARGS_ ((LPVOID arg)) [static]
static void StopCalibration _ANSI_ARGS_ ((ClientData)) [static]
static struct tm* ComputeGMT _ANSI_ARGS_ ((const time_t *tp)) [static]
static Tcl_WideInt AccumulateSample (Tcl_WideInt perfCounter, Tcl_WideUInt fileTime) [static]

Definition at line 1022 of file tclWinTime.c.
References TimeInfo::fileTimeSample, TimeInfo::nominalFreq, TimeInfo::perfCounterSample, ResetCounterSamples(), TimeInfo::sampleNo, SAMPLES, and timeInfo.
Referenced by UpdateTimeEachSecond().1024 {
1025     Tcl_WideUInt workFTSample;  /* File time sample being removed
1026          * from or added to the circular buffer */
1027 
1028     Tcl_WideInt workPCSample; /* Performance counter sample being
1029          * removed from or added to the circular 
1030          * buffer */
1031 
1032     Tcl_WideUInt lastFTSample;  /* Last file time sample recorded */
1033 
1034     Tcl_WideInt lastPCSample; /* Last performance counter sample recorded */
1035 
1036     Tcl_WideInt FTdiff;   /* Difference between last FT and current */
1037 
1038     Tcl_WideInt PCdiff;   /* Difference between last PC and current */
1039 
1040     Tcl_WideInt estFreq;  /* Estimated performance counter frequency */
1041 
1042     /* Test for jumps and reset the samples if we have one. */
1043 
1044     if ( timeInfo.sampleNo == 0 ) {
1045   lastPCSample = timeInfo.perfCounterSample[ timeInfo.sampleNo
1046                + SAMPLES - 1 ];
1047   lastFTSample = timeInfo.fileTimeSample[ timeInfo.sampleNo
1048             + SAMPLES - 1 ];
1049     } else {
1050   lastPCSample = timeInfo.perfCounterSample[ timeInfo.sampleNo - 1 ];
1051   lastFTSample = timeInfo.fileTimeSample[ timeInfo.sampleNo - 1 ];
1052     }
1053     PCdiff = perfCounter - lastPCSample;
1054     FTdiff = fileTime - lastFTSample;
1055     if ( PCdiff < timeInfo.nominalFreq.QuadPart * 9 / 10
1056    || PCdiff > timeInfo.nominalFreq.QuadPart * 11 / 10
1057    || FTdiff < 9000000
1058    || FTdiff > 11000000 ) {
1059   ResetCounterSamples( fileTime, perfCounter,
1060            timeInfo.nominalFreq.QuadPart );
1061   return timeInfo.nominalFreq.QuadPart;
1062 
1063     } else {
1064     
1065   /* Estimate the frequency */
1066   
1067   workPCSample = timeInfo.perfCounterSample[ timeInfo.sampleNo ];
1068   workFTSample = timeInfo.fileTimeSample[ timeInfo.sampleNo ];
1069   estFreq = 10000000 * ( perfCounter - workPCSample )
1070       / ( fileTime - workFTSample );
1071   timeInfo.perfCounterSample[ timeInfo.sampleNo ] = perfCounter;
1072   timeInfo.fileTimeSample[ timeInfo.sampleNo ] = (Tcl_WideInt) fileTime;
1073   
1074   /* Advance the sample number */
1075   
1076   if ( ++timeInfo.sampleNo >= SAMPLES ) {
1077       timeInfo.sampleNo = 0;
1078   } 
1079   
1080   return estFreq;
1081     }
1082 }
static DWORD WINAPI CalibrationThread (LPVOID arg) [static]

Definition at line 788 of file tclWinTime.c.
References TimeInfo::curCounterFreq, DWORD(), TimeInfo::exitEvent, FALSE, TimeInfo::fileTimeLastCall, TimeInfo::perfCounterLastCall, TimeInfo::readyEvent, ResetCounterSamples(), timeInfo, and UpdateTimeEachSecond().
Referenced by Tcl_GetTime().789 {
790     FILETIME curFileTime;
791     DWORD waitResult;
792 
793     /* Get initial system time and performance counter */
794 
795     GetSystemTimeAsFileTime( &curFileTime );
796     QueryPerformanceCounter( &timeInfo.perfCounterLastCall );
797     QueryPerformanceFrequency( &timeInfo.curCounterFreq );
798     timeInfo.fileTimeLastCall.LowPart = curFileTime.dwLowDateTime;
799     timeInfo.fileTimeLastCall.HighPart = curFileTime.dwHighDateTime;
800 
801     ResetCounterSamples( timeInfo.fileTimeLastCall.QuadPart,
802        timeInfo.perfCounterLastCall.QuadPart,
803        timeInfo.curCounterFreq.QuadPart );
804 
805     /*
806      * Wake up the calling thread.  When it wakes up, it will release the
807      * initialization lock.
808      */
809 
810     SetEvent( timeInfo.readyEvent );
811 
812     /* Run the calibration once a second */
813 
814     for ( ; ; ) {
815 
816   /* If the exitEvent is set, break out of the loop. */
817 
818   waitResult = WaitForSingleObjectEx(timeInfo.exitEvent, 1000, FALSE);
819   if ( waitResult == WAIT_OBJECT_0 ) {
820       break;
821   }
822   UpdateTimeEachSecond();
823     }
824 
825     /* lint */
826     return (DWORD) 0;
827 }
static struct tm* ComputeGMT (time_t * tp) const [static]

Definition at line 667 of file tclWinTime.c.
References dataKey, leapDays, normalDays, SECSPER4YEAR, SECSPERDAY, SECSPERYEAR, TCL_TSD_INIT, and ThreadSpecificData::tm.
Referenced by TclpGetDate().669 {
670     struct tm *tmPtr;
671     long tmp, rem;
672     int isLeap;
673     int *days;
674     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
675 
676     tmPtr = &tsdPtr->tm;
677 
678     /*
679      * Compute the 4 year span containing the specified time.
680      */
681 
682     tmp = (long)(*tp / SECSPER4YEAR);
683     rem = (LONG)(*tp % SECSPER4YEAR);
684 
685     /*
686      * Correct for weird mod semantics so the remainder is always positive.
687      */
688 
689     if (rem < 0) {
690   tmp--;
691   rem += SECSPER4YEAR;
692     }
693 
694     /*
695      * Compute the year after 1900 by taking the 4 year span and adjusting
696      * for the remainder.  This works because 2000 is a leap year, and
697      * 1900/2100 are out of the range.
698      */
699 
700     tmp = (tmp * 4) + 70;
701     isLeap = 0;
702     if (rem >= SECSPERYEAR) {       /* 1971, etc. */
703   tmp++;
704   rem -= SECSPERYEAR;
705   if (rem >= SECSPERYEAR) {     /* 1972, etc. */
706       tmp++;
707       rem -= SECSPERYEAR;
708       if (rem >= SECSPERYEAR + SECSPERDAY) { /* 1973, etc. */
709     tmp++;
710     rem -= SECSPERYEAR + SECSPERDAY;
711       } else {
712     isLeap = 1;
713       }
714   }
715     }
716     tmPtr->tm_year = tmp;
717 
718     /*
719      * Compute the day of year and leave the seconds in the current day in
720      * the remainder.
721      */
722 
723     tmPtr->tm_yday = rem / SECSPERDAY;
724     rem %= SECSPERDAY;
725     
726     /*
727      * Compute the time of day.
728      */
729 
730     tmPtr->tm_hour = rem / 3600;
731     rem %= 3600;
732     tmPtr->tm_min = rem / 60;
733     tmPtr->tm_sec = rem % 60;
734 
735     /*
736      * Compute the month and day of month.
737      */
738 
739     days = (isLeap) ? leapDays : normalDays;
740     for (tmp = 1; days[tmp] < tmPtr->tm_yday; tmp++) {
741     }
742     tmPtr->tm_mon = --tmp;
743     tmPtr->tm_mday = tmPtr->tm_yday - days[tmp];
744 
745     /*
746      * Compute day of week.  Epoch started on a Thursday.
747      */
748 
749     tmPtr->tm_wday = (long)(*tp / SECSPERDAY) + 4;
750     if ((*tp % SECSPERDAY) < 0) {
751   tmPtr->tm_wday--;
752     }
753     tmPtr->tm_wday %= 7;
754     if (tmPtr->tm_wday < 0) {
755   tmPtr->tm_wday += 7;
756     }
757 
758     return tmPtr;
759 }
static void ResetCounterSamples (Tcl_WideUInt fileTime, Tcl_WideInt perfCounter, Tcl_WideInt perfFreq) [static]

Definition at line 977 of file tclWinTime.c.
References TimeInfo::fileTimeSample, TimeInfo::perfCounterSample, TimeInfo::sampleNo, SAMPLES, and timeInfo.
Referenced by AccumulateSample(), and CalibrationThread().983 {
984     int i;
985     for ( i = SAMPLES-1; i >= 0; --i ) {
986   timeInfo.perfCounterSample[i] = perfCounter;
987   timeInfo.fileTimeSample[i] = fileTime;
988   perfCounter -= perfFreq;
989   fileTime -= 10000000;
990     }
991     timeInfo.sampleNo = 0;
992 }
static void StopCalibration (ClientData unused) [static]

Definition at line 461 of file tclWinTime.c.
References TimeInfo::calibrationThread, TimeInfo::exitEvent, and timeInfo.
Referenced by Tcl_GetTime().463 {
464     SetEvent( timeInfo.exitEvent );
465     WaitForSingleObject( timeInfo.calibrationThread, INFINITE );
466     CloseHandle( timeInfo.exitEvent );
467     CloseHandle( timeInfo.calibrationThread );
468 }
void Tcl_GetTime (Tcl_Time * timePtr)

Definition at line 260 of file tclWinTime.c.
References CalibrationThread(), TimeInfo::calibrationThread, TimeInfo::cs, TimeInfo::curCounterFreq, DWORD(), TimeInfo::exitEvent, FALSE, TimeInfo::fileTimeLastCall, TimeInfo::initialized, TimeInfo::nominalFreq, NULL, TimeInfo::perfCounterAvailable, TimeInfo::perfCounterLastCall, TimeInfo::readyEvent, StopCalibration(), Tcl_CreateExitHandler(), TCL_OK, TclpInitLock(), TclpInitUnlock(), TclWinCPUID(), timeInfo, and TRUE.262 {
263     struct timeb t;
264 
265     int useFtime = 1;   /* Flag == TRUE if we need to fall back
266          * on ftime rather than using the perf
267          * counter */
268 
269     /* Initialize static storage on the first trip through. */
270 
271     /*
272      * Note: Outer check for 'initialized' is a performance win
273      * since it avoids an extra mutex lock in the common case.
274      */
275 
276     if ( !timeInfo.initialized ) { 
277   TclpInitLock();
278   if ( !timeInfo.initialized ) {
279       timeInfo.perfCounterAvailable
280     = QueryPerformanceFrequency( &timeInfo.nominalFreq );
281 
282       /*
283        * Some hardware abstraction layers use the CPU clock
284        * in place of the real-time clock as a performance counter
285        * reference.  This results in:
286        *    - inconsistent results among the processors on
287        *      multi-processor systems.
288        *    - unpredictable changes in performance counter frequency
289        *      on "gearshift" processors such as Transmeta and
290        *      SpeedStep.
291        *
292        * There seems to be no way to test whether the performance
293        * counter is reliable, but a useful heuristic is that
294        * if its frequency is 1.193182 MHz or 3.579545 MHz, it's
295        * derived from a colorburst crystal and is therefore
296        * the RTC rather than the TSC.
297        *
298        * A sloppier but serviceable heuristic is that the RTC crystal
299        * is normally less than 15 MHz while the TSC crystal is
300        * virtually assured to be greater than 100 MHz.  Since Win98SE
301        * appears to fiddle with the definition of the perf counter
302        * frequency (perhaps in an attempt to calibrate the clock?)
303        * we use the latter rule rather than an exact match.
304        */
305 
306       if ( timeInfo.perfCounterAvailable
307      /* The following lines would do an exact match on
308       * crystal frequency:
309       * && timeInfo.nominalFreq.QuadPart != (Tcl_WideInt) 1193182
310       * && timeInfo.nominalFreq.QuadPart != (Tcl_WideInt) 3579545
311       */
312      && timeInfo.nominalFreq.QuadPart > (Tcl_WideInt) 15000000 ) {
313 
314     /*
315      * As an exception, if every logical processor on the system
316      * is on the same chip, we use the performance counter anyway,
317      * presuming that everyone's TSC is locked to the same
318      * oscillator.
319      */
320 
321     SYSTEM_INFO systemInfo;
322     unsigned int regs[4];
323     GetSystemInfo( &systemInfo );
324     if ( TclWinCPUID( 0, regs ) == TCL_OK
325 
326          && regs[1] == 0x756e6547 /* "Genu" */
327          && regs[3] == 0x49656e69 /* "ineI" */
328          && regs[2] == 0x6c65746e /* "ntel" */
329 
330          && TclWinCPUID( 1, regs ) == TCL_OK 
331 
332          && ( (regs[0] & 0x00000F00) == 0x00000F00 /* Pentium 4 */
333         || ( (regs[0] & 0x00F00000)    /* Extended family */
334              && (regs[3] & 0x10000000) ) ) /* Hyperthread */
335          && ( ( ( regs[1] & 0x00FF0000 ) >> 16 ) /* CPU count */
336         == systemInfo.dwNumberOfProcessors ) 
337 
338         ) {
339         timeInfo.perfCounterAvailable = TRUE;
340     } else {
341     timeInfo.perfCounterAvailable = FALSE;
342       }
343 
344       }
345 
346       /*
347        * If the performance counter is available, start a thread to
348        * calibrate it.
349        */
350 
351       if ( timeInfo.perfCounterAvailable ) {
352     DWORD id;
353     InitializeCriticalSection( &timeInfo.cs );
354     timeInfo.readyEvent = CreateEvent( NULL, FALSE, FALSE, NULL );
355     timeInfo.exitEvent = CreateEvent( NULL, FALSE, FALSE, NULL );
356     timeInfo.calibrationThread = CreateThread( NULL,
357                  256,
358                  CalibrationThread,
359                  (LPVOID) NULL,
360                  0,
361                  &id );
362     SetThreadPriority( timeInfo.calibrationThread,
363            THREAD_PRIORITY_HIGHEST );
364 
365     /*
366      * Wait for the thread just launched to start running,
367      * and create an exit handler that kills it so that it
368      * doesn't outlive unloading tclXX.dll
369      */
370 
371     WaitForSingleObject( timeInfo.readyEvent, INFINITE );
372     CloseHandle( timeInfo.readyEvent );
373     Tcl_CreateExitHandler( StopCalibration, (ClientData) NULL );
374       }
375       timeInfo.initialized = TRUE;
376   }
377   TclpInitUnlock();
378     }
379 
380     if ( timeInfo.perfCounterAvailable ) {
381   /*
382    * Query the performance counter and use it to calculate the
383    * current time.
384    */
385 
386   LARGE_INTEGER curCounter;
387         /* Current performance counter */
388 
389   Tcl_WideInt curFileTime;
390         /* Current estimated time, expressed
391          * as 100-ns ticks since the Windows epoch */
392 
393   static LARGE_INTEGER posixEpoch;
394         /* Posix epoch expressed as 100-ns ticks
395          * since the windows epoch */
396 
397   Tcl_WideInt usecSincePosixEpoch;
398         /* Current microseconds since Posix epoch */
399 
400   posixEpoch.LowPart = 0xD53E8000;
401   posixEpoch.HighPart = 0x019DB1DE;
402 
403   EnterCriticalSection( &timeInfo.cs );
404 
405   QueryPerformanceCounter( &curCounter );
406 
407   /* 
408    * If it appears to be more than 1.1 seconds since the last trip
409    * through the calibration loop, the performance counter may
410    * have jumped forward. (See MSDN Knowledge Base article
411    * Q274323 for a description of the hardware problem that makes
412    * this test necessary.) If the counter jumps, we don't want
413    * to use it directly. Instead, we must return system time.
414    * Eventually, the calibration loop should recover.
415    */
416   if ( curCounter.QuadPart - timeInfo.perfCounterLastCall.QuadPart
417        < 11 * timeInfo.curCounterFreq.QuadPart / 10 ) {
418 
419       curFileTime = timeInfo.fileTimeLastCall.QuadPart
420     + ( ( curCounter.QuadPart - timeInfo.perfCounterLastCall.QuadPart )
421         * 10000000 / timeInfo.curCounterFreq.QuadPart );
422       timeInfo.fileTimeLastCall.QuadPart = curFileTime;
423       timeInfo.perfCounterLastCall.QuadPart = curCounter.QuadPart;
424       usecSincePosixEpoch = ( curFileTime - posixEpoch.QuadPart ) / 10;
425       timePtr->sec = (long) ( usecSincePosixEpoch / 1000000 );
426       timePtr->usec = (unsigned long ) ( usecSincePosixEpoch % 1000000 );
427       useFtime = 0;
428   }
429 
430   LeaveCriticalSection( &timeInfo.cs );
431     }
432 
433     if ( useFtime ) {
434   /* High resolution timer is not available.  Just use ftime */
435 
436   ftime(&t);
437   timePtr->sec = (long)t.time;
438   timePtr->usec = t.millitm * 1000;
439     }
440 }
unsigned long TclpGetClicks ()

Definition at line 190 of file tclWinTime.c.
References Tcl_Time::sec, Tcl_GetTime(), and Tcl_Time::usec.191 {
192     /*
193      * Use the Tcl_GetTime abstraction to get the time in microseconds,
194      * as nearly as we can, and return it.
195      */
196 
197     Tcl_Time now;   /* Current Tcl time */
198     unsigned long retval; /* Value to return */
199 
200     Tcl_GetTime( &now );
201     retval = ( now.sec * 1000000 ) + now.usec;
202     return retval;
203 
204 }
struct tm* TclpGetDate (TclpTime_t t, int useGMT)

Definition at line 575 of file tclWinTime.c.
References ComputeGMT(), LONG_MAX, LONG_MIN, SECSPERDAY, and tzset.578 {
579     const time_t *tp = (const time_t *) t;
580     struct tm *tmPtr;
581     time_t time;
582 
583     if (!useGMT) {
584   tzset();
585 
586   /*
587    * If we are in the valid range, let the C run-time library
588    * handle it.  Otherwise we need to fake it.  Note that this
589    * algorithm ignores daylight savings time before the epoch.
590    */
591 
592   if (*tp >= 0) {
593       return localtime(tp);
594   }
595 
596   time = *tp - _timezone;
597 
598   /*
599    * If we aren't near to overflowing the long, just add the bias and
600    * use the normal calculation.  Otherwise we will need to adjust
601    * the result at the end.
602    */
603 
604   if (*tp < (LONG_MAX - 2 * SECSPERDAY)
605     && *tp > (LONG_MIN + 2 * SECSPERDAY)) {
606       tmPtr = ComputeGMT(&time);
607   } else {
608       tmPtr = ComputeGMT(tp);
609 
610       tzset();
611 
612       /*
613        * Add the bias directly to the tm structure to avoid overflow.
614        * Propagate seconds overflow into minutes, hours and days.
615        */
616 
617       time = tmPtr->tm_sec - _timezone;
618       tmPtr->tm_sec = (int)(time % 60);
619       if (tmPtr->tm_sec < 0) {
620     tmPtr->tm_sec += 60;
621     time -= 60;
622       }
623 
624       time = tmPtr->tm_min + time/60;
625       tmPtr->tm_min = (int)(time % 60);
626       if (tmPtr->tm_min < 0) {
627     tmPtr->tm_min += 60;
628     time -= 60;
629       }
630 
631       time = tmPtr->tm_hour + time/60;
632       tmPtr->tm_hour = (int)(time % 24);
633       if (tmPtr->tm_hour < 0) {
634     tmPtr->tm_hour += 24;
635     time -= 24;
636       }
637 
638       time /= 24;
639       tmPtr->tm_mday += (int)time;
640       tmPtr->tm_yday += (int)time;
641       tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7;
642   }
643     } else {
644   tmPtr = ComputeGMT(tp);
645     }
646     return tmPtr;
647 }
unsigned long TclpGetSeconds ()

Definition at line 162 of file tclWinTime.c.
References Tcl_Time::sec, and Tcl_GetTime().163 {
164     Tcl_Time t;
165     Tcl_GetTime( &t );
166     return t.sec;
167 }
int TclpGetTimeZone (Tcl_WideInt currentTime)

Definition at line 225 of file tclWinTime.c.
References tzset.227 {
228     int timeZone;
229 
230     tzset();
231     timeZone = _timezone / 60;
232 
233     return timeZone;
234 }
char* TclpGetTZName (int dst)

Definition at line 487 of file tclWinTime.c.
References dataKey, NULL, size_t(), Tcl_ExternalToUtf(), Tcl_FreeEncoding(), Tcl_GetEncoding(), TCL_TSD_INIT, and ThreadSpecificData::tzName.488 {
489     size_t len;
490     char *zone, *p;
491     TIME_ZONE_INFORMATION tz;
492     Tcl_Encoding encoding;
493     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
494     char *name = tsdPtr->tzName;
495 
496     /*
497      * tzset() under Borland doesn't seem to set up tzname[] at all.
498      * tzset() under MSVC has the following weird observed behavior:
499      *   First time we call "clock format [clock seconds] -format %Z -gmt 1"
500      *   we get "GMT", but on all subsequent calls we get the current time 
501      *   zone string, even though env(TZ) is GMT and the variable _timezone 
502      *   is 0.
503      */
504 
505     name[0] = '\0';
506 
507     zone = getenv("TZ");
508     if (zone != NULL) {
509   /*
510    * TZ is of form "NST-4:30NDT", where "NST" would be the
511    * name of the standard time zone for this area, "-4:30" is
512    * the offset from GMT in hours, and "NDT is the name of 
513    * the daylight savings time zone in this area.  The offset 
514    * and DST strings are optional.
515    */
516 
517   len = strlen(zone);
518   if (len > 3) {
519       len = 3;
520   }
521   if (dst != 0) {
522       /*
523        * Skip the offset string and get the DST string.
524        */
525 
526       p = zone + len;
527       p += strspn(p, "+-:0123456789");
528       if (*p != '\0') {
529     zone = p;
530     len = strlen(zone);
531     if (len > 3) {
532         len = 3;
533     }
534       }
535   }
536   Tcl_ExternalToUtf(NULL, NULL, zone, (int)len, 0, NULL, name,
537     sizeof(tsdPtr->tzName), NULL, NULL, NULL);
538     }
539     if (name[0] == '\0') {
540   if (GetTimeZoneInformation(&tz) == TIME_ZONE_ID_UNKNOWN) {
541       /*
542        * MSDN: On NT this is returned if DST is not used in
543        * the current TZ
544        */
545       dst = 0;
546   }
547   encoding = Tcl_GetEncoding(NULL, "unicode");
548   Tcl_ExternalToUtf(NULL, encoding, 
549     (char *) ((dst) ? tz.DaylightName : tz.StandardName), -1, 
550     0, NULL, name, sizeof(tsdPtr->tzName), NULL, NULL, NULL);
551   Tcl_FreeEncoding(encoding);
552     } 
553     return name;
554 }
struct tm* TclpGmtime (CONST TclpTime_t tt)

Definition at line 1102 of file tclWinTime.c.
References CONST.1104 {
1105     CONST time_t *timePtr = (CONST time_t *) tt;
1106         /* Pointer to the number of seconds
1107          * since the local system's epoch */
1108     /*
1109      * The MS implementation of gmtime is thread safe because
1110      * it returns the time in a block of thread-local storage,
1111      * and Windows does not provide a Posix gmtime_r function.
1112      */
1113     return gmtime( timePtr );
1114 }
struct tm* TclpLocaltime (CONST TclpTime_t tt)

Definition at line 1134 of file tclWinTime.c.
References CONST.1136 {
1137     CONST time_t *timePtr = (CONST time_t *) tt;
1138         /* Pointer to the number of seconds
1139          * since the local system's epoch */
1140 
1141     /*
1142      * The MS implementation of localtime is thread safe because
1143      * it returns the time in a block of thread-local storage,
1144      * and Windows does not provide a Posix localtime_r function.
1145      */
1146     return localtime( timePtr );
1147 }
static void UpdateTimeEachSecond () [static]

Definition at line 850 of file tclWinTime.c.
References AccumulateSample(), TimeInfo::cs, TimeInfo::curCounterFreq, TimeInfo::fileTimeLastCall, TimeInfo::perfCounterLastCall, and timeInfo.
Referenced by CalibrationThread().851 {
852 
853     LARGE_INTEGER curPerfCounter;
854         /* Current value returned from
855          * QueryPerformanceCounter */
856 
857     FILETIME curSysTime;  /* Current system time */
858 
859     LARGE_INTEGER curFileTime;  /* File time at the time this callback
860          * was scheduled. */
861 
862     Tcl_WideInt estFreq;  /* Estimated perf counter frequency */
863 
864     Tcl_WideInt vt0;    /* Tcl time right now */
865     Tcl_WideInt vt1;    /* Tcl time one second from now */
866 
867     Tcl_WideInt tdiff;    /* Difference between system clock and
868          * Tcl time. */
869 
870     Tcl_WideInt driftFreq;  /* Frequency needed to drift virtual time
871          * into step over 1 second */
872 
873     /*
874      * Sample performance counter and system time.
875      */
876 
877     QueryPerformanceCounter( &curPerfCounter );
878     GetSystemTimeAsFileTime( &curSysTime );
879     curFileTime.LowPart = curSysTime.dwLowDateTime;
880     curFileTime.HighPart = curSysTime.dwHighDateTime;
881 
882     EnterCriticalSection( &timeInfo.cs );
883 
884     /*
885      * Several things may have gone wrong here that have to
886      * be checked for.
887      * (1) The performance counter may have jumped.
888      * (2) The system clock may have been reset.
889      *
890      * In either case, we'll need to reinitialize the circular buffer
891      * with samples relative to the current system time and the NOMINAL
892      * performance frequency (not the actual, because the actual has
893      * probably run slow in the first case). Our estimated frequency
894      * will be the nominal frequency.
895      */
896 
897     /*
898      * Store the current sample into the circular buffer of samples,
899      * and estimate the performance counter frequency.
900      */
901 
902     estFreq = AccumulateSample( curPerfCounter.QuadPart,
903         (Tcl_WideUInt) curFileTime.QuadPart );
904 
905     /*
906      * We want to adjust things so that time appears to be continuous.
907      * Virtual file time, right now, is 
908      *
909      * vt0 = 10000000 * ( curPerfCounter - perfCounterLastCall )
910      *       / curCounterFreq
911      *       + fileTimeLastCall
912      *
913      * Ideally, we would like to drift the clock into place over a
914      * period of 2 sec, so that virtual time 2 sec from now will be
915      *
916      * vt1 = 20000000 + curFileTime
917      * 
918      * The frequency that we need to use to drift the counter back into
919      * place is estFreq * 20000000 / ( vt1 - vt0 )
920      */
921     
922     vt0 = 10000000 * ( curPerfCounter.QuadPart
923            - timeInfo.perfCounterLastCall.QuadPart )
924   / timeInfo.curCounterFreq.QuadPart
925   + timeInfo.fileTimeLastCall.QuadPart;
926     vt1 = 20000000 + curFileTime.QuadPart;
927 
928     /*
929      * If we've gotten more than a second away from system time,
930      * then drifting the clock is going to be pretty hopeless.
931      * Just let it jump. Otherwise, compute the drift frequency and
932      * fill in everything.
933      */
934 
935     tdiff = vt0 - curFileTime.QuadPart;
936     if ( tdiff > 10000000 || tdiff < -10000000 ) {
937   timeInfo.fileTimeLastCall.QuadPart = curFileTime.QuadPart;
938   timeInfo.curCounterFreq.QuadPart = estFreq;
939     } else {
940   driftFreq = estFreq * 20000000 / ( vt1 - vt0 );
941   if ( driftFreq > 1003 * estFreq / 1000 ) {
942       driftFreq = 1003 * estFreq / 1000;
943   }
944   if ( driftFreq < 997 * estFreq / 1000 ) {
945       driftFreq = 997 * estFreq / 1000;
946   }
947   timeInfo.fileTimeLastCall.QuadPart = vt0;
948   timeInfo.curCounterFreq.QuadPart = driftFreq;
949     }
950 
951     timeInfo.perfCounterLastCall.QuadPart = curPerfCounter.QuadPart;
952 
953     LeaveCriticalSection( &timeInfo.cs );
954 
955 }

Variable Documentation
Tcl_ThreadDataKey dataKey [static]

Definition at line 43 of file tclWinTime.c.int leapDays[] [static]
Initial value: {
    -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365
}
Definition at line 35 of file tclWinTime.c.
Referenced by ComputeGMT().int normalDays[] [static]
Initial value: {
    -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364
}
Definition at line 31 of file tclWinTime.c.
Referenced by ComputeGMT().CONST FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE } [static]

Definition at line 124 of file tclWinTime.c.
Referenced by TestwinclockCmd().TimeInfo timeInfo [static]
Initial value: {
    { NULL },
    0,
    0,
    (HANDLE) NULL,
    (HANDLE) NULL,
    (HANDLE) NULL,

    0,
    0,
    0,
    0,

    { 0 },
    { 0 },
    0
}
Definition at line 101 of file tclWinTime.c.
Referenced by AccumulateSample(), CalibrationThread(), ResetCounterSamples(), StopCalibration(), Tcl_GetTime(), and UpdateTimeEachSecond().
Index
INDEX